when compiling, use make-lexical to residualize original var names
[bpt/guile.git] / module / ice-9 / psyntax-pp.scm
dissimilarity index 82%
index 31066c3..8b41c5e 100644 (file)
@@ -1,13 +1,13 @@
-(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
-(void)
-(letrec ((lambda-var-list1132 (lambda (vars1337) (let lvl1338 ((vars1339 vars1337) (ls1340 (quote ())) (w1341 (quote (())))) (cond ((pair? vars1339) (lvl1338 (cdr vars1339) (cons (wrap1111 (car vars1339) w1341 #f) ls1340) w1341)) ((id?1083 vars1339) (cons (wrap1111 vars1339 w1341 #f) ls1340)) ((null? vars1339) ls1340) ((syntax-object?1067 vars1339) (lvl1338 (syntax-object-expression1068 vars1339) ls1340 (join-wraps1102 w1341 (syntax-object-wrap1069 vars1339)))) ((annotation? vars1339) (lvl1338 (annotation-expression vars1339) ls1340 w1341)) (else (cons vars1339 ls1340)))))) (gen-var1131 (lambda (id1342) (let ((id1343 (if (syntax-object?1067 id1342) (syntax-object-expression1068 id1342) id1342))) (if (annotation? id1343) (build-annotated1060 (annotation-source id1343) (gensym (symbol->string (annotation-expression id1343)))) (build-annotated1060 #f (gensym (symbol->string id1343))))))) (strip1130 (lambda (x1344 w1345) (if (memq (quote top) (wrap-marks1086 w1345)) (if (or (annotation? x1344) (and (pair? x1344) (annotation? (car x1344)))) (strip-annotation1129 x1344 #f) x1344) (let f1346 ((x1347 x1344)) (cond ((syntax-object?1067 x1347) (strip1130 (syntax-object-expression1068 x1347) (syntax-object-wrap1069 x1347))) ((pair? x1347) (let ((a1348 (f1346 (car x1347))) (d1349 (f1346 (cdr x1347)))) (if (and (eq? a1348 (car x1347)) (eq? d1349 (cdr x1347))) x1347 (cons a1348 d1349)))) ((vector? x1347) (let ((old1350 (vector->list x1347))) (let ((new1351 (map f1346 old1350))) (if (andmap eq? old1350 new1351) x1347 (list->vector new1351))))) (else x1347)))))) (strip-annotation1129 (lambda (x1352 parent1353) (cond ((pair? x1352) (let ((new1354 (cons #f #f))) (begin (if parent1353 (set-annotation-stripped! parent1353 new1354)) (set-car! new1354 (strip-annotation1129 (car x1352) #f)) (set-cdr! new1354 (strip-annotation1129 (cdr x1352) #f)) new1354))) ((annotation? x1352) (or (annotation-stripped x1352) (strip-annotation1129 (annotation-expression x1352) x1352))) ((vector? x1352) (let ((new1355 (make-vector (vector-length x1352)))) (begin (if parent1353 (set-annotation-stripped! parent1353 new1355)) (let loop1356 ((i1357 (- (vector-length x1352) 1))) (unless (fx<1053 i1357 0) (vector-set! new1355 i1357 (strip-annotation1129 (vector-ref x1352 i1357) #f)) (loop1356 (fx-1051 i1357 1)))) new1355))) (else x1352)))) (ellipsis?1128 (lambda (x1358) (and (nonsymbol-id?1082 x1358) (free-id=?1106 x1358 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1127 (lambda () (build-annotated1060 #f (list (build-annotated1060 #f (quote void)))))) (eval-local-transformer1126 (lambda (expanded1359 mod1360) (let ((p1361 (local-eval-hook1055 expanded1359 mod1360))) (if (procedure? p1361) p1361 (syntax-violation #f "nonprocedure transformer" p1361))))) (chi-local-syntax1125 (lambda (rec?1362 e1363 r1364 w1365 s1366 mod1367 k1368) ((lambda (tmp1369) ((lambda (tmp1370) (if tmp1370 (apply (lambda (_1371 id1372 val1373 e11374 e21375) (let ((ids1376 id1372)) (if (not (valid-bound-ids?1108 ids1376)) (syntax-violation #f "duplicate bound keyword" e1363) (let ((labels1378 (gen-labels1089 ids1376))) (let ((new-w1379 (make-binding-wrap1100 ids1376 labels1378 w1365))) (k1368 (cons e11374 e21375) (extend-env1077 labels1378 (let ((w1381 (if rec?1362 new-w1379 w1365)) (trans-r1382 (macros-only-env1079 r1364))) (map (lambda (x1383) (cons (quote macro) (eval-local-transformer1126 (chi1119 x1383 trans-r1382 w1381 mod1367) mod1367))) val1373)) r1364) new-w1379 s1366 mod1367)))))) tmp1370) ((lambda (_1385) (syntax-violation #f "bad local syntax definition" (source-wrap1112 e1363 w1365 s1366 mod1367))) tmp1369))) ($sc-dispatch tmp1369 (quote (any #(each (any any)) any . each-any))))) e1363))) (chi-lambda-clause1124 (lambda (e1386 docstring1387 c1388 r1389 w1390 mod1391 k1392) ((lambda (tmp1393) ((lambda (tmp1394) (if (if tmp1394 (apply (lambda (args1395 doc1396 e11397 e21398) (and (string? (syntax->datum doc1396)) (not docstring1387))) tmp1394) #f) (apply (lambda (args1399 doc1400 e11401 e21402) (chi-lambda-clause1124 e1386 doc1400 (cons args1399 (cons e11401 e21402)) r1389 w1390 mod1391 k1392)) tmp1394) ((lambda (tmp1404) (if tmp1404 (apply (lambda (id1405 e11406 e21407) (let ((ids1408 id1405)) (if (not (valid-bound-ids?1108 ids1408)) (syntax-violation (quote lambda) "invalid parameter list" e1386) (let ((labels1410 (gen-labels1089 ids1408)) (new-vars1411 (map gen-var1131 ids1408))) (k1392 new-vars1411 docstring1387 (chi-body1123 (cons e11406 e21407) e1386 (extend-var-env1078 labels1410 new-vars1411 r1389) (make-binding-wrap1100 ids1408 labels1410 w1390) mod1391)))))) tmp1404) ((lambda (tmp1413) (if tmp1413 (apply (lambda (ids1414 e11415 e21416) (let ((old-ids1417 (lambda-var-list1132 ids1414))) (if (not (valid-bound-ids?1108 old-ids1417)) (syntax-violation (quote lambda) "invalid parameter list" e1386) (let ((labels1418 (gen-labels1089 old-ids1417)) (new-vars1419 (map gen-var1131 old-ids1417))) (k1392 (let f1420 ((ls11421 (cdr new-vars1419)) (ls21422 (car new-vars1419))) (if (null? ls11421) ls21422 (f1420 (cdr ls11421) (cons (car ls11421) ls21422)))) docstring1387 (chi-body1123 (cons e11415 e21416) e1386 (extend-var-env1078 labels1418 new-vars1419 r1389) (make-binding-wrap1100 old-ids1417 labels1418 w1390) mod1391)))))) tmp1413) ((lambda (_1424) (syntax-violation (quote lambda) "bad lambda" e1386)) tmp1393))) ($sc-dispatch tmp1393 (quote (any any . each-any)))))) ($sc-dispatch tmp1393 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1393 (quote (any any any . each-any))))) c1388))) (chi-body1123 (lambda (body1425 outer-form1426 r1427 w1428 mod1429) (let ((r1430 (cons (quote ("placeholder" placeholder)) r1427))) (let ((ribcage1431 (make-ribcage1090 (quote ()) (quote ()) (quote ())))) (let ((w1432 (make-wrap1085 (wrap-marks1086 w1428) (cons ribcage1431 (wrap-subst1087 w1428))))) (let parse1433 ((body1434 (map (lambda (x1440) (cons r1430 (wrap1111 x1440 w1432 mod1429))) body1425)) (ids1435 (quote ())) (labels1436 (quote ())) (vars1437 (quote ())) (vals1438 (quote ())) (bindings1439 (quote ()))) (if (null? body1434) (syntax-violation #f "no expressions in body" outer-form1426) (let ((e1441 (cdar body1434)) (er1442 (caar body1434))) (call-with-values (lambda () (syntax-type1117 e1441 er1442 (quote (())) #f ribcage1431 mod1429)) (lambda (type1443 value1444 e1445 w1446 s1447 mod1448) (let ((t1449 type1443)) (if (memv t1449 (quote (define-form))) (let ((id1450 (wrap1111 value1444 w1446 mod1448)) (label1451 (gen-label1088))) (let ((var1452 (gen-var1131 id1450))) (begin (extend-ribcage!1099 ribcage1431 id1450 label1451) (parse1433 (cdr body1434) (cons id1450 ids1435) (cons label1451 labels1436) (cons var1452 vars1437) (cons (cons er1442 (wrap1111 e1445 w1446 mod1448)) vals1438) (cons (cons (quote lexical) var1452) bindings1439))))) (if (memv t1449 (quote (define-syntax-form))) (let ((id1453 (wrap1111 value1444 w1446 mod1448)) (label1454 (gen-label1088))) (begin (extend-ribcage!1099 ribcage1431 id1453 label1454) (parse1433 (cdr body1434) (cons id1453 ids1435) (cons label1454 labels1436) vars1437 vals1438 (cons (cons (quote macro) (cons er1442 (wrap1111 e1445 w1446 mod1448))) bindings1439)))) (if (memv t1449 (quote (begin-form))) ((lambda (tmp1455) ((lambda (tmp1456) (if tmp1456 (apply (lambda (_1457 e11458) (parse1433 (let f1459 ((forms1460 e11458)) (if (null? forms1460) (cdr body1434) (cons (cons er1442 (wrap1111 (car forms1460) w1446 mod1448)) (f1459 (cdr forms1460))))) ids1435 labels1436 vars1437 vals1438 bindings1439)) tmp1456) (syntax-violation #f "source expression failed to match any pattern" tmp1455))) ($sc-dispatch tmp1455 (quote (any . each-any))))) e1445) (if (memv t1449 (quote (local-syntax-form))) (chi-local-syntax1125 value1444 e1445 er1442 w1446 s1447 mod1448 (lambda (forms1462 er1463 w1464 s1465 mod1466) (parse1433 (let f1467 ((forms1468 forms1462)) (if (null? forms1468) (cdr body1434) (cons (cons er1463 (wrap1111 (car forms1468) w1464 mod1466)) (f1467 (cdr forms1468))))) ids1435 labels1436 vars1437 vals1438 bindings1439))) (if (null? ids1435) (build-sequence1062 #f (map (lambda (x1469) (chi1119 (cdr x1469) (car x1469) (quote (())) mod1448)) (cons (cons er1442 (source-wrap1112 e1445 w1446 s1447 mod1448)) (cdr body1434)))) (begin (if (not (valid-bound-ids?1108 ids1435)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1426)) (let loop1470 ((bs1471 bindings1439) (er-cache1472 #f) (r-cache1473 #f)) (if (not (null? bs1471)) (let ((b1474 (car bs1471))) (if (eq? (car b1474) (quote macro)) (let ((er1475 (cadr b1474))) (let ((r-cache1476 (if (eq? er1475 er-cache1472) r-cache1473 (macros-only-env1079 er1475)))) (begin (set-cdr! b1474 (eval-local-transformer1126 (chi1119 (cddr b1474) r-cache1476 (quote (())) mod1448) mod1448)) (loop1470 (cdr bs1471) er1475 r-cache1476)))) (loop1470 (cdr bs1471) er-cache1472 r-cache1473))))) (set-cdr! r1430 (extend-env1077 labels1436 bindings1439 (cdr r1430))) (build-letrec1065 #f vars1437 (map (lambda (x1477) (chi1119 (cdr x1477) (car x1477) (quote (())) mod1448)) vals1438) (build-sequence1062 #f (map (lambda (x1478) (chi1119 (cdr x1478) (car x1478) (quote (())) mod1448)) (cons (cons er1442 (source-wrap1112 e1445 w1446 s1447 mod1448)) (cdr body1434)))))))))))))))))))))) (chi-macro1122 (lambda (p1479 e1480 r1481 w1482 rib1483 mod1484) (letrec ((rebuild-macro-output1485 (lambda (x1486 m1487) (cond ((pair? x1486) (cons (rebuild-macro-output1485 (car x1486) m1487) (rebuild-macro-output1485 (cdr x1486) m1487))) ((syntax-object?1067 x1486) (let ((w1488 (syntax-object-wrap1069 x1486))) (let ((ms1489 (wrap-marks1086 w1488)) (s1490 (wrap-subst1087 w1488))) (if (and (pair? ms1489) (eq? (car ms1489) #f)) (make-syntax-object1066 (syntax-object-expression1068 x1486) (make-wrap1085 (cdr ms1489) (if rib1483 (cons rib1483 (cdr s1490)) (cdr s1490))) (syntax-object-module1070 x1486)) (make-syntax-object1066 (syntax-object-expression1068 x1486) (make-wrap1085 (cons m1487 ms1489) (if rib1483 (cons rib1483 (cons (quote shift) s1490)) (cons (quote shift) s1490))) (let ((pmod1491 (procedure-module p1479))) (if pmod1491 (cons (quote hygiene) (module-name pmod1491)) (quote (hygiene guile))))))))) ((vector? x1486) (let ((n1492 (vector-length x1486))) (let ((v1493 (make-vector n1492))) (let doloop1494 ((i1495 0)) (if (fx=1052 i1495 n1492) v1493 (begin (vector-set! v1493 i1495 (rebuild-macro-output1485 (vector-ref x1486 i1495) m1487)) (doloop1494 (fx+1050 i1495 1)))))))) ((symbol? x1486) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1112 e1480 w1482 s mod1484) x1486)) (else x1486))))) (rebuild-macro-output1485 (p1479 (wrap1111 e1480 (anti-mark1098 w1482) mod1484)) (string #\m))))) (chi-application1121 (lambda (x1496 e1497 r1498 w1499 s1500 mod1501) ((lambda (tmp1502) ((lambda (tmp1503) (if tmp1503 (apply (lambda (e01504 e11505) (build-annotated1060 s1500 (cons x1496 (map (lambda (e1506) (chi1119 e1506 r1498 w1499 mod1501)) e11505)))) tmp1503) (syntax-violation #f "source expression failed to match any pattern" tmp1502))) ($sc-dispatch tmp1502 (quote (any . each-any))))) e1497))) (chi-expr1120 (lambda (type1508 value1509 e1510 r1511 w1512 s1513 mod1514) (let ((t1515 type1508)) (if (memv t1515 (quote (lexical))) (build-annotated1060 s1513 value1509) (if (memv t1515 (quote (core external-macro))) (value1509 e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (module-ref))) (call-with-values (lambda () (value1509 e1510)) (lambda (id1516 mod1517) (build-annotated1060 s1513 (if mod1517 (make-module-ref (cdr mod1517) id1516 (car mod1517)) (make-module-ref mod1517 id1516 (quote bare)))))) (if (memv t1515 (quote (lexical-call))) (chi-application1121 (build-annotated1060 (source-annotation1074 (car e1510)) value1509) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (global-call))) (chi-application1121 (build-annotated1060 (source-annotation1074 (car e1510)) (if (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514) (make-module-ref (cdr (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514)) value1509 (car (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514))) (make-module-ref (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514) value1509 (quote bare)))) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (constant))) (build-data1061 s1513 (strip1130 (source-wrap1112 e1510 w1512 s1513 mod1514) (quote (())))) (if (memv t1515 (quote (global))) (build-annotated1060 s1513 (if mod1514 (make-module-ref (cdr mod1514) value1509 (car mod1514)) (make-module-ref mod1514 value1509 (quote bare)))) (if (memv t1515 (quote (call))) (chi-application1121 (chi1119 (car e1510) r1511 w1512 mod1514) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (begin-form))) ((lambda (tmp1518) ((lambda (tmp1519) (if tmp1519 (apply (lambda (_1520 e11521 e21522) (chi-sequence1113 (cons e11521 e21522) r1511 w1512 s1513 mod1514)) tmp1519) (syntax-violation #f "source expression failed to match any pattern" tmp1518))) ($sc-dispatch tmp1518 (quote (any any . each-any))))) e1510) (if (memv t1515 (quote (local-syntax-form))) (chi-local-syntax1125 value1509 e1510 r1511 w1512 s1513 mod1514 chi-sequence1113) (if (memv t1515 (quote (eval-when-form))) ((lambda (tmp1524) ((lambda (tmp1525) (if tmp1525 (apply (lambda (_1526 x1527 e11528 e21529) (let ((when-list1530 (chi-when-list1116 e1510 x1527 w1512))) (if (memq (quote eval) when-list1530) (chi-sequence1113 (cons e11528 e21529) r1511 w1512 s1513 mod1514) (chi-void1127)))) tmp1525) (syntax-violation #f "source expression failed to match any pattern" tmp1524))) ($sc-dispatch tmp1524 (quote (any each-any any . each-any))))) e1510) (if (memv t1515 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1510 (wrap1111 value1509 w1512 mod1514)) (if (memv t1515 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1112 e1510 w1512 s1513 mod1514)) (if (memv t1515 (quote (displaced-lexical))) (syntax-violation #f (source-wrap1112 e1510 w1512 s1513 mod1514) "reference to identifier outside its scope") (syntax-violation #f "unexpected syntax" (source-wrap1112 e1510 w1512 s1513 mod1514))))))))))))))))))) (chi1119 (lambda (e1533 r1534 w1535 mod1536) (call-with-values (lambda () (syntax-type1117 e1533 r1534 w1535 #f #f mod1536)) (lambda (type1537 value1538 e1539 w1540 s1541 mod1542) (chi-expr1120 type1537 value1538 e1539 r1534 w1540 s1541 mod1542))))) (chi-top1118 (lambda (e1543 r1544 w1545 m1546 esew1547 mod1548) (call-with-values (lambda () (syntax-type1117 e1543 r1544 w1545 #f #f mod1548)) (lambda (type1556 value1557 e1558 w1559 s1560 mod1561) (let ((t1562 type1556)) (if (memv t1562 (quote (begin-form))) ((lambda (tmp1563) ((lambda (tmp1564) (if tmp1564 (apply (lambda (_1565) (chi-void1127)) tmp1564) ((lambda (tmp1566) (if tmp1566 (apply (lambda (_1567 e11568 e21569) (chi-top-sequence1114 (cons e11568 e21569) r1544 w1559 s1560 m1546 esew1547 mod1561)) tmp1566) (syntax-violation #f "source expression failed to match any pattern" tmp1563))) ($sc-dispatch tmp1563 (quote (any any . each-any)))))) ($sc-dispatch tmp1563 (quote (any))))) e1558) (if (memv t1562 (quote (local-syntax-form))) (chi-local-syntax1125 value1557 e1558 r1544 w1559 s1560 mod1561 (lambda (body1571 r1572 w1573 s1574 mod1575) (chi-top-sequence1114 body1571 r1572 w1573 s1574 m1546 esew1547 mod1575))) (if (memv t1562 (quote (eval-when-form))) ((lambda (tmp1576) ((lambda (tmp1577) (if tmp1577 (apply (lambda (_1578 x1579 e11580 e21581) (let ((when-list1582 (chi-when-list1116 e1558 x1579 w1559)) (body1583 (cons e11580 e21581))) (cond ((eq? m1546 (quote e)) (if (memq (quote eval) when-list1582) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote e) (quote (eval)) mod1561) (chi-void1127))) ((memq (quote load) when-list1582) (if (or (memq (quote compile) when-list1582) (and (eq? m1546 (quote c&e)) (memq (quote eval) when-list1582))) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote c&e) (quote (compile load)) mod1561) (if (memq m1546 (quote (c c&e))) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote c) (quote (load)) mod1561) (chi-void1127)))) ((or (memq (quote compile) when-list1582) (and (eq? m1546 (quote c&e)) (memq (quote eval) when-list1582))) (top-level-eval-hook1054 (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote e) (quote (eval)) mod1561) mod1561) (chi-void1127)) (else (chi-void1127))))) tmp1577) (syntax-violation #f "source expression failed to match any pattern" tmp1576))) ($sc-dispatch tmp1576 (quote (any each-any any . each-any))))) e1558) (if (memv t1562 (quote (define-syntax-form))) (let ((n1586 (id-var-name1105 value1557 w1559)) (r1587 (macros-only-env1079 r1544))) (let ((t1588 m1546)) (if (memv t1588 (quote (c))) (if (memq (quote compile) esew1547) (let ((e1589 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)))) (begin (top-level-eval-hook1054 e1589 mod1561) (if (memq (quote load) esew1547) e1589 (chi-void1127)))) (if (memq (quote load) esew1547) (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)) (chi-void1127))) (if (memv t1588 (quote (c&e))) (let ((e1590 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)))) (begin (top-level-eval-hook1054 e1590 mod1561) e1590)) (begin (if (memq (quote eval) esew1547) (top-level-eval-hook1054 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)) mod1561)) (chi-void1127)))))) (if (memv t1562 (quote (define-form))) (let ((n1591 (id-var-name1105 value1557 w1559))) (let ((type1592 (binding-type1075 (lookup1080 n1591 r1544 mod1561)))) (let ((t1593 type1592)) (if (memv t1593 (quote (global))) (let ((x1594 (build-annotated1060 s1560 (list (quote define) n1591 (chi1119 e1558 r1544 w1559 mod1561))))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1594 mod1561)) x1594)) (if (memv t1593 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1558 (wrap1111 value1557 w1559 mod1561)) (if (memv t1593 (quote (core macro module-ref))) (begin (remove-global-definition-hook1058 n1591) (let ((x1595 (build-annotated1060 s1560 (list (quote define) n1591 (chi1119 e1558 r1544 w1559 mod1561))))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1595 mod1561)) x1595))) (syntax-violation #f "cannot define keyword at top level" e1558 (wrap1111 value1557 w1559 mod1561)))))))) (let ((x1596 (chi-expr1120 type1556 value1557 e1558 r1544 w1559 s1560 mod1561))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1596 mod1561)) x1596)))))))))))) (syntax-type1117 (lambda (e1597 r1598 w1599 s1600 rib1601 mod1602) (cond ((symbol? e1597) (let ((n1603 (id-var-name1105 e1597 w1599))) (let ((b1604 (lookup1080 n1603 r1598 mod1602))) (let ((type1605 (binding-type1075 b1604))) (let ((t1606 type1605)) (if (memv t1606 (quote (lexical))) (values type1605 (binding-value1076 b1604) e1597 w1599 s1600 mod1602) (if (memv t1606 (quote (global))) (values type1605 n1603 e1597 w1599 s1600 mod1602) (if (memv t1606 (quote (macro))) (syntax-type1117 (chi-macro1122 (binding-value1076 b1604) e1597 r1598 w1599 rib1601 mod1602) r1598 (quote (())) s1600 rib1601 mod1602) (values type1605 (binding-value1076 b1604) e1597 w1599 s1600 mod1602))))))))) ((pair? e1597) (let ((first1607 (car e1597))) (if (id?1083 first1607) (let ((n1608 (id-var-name1105 first1607 w1599))) (let ((b1609 (lookup1080 n1608 r1598 (or (and (syntax-object?1067 first1607) (syntax-object-module1070 first1607)) mod1602)))) (let ((type1610 (binding-type1075 b1609))) (let ((t1611 type1610)) (if (memv t1611 (quote (lexical))) (values (quote lexical-call) (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (global))) (values (quote global-call) n1608 e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (macro))) (syntax-type1117 (chi-macro1122 (binding-value1076 b1609) e1597 r1598 w1599 rib1601 mod1602) r1598 (quote (())) s1600 rib1601 mod1602) (if (memv t1611 (quote (core external-macro module-ref))) (values type1610 (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (begin))) (values (quote begin-form) #f e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (eval-when))) (values (quote eval-when-form) #f e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (define))) ((lambda (tmp1612) ((lambda (tmp1613) (if (if tmp1613 (apply (lambda (_1614 name1615 val1616) (id?1083 name1615)) tmp1613) #f) (apply (lambda (_1617 name1618 val1619) (values (quote define-form) name1618 val1619 w1599 s1600 mod1602)) tmp1613) ((lambda (tmp1620) (if (if tmp1620 (apply (lambda (_1621 name1622 args1623 e11624 e21625) (and (id?1083 name1622) (valid-bound-ids?1108 (lambda-var-list1132 args1623)))) tmp1620) #f) (apply (lambda (_1626 name1627 args1628 e11629 e21630) (values (quote define-form) (wrap1111 name1627 w1599 mod1602) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1111 (cons args1628 (cons e11629 e21630)) w1599 mod1602)) (quote (())) s1600 mod1602)) tmp1620) ((lambda (tmp1632) (if (if tmp1632 (apply (lambda (_1633 name1634) (id?1083 name1634)) tmp1632) #f) (apply (lambda (_1635 name1636) (values (quote define-form) (wrap1111 name1636 w1599 mod1602) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1600 mod1602)) tmp1632) (syntax-violation #f "source expression failed to match any pattern" tmp1612))) ($sc-dispatch tmp1612 (quote (any any)))))) ($sc-dispatch tmp1612 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1612 (quote (any any any))))) e1597) (if (memv t1611 (quote (define-syntax))) ((lambda (tmp1637) ((lambda (tmp1638) (if (if tmp1638 (apply (lambda (_1639 name1640 val1641) (id?1083 name1640)) tmp1638) #f) (apply (lambda (_1642 name1643 val1644) (values (quote define-syntax-form) name1643 val1644 w1599 s1600 mod1602)) tmp1638) (syntax-violation #f "source expression failed to match any pattern" tmp1637))) ($sc-dispatch tmp1637 (quote (any any any))))) e1597) (values (quote call) #f e1597 w1599 s1600 mod1602)))))))))))))) (values (quote call) #f e1597 w1599 s1600 mod1602)))) ((syntax-object?1067 e1597) (syntax-type1117 (syntax-object-expression1068 e1597) r1598 (join-wraps1102 w1599 (syntax-object-wrap1069 e1597)) #f rib1601 (or (syntax-object-module1070 e1597) mod1602))) ((annotation? e1597) (syntax-type1117 (annotation-expression e1597) r1598 w1599 (annotation-source e1597) rib1601 mod1602)) ((self-evaluating? e1597) (values (quote constant) #f e1597 w1599 s1600 mod1602)) (else (values (quote other) #f e1597 w1599 s1600 mod1602))))) (chi-when-list1116 (lambda (e1645 when-list1646 w1647) (let f1648 ((when-list1649 when-list1646) (situations1650 (quote ()))) (if (null? when-list1649) situations1650 (f1648 (cdr when-list1649) (cons (let ((x1651 (car when-list1649))) (cond ((free-id=?1106 x1651 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1106 x1651 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1106 x1651 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1645 (wrap1111 x1651 w1647 #f))))) situations1650)))))) (chi-install-global1115 (lambda (name1652 e1653) (build-annotated1060 #f (list (build-annotated1060 #f (quote install-global-transformer)) (build-data1061 #f name1652) e1653)))) (chi-top-sequence1114 (lambda (body1654 r1655 w1656 s1657 m1658 esew1659 mod1660) (build-sequence1062 s1657 (let dobody1661 ((body1662 body1654) (r1663 r1655) (w1664 w1656) (m1665 m1658) (esew1666 esew1659) (mod1667 mod1660)) (if (null? body1662) (quote ()) (let ((first1668 (chi-top1118 (car body1662) r1663 w1664 m1665 esew1666 mod1667))) (cons first1668 (dobody1661 (cdr body1662) r1663 w1664 m1665 esew1666 mod1667)))))))) (chi-sequence1113 (lambda (body1669 r1670 w1671 s1672 mod1673) (build-sequence1062 s1672 (let dobody1674 ((body1675 body1669) (r1676 r1670) (w1677 w1671) (mod1678 mod1673)) (if (null? body1675) (quote ()) (let ((first1679 (chi1119 (car body1675) r1676 w1677 mod1678))) (cons first1679 (dobody1674 (cdr body1675) r1676 w1677 mod1678)))))))) (source-wrap1112 (lambda (x1680 w1681 s1682 defmod1683) (wrap1111 (if s1682 (make-annotation x1680 s1682 #f) x1680) w1681 defmod1683))) (wrap1111 (lambda (x1684 w1685 defmod1686) (cond ((and (null? (wrap-marks1086 w1685)) (null? (wrap-subst1087 w1685))) x1684) ((syntax-object?1067 x1684) (make-syntax-object1066 (syntax-object-expression1068 x1684) (join-wraps1102 w1685 (syntax-object-wrap1069 x1684)) (syntax-object-module1070 x1684))) ((null? x1684) x1684) (else (make-syntax-object1066 x1684 w1685 defmod1686))))) (bound-id-member?1110 (lambda (x1687 list1688) (and (not (null? list1688)) (or (bound-id=?1107 x1687 (car list1688)) (bound-id-member?1110 x1687 (cdr list1688)))))) (distinct-bound-ids?1109 (lambda (ids1689) (let distinct?1690 ((ids1691 ids1689)) (or (null? ids1691) (and (not (bound-id-member?1110 (car ids1691) (cdr ids1691))) (distinct?1690 (cdr ids1691))))))) (valid-bound-ids?1108 (lambda (ids1692) (and (let all-ids?1693 ((ids1694 ids1692)) (or (null? ids1694) (and (id?1083 (car ids1694)) (all-ids?1693 (cdr ids1694))))) (distinct-bound-ids?1109 ids1692)))) (bound-id=?1107 (lambda (i1695 j1696) (if (and (syntax-object?1067 i1695) (syntax-object?1067 j1696)) (and (eq? (let ((e1697 (syntax-object-expression1068 i1695))) (if (annotation? e1697) (annotation-expression e1697) e1697)) (let ((e1698 (syntax-object-expression1068 j1696))) (if (annotation? e1698) (annotation-expression e1698) e1698))) (same-marks?1104 (wrap-marks1086 (syntax-object-wrap1069 i1695)) (wrap-marks1086 (syntax-object-wrap1069 j1696)))) (eq? (let ((e1699 i1695)) (if (annotation? e1699) (annotation-expression e1699) e1699)) (let ((e1700 j1696)) (if (annotation? e1700) (annotation-expression e1700) e1700)))))) (free-id=?1106 (lambda (i1701 j1702) (and (eq? (let ((x1703 i1701)) (let ((e1704 (if (syntax-object?1067 x1703) (syntax-object-expression1068 x1703) x1703))) (if (annotation? e1704) (annotation-expression e1704) e1704))) (let ((x1705 j1702)) (let ((e1706 (if (syntax-object?1067 x1705) (syntax-object-expression1068 x1705) x1705))) (if (annotation? e1706) (annotation-expression e1706) e1706)))) (eq? (id-var-name1105 i1701 (quote (()))) (id-var-name1105 j1702 (quote (()))))))) (id-var-name1105 (lambda (id1707 w1708) (letrec ((search-vector-rib1711 (lambda (sym1717 subst1718 marks1719 symnames1720 ribcage1721) (let ((n1722 (vector-length symnames1720))) (let f1723 ((i1724 0)) (cond ((fx=1052 i1724 n1722) (search1709 sym1717 (cdr subst1718) marks1719)) ((and (eq? (vector-ref symnames1720 i1724) sym1717) (same-marks?1104 marks1719 (vector-ref (ribcage-marks1093 ribcage1721) i1724))) (values (vector-ref (ribcage-labels1094 ribcage1721) i1724) marks1719)) (else (f1723 (fx+1050 i1724 1)))))))) (search-list-rib1710 (lambda (sym1725 subst1726 marks1727 symnames1728 ribcage1729) (let f1730 ((symnames1731 symnames1728) (i1732 0)) (cond ((null? symnames1731) (search1709 sym1725 (cdr subst1726) marks1727)) ((and (eq? (car symnames1731) sym1725) (same-marks?1104 marks1727 (list-ref (ribcage-marks1093 ribcage1729) i1732))) (values (list-ref (ribcage-labels1094 ribcage1729) i1732) marks1727)) (else (f1730 (cdr symnames1731) (fx+1050 i1732 1))))))) (search1709 (lambda (sym1733 subst1734 marks1735) (if (null? subst1734) (values #f marks1735) (let ((fst1736 (car subst1734))) (if (eq? fst1736 (quote shift)) (search1709 sym1733 (cdr subst1734) (cdr marks1735)) (let ((symnames1737 (ribcage-symnames1092 fst1736))) (if (vector? symnames1737) (search-vector-rib1711 sym1733 subst1734 marks1735 symnames1737 fst1736) (search-list-rib1710 sym1733 subst1734 marks1735 symnames1737 fst1736))))))))) (cond ((symbol? id1707) (or (call-with-values (lambda () (search1709 id1707 (wrap-subst1087 w1708) (wrap-marks1086 w1708))) (lambda (x1739 . ignore1738) x1739)) id1707)) ((syntax-object?1067 id1707) (let ((id1740 (let ((e1742 (syntax-object-expression1068 id1707))) (if (annotation? e1742) (annotation-expression e1742) e1742))) (w11741 (syntax-object-wrap1069 id1707))) (let ((marks1743 (join-marks1103 (wrap-marks1086 w1708) (wrap-marks1086 w11741)))) (call-with-values (lambda () (search1709 id1740 (wrap-subst1087 w1708) marks1743)) (lambda (new-id1744 marks1745) (or new-id1744 (call-with-values (lambda () (search1709 id1740 (wrap-subst1087 w11741) marks1745)) (lambda (x1747 . ignore1746) x1747)) id1740)))))) ((annotation? id1707) (let ((id1748 (let ((e1749 id1707)) (if (annotation? e1749) (annotation-expression e1749) e1749)))) (or (call-with-values (lambda () (search1709 id1748 (wrap-subst1087 w1708) (wrap-marks1086 w1708))) (lambda (x1751 . ignore1750) x1751)) id1748))) (else (error-hook1056 (quote id-var-name) "invalid id" id1707)))))) (same-marks?1104 (lambda (x1752 y1753) (or (eq? x1752 y1753) (and (not (null? x1752)) (not (null? y1753)) (eq? (car x1752) (car y1753)) (same-marks?1104 (cdr x1752) (cdr y1753)))))) (join-marks1103 (lambda (m11754 m21755) (smart-append1101 m11754 m21755))) (join-wraps1102 (lambda (w11756 w21757) (let ((m11758 (wrap-marks1086 w11756)) (s11759 (wrap-subst1087 w11756))) (if (null? m11758) (if (null? s11759) w21757 (make-wrap1085 (wrap-marks1086 w21757) (smart-append1101 s11759 (wrap-subst1087 w21757)))) (make-wrap1085 (smart-append1101 m11758 (wrap-marks1086 w21757)) (smart-append1101 s11759 (wrap-subst1087 w21757))))))) (smart-append1101 (lambda (m11760 m21761) (if (null? m21761) m11760 (append m11760 m21761)))) (make-binding-wrap1100 (lambda (ids1762 labels1763 w1764) (if (null? ids1762) w1764 (make-wrap1085 (wrap-marks1086 w1764) (cons (let ((labelvec1765 (list->vector labels1763))) (let ((n1766 (vector-length labelvec1765))) (let ((symnamevec1767 (make-vector n1766)) (marksvec1768 (make-vector n1766))) (begin (let f1769 ((ids1770 ids1762) (i1771 0)) (if (not (null? ids1770)) (call-with-values (lambda () (id-sym-name&marks1084 (car ids1770) w1764)) (lambda (symname1772 marks1773) (begin (vector-set! symnamevec1767 i1771 symname1772) (vector-set! marksvec1768 i1771 marks1773) (f1769 (cdr ids1770) (fx+1050 i1771 1))))))) (make-ribcage1090 symnamevec1767 marksvec1768 labelvec1765))))) (wrap-subst1087 w1764)))))) (extend-ribcage!1099 (lambda (ribcage1774 id1775 label1776) (begin (set-ribcage-symnames!1095 ribcage1774 (cons (let ((e1777 (syntax-object-expression1068 id1775))) (if (annotation? e1777) (annotation-expression e1777) e1777)) (ribcage-symnames1092 ribcage1774))) (set-ribcage-marks!1096 ribcage1774 (cons (wrap-marks1086 (syntax-object-wrap1069 id1775)) (ribcage-marks1093 ribcage1774))) (set-ribcage-labels!1097 ribcage1774 (cons label1776 (ribcage-labels1094 ribcage1774)))))) (anti-mark1098 (lambda (w1778) (make-wrap1085 (cons #f (wrap-marks1086 w1778)) (cons (quote shift) (wrap-subst1087 w1778))))) (set-ribcage-labels!1097 (lambda (x1779 update1780) (vector-set! x1779 3 update1780))) (set-ribcage-marks!1096 (lambda (x1781 update1782) (vector-set! x1781 2 update1782))) (set-ribcage-symnames!1095 (lambda (x1783 update1784) (vector-set! x1783 1 update1784))) (ribcage-labels1094 (lambda (x1785) (vector-ref x1785 3))) (ribcage-marks1093 (lambda (x1786) (vector-ref x1786 2))) (ribcage-symnames1092 (lambda (x1787) (vector-ref x1787 1))) (ribcage?1091 (lambda (x1788) (and (vector? x1788) (= (vector-length x1788) 4) (eq? (vector-ref x1788 0) (quote ribcage))))) (make-ribcage1090 (lambda (symnames1789 marks1790 labels1791) (vector (quote ribcage) symnames1789 marks1790 labels1791))) (gen-labels1089 (lambda (ls1792) (if (null? ls1792) (quote ()) (cons (gen-label1088) (gen-labels1089 (cdr ls1792)))))) (gen-label1088 (lambda () (string #\i))) (wrap-subst1087 cdr) (wrap-marks1086 car) (make-wrap1085 cons) (id-sym-name&marks1084 (lambda (x1793 w1794) (if (syntax-object?1067 x1793) (values (let ((e1795 (syntax-object-expression1068 x1793))) (if (annotation? e1795) (annotation-expression e1795) e1795)) (join-marks1103 (wrap-marks1086 w1794) (wrap-marks1086 (syntax-object-wrap1069 x1793)))) (values (let ((e1796 x1793)) (if (annotation? e1796) (annotation-expression e1796) e1796)) (wrap-marks1086 w1794))))) (id?1083 (lambda (x1797) (cond ((symbol? x1797) #t) ((syntax-object?1067 x1797) (symbol? (let ((e1798 (syntax-object-expression1068 x1797))) (if (annotation? e1798) (annotation-expression e1798) e1798)))) ((annotation? x1797) (symbol? (annotation-expression x1797))) (else #f)))) (nonsymbol-id?1082 (lambda (x1799) (and (syntax-object?1067 x1799) (symbol? (let ((e1800 (syntax-object-expression1068 x1799))) (if (annotation? e1800) (annotation-expression e1800) e1800)))))) (global-extend1081 (lambda (type1801 sym1802 val1803) (put-global-definition-hook1057 sym1802 type1801 val1803))) (lookup1080 (lambda (x1804 r1805 mod1806) (cond ((assq x1804 r1805) => cdr) ((symbol? x1804) (or (get-global-definition-hook1059 x1804 mod1806) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1079 (lambda (r1807) (if (null? r1807) (quote ()) (let ((a1808 (car r1807))) (if (eq? (cadr a1808) (quote macro)) (cons a1808 (macros-only-env1079 (cdr r1807))) (macros-only-env1079 (cdr r1807))))))) (extend-var-env1078 (lambda (labels1809 vars1810 r1811) (if (null? labels1809) r1811 (extend-var-env1078 (cdr labels1809) (cdr vars1810) (cons (cons (car labels1809) (cons (quote lexical) (car vars1810))) r1811))))) (extend-env1077 (lambda (labels1812 bindings1813 r1814) (if (null? labels1812) r1814 (extend-env1077 (cdr labels1812) (cdr bindings1813) (cons (cons (car labels1812) (car bindings1813)) r1814))))) (binding-value1076 cdr) (binding-type1075 car) (source-annotation1074 (lambda (x1815) (cond ((annotation? x1815) (annotation-source x1815)) ((syntax-object?1067 x1815) (source-annotation1074 (syntax-object-expression1068 x1815))) (else #f)))) (set-syntax-object-module!1073 (lambda (x1816 update1817) (vector-set! x1816 3 update1817))) (set-syntax-object-wrap!1072 (lambda (x1818 update1819) (vector-set! x1818 2 update1819))) (set-syntax-object-expression!1071 (lambda (x1820 update1821) (vector-set! x1820 1 update1821))) (syntax-object-module1070 (lambda (x1822) (vector-ref x1822 3))) (syntax-object-wrap1069 (lambda (x1823) (vector-ref x1823 2))) (syntax-object-expression1068 (lambda (x1824) (vector-ref x1824 1))) (syntax-object?1067 (lambda (x1825) (and (vector? x1825) (= (vector-length x1825) 4) (eq? (vector-ref x1825 0) (quote syntax-object))))) (make-syntax-object1066 (lambda (expression1826 wrap1827 module1828) (vector (quote syntax-object) expression1826 wrap1827 module1828))) (build-letrec1065 (lambda (src1829 vars1830 val-exps1831 body-exp1832) (if (null? vars1830) (build-annotated1060 src1829 body-exp1832) (build-annotated1060 src1829 (list (quote letrec) (map list vars1830 val-exps1831) body-exp1832))))) (build-named-let1064 (lambda (src1833 vars1834 val-exps1835 body-exp1836) (if (null? vars1834) (build-annotated1060 src1833 body-exp1836) (build-annotated1060 src1833 (list (quote let) (car vars1834) (map list (cdr vars1834) val-exps1835) body-exp1836))))) (build-let1063 (lambda (src1837 vars1838 val-exps1839 body-exp1840) (if (null? vars1838) (build-annotated1060 src1837 body-exp1840) (build-annotated1060 src1837 (list (quote let) (map list vars1838 val-exps1839) body-exp1840))))) (build-sequence1062 (lambda (src1841 exps1842) (if (null? (cdr exps1842)) (build-annotated1060 src1841 (car exps1842)) (build-annotated1060 src1841 (cons (quote begin) exps1842))))) (build-data1061 (lambda (src1843 exp1844) (if (and (self-evaluating? exp1844) (not (vector? exp1844))) (build-annotated1060 src1843 exp1844) (build-annotated1060 src1843 (list (quote quote) exp1844))))) (build-annotated1060 (lambda (src1845 exp1846) (if (and src1845 (not (annotation? exp1846))) (make-annotation exp1846 src1845 #t) exp1846))) (get-global-definition-hook1059 (lambda (symbol1847 module1848) (begin (if (and (not module1848) (current-module)) (warn "module system is booted, we should have a module" symbol1847)) (module-lookup-keyword (if module1848 (resolve-module (cdr module1848)) (current-module)) symbol1847)))) (remove-global-definition-hook1058 (lambda (symbol1849) (module-undefine-keyword! (current-module) symbol1849))) (put-global-definition-hook1057 (lambda (symbol1850 type1851 val1852) (module-define-keyword! (current-module) symbol1850 type1851 val1852))) (error-hook1056 (lambda (who1853 why1854 what1855) (error who1853 "~a ~s" why1854 what1855))) (local-eval-hook1055 (lambda (x1856 mod1857) (primitive-eval (list noexpand1049 x1856)))) (top-level-eval-hook1054 (lambda (x1858 mod1859) (primitive-eval (list noexpand1049 x1858)))) (fx<1053 <) (fx=1052 =) (fx-1051 -) (fx+1050 +) (noexpand1049 "noexpand")) (begin (global-extend1081 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1081 (quote local-syntax) (quote let-syntax) #f) (global-extend1081 (quote core) (quote fluid-let-syntax) (lambda (e1860 r1861 w1862 s1863 mod1864) ((lambda (tmp1865) ((lambda (tmp1866) (if (if tmp1866 (apply (lambda (_1867 var1868 val1869 e11870 e21871) (valid-bound-ids?1108 var1868)) tmp1866) #f) (apply (lambda (_1873 var1874 val1875 e11876 e21877) (let ((names1878 (map (lambda (x1879) (id-var-name1105 x1879 w1862)) var1874))) (begin (for-each (lambda (id1881 n1882) (let ((t1883 (binding-type1075 (lookup1080 n1882 r1861 mod1864)))) (if (memv t1883 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1860 (source-wrap1112 id1881 w1862 s1863 mod1864))))) var1874 names1878) (chi-body1123 (cons e11876 e21877) (source-wrap1112 e1860 w1862 s1863 mod1864) (extend-env1077 names1878 (let ((trans-r1886 (macros-only-env1079 r1861))) (map (lambda (x1887) (cons (quote macro) (eval-local-transformer1126 (chi1119 x1887 trans-r1886 w1862 mod1864) mod1864))) val1875)) r1861) w1862 mod1864)))) tmp1866) ((lambda (_1889) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1112 e1860 w1862 s1863 mod1864))) tmp1865))) ($sc-dispatch tmp1865 (quote (any #(each (any any)) any . each-any))))) e1860))) (global-extend1081 (quote core) (quote quote) (lambda (e1890 r1891 w1892 s1893 mod1894) ((lambda (tmp1895) ((lambda (tmp1896) (if tmp1896 (apply (lambda (_1897 e1898) (build-data1061 s1893 (strip1130 e1898 w1892))) tmp1896) ((lambda (_1899) (syntax-violation (quote quote) "bad syntax" (source-wrap1112 e1890 w1892 s1893 mod1894))) tmp1895))) ($sc-dispatch tmp1895 (quote (any any))))) e1890))) (global-extend1081 (quote core) (quote syntax) (letrec ((regen1907 (lambda (x1908) (let ((t1909 (car x1908))) (if (memv t1909 (quote (ref))) (build-annotated1060 #f (cadr x1908)) (if (memv t1909 (quote (primitive))) (build-annotated1060 #f (cadr x1908)) (if (memv t1909 (quote (quote))) (build-data1061 #f (cadr x1908)) (if (memv t1909 (quote (lambda))) (build-annotated1060 #f (list (quote lambda) (cadr x1908) (regen1907 (caddr x1908)))) (if (memv t1909 (quote (map))) (let ((ls1910 (map regen1907 (cdr x1908)))) (build-annotated1060 #f (cons (if (fx=1052 (length ls1910) 2) (build-annotated1060 #f (quote map)) (build-annotated1060 #f (quote map))) ls1910))) (build-annotated1060 #f (cons (build-annotated1060 #f (car x1908)) (map regen1907 (cdr x1908)))))))))))) (gen-vector1906 (lambda (x1911) (cond ((eq? (car x1911) (quote list)) (cons (quote vector) (cdr x1911))) ((eq? (car x1911) (quote quote)) (list (quote quote) (list->vector (cadr x1911)))) (else (list (quote list->vector) x1911))))) (gen-append1905 (lambda (x1912 y1913) (if (equal? y1913 (quote (quote ()))) x1912 (list (quote append) x1912 y1913)))) (gen-cons1904 (lambda (x1914 y1915) (let ((t1916 (car y1915))) (if (memv t1916 (quote (quote))) (if (eq? (car x1914) (quote quote)) (list (quote quote) (cons (cadr x1914) (cadr y1915))) (if (eq? (cadr y1915) (quote ())) (list (quote list) x1914) (list (quote cons) x1914 y1915))) (if (memv t1916 (quote (list))) (cons (quote list) (cons x1914 (cdr y1915))) (list (quote cons) x1914 y1915)))))) (gen-map1903 (lambda (e1917 map-env1918) (let ((formals1919 (map cdr map-env1918)) (actuals1920 (map (lambda (x1921) (list (quote ref) (car x1921))) map-env1918))) (cond ((eq? (car e1917) (quote ref)) (car actuals1920)) ((andmap (lambda (x1922) (and (eq? (car x1922) (quote ref)) (memq (cadr x1922) formals1919))) (cdr e1917)) (cons (quote map) (cons (list (quote primitive) (car e1917)) (map (let ((r1923 (map cons formals1919 actuals1920))) (lambda (x1924) (cdr (assq (cadr x1924) r1923)))) (cdr e1917))))) (else (cons (quote map) (cons (list (quote lambda) formals1919 e1917) actuals1920))))))) (gen-mappend1902 (lambda (e1925 map-env1926) (list (quote apply) (quote (primitive append)) (gen-map1903 e1925 map-env1926)))) (gen-ref1901 (lambda (src1927 var1928 level1929 maps1930) (if (fx=1052 level1929 0) (values var1928 maps1930) (if (null? maps1930) (syntax-violation (quote syntax) "missing ellipsis" src1927) (call-with-values (lambda () (gen-ref1901 src1927 var1928 (fx-1051 level1929 1) (cdr maps1930))) (lambda (outer-var1931 outer-maps1932) (let ((b1933 (assq outer-var1931 (car maps1930)))) (if b1933 (values (cdr b1933) maps1930) (let ((inner-var1934 (gen-var1131 (quote tmp)))) (values inner-var1934 (cons (cons (cons outer-var1931 inner-var1934) (car maps1930)) outer-maps1932))))))))))) (gen-syntax1900 (lambda (src1935 e1936 r1937 maps1938 ellipsis?1939 mod1940) (if (id?1083 e1936) (let ((label1941 (id-var-name1105 e1936 (quote (()))))) (let ((b1942 (lookup1080 label1941 r1937 mod1940))) (if (eq? (binding-type1075 b1942) (quote syntax)) (call-with-values (lambda () (let ((var.lev1943 (binding-value1076 b1942))) (gen-ref1901 src1935 (car var.lev1943) (cdr var.lev1943) maps1938))) (lambda (var1944 maps1945) (values (list (quote ref) var1944) maps1945))) (if (ellipsis?1939 e1936) (syntax-violation (quote syntax) "misplaced ellipsis" src1935) (values (list (quote quote) e1936) maps1938))))) ((lambda (tmp1946) ((lambda (tmp1947) (if (if tmp1947 (apply (lambda (dots1948 e1949) (ellipsis?1939 dots1948)) tmp1947) #f) (apply (lambda (dots1950 e1951) (gen-syntax1900 src1935 e1951 r1937 maps1938 (lambda (x1952) #f) mod1940)) tmp1947) ((lambda (tmp1953) (if (if tmp1953 (apply (lambda (x1954 dots1955 y1956) (ellipsis?1939 dots1955)) tmp1953) #f) (apply (lambda (x1957 dots1958 y1959) (let f1960 ((y1961 y1959) (k1962 (lambda (maps1963) (call-with-values (lambda () (gen-syntax1900 src1935 x1957 r1937 (cons (quote ()) maps1963) ellipsis?1939 mod1940)) (lambda (x1964 maps1965) (if (null? (car maps1965)) (syntax-violation (quote syntax) "extra ellipsis" src1935) (values (gen-map1903 x1964 (car maps1965)) (cdr maps1965)))))))) ((lambda (tmp1966) ((lambda (tmp1967) (if (if tmp1967 (apply (lambda (dots1968 y1969) (ellipsis?1939 dots1968)) tmp1967) #f) (apply (lambda (dots1970 y1971) (f1960 y1971 (lambda (maps1972) (call-with-values (lambda () (k1962 (cons (quote ()) maps1972))) (lambda (x1973 maps1974) (if (null? (car maps1974)) (syntax-violation (quote syntax) "extra ellipsis" src1935) (values (gen-mappend1902 x1973 (car maps1974)) (cdr maps1974)))))))) tmp1967) ((lambda (_1975) (call-with-values (lambda () (gen-syntax1900 src1935 y1961 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (y1976 maps1977) (call-with-values (lambda () (k1962 maps1977)) (lambda (x1978 maps1979) (values (gen-append1905 x1978 y1976) maps1979)))))) tmp1966))) ($sc-dispatch tmp1966 (quote (any . any))))) y1961))) tmp1953) ((lambda (tmp1980) (if tmp1980 (apply (lambda (x1981 y1982) (call-with-values (lambda () (gen-syntax1900 src1935 x1981 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (x1983 maps1984) (call-with-values (lambda () (gen-syntax1900 src1935 y1982 r1937 maps1984 ellipsis?1939 mod1940)) (lambda (y1985 maps1986) (values (gen-cons1904 x1983 y1985) maps1986)))))) tmp1980) ((lambda (tmp1987) (if tmp1987 (apply (lambda (e11988 e21989) (call-with-values (lambda () (gen-syntax1900 src1935 (cons e11988 e21989) r1937 maps1938 ellipsis?1939 mod1940)) (lambda (e1991 maps1992) (values (gen-vector1906 e1991) maps1992)))) tmp1987) ((lambda (_1993) (values (list (quote quote) e1936) maps1938)) tmp1946))) ($sc-dispatch tmp1946 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1946 (quote (any . any)))))) ($sc-dispatch tmp1946 (quote (any any . any)))))) ($sc-dispatch tmp1946 (quote (any any))))) e1936))))) (lambda (e1994 r1995 w1996 s1997 mod1998) (let ((e1999 (source-wrap1112 e1994 w1996 s1997 mod1998))) ((lambda (tmp2000) ((lambda (tmp2001) (if tmp2001 (apply (lambda (_2002 x2003) (call-with-values (lambda () (gen-syntax1900 e1999 x2003 r1995 (quote ()) ellipsis?1128 mod1998)) (lambda (e2004 maps2005) (regen1907 e2004)))) tmp2001) ((lambda (_2006) (syntax-violation (quote syntax) "bad `syntax' form" e1999)) tmp2000))) ($sc-dispatch tmp2000 (quote (any any))))) e1999))))) (global-extend1081 (quote core) (quote lambda) (lambda (e2007 r2008 w2009 s2010 mod2011) ((lambda (tmp2012) ((lambda (tmp2013) (if tmp2013 (apply (lambda (_2014 c2015) (chi-lambda-clause1124 (source-wrap1112 e2007 w2009 s2010 mod2011) #f c2015 r2008 w2009 mod2011 (lambda (vars2016 docstring2017 body2018) (build-annotated1060 s2010 (cons (quote lambda) (cons vars2016 (append (if docstring2017 (list docstring2017) (quote ())) (list body2018)))))))) tmp2013) (syntax-violation #f "source expression failed to match any pattern" tmp2012))) ($sc-dispatch tmp2012 (quote (any . any))))) e2007))) (global-extend1081 (quote core) (quote let) (letrec ((chi-let2019 (lambda (e2020 r2021 w2022 s2023 mod2024 constructor2025 ids2026 vals2027 exps2028) (if (not (valid-bound-ids?1108 ids2026)) (syntax-violation (quote let) "duplicate bound variable" e2020) (let ((labels2029 (gen-labels1089 ids2026)) (new-vars2030 (map gen-var1131 ids2026))) (let ((nw2031 (make-binding-wrap1100 ids2026 labels2029 w2022)) (nr2032 (extend-var-env1078 labels2029 new-vars2030 r2021))) (constructor2025 s2023 new-vars2030 (map (lambda (x2033) (chi1119 x2033 r2021 w2022 mod2024)) vals2027) (chi-body1123 exps2028 (source-wrap1112 e2020 nw2031 s2023 mod2024) nr2032 nw2031 mod2024)))))))) (lambda (e2034 r2035 w2036 s2037 mod2038) ((lambda (tmp2039) ((lambda (tmp2040) (if tmp2040 (apply (lambda (_2041 id2042 val2043 e12044 e22045) (chi-let2019 e2034 r2035 w2036 s2037 mod2038 build-let1063 id2042 val2043 (cons e12044 e22045))) tmp2040) ((lambda (tmp2049) (if (if tmp2049 (apply (lambda (_2050 f2051 id2052 val2053 e12054 e22055) (id?1083 f2051)) tmp2049) #f) (apply (lambda (_2056 f2057 id2058 val2059 e12060 e22061) (chi-let2019 e2034 r2035 w2036 s2037 mod2038 build-named-let1064 (cons f2057 id2058) val2059 (cons e12060 e22061))) tmp2049) ((lambda (_2065) (syntax-violation (quote let) "bad let" (source-wrap1112 e2034 w2036 s2037 mod2038))) tmp2039))) ($sc-dispatch tmp2039 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2039 (quote (any #(each (any any)) any . each-any))))) e2034)))) (global-extend1081 (quote core) (quote letrec) (lambda (e2066 r2067 w2068 s2069 mod2070) ((lambda (tmp2071) ((lambda (tmp2072) (if tmp2072 (apply (lambda (_2073 id2074 val2075 e12076 e22077) (let ((ids2078 id2074)) (if (not (valid-bound-ids?1108 ids2078)) (syntax-violation (quote letrec) "duplicate bound variable" e2066) (let ((labels2080 (gen-labels1089 ids2078)) (new-vars2081 (map gen-var1131 ids2078))) (let ((w2082 (make-binding-wrap1100 ids2078 labels2080 w2068)) (r2083 (extend-var-env1078 labels2080 new-vars2081 r2067))) (build-letrec1065 s2069 new-vars2081 (map (lambda (x2084) (chi1119 x2084 r2083 w2082 mod2070)) val2075) (chi-body1123 (cons e12076 e22077) (source-wrap1112 e2066 w2082 s2069 mod2070) r2083 w2082 mod2070))))))) tmp2072) ((lambda (_2087) (syntax-violation (quote letrec) "bad letrec" (source-wrap1112 e2066 w2068 s2069 mod2070))) tmp2071))) ($sc-dispatch tmp2071 (quote (any #(each (any any)) any . each-any))))) e2066))) (global-extend1081 (quote core) (quote set!) (lambda (e2088 r2089 w2090 s2091 mod2092) ((lambda (tmp2093) ((lambda (tmp2094) (if (if tmp2094 (apply (lambda (_2095 id2096 val2097) (id?1083 id2096)) tmp2094) #f) (apply (lambda (_2098 id2099 val2100) (let ((val2101 (chi1119 val2100 r2089 w2090 mod2092)) (n2102 (id-var-name1105 id2099 w2090))) (let ((b2103 (lookup1080 n2102 r2089 mod2092))) (let ((t2104 (binding-type1075 b2103))) (if (memv t2104 (quote (lexical))) (build-annotated1060 s2091 (list (quote set!) (binding-value1076 b2103) val2101)) (if (memv t2104 (quote (global))) (build-annotated1060 s2091 (list (quote set!) (if mod2092 (make-module-ref (cdr mod2092) n2102 (car mod2092)) (make-module-ref mod2092 n2102 (quote bare))) val2101)) (if (memv t2104 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1111 id2099 w2090 mod2092)) (syntax-violation (quote set!) "bad set!" (source-wrap1112 e2088 w2090 s2091 mod2092))))))))) tmp2094) ((lambda (tmp2105) (if tmp2105 (apply (lambda (_2106 head2107 tail2108 val2109) (call-with-values (lambda () (syntax-type1117 head2107 r2089 (quote (())) #f #f mod2092)) (lambda (type2110 value2111 ee2112 ww2113 ss2114 modmod2115) (let ((t2116 type2110)) (if (memv t2116 (quote (module-ref))) (let ((val2117 (chi1119 val2109 r2089 w2090 mod2092))) (call-with-values (lambda () (value2111 (cons head2107 tail2108))) (lambda (id2119 mod2120) (build-annotated1060 s2091 (list (quote set!) (if mod2120 (make-module-ref (cdr mod2120) id2119 (car mod2120)) (make-module-ref mod2120 id2119 (quote bare))) val2117))))) (build-annotated1060 s2091 (cons (chi1119 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2107) r2089 w2090 mod2092) (map (lambda (e2121) (chi1119 e2121 r2089 w2090 mod2092)) (append tail2108 (list val2109)))))))))) tmp2105) ((lambda (_2123) (syntax-violation (quote set!) "bad set!" (source-wrap1112 e2088 w2090 s2091 mod2092))) tmp2093))) ($sc-dispatch tmp2093 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2093 (quote (any any any))))) e2088))) (global-extend1081 (quote module-ref) (quote @) (lambda (e2124) ((lambda (tmp2125) ((lambda (tmp2126) (if (if tmp2126 (apply (lambda (_2127 mod2128 id2129) (and (andmap id?1083 mod2128) (id?1083 id2129))) tmp2126) #f) (apply (lambda (_2131 mod2132 id2133) (values (syntax->datum id2133) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2132)))) tmp2126) (syntax-violation #f "source expression failed to match any pattern" tmp2125))) ($sc-dispatch tmp2125 (quote (any each-any any))))) e2124))) (global-extend1081 (quote module-ref) (quote @@) (lambda (e2135) ((lambda (tmp2136) ((lambda (tmp2137) (if (if tmp2137 (apply (lambda (_2138 mod2139 id2140) (and (andmap id?1083 mod2139) (id?1083 id2140))) tmp2137) #f) (apply (lambda (_2142 mod2143 id2144) (values (syntax->datum id2144) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2143)))) tmp2137) (syntax-violation #f "source expression failed to match any pattern" tmp2136))) ($sc-dispatch tmp2136 (quote (any each-any any))))) e2135))) (global-extend1081 (quote begin) (quote begin) (quote ())) (global-extend1081 (quote define) (quote define) (quote ())) (global-extend1081 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1081 (quote eval-when) (quote eval-when) (quote ())) (global-extend1081 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2149 (lambda (x2150 keys2151 clauses2152 r2153 mod2154) (if (null? clauses2152) (build-annotated1060 #f (list (build-annotated1060 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2150)) ((lambda (tmp2155) ((lambda (tmp2156) (if tmp2156 (apply (lambda (pat2157 exp2158) (if (and (id?1083 pat2157) (andmap (lambda (x2159) (not (free-id=?1106 pat2157 x2159))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2151))) (let ((labels2160 (list (gen-label1088))) (var2161 (gen-var1131 pat2157))) (build-annotated1060 #f (list (build-annotated1060 #f (list (quote lambda) (list var2161) (chi1119 exp2158 (extend-env1077 labels2160 (list (cons (quote syntax) (cons var2161 0))) r2153) (make-binding-wrap1100 (list pat2157) labels2160 (quote (()))) mod2154))) x2150))) (gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2157 #t exp2158 mod2154))) tmp2156) ((lambda (tmp2162) (if tmp2162 (apply (lambda (pat2163 fender2164 exp2165) (gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2163 fender2164 exp2165 mod2154)) tmp2162) ((lambda (_2166) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2152))) tmp2155))) ($sc-dispatch tmp2155 (quote (any any any)))))) ($sc-dispatch tmp2155 (quote (any any))))) (car clauses2152))))) (gen-clause2148 (lambda (x2167 keys2168 clauses2169 r2170 pat2171 fender2172 exp2173 mod2174) (call-with-values (lambda () (convert-pattern2146 pat2171 keys2168)) (lambda (p2175 pvars2176) (cond ((not (distinct-bound-ids?1109 (map car pvars2176))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2171)) ((not (andmap (lambda (x2177) (not (ellipsis?1128 (car x2177)))) pvars2176)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2171)) (else (let ((y2178 (gen-var1131 (quote tmp)))) (build-annotated1060 #f (list (build-annotated1060 #f (list (quote lambda) (list y2178) (let ((y2179 (build-annotated1060 #f y2178))) (build-annotated1060 #f (list (quote if) ((lambda (tmp2180) ((lambda (tmp2181) (if tmp2181 (apply (lambda () y2179) tmp2181) ((lambda (_2182) (build-annotated1060 #f (list (quote if) y2179 (build-dispatch-call2147 pvars2176 fender2172 y2179 r2170 mod2174) (build-data1061 #f #f)))) tmp2180))) ($sc-dispatch tmp2180 (quote #(atom #t))))) fender2172) (build-dispatch-call2147 pvars2176 exp2173 y2179 r2170 mod2174) (gen-syntax-case2149 x2167 keys2168 clauses2169 r2170 mod2174)))))) (if (eq? p2175 (quote any)) (build-annotated1060 #f (list (build-annotated1060 #f (quote list)) x2167)) (build-annotated1060 #f (list (build-annotated1060 #f (quote $sc-dispatch)) x2167 (build-data1061 #f p2175))))))))))))) (build-dispatch-call2147 (lambda (pvars2183 exp2184 y2185 r2186 mod2187) (let ((ids2188 (map car pvars2183)) (levels2189 (map cdr pvars2183))) (let ((labels2190 (gen-labels1089 ids2188)) (new-vars2191 (map gen-var1131 ids2188))) (build-annotated1060 #f (list (build-annotated1060 #f (quote apply)) (build-annotated1060 #f (list (quote lambda) new-vars2191 (chi1119 exp2184 (extend-env1077 labels2190 (map (lambda (var2192 level2193) (cons (quote syntax) (cons var2192 level2193))) new-vars2191 (map cdr pvars2183)) r2186) (make-binding-wrap1100 ids2188 labels2190 (quote (()))) mod2187))) y2185)))))) (convert-pattern2146 (lambda (pattern2194 keys2195) (let cvt2196 ((p2197 pattern2194) (n2198 0) (ids2199 (quote ()))) (if (id?1083 p2197) (if (bound-id-member?1110 p2197 keys2195) (values (vector (quote free-id) p2197) ids2199) (values (quote any) (cons (cons p2197 n2198) ids2199))) ((lambda (tmp2200) ((lambda (tmp2201) (if (if tmp2201 (apply (lambda (x2202 dots2203) (ellipsis?1128 dots2203)) tmp2201) #f) (apply (lambda (x2204 dots2205) (call-with-values (lambda () (cvt2196 x2204 (fx+1050 n2198 1) ids2199)) (lambda (p2206 ids2207) (values (if (eq? p2206 (quote any)) (quote each-any) (vector (quote each) p2206)) ids2207)))) tmp2201) ((lambda (tmp2208) (if tmp2208 (apply (lambda (x2209 y2210) (call-with-values (lambda () (cvt2196 y2210 n2198 ids2199)) (lambda (y2211 ids2212) (call-with-values (lambda () (cvt2196 x2209 n2198 ids2212)) (lambda (x2213 ids2214) (values (cons x2213 y2211) ids2214)))))) tmp2208) ((lambda (tmp2215) (if tmp2215 (apply (lambda () (values (quote ()) ids2199)) tmp2215) ((lambda (tmp2216) (if tmp2216 (apply (lambda (x2217) (call-with-values (lambda () (cvt2196 x2217 n2198 ids2199)) (lambda (p2219 ids2220) (values (vector (quote vector) p2219) ids2220)))) tmp2216) ((lambda (x2221) (values (vector (quote atom) (strip1130 p2197 (quote (())))) ids2199)) tmp2200))) ($sc-dispatch tmp2200 (quote #(vector each-any)))))) ($sc-dispatch tmp2200 (quote ()))))) ($sc-dispatch tmp2200 (quote (any . any)))))) ($sc-dispatch tmp2200 (quote (any any))))) p2197)))))) (lambda (e2222 r2223 w2224 s2225 mod2226) (let ((e2227 (source-wrap1112 e2222 w2224 s2225 mod2226))) ((lambda (tmp2228) ((lambda (tmp2229) (if tmp2229 (apply (lambda (_2230 val2231 key2232 m2233) (if (andmap (lambda (x2234) (and (id?1083 x2234) (not (ellipsis?1128 x2234)))) key2232) (let ((x2236 (gen-var1131 (quote tmp)))) (build-annotated1060 s2225 (list (build-annotated1060 #f (list (quote lambda) (list x2236) (gen-syntax-case2149 (build-annotated1060 #f x2236) key2232 m2233 r2223 mod2226))) (chi1119 val2231 r2223 (quote (())) mod2226)))) (syntax-violation (quote syntax-case) "invalid literals list" e2227))) tmp2229) (syntax-violation #f "source expression failed to match any pattern" tmp2228))) ($sc-dispatch tmp2228 (quote (any any each-any . each-any))))) e2227))))) (set! sc-expand (let ((m2239 (quote e)) (esew2240 (quote (eval)))) (lambda (x2241) (if (and (pair? x2241) (equal? (car x2241) noexpand1049)) (cadr x2241) (chi-top1118 x2241 (quote ()) (quote ((top))) m2239 esew2240 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2242 (quote e)) (esew2243 (quote (eval)))) (lambda (x2245 . rest2244) (if (and (pair? x2245) (equal? (car x2245) noexpand1049)) (cadr x2245) (chi-top1118 x2245 (quote ()) (quote ((top))) (if (null? rest2244) m2242 (car rest2244)) (if (or (null? rest2244) (null? (cdr rest2244))) esew2243 (cadr rest2244)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2246) (nonsymbol-id?1082 x2246))) (set! datum->syntax (lambda (id2247 datum2248) (make-syntax-object1066 datum2248 (syntax-object-wrap1069 id2247) #f))) (set! syntax->datum (lambda (x2249) (strip1130 x2249 (quote (()))))) (set! generate-temporaries (lambda (ls2250) (begin (let ((x2251 ls2250)) (if (not (list? x2251)) (error-hook1056 (quote generate-temporaries) "invalid argument" x2251))) (map (lambda (x2252) (wrap1111 (gensym) (quote ((top))) #f)) ls2250)))) (set! free-identifier=? (lambda (x2253 y2254) (begin (let ((x2255 x2253)) (if (not (nonsymbol-id?1082 x2255)) (error-hook1056 (quote free-identifier=?) "invalid argument" x2255))) (let ((x2256 y2254)) (if (not (nonsymbol-id?1082 x2256)) (error-hook1056 (quote free-identifier=?) "invalid argument" x2256))) (free-id=?1106 x2253 y2254)))) (set! bound-identifier=? (lambda (x2257 y2258) (begin (let ((x2259 x2257)) (if (not (nonsymbol-id?1082 x2259)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2259))) (let ((x2260 y2258)) (if (not (nonsymbol-id?1082 x2260)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2260))) (bound-id=?1107 x2257 y2258)))) (set! syntax-violation (lambda (who2264 message2263 form2262 . subform2261) (begin (let ((x2265 who2264)) (if (not ((lambda (x2266) (or (not x2266) (string? x2266) (symbol? x2266))) x2265)) (error-hook1056 (quote syntax-violation) "invalid argument" x2265))) (let ((x2267 message2263)) (if (not (string? x2267)) (error-hook1056 (quote syntax-violation) "invalid argument" x2267))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2264 "~a: " "") "~a " (if (null? subform2261) "in ~a" "in subform `~s' of `~s'")) (let ((tail2268 (cons message2263 (map (lambda (x2269) (strip1130 x2269 (quote (())))) (append subform2261 (list form2262)))))) (if who2264 (cons who2264 tail2268) tail2268)) #f)))) (set! install-global-transformer (lambda (sym2270 v2271) (begin (let ((x2272 sym2270)) (if (not (symbol? x2272)) (error-hook1056 (quote define-syntax) "invalid argument" x2272))) (let ((x2273 v2271)) (if (not (procedure? x2273)) (error-hook1056 (quote define-syntax) "invalid argument" x2273))) (global-extend1081 (quote macro) sym2270 v2271)))) (letrec ((match2278 (lambda (e2279 p2280 w2281 r2282 mod2283) (cond ((not r2282) #f) ((eq? p2280 (quote any)) (cons (wrap1111 e2279 w2281 mod2283) r2282)) ((syntax-object?1067 e2279) (match*2277 (let ((e2284 (syntax-object-expression1068 e2279))) (if (annotation? e2284) (annotation-expression e2284) e2284)) p2280 (join-wraps1102 w2281 (syntax-object-wrap1069 e2279)) r2282 (syntax-object-module1070 e2279))) (else (match*2277 (let ((e2285 e2279)) (if (annotation? e2285) (annotation-expression e2285) e2285)) p2280 w2281 r2282 mod2283))))) (match*2277 (lambda (e2286 p2287 w2288 r2289 mod2290) (cond ((null? p2287) (and (null? e2286) r2289)) ((pair? p2287) (and (pair? e2286) (match2278 (car e2286) (car p2287) w2288 (match2278 (cdr e2286) (cdr p2287) w2288 r2289 mod2290) mod2290))) ((eq? p2287 (quote each-any)) (let ((l2291 (match-each-any2275 e2286 w2288 mod2290))) (and l2291 (cons l2291 r2289)))) (else (let ((t2292 (vector-ref p2287 0))) (if (memv t2292 (quote (each))) (if (null? e2286) (match-empty2276 (vector-ref p2287 1) r2289) (let ((l2293 (match-each2274 e2286 (vector-ref p2287 1) w2288 mod2290))) (and l2293 (let collect2294 ((l2295 l2293)) (if (null? (car l2295)) r2289 (cons (map car l2295) (collect2294 (map cdr l2295)))))))) (if (memv t2292 (quote (free-id))) (and (id?1083 e2286) (free-id=?1106 (wrap1111 e2286 w2288 mod2290) (vector-ref p2287 1)) r2289) (if (memv t2292 (quote (atom))) (and (equal? (vector-ref p2287 1) (strip1130 e2286 w2288)) r2289) (if (memv t2292 (quote (vector))) (and (vector? e2286) (match2278 (vector->list e2286) (vector-ref p2287 1) w2288 r2289 mod2290))))))))))) (match-empty2276 (lambda (p2296 r2297) (cond ((null? p2296) r2297) ((eq? p2296 (quote any)) (cons (quote ()) r2297)) ((pair? p2296) (match-empty2276 (car p2296) (match-empty2276 (cdr p2296) r2297))) ((eq? p2296 (quote each-any)) (cons (quote ()) r2297)) (else (let ((t2298 (vector-ref p2296 0))) (if (memv t2298 (quote (each))) (match-empty2276 (vector-ref p2296 1) r2297) (if (memv t2298 (quote (free-id atom))) r2297 (if (memv t2298 (quote (vector))) (match-empty2276 (vector-ref p2296 1) r2297))))))))) (match-each-any2275 (lambda (e2299 w2300 mod2301) (cond ((annotation? e2299) (match-each-any2275 (annotation-expression e2299) w2300 mod2301)) ((pair? e2299) (let ((l2302 (match-each-any2275 (cdr e2299) w2300 mod2301))) (and l2302 (cons (wrap1111 (car e2299) w2300 mod2301) l2302)))) ((null? e2299) (quote ())) ((syntax-object?1067 e2299) (match-each-any2275 (syntax-object-expression1068 e2299) (join-wraps1102 w2300 (syntax-object-wrap1069 e2299)) mod2301)) (else #f)))) (match-each2274 (lambda (e2303 p2304 w2305 mod2306) (cond ((annotation? e2303) (match-each2274 (annotation-expression e2303) p2304 w2305 mod2306)) ((pair? e2303) (let ((first2307 (match2278 (car e2303) p2304 w2305 (quote ()) mod2306))) (and first2307 (let ((rest2308 (match-each2274 (cdr e2303) p2304 w2305 mod2306))) (and rest2308 (cons first2307 rest2308)))))) ((null? e2303) (quote ())) ((syntax-object?1067 e2303) (match-each2274 (syntax-object-expression1068 e2303) p2304 (join-wraps1102 w2305 (syntax-object-wrap1069 e2303)) (syntax-object-module1070 e2303))) (else #f))))) (set! $sc-dispatch (lambda (e2309 p2310) (cond ((eq? p2310 (quote any)) (list e2309)) ((syntax-object?1067 e2309) (match*2277 (let ((e2311 (syntax-object-expression1068 e2309))) (if (annotation? e2311) (annotation-expression e2311) e2311)) p2310 (syntax-object-wrap1069 e2309) (quote ()) (syntax-object-module1070 e2309))) (else (match*2277 (let ((e2312 e2309)) (if (annotation? e2312) (annotation-expression e2312) e2312)) p2310 (quote (())) (quote ()) #f))))))))
-(install-global-transformer (quote with-syntax) (lambda (x2313) ((lambda (tmp2314) ((lambda (tmp2315) (if tmp2315 (apply (lambda (_2316 e12317 e22318) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12317 e22318))) tmp2315) ((lambda (tmp2320) (if tmp2320 (apply (lambda (_2321 out2322 in2323 e12324 e22325) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2323 (quote ()) (list out2322 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12324 e22325))))) tmp2320) ((lambda (tmp2327) (if tmp2327 (apply (lambda (_2328 out2329 in2330 e12331 e22332) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2330) (quote ()) (list out2329 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12331 e22332))))) tmp2327) (syntax-violation #f "source expression failed to match any pattern" tmp2314))) ($sc-dispatch tmp2314 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2314 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2314 (quote (any () any . each-any))))) x2313)))
-(install-global-transformer (quote syntax-rules) (lambda (x2336) ((lambda (tmp2337) ((lambda (tmp2338) (if tmp2338 (apply (lambda (_2339 k2340 keyword2341 pattern2342 template2343) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k2340 (map (lambda (tmp2346 tmp2345) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2345) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2346))) template2343 pattern2342)))))) tmp2338) (syntax-violation #f "source expression failed to match any pattern" tmp2337))) ($sc-dispatch tmp2337 (quote (any each-any . #(each ((any . any) any))))))) x2336)))
-(install-global-transformer (quote let*) (lambda (x2347) ((lambda (tmp2348) ((lambda (tmp2349) (if (if tmp2349 (apply (lambda (let*2350 x2351 v2352 e12353 e22354) (andmap identifier? x2351)) tmp2349) #f) (apply (lambda (let*2356 x2357 v2358 e12359 e22360) (let f2361 ((bindings2362 (map list x2357 v2358))) (if (null? bindings2362) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e12359 e22360))) ((lambda (tmp2366) ((lambda (tmp2367) (if tmp2367 (apply (lambda (body2368 binding2369) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding2369) body2368)) tmp2367) (syntax-violation #f "source expression failed to match any pattern" tmp2366))) ($sc-dispatch tmp2366 (quote (any any))))) (list (f2361 (cdr bindings2362)) (car bindings2362)))))) tmp2349) (syntax-violation #f "source expression failed to match any pattern" tmp2348))) ($sc-dispatch tmp2348 (quote (any #(each (any any)) any . each-any))))) x2347)))
-(install-global-transformer (quote do) (lambda (orig-x2370) ((lambda (tmp2371) ((lambda (tmp2372) (if tmp2372 (apply (lambda (_2373 var2374 init2375 step2376 e02377 e12378 c2379) ((lambda (tmp2380) ((lambda (tmp2381) (if tmp2381 (apply (lambda (step2382) ((lambda (tmp2383) ((lambda (tmp2384) (if tmp2384 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2374 init2375) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02377) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2379 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2382))))))) tmp2384) ((lambda (tmp2389) (if tmp2389 (apply (lambda (e12390 e22391) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2374 init2375) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02377 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e12390 e22391)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2379 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2382))))))) tmp2389) (syntax-violation #f "source expression failed to match any pattern" tmp2383))) ($sc-dispatch tmp2383 (quote (any . each-any)))))) ($sc-dispatch tmp2383 (quote ())))) e12378)) tmp2381) (syntax-violation #f "source expression failed to match any pattern" tmp2380))) ($sc-dispatch tmp2380 (quote each-any)))) (map (lambda (v2398 s2399) ((lambda (tmp2400) ((lambda (tmp2401) (if tmp2401 (apply (lambda () v2398) tmp2401) ((lambda (tmp2402) (if tmp2402 (apply (lambda (e2403) e2403) tmp2402) ((lambda (_2404) (syntax-violation (quote do) "bad step expression" orig-x2370 s2399)) tmp2400))) ($sc-dispatch tmp2400 (quote (any)))))) ($sc-dispatch tmp2400 (quote ())))) s2399)) var2374 step2376))) tmp2372) (syntax-violation #f "source expression failed to match any pattern" tmp2371))) ($sc-dispatch tmp2371 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2370)))
-(install-global-transformer (quote quasiquote) (letrec ((quasicons2407 (lambda (x2411 y2412) ((lambda (tmp2413) ((lambda (tmp2414) (if tmp2414 (apply (lambda (x2415 y2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (dy2419) ((lambda (tmp2420) ((lambda (tmp2421) (if tmp2421 (apply (lambda (dx2422) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx2422 dy2419))) tmp2421) ((lambda (_2423) (if (null? dy2419) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2415) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2415 y2416))) tmp2420))) ($sc-dispatch tmp2420 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x2415)) tmp2418) ((lambda (tmp2424) (if tmp2424 (apply (lambda (stuff2425) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x2415 stuff2425))) tmp2424) ((lambda (else2426) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2415 y2416)) tmp2417))) ($sc-dispatch tmp2417 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp2417 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y2416)) tmp2414) (syntax-violation #f "source expression failed to match any pattern" tmp2413))) ($sc-dispatch tmp2413 (quote (any any))))) (list x2411 y2412)))) (quasiappend2408 (lambda (x2427 y2428) ((lambda (tmp2429) ((lambda (tmp2430) (if tmp2430 (apply (lambda (x2431 y2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda () x2431) tmp2434) ((lambda (_2435) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2431 y2432)) tmp2433))) ($sc-dispatch tmp2433 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y2432)) tmp2430) (syntax-violation #f "source expression failed to match any pattern" tmp2429))) ($sc-dispatch tmp2429 (quote (any any))))) (list x2427 y2428)))) (quasivector2409 (lambda (x2436) ((lambda (tmp2437) ((lambda (x2438) ((lambda (tmp2439) ((lambda (tmp2440) (if tmp2440 (apply (lambda (x2441) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x2441))) tmp2440) ((lambda (tmp2443) (if tmp2443 (apply (lambda (x2444) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2444)) tmp2443) ((lambda (_2446) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2438)) tmp2439))) ($sc-dispatch tmp2439 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp2439 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x2438)) tmp2437)) x2436))) (quasi2410 (lambda (p2447 lev2448) ((lambda (tmp2449) ((lambda (tmp2450) (if tmp2450 (apply (lambda (p2451) (if (= lev2448 0) p2451 (quasicons2407 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2410 (list p2451) (- lev2448 1))))) tmp2450) ((lambda (tmp2452) (if tmp2452 (apply (lambda (p2453 q2454) (if (= lev2448 0) (quasiappend2408 p2453 (quasi2410 q2454 lev2448)) (quasicons2407 (quasicons2407 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2410 (list p2453) (- lev2448 1))) (quasi2410 q2454 lev2448)))) tmp2452) ((lambda (tmp2455) (if tmp2455 (apply (lambda (p2456) (quasicons2407 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2410 (list p2456) (+ lev2448 1)))) tmp2455) ((lambda (tmp2457) (if tmp2457 (apply (lambda (p2458 q2459) (quasicons2407 (quasi2410 p2458 lev2448) (quasi2410 q2459 lev2448))) tmp2457) ((lambda (tmp2460) (if tmp2460 (apply (lambda (x2461) (quasivector2409 (quasi2410 x2461 lev2448))) tmp2460) ((lambda (p2463) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p2463)) tmp2449))) ($sc-dispatch tmp2449 (quote #(vector each-any)))))) ($sc-dispatch tmp2449 (quote (any . any)))))) ($sc-dispatch tmp2449 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp2449 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp2449 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p2447)))) (lambda (x2464) ((lambda (tmp2465) ((lambda (tmp2466) (if tmp2466 (apply (lambda (_2467 e2468) (quasi2410 e2468 0)) tmp2466) (syntax-violation #f "source expression failed to match any pattern" tmp2465))) ($sc-dispatch tmp2465 (quote (any any))))) x2464))))
-(install-global-transformer (quote include) (lambda (x2469) (letrec ((read-file2470 (lambda (fn2471 k2472) (let ((p2473 (open-input-file fn2471))) (let f2474 ((x2475 (read p2473))) (if (eof-object? x2475) (begin (close-input-port p2473) (quote ())) (cons (datum->syntax k2472 x2475) (f2474 (read p2473))))))))) ((lambda (tmp2476) ((lambda (tmp2477) (if tmp2477 (apply (lambda (k2478 filename2479) (let ((fn2480 (syntax->datum filename2479))) ((lambda (tmp2481) ((lambda (tmp2482) (if tmp2482 (apply (lambda (exp2483) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp2483)) tmp2482) (syntax-violation #f "source expression failed to match any pattern" tmp2481))) ($sc-dispatch tmp2481 (quote each-any)))) (read-file2470 fn2480 k2478)))) tmp2477) (syntax-violation #f "source expression failed to match any pattern" tmp2476))) ($sc-dispatch tmp2476 (quote (any any))))) x2469))))
-(install-global-transformer (quote unquote) (lambda (x2485) ((lambda (tmp2486) ((lambda (tmp2487) (if tmp2487 (apply (lambda (_2488 e2489) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2489))) tmp2487) (syntax-violation #f "source expression failed to match any pattern" tmp2486))) ($sc-dispatch tmp2486 (quote (any any))))) x2485)))
-(install-global-transformer (quote unquote-splicing) (lambda (x2490) ((lambda (tmp2491) ((lambda (tmp2492) (if tmp2492 (apply (lambda (_2493 e2494) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2494))) tmp2492) (syntax-violation #f "source expression failed to match any pattern" tmp2491))) ($sc-dispatch tmp2491 (quote (any any))))) x2490)))
-(install-global-transformer (quote case) (lambda (x2495) ((lambda (tmp2496) ((lambda (tmp2497) (if tmp2497 (apply (lambda (_2498 e2499 m12500 m22501) ((lambda (tmp2502) ((lambda (body2503) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2499)) body2503)) tmp2502)) (let f2504 ((clause2505 m12500) (clauses2506 m22501)) (if (null? clauses2506) ((lambda (tmp2508) ((lambda (tmp2509) (if tmp2509 (apply (lambda (e12510 e22511) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12510 e22511))) tmp2509) ((lambda (tmp2513) (if tmp2513 (apply (lambda (k2514 e12515 e22516) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2514)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12515 e22516)))) tmp2513) ((lambda (_2519) (syntax-violation (quote case) "bad clause" x2495 clause2505)) tmp2508))) ($sc-dispatch tmp2508 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2508 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause2505) ((lambda (tmp2520) ((lambda (rest2521) ((lambda (tmp2522) ((lambda (tmp2523) (if tmp2523 (apply (lambda (k2524 e12525 e22526) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2524)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12525 e22526)) rest2521)) tmp2523) ((lambda (_2529) (syntax-violation (quote case) "bad clause" x2495 clause2505)) tmp2522))) ($sc-dispatch tmp2522 (quote (each-any any . each-any))))) clause2505)) tmp2520)) (f2504 (car clauses2506) (cdr clauses2506))))))) tmp2497) (syntax-violation #f "source expression failed to match any pattern" tmp2496))) ($sc-dispatch tmp2496 (quote (any any any . each-any))))) x2495)))
-(install-global-transformer (quote identifier-syntax) (lambda (x2530) ((lambda (tmp2531) ((lambda (tmp2532) (if tmp2532 (apply (lambda (_2533 e2534) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2534)) (list (cons _2533 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e2534 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp2532) (syntax-violation #f "source expression failed to match any pattern" tmp2531))) ($sc-dispatch tmp2531 (quote (any any))))) x2530)))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(if #f #f)
+(letrec ((and-map*1170 (lambda (f1210 first1209 . rest1208) (or (null? first1209) (if (null? rest1208) (let andmap1211 ((first1212 first1209)) (let ((x1213 (car first1212)) (first1214 (cdr first1212))) (if (null? first1214) (f1210 x1213) (and (f1210 x1213) (andmap1211 first1214))))) (let andmap1215 ((first1216 first1209) (rest1217 rest1208)) (let ((x1218 (car first1216)) (xr1219 (map car rest1217)) (first1220 (cdr first1216)) (rest1221 (map cdr rest1217))) (if (null? first1220) (apply f1210 (cons x1218 xr1219)) (and (apply f1210 (cons x1218 xr1219)) (andmap1215 first1220 rest1221)))))))))) (letrec ((lambda-var-list1308 (lambda (vars1484) (let lvl1485 ((vars1486 vars1484) (ls1487 (quote ())) (w1488 (quote (())))) (cond ((pair? vars1486) (lvl1485 (cdr vars1486) (cons (wrap1287 (car vars1486) w1488 #f) ls1487) w1488)) ((id?1259 vars1486) (cons (wrap1287 vars1486 w1488 #f) ls1487)) ((null? vars1486) ls1487) ((syntax-object?1243 vars1486) (lvl1485 (syntax-object-expression1244 vars1486) ls1487 (join-wraps1278 w1488 (syntax-object-wrap1245 vars1486)))) ((annotation? vars1486) (lvl1485 (annotation-expression vars1486) ls1487 w1488)) (else (cons vars1486 ls1487)))))) (gen-var1307 (lambda (id1489) (let ((id1490 (if (syntax-object?1243 id1489) (syntax-object-expression1244 id1489) id1489))) (if (annotation? id1490) (build-annotated1232 (annotation-source id1490) (gensym (symbol->string (annotation-expression id1490)))) (build-annotated1232 #f (gensym (symbol->string id1490))))))) (strip1306 (lambda (x1491 w1492) (if (memq (quote top) (wrap-marks1262 w1492)) (if (or (annotation? x1491) (and (pair? x1491) (annotation? (car x1491)))) (strip-annotation1305 x1491 #f) x1491) (let f1493 ((x1494 x1491)) (cond ((syntax-object?1243 x1494) (strip1306 (syntax-object-expression1244 x1494) (syntax-object-wrap1245 x1494))) ((pair? x1494) (let ((a1495 (f1493 (car x1494))) (d1496 (f1493 (cdr x1494)))) (if (and (eq? a1495 (car x1494)) (eq? d1496 (cdr x1494))) x1494 (cons a1495 d1496)))) ((vector? x1494) (let ((old1497 (vector->list x1494))) (let ((new1498 (map f1493 old1497))) (if (and-map*1170 eq? old1497 new1498) x1494 (list->vector new1498))))) (else x1494)))))) (strip-annotation1305 (lambda (x1499 parent1500) (cond ((pair? x1499) (let ((new1501 (cons #f #f))) (begin (if parent1500 (set-annotation-stripped! parent1500 new1501)) (set-car! new1501 (strip-annotation1305 (car x1499) #f)) (set-cdr! new1501 (strip-annotation1305 (cdr x1499) #f)) new1501))) ((annotation? x1499) (or (annotation-stripped x1499) (strip-annotation1305 (annotation-expression x1499) x1499))) ((vector? x1499) (let ((new1502 (make-vector (vector-length x1499)))) (begin (if parent1500 (set-annotation-stripped! parent1500 new1502)) (let loop1503 ((i1504 (- (vector-length x1499) 1))) (unless (fx<1227 i1504 0) (vector-set! new1502 i1504 (strip-annotation1305 (vector-ref x1499 i1504) #f)) (loop1503 (fx-1225 i1504 1)))) new1502))) (else x1499)))) (ellipsis?1304 (lambda (x1505) (and (nonsymbol-id?1258 x1505) (free-id=?1282 x1505 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))))))) (chi-void1303 (lambda () (build-annotated1232 #f (cons (build-annotated1232 #f (quote if)) (quote (#f #f)))))) (eval-local-transformer1302 (lambda (expanded1506 mod1507) (let ((p1508 (local-eval-hook1229 expanded1506 mod1507))) (if (procedure? p1508) p1508 (syntax-violation #f "nonprocedure transformer" p1508))))) (chi-local-syntax1301 (lambda (rec?1509 e1510 r1511 w1512 s1513 mod1514 k1515) ((lambda (tmp1516) ((lambda (tmp1517) (if tmp1517 (apply (lambda (_1518 id1519 val1520 e11521 e21522) (let ((ids1523 id1519)) (if (not (valid-bound-ids?1284 ids1523)) (syntax-violation #f "duplicate bound keyword" e1510) (let ((labels1525 (gen-labels1265 ids1523))) (let ((new-w1526 (make-binding-wrap1276 ids1523 labels1525 w1512))) (k1515 (cons e11521 e21522) (extend-env1253 labels1525 (let ((w1528 (if rec?1509 new-w1526 w1512)) (trans-r1529 (macros-only-env1255 r1511))) (map (lambda (x1530) (cons (quote macro) (eval-local-transformer1302 (chi1295 x1530 trans-r1529 w1528 mod1514) mod1514))) val1520)) r1511) new-w1526 s1513 mod1514)))))) tmp1517) ((lambda (_1532) (syntax-violation #f "bad local syntax definition" (source-wrap1288 e1510 w1512 s1513 mod1514))) tmp1516))) ($sc-dispatch tmp1516 (quote (any #(each (any any)) any . each-any))))) e1510))) (chi-lambda-clause1300 (lambda (e1533 docstring1534 c1535 r1536 w1537 mod1538 k1539) ((lambda (tmp1540) ((lambda (tmp1541) (if (if tmp1541 (apply (lambda (args1542 doc1543 e11544 e21545) (and (string? (syntax->datum doc1543)) (not docstring1534))) tmp1541) #f) (apply (lambda (args1546 doc1547 e11548 e21549) (chi-lambda-clause1300 e1533 doc1547 (cons args1546 (cons e11548 e21549)) r1536 w1537 mod1538 k1539)) tmp1541) ((lambda (tmp1551) (if tmp1551 (apply (lambda (id1552 e11553 e21554) (let ((ids1555 id1552)) (if (not (valid-bound-ids?1284 ids1555)) (syntax-violation (quote lambda) "invalid parameter list" e1533) (let ((labels1557 (gen-labels1265 ids1555)) (new-vars1558 (map gen-var1307 ids1555))) (k1539 new-vars1558 docstring1534 (chi-body1299 (cons e11553 e21554) e1533 (extend-var-env1254 labels1557 new-vars1558 r1536) (make-binding-wrap1276 ids1555 labels1557 w1537) mod1538)))))) tmp1551) ((lambda (tmp1560) (if tmp1560 (apply (lambda (ids1561 e11562 e21563) (let ((old-ids1564 (lambda-var-list1308 ids1561))) (if (not (valid-bound-ids?1284 old-ids1564)) (syntax-violation (quote lambda) "invalid parameter list" e1533) (let ((labels1565 (gen-labels1265 old-ids1564)) (new-vars1566 (map gen-var1307 old-ids1564))) (k1539 (let f1567 ((ls11568 (cdr new-vars1566)) (ls21569 (car new-vars1566))) (if (null? ls11568) ls21569 (f1567 (cdr ls11568) (cons (car ls11568) ls21569)))) docstring1534 (chi-body1299 (cons e11562 e21563) e1533 (extend-var-env1254 labels1565 new-vars1566 r1536) (make-binding-wrap1276 old-ids1564 labels1565 w1537) mod1538)))))) tmp1560) ((lambda (_1571) (syntax-violation (quote lambda) "bad lambda" e1533)) tmp1540))) ($sc-dispatch tmp1540 (quote (any any . each-any)))))) ($sc-dispatch tmp1540 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1540 (quote (any any any . each-any))))) c1535))) (chi-body1299 (lambda (body1572 outer-form1573 r1574 w1575 mod1576) (let ((r1577 (cons (quote ("placeholder" placeholder)) r1574))) (let ((ribcage1578 (make-ribcage1266 (quote ()) (quote ()) (quote ())))) (let ((w1579 (make-wrap1261 (wrap-marks1262 w1575) (cons ribcage1578 (wrap-subst1263 w1575))))) (let parse1580 ((body1581 (map (lambda (x1587) (cons r1577 (wrap1287 x1587 w1579 mod1576))) body1572)) (ids1582 (quote ())) (labels1583 (quote ())) (vars1584 (quote ())) (vals1585 (quote ())) (bindings1586 (quote ()))) (if (null? body1581) (syntax-violation #f "no expressions in body" outer-form1573) (let ((e1588 (cdar body1581)) (er1589 (caar body1581))) (call-with-values (lambda () (syntax-type1293 e1588 er1589 (quote (())) #f ribcage1578 mod1576)) (lambda (type1590 value1591 e1592 w1593 s1594 mod1595) (let ((t1596 type1590)) (if (memv t1596 (quote (define-form))) (let ((id1597 (wrap1287 value1591 w1593 mod1595)) (label1598 (gen-label1264))) (let ((var1599 (gen-var1307 id1597))) (begin (extend-ribcage!1275 ribcage1578 id1597 label1598) (parse1580 (cdr body1581) (cons id1597 ids1582) (cons label1598 labels1583) (cons var1599 vars1584) (cons (cons er1589 (wrap1287 e1592 w1593 mod1595)) vals1585) (cons (cons (quote lexical) var1599) bindings1586))))) (if (memv t1596 (quote (define-syntax-form))) (let ((id1600 (wrap1287 value1591 w1593 mod1595)) (label1601 (gen-label1264))) (begin (extend-ribcage!1275 ribcage1578 id1600 label1601) (parse1580 (cdr body1581) (cons id1600 ids1582) (cons label1601 labels1583) vars1584 vals1585 (cons (cons (quote macro) (cons er1589 (wrap1287 e1592 w1593 mod1595))) bindings1586)))) (if (memv t1596 (quote (begin-form))) ((lambda (tmp1602) ((lambda (tmp1603) (if tmp1603 (apply (lambda (_1604 e11605) (parse1580 (let f1606 ((forms1607 e11605)) (if (null? forms1607) (cdr body1581) (cons (cons er1589 (wrap1287 (car forms1607) w1593 mod1595)) (f1606 (cdr forms1607))))) ids1582 labels1583 vars1584 vals1585 bindings1586)) tmp1603) (syntax-violation #f "source expression failed to match any pattern" tmp1602))) ($sc-dispatch tmp1602 (quote (any . each-any))))) e1592) (if (memv t1596 (quote (local-syntax-form))) (chi-local-syntax1301 value1591 e1592 er1589 w1593 s1594 mod1595 (lambda (forms1609 er1610 w1611 s1612 mod1613) (parse1580 (let f1614 ((forms1615 forms1609)) (if (null? forms1615) (cdr body1581) (cons (cons er1610 (wrap1287 (car forms1615) w1611 mod1613)) (f1614 (cdr forms1615))))) ids1582 labels1583 vars1584 vals1585 bindings1586))) (if (null? ids1582) (build-sequence1238 #f (map (lambda (x1616) (chi1295 (cdr x1616) (car x1616) (quote (())) mod1595)) (cons (cons er1589 (source-wrap1288 e1592 w1593 s1594 mod1595)) (cdr body1581)))) (begin (if (not (valid-bound-ids?1284 ids1582)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1573)) (let loop1617 ((bs1618 bindings1586) (er-cache1619 #f) (r-cache1620 #f)) (if (not (null? bs1618)) (let ((b1621 (car bs1618))) (if (eq? (car b1621) (quote macro)) (let ((er1622 (cadr b1621))) (let ((r-cache1623 (if (eq? er1622 er-cache1619) r-cache1620 (macros-only-env1255 er1622)))) (begin (set-cdr! b1621 (eval-local-transformer1302 (chi1295 (cddr b1621) r-cache1623 (quote (())) mod1595) mod1595)) (loop1617 (cdr bs1618) er1622 r-cache1623)))) (loop1617 (cdr bs1618) er-cache1619 r-cache1620))))) (set-cdr! r1577 (extend-env1253 labels1583 bindings1586 (cdr r1577))) (build-letrec1241 #f vars1584 (map (lambda (x1624) (chi1295 (cdr x1624) (car x1624) (quote (())) mod1595)) vals1585) (build-sequence1238 #f (map (lambda (x1625) (chi1295 (cdr x1625) (car x1625) (quote (())) mod1595)) (cons (cons er1589 (source-wrap1288 e1592 w1593 s1594 mod1595)) (cdr body1581)))))))))))))))))))))) (chi-macro1298 (lambda (p1626 e1627 r1628 w1629 rib1630 mod1631) (letrec ((rebuild-macro-output1632 (lambda (x1633 m1634) (cond ((pair? x1633) (cons (rebuild-macro-output1632 (car x1633) m1634) (rebuild-macro-output1632 (cdr x1633) m1634))) ((syntax-object?1243 x1633) (let ((w1635 (syntax-object-wrap1245 x1633))) (let ((ms1636 (wrap-marks1262 w1635)) (s1637 (wrap-subst1263 w1635))) (if (and (pair? ms1636) (eq? (car ms1636) #f)) (make-syntax-object1242 (syntax-object-expression1244 x1633) (make-wrap1261 (cdr ms1636) (if rib1630 (cons rib1630 (cdr s1637)) (cdr s1637))) (syntax-object-module1246 x1633)) (make-syntax-object1242 (syntax-object-expression1244 x1633) (make-wrap1261 (cons m1634 ms1636) (if rib1630 (cons rib1630 (cons (quote shift) s1637)) (cons (quote shift) s1637))) (let ((pmod1638 (procedure-module p1626))) (if pmod1638 (cons (quote hygiene) (module-name pmod1638)) (quote (hygiene guile))))))))) ((vector? x1633) (let ((n1639 (vector-length x1633))) (let ((v1640 (make-vector n1639))) (let doloop1641 ((i1642 0)) (if (fx=1226 i1642 n1639) v1640 (begin (vector-set! v1640 i1642 (rebuild-macro-output1632 (vector-ref x1633 i1642) m1634)) (doloop1641 (fx+1224 i1642 1)))))))) ((symbol? x1633) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1288 e1627 w1629 s mod1631) x1633)) (else x1633))))) (rebuild-macro-output1632 (p1626 (wrap1287 e1627 (anti-mark1274 w1629) mod1631)) (string #\m))))) (chi-application1297 (lambda (x1643 e1644 r1645 w1646 s1647 mod1648) ((lambda (tmp1649) ((lambda (tmp1650) (if tmp1650 (apply (lambda (e01651 e11652) (build-annotated1232 s1647 (cons x1643 (map (lambda (e1653) (chi1295 e1653 r1645 w1646 mod1648)) e11652)))) tmp1650) (syntax-violation #f "source expression failed to match any pattern" tmp1649))) ($sc-dispatch tmp1649 (quote (any . each-any))))) e1644))) (chi-expr1296 (lambda (type1655 value1656 e1657 r1658 w1659 s1660 mod1661) (let ((t1662 type1655)) (if (memv t1662 (quote (lexical))) (build-lexical-reference1233 (quote value) s1660 e1657 value1656) (if (memv t1662 (quote (core external-macro))) (value1656 e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote (module-ref))) (call-with-values (lambda () (value1656 e1657)) (lambda (id1663 mod1664) (build-global-reference1235 s1660 id1663 mod1664))) (if (memv t1662 (quote (lexical-call))) (chi-application1297 (build-lexical-reference1233 (quote fun) (source-annotation1250 (car e1657)) (car e1657) value1656) e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote (global-call))) (chi-application1297 (build-global-reference1235 (source-annotation1250 (car e1657)) value1656 (if (syntax-object?1243 (car e1657)) (syntax-object-module1246 (car e1657)) mod1661)) e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote (constant))) (build-data1237 s1660 (strip1306 (source-wrap1288 e1657 w1659 s1660 mod1661) (quote (())))) (if (memv t1662 (quote (global))) (build-global-reference1235 s1660 value1656 mod1661) (if (memv t1662 (quote (call))) (chi-application1297 (chi1295 (car e1657) r1658 w1659 mod1661) e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote (begin-form))) ((lambda (tmp1665) ((lambda (tmp1666) (if tmp1666 (apply (lambda (_1667 e11668 e21669) (chi-sequence1289 (cons e11668 e21669) r1658 w1659 s1660 mod1661)) tmp1666) (syntax-violation #f "source expression failed to match any pattern" tmp1665))) ($sc-dispatch tmp1665 (quote (any any . each-any))))) e1657) (if (memv t1662 (quote (local-syntax-form))) (chi-local-syntax1301 value1656 e1657 r1658 w1659 s1660 mod1661 chi-sequence1289) (if (memv t1662 (quote (eval-when-form))) ((lambda (tmp1671) ((lambda (tmp1672) (if tmp1672 (apply (lambda (_1673 x1674 e11675 e21676) (let ((when-list1677 (chi-when-list1292 e1657 x1674 w1659))) (if (memq (quote eval) when-list1677) (chi-sequence1289 (cons e11675 e21676) r1658 w1659 s1660 mod1661) (chi-void1303)))) tmp1672) (syntax-violation #f "source expression failed to match any pattern" tmp1671))) ($sc-dispatch tmp1671 (quote (any each-any any . each-any))))) e1657) (if (memv t1662 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1657 (wrap1287 value1656 w1659 mod1661)) (if (memv t1662 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1288 e1657 w1659 s1660 mod1661)) (if (memv t1662 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1288 e1657 w1659 s1660 mod1661)) (syntax-violation #f "unexpected syntax" (source-wrap1288 e1657 w1659 s1660 mod1661))))))))))))))))))) (chi1295 (lambda (e1680 r1681 w1682 mod1683) (call-with-values (lambda () (syntax-type1293 e1680 r1681 w1682 #f #f mod1683)) (lambda (type1684 value1685 e1686 w1687 s1688 mod1689) (chi-expr1296 type1684 value1685 e1686 r1681 w1687 s1688 mod1689))))) (chi-top1294 (lambda (e1690 r1691 w1692 m1693 esew1694 mod1695) (call-with-values (lambda () (syntax-type1293 e1690 r1691 w1692 #f #f mod1695)) (lambda (type1703 value1704 e1705 w1706 s1707 mod1708) (let ((t1709 type1703)) (if (memv t1709 (quote (begin-form))) ((lambda (tmp1710) ((lambda (tmp1711) (if tmp1711 (apply (lambda (_1712) (chi-void1303)) tmp1711) ((lambda (tmp1713) (if tmp1713 (apply (lambda (_1714 e11715 e21716) (chi-top-sequence1290 (cons e11715 e21716) r1691 w1706 s1707 m1693 esew1694 mod1708)) tmp1713) (syntax-violation #f "source expression failed to match any pattern" tmp1710))) ($sc-dispatch tmp1710 (quote (any any . each-any)))))) ($sc-dispatch tmp1710 (quote (any))))) e1705) (if (memv t1709 (quote (local-syntax-form))) (chi-local-syntax1301 value1704 e1705 r1691 w1706 s1707 mod1708 (lambda (body1718 r1719 w1720 s1721 mod1722) (chi-top-sequence1290 body1718 r1719 w1720 s1721 m1693 esew1694 mod1722))) (if (memv t1709 (quote (eval-when-form))) ((lambda (tmp1723) ((lambda (tmp1724) (if tmp1724 (apply (lambda (_1725 x1726 e11727 e21728) (let ((when-list1729 (chi-when-list1292 e1705 x1726 w1706)) (body1730 (cons e11727 e21728))) (cond ((eq? m1693 (quote e)) (if (memq (quote eval) when-list1729) (chi-top-sequence1290 body1730 r1691 w1706 s1707 (quote e) (quote (eval)) mod1708) (chi-void1303))) ((memq (quote load) when-list1729) (if (or (memq (quote compile) when-list1729) (and (eq? m1693 (quote c&e)) (memq (quote eval) when-list1729))) (chi-top-sequence1290 body1730 r1691 w1706 s1707 (quote c&e) (quote (compile load)) mod1708) (if (memq m1693 (quote (c c&e))) (chi-top-sequence1290 body1730 r1691 w1706 s1707 (quote c) (quote (load)) mod1708) (chi-void1303)))) ((or (memq (quote compile) when-list1729) (and (eq? m1693 (quote c&e)) (memq (quote eval) when-list1729))) (top-level-eval-hook1228 (chi-top-sequence1290 body1730 r1691 w1706 s1707 (quote e) (quote (eval)) mod1708) mod1708) (chi-void1303)) (else (chi-void1303))))) tmp1724) (syntax-violation #f "source expression failed to match any pattern" tmp1723))) ($sc-dispatch tmp1723 (quote (any each-any any . each-any))))) e1705) (if (memv t1709 (quote (define-syntax-form))) (let ((n1733 (id-var-name1281 value1704 w1706)) (r1734 (macros-only-env1255 r1691))) (let ((t1735 m1693)) (if (memv t1735 (quote (c))) (if (memq (quote compile) esew1694) (let ((e1736 (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)))) (begin (top-level-eval-hook1228 e1736 mod1708) (if (memq (quote load) esew1694) e1736 (chi-void1303)))) (if (memq (quote load) esew1694) (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)) (chi-void1303))) (if (memv t1735 (quote (c&e))) (let ((e1737 (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)))) (begin (top-level-eval-hook1228 e1737 mod1708) e1737)) (begin (if (memq (quote eval) esew1694) (top-level-eval-hook1228 (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)) mod1708)) (chi-void1303)))))) (if (memv t1709 (quote (define-form))) (let ((n1738 (id-var-name1281 value1704 w1706))) (let ((type1739 (binding-type1251 (lookup1256 n1738 r1691 mod1708)))) (let ((t1740 type1739)) (if (memv t1740 (quote (global core macro module-ref))) (let ((x1741 (build-annotated1232 s1707 (list (quote define) n1738 (chi1295 e1705 r1691 w1706 mod1708))))) (begin (if (eq? m1693 (quote c&e)) (top-level-eval-hook1228 x1741 mod1708)) x1741)) (if (memv t1740 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1705 (wrap1287 value1704 w1706 mod1708)) (syntax-violation #f "cannot define keyword at top level" e1705 (wrap1287 value1704 w1706 mod1708))))))) (let ((x1742 (chi-expr1296 type1703 value1704 e1705 r1691 w1706 s1707 mod1708))) (begin (if (eq? m1693 (quote c&e)) (top-level-eval-hook1228 x1742 mod1708)) x1742)))))))))))) (syntax-type1293 (lambda (e1743 r1744 w1745 s1746 rib1747 mod1748) (cond ((symbol? e1743) (let ((n1749 (id-var-name1281 e1743 w1745))) (let ((b1750 (lookup1256 n1749 r1744 mod1748))) (let ((type1751 (binding-type1251 b1750))) (let ((t1752 type1751)) (if (memv t1752 (quote (lexical))) (values type1751 (binding-value1252 b1750) e1743 w1745 s1746 mod1748) (if (memv t1752 (quote (global))) (values type1751 n1749 e1743 w1745 s1746 mod1748) (if (memv t1752 (quote (macro))) (syntax-type1293 (chi-macro1298 (binding-value1252 b1750) e1743 r1744 w1745 rib1747 mod1748) r1744 (quote (())) s1746 rib1747 mod1748) (values type1751 (binding-value1252 b1750) e1743 w1745 s1746 mod1748))))))))) ((pair? e1743) (let ((first1753 (car e1743))) (if (id?1259 first1753) (let ((n1754 (id-var-name1281 first1753 w1745))) (let ((b1755 (lookup1256 n1754 r1744 (or (and (syntax-object?1243 first1753) (syntax-object-module1246 first1753)) mod1748)))) (let ((type1756 (binding-type1251 b1755))) (let ((t1757 type1756)) (if (memv t1757 (quote (lexical))) (values (quote lexical-call) (binding-value1252 b1755) e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (global))) (values (quote global-call) n1754 e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (macro))) (syntax-type1293 (chi-macro1298 (binding-value1252 b1755) e1743 r1744 w1745 rib1747 mod1748) r1744 (quote (())) s1746 rib1747 mod1748) (if (memv t1757 (quote (core external-macro module-ref))) (values type1756 (binding-value1252 b1755) e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1252 b1755) e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (begin))) (values (quote begin-form) #f e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (eval-when))) (values (quote eval-when-form) #f e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (define))) ((lambda (tmp1758) ((lambda (tmp1759) (if (if tmp1759 (apply (lambda (_1760 name1761 val1762) (id?1259 name1761)) tmp1759) #f) (apply (lambda (_1763 name1764 val1765) (values (quote define-form) name1764 val1765 w1745 s1746 mod1748)) tmp1759) ((lambda (tmp1766) (if (if tmp1766 (apply (lambda (_1767 name1768 args1769 e11770 e21771) (and (id?1259 name1768) (valid-bound-ids?1284 (lambda-var-list1308 args1769)))) tmp1766) #f) (apply (lambda (_1772 name1773 args1774 e11775 e21776) (values (quote define-form) (wrap1287 name1773 w1745 mod1748) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap1287 (cons args1774 (cons e11775 e21776)) w1745 mod1748)) (quote (())) s1746 mod1748)) tmp1766) ((lambda (tmp1778) (if (if tmp1778 (apply (lambda (_1779 name1780) (id?1259 name1780)) tmp1778) #f) (apply (lambda (_1781 name1782) (values (quote define-form) (wrap1287 name1782 w1745 mod1748) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s1746 mod1748)) tmp1778) (syntax-violation #f "source expression failed to match any pattern" tmp1758))) ($sc-dispatch tmp1758 (quote (any any)))))) ($sc-dispatch tmp1758 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1758 (quote (any any any))))) e1743) (if (memv t1757 (quote (define-syntax))) ((lambda (tmp1783) ((lambda (tmp1784) (if (if tmp1784 (apply (lambda (_1785 name1786 val1787) (id?1259 name1786)) tmp1784) #f) (apply (lambda (_1788 name1789 val1790) (values (quote define-syntax-form) name1789 val1790 w1745 s1746 mod1748)) tmp1784) (syntax-violation #f "source expression failed to match any pattern" tmp1783))) ($sc-dispatch tmp1783 (quote (any any any))))) e1743) (values (quote call) #f e1743 w1745 s1746 mod1748)))))))))))))) (values (quote call) #f e1743 w1745 s1746 mod1748)))) ((syntax-object?1243 e1743) (syntax-type1293 (syntax-object-expression1244 e1743) r1744 (join-wraps1278 w1745 (syntax-object-wrap1245 e1743)) #f rib1747 (or (syntax-object-module1246 e1743) mod1748))) ((annotation? e1743) (syntax-type1293 (annotation-expression e1743) r1744 w1745 (annotation-source e1743) rib1747 mod1748)) ((self-evaluating? e1743) (values (quote constant) #f e1743 w1745 s1746 mod1748)) (else (values (quote other) #f e1743 w1745 s1746 mod1748))))) (chi-when-list1292 (lambda (e1791 when-list1792 w1793) (let f1794 ((when-list1795 when-list1792) (situations1796 (quote ()))) (if (null? when-list1795) situations1796 (f1794 (cdr when-list1795) (cons (let ((x1797 (car when-list1795))) (cond ((free-id=?1282 x1797 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile)) ((free-id=?1282 x1797 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load)) ((free-id=?1282 x1797 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1791 (wrap1287 x1797 w1793 #f))))) situations1796)))))) (chi-install-global1291 (lambda (name1798 e1799) (build-annotated1232 #f (list (build-annotated1232 #f (quote define)) name1798 (if (let ((v1800 (module-variable (current-module) name1798))) (and v1800 (variable-bound? v1800) (macro? (variable-ref v1800)) (not (eq? (macro-type (variable-ref v1800)) (quote syncase-macro))))) (build-annotated1232 #f (list (build-annotated1232 #f (quote make-extended-syncase-macro)) (build-annotated1232 #f (list (build-annotated1232 #f (quote module-ref)) (build-annotated1232 #f (quote (current-module))) (build-data1237 #f name1798))) (build-data1237 #f (quote macro)) e1799)) (build-annotated1232 #f (list (build-annotated1232 #f (quote make-syncase-macro)) (build-data1237 #f (quote macro)) e1799))))))) (chi-top-sequence1290 (lambda (body1801 r1802 w1803 s1804 m1805 esew1806 mod1807) (build-sequence1238 s1804 (let dobody1808 ((body1809 body1801) (r1810 r1802) (w1811 w1803) (m1812 m1805) (esew1813 esew1806) (mod1814 mod1807)) (if (null? body1809) (quote ()) (let ((first1815 (chi-top1294 (car body1809) r1810 w1811 m1812 esew1813 mod1814))) (cons first1815 (dobody1808 (cdr body1809) r1810 w1811 m1812 esew1813 mod1814)))))))) (chi-sequence1289 (lambda (body1816 r1817 w1818 s1819 mod1820) (build-sequence1238 s1819 (let dobody1821 ((body1822 body1816) (r1823 r1817) (w1824 w1818) (mod1825 mod1820)) (if (null? body1822) (quote ()) (let ((first1826 (chi1295 (car body1822) r1823 w1824 mod1825))) (cons first1826 (dobody1821 (cdr body1822) r1823 w1824 mod1825)))))))) (source-wrap1288 (lambda (x1827 w1828 s1829 defmod1830) (wrap1287 (if s1829 (make-annotation x1827 s1829 #f) x1827) w1828 defmod1830))) (wrap1287 (lambda (x1831 w1832 defmod1833) (cond ((and (null? (wrap-marks1262 w1832)) (null? (wrap-subst1263 w1832))) x1831) ((syntax-object?1243 x1831) (make-syntax-object1242 (syntax-object-expression1244 x1831) (join-wraps1278 w1832 (syntax-object-wrap1245 x1831)) (syntax-object-module1246 x1831))) ((null? x1831) x1831) (else (make-syntax-object1242 x1831 w1832 defmod1833))))) (bound-id-member?1286 (lambda (x1834 list1835) (and (not (null? list1835)) (or (bound-id=?1283 x1834 (car list1835)) (bound-id-member?1286 x1834 (cdr list1835)))))) (distinct-bound-ids?1285 (lambda (ids1836) (let distinct?1837 ((ids1838 ids1836)) (or (null? ids1838) (and (not (bound-id-member?1286 (car ids1838) (cdr ids1838))) (distinct?1837 (cdr ids1838))))))) (valid-bound-ids?1284 (lambda (ids1839) (and (let all-ids?1840 ((ids1841 ids1839)) (or (null? ids1841) (and (id?1259 (car ids1841)) (all-ids?1840 (cdr ids1841))))) (distinct-bound-ids?1285 ids1839)))) (bound-id=?1283 (lambda (i1842 j1843) (if (and (syntax-object?1243 i1842) (syntax-object?1243 j1843)) (and (eq? (let ((e1844 (syntax-object-expression1244 i1842))) (if (annotation? e1844) (annotation-expression e1844) e1844)) (let ((e1845 (syntax-object-expression1244 j1843))) (if (annotation? e1845) (annotation-expression e1845) e1845))) (same-marks?1280 (wrap-marks1262 (syntax-object-wrap1245 i1842)) (wrap-marks1262 (syntax-object-wrap1245 j1843)))) (eq? (let ((e1846 i1842)) (if (annotation? e1846) (annotation-expression e1846) e1846)) (let ((e1847 j1843)) (if (annotation? e1847) (annotation-expression e1847) e1847)))))) (free-id=?1282 (lambda (i1848 j1849) (and (eq? (let ((x1850 i1848)) (let ((e1851 (if (syntax-object?1243 x1850) (syntax-object-expression1244 x1850) x1850))) (if (annotation? e1851) (annotation-expression e1851) e1851))) (let ((x1852 j1849)) (let ((e1853 (if (syntax-object?1243 x1852) (syntax-object-expression1244 x1852) x1852))) (if (annotation? e1853) (annotation-expression e1853) e1853)))) (eq? (id-var-name1281 i1848 (quote (()))) (id-var-name1281 j1849 (quote (()))))))) (id-var-name1281 (lambda (id1854 w1855) (letrec ((search-vector-rib1858 (lambda (sym1864 subst1865 marks1866 symnames1867 ribcage1868) (let ((n1869 (vector-length symnames1867))) (let f1870 ((i1871 0)) (cond ((fx=1226 i1871 n1869) (search1856 sym1864 (cdr subst1865) marks1866)) ((and (eq? (vector-ref symnames1867 i1871) sym1864) (same-marks?1280 marks1866 (vector-ref (ribcage-marks1269 ribcage1868) i1871))) (values (vector-ref (ribcage-labels1270 ribcage1868) i1871) marks1866)) (else (f1870 (fx+1224 i1871 1)))))))) (search-list-rib1857 (lambda (sym1872 subst1873 marks1874 symnames1875 ribcage1876) (let f1877 ((symnames1878 symnames1875) (i1879 0)) (cond ((null? symnames1878) (search1856 sym1872 (cdr subst1873) marks1874)) ((and (eq? (car symnames1878) sym1872) (same-marks?1280 marks1874 (list-ref (ribcage-marks1269 ribcage1876) i1879))) (values (list-ref (ribcage-labels1270 ribcage1876) i1879) marks1874)) (else (f1877 (cdr symnames1878) (fx+1224 i1879 1))))))) (search1856 (lambda (sym1880 subst1881 marks1882) (if (null? subst1881) (values #f marks1882) (let ((fst1883 (car subst1881))) (if (eq? fst1883 (quote shift)) (search1856 sym1880 (cdr subst1881) (cdr marks1882)) (let ((symnames1884 (ribcage-symnames1268 fst1883))) (if (vector? symnames1884) (search-vector-rib1858 sym1880 subst1881 marks1882 symnames1884 fst1883) (search-list-rib1857 sym1880 subst1881 marks1882 symnames1884 fst1883))))))))) (cond ((symbol? id1854) (or (call-with-values (lambda () (search1856 id1854 (wrap-subst1263 w1855) (wrap-marks1262 w1855))) (lambda (x1886 . ignore1885) x1886)) id1854)) ((syntax-object?1243 id1854) (let ((id1887 (let ((e1889 (syntax-object-expression1244 id1854))) (if (annotation? e1889) (annotation-expression e1889) e1889))) (w11888 (syntax-object-wrap1245 id1854))) (let ((marks1890 (join-marks1279 (wrap-marks1262 w1855) (wrap-marks1262 w11888)))) (call-with-values (lambda () (search1856 id1887 (wrap-subst1263 w1855) marks1890)) (lambda (new-id1891 marks1892) (or new-id1891 (call-with-values (lambda () (search1856 id1887 (wrap-subst1263 w11888) marks1892)) (lambda (x1894 . ignore1893) x1894)) id1887)))))) ((annotation? id1854) (let ((id1895 (let ((e1896 id1854)) (if (annotation? e1896) (annotation-expression e1896) e1896)))) (or (call-with-values (lambda () (search1856 id1895 (wrap-subst1263 w1855) (wrap-marks1262 w1855))) (lambda (x1898 . ignore1897) x1898)) id1895))) (else (syntax-violation (quote id-var-name) "invalid id" id1854)))))) (same-marks?1280 (lambda (x1899 y1900) (or (eq? x1899 y1900) (and (not (null? x1899)) (not (null? y1900)) (eq? (car x1899) (car y1900)) (same-marks?1280 (cdr x1899) (cdr y1900)))))) (join-marks1279 (lambda (m11901 m21902) (smart-append1277 m11901 m21902))) (join-wraps1278 (lambda (w11903 w21904) (let ((m11905 (wrap-marks1262 w11903)) (s11906 (wrap-subst1263 w11903))) (if (null? m11905) (if (null? s11906) w21904 (make-wrap1261 (wrap-marks1262 w21904) (smart-append1277 s11906 (wrap-subst1263 w21904)))) (make-wrap1261 (smart-append1277 m11905 (wrap-marks1262 w21904)) (smart-append1277 s11906 (wrap-subst1263 w21904))))))) (smart-append1277 (lambda (m11907 m21908) (if (null? m21908) m11907 (append m11907 m21908)))) (make-binding-wrap1276 (lambda (ids1909 labels1910 w1911) (if (null? ids1909) w1911 (make-wrap1261 (wrap-marks1262 w1911) (cons (let ((labelvec1912 (list->vector labels1910))) (let ((n1913 (vector-length labelvec1912))) (let ((symnamevec1914 (make-vector n1913)) (marksvec1915 (make-vector n1913))) (begin (let f1916 ((ids1917 ids1909) (i1918 0)) (if (not (null? ids1917)) (call-with-values (lambda () (id-sym-name&marks1260 (car ids1917) w1911)) (lambda (symname1919 marks1920) (begin (vector-set! symnamevec1914 i1918 symname1919) (vector-set! marksvec1915 i1918 marks1920) (f1916 (cdr ids1917) (fx+1224 i1918 1))))))) (make-ribcage1266 symnamevec1914 marksvec1915 labelvec1912))))) (wrap-subst1263 w1911)))))) (extend-ribcage!1275 (lambda (ribcage1921 id1922 label1923) (begin (set-ribcage-symnames!1271 ribcage1921 (cons (let ((e1924 (syntax-object-expression1244 id1922))) (if (annotation? e1924) (annotation-expression e1924) e1924)) (ribcage-symnames1268 ribcage1921))) (set-ribcage-marks!1272 ribcage1921 (cons (wrap-marks1262 (syntax-object-wrap1245 id1922)) (ribcage-marks1269 ribcage1921))) (set-ribcage-labels!1273 ribcage1921 (cons label1923 (ribcage-labels1270 ribcage1921)))))) (anti-mark1274 (lambda (w1925) (make-wrap1261 (cons #f (wrap-marks1262 w1925)) (cons (quote shift) (wrap-subst1263 w1925))))) (set-ribcage-labels!1273 (lambda (x1926 update1927) (vector-set! x1926 3 update1927))) (set-ribcage-marks!1272 (lambda (x1928 update1929) (vector-set! x1928 2 update1929))) (set-ribcage-symnames!1271 (lambda (x1930 update1931) (vector-set! x1930 1 update1931))) (ribcage-labels1270 (lambda (x1932) (vector-ref x1932 3))) (ribcage-marks1269 (lambda (x1933) (vector-ref x1933 2))) (ribcage-symnames1268 (lambda (x1934) (vector-ref x1934 1))) (ribcage?1267 (lambda (x1935) (and (vector? x1935) (= (vector-length x1935) 4) (eq? (vector-ref x1935 0) (quote ribcage))))) (make-ribcage1266 (lambda (symnames1936 marks1937 labels1938) (vector (quote ribcage) symnames1936 marks1937 labels1938))) (gen-labels1265 (lambda (ls1939) (if (null? ls1939) (quote ()) (cons (gen-label1264) (gen-labels1265 (cdr ls1939)))))) (gen-label1264 (lambda () (string #\i))) (wrap-subst1263 cdr) (wrap-marks1262 car) (make-wrap1261 cons) (id-sym-name&marks1260 (lambda (x1940 w1941) (if (syntax-object?1243 x1940) (values (let ((e1942 (syntax-object-expression1244 x1940))) (if (annotation? e1942) (annotation-expression e1942) e1942)) (join-marks1279 (wrap-marks1262 w1941) (wrap-marks1262 (syntax-object-wrap1245 x1940)))) (values (let ((e1943 x1940)) (if (annotation? e1943) (annotation-expression e1943) e1943)) (wrap-marks1262 w1941))))) (id?1259 (lambda (x1944) (cond ((symbol? x1944) #t) ((syntax-object?1243 x1944) (symbol? (let ((e1945 (syntax-object-expression1244 x1944))) (if (annotation? e1945) (annotation-expression e1945) e1945)))) ((annotation? x1944) (symbol? (annotation-expression x1944))) (else #f)))) (nonsymbol-id?1258 (lambda (x1946) (and (syntax-object?1243 x1946) (symbol? (let ((e1947 (syntax-object-expression1244 x1946))) (if (annotation? e1947) (annotation-expression e1947) e1947)))))) (global-extend1257 (lambda (type1948 sym1949 val1950) (put-global-definition-hook1230 sym1949 type1948 val1950))) (lookup1256 (lambda (x1951 r1952 mod1953) (cond ((assq x1951 r1952) => cdr) ((symbol? x1951) (or (get-global-definition-hook1231 x1951 mod1953) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1255 (lambda (r1954) (if (null? r1954) (quote ()) (let ((a1955 (car r1954))) (if (eq? (cadr a1955) (quote macro)) (cons a1955 (macros-only-env1255 (cdr r1954))) (macros-only-env1255 (cdr r1954))))))) (extend-var-env1254 (lambda (labels1956 vars1957 r1958) (if (null? labels1956) r1958 (extend-var-env1254 (cdr labels1956) (cdr vars1957) (cons (cons (car labels1956) (cons (quote lexical) (car vars1957))) r1958))))) (extend-env1253 (lambda (labels1959 bindings1960 r1961) (if (null? labels1959) r1961 (extend-env1253 (cdr labels1959) (cdr bindings1960) (cons (cons (car labels1959) (car bindings1960)) r1961))))) (binding-value1252 cdr) (binding-type1251 car) (source-annotation1250 (lambda (x1962) (cond ((annotation? x1962) (annotation-source x1962)) ((syntax-object?1243 x1962) (source-annotation1250 (syntax-object-expression1244 x1962))) (else #f)))) (set-syntax-object-module!1249 (lambda (x1963 update1964) (vector-set! x1963 3 update1964))) (set-syntax-object-wrap!1248 (lambda (x1965 update1966) (vector-set! x1965 2 update1966))) (set-syntax-object-expression!1247 (lambda (x1967 update1968) (vector-set! x1967 1 update1968))) (syntax-object-module1246 (lambda (x1969) (vector-ref x1969 3))) (syntax-object-wrap1245 (lambda (x1970) (vector-ref x1970 2))) (syntax-object-expression1244 (lambda (x1971) (vector-ref x1971 1))) (syntax-object?1243 (lambda (x1972) (and (vector? x1972) (= (vector-length x1972) 4) (eq? (vector-ref x1972 0) (quote syntax-object))))) (make-syntax-object1242 (lambda (expression1973 wrap1974 module1975) (vector (quote syntax-object) expression1973 wrap1974 module1975))) (build-letrec1241 (lambda (src1976 vars1977 val-exps1978 body-exp1979) (if (null? vars1977) (build-annotated1232 src1976 body-exp1979) (build-annotated1232 src1976 (list (quote letrec) (map list vars1977 val-exps1978) body-exp1979))))) (build-named-let1240 (lambda (src1980 vars1981 val-exps1982 body-exp1983) (if (null? vars1981) (build-annotated1232 src1980 body-exp1983) (build-annotated1232 src1980 (list (quote let) (car vars1981) (map list (cdr vars1981) val-exps1982) body-exp1983))))) (build-let1239 (lambda (src1984 vars1985 val-exps1986 body-exp1987) (if (null? vars1985) (build-annotated1232 src1984 body-exp1987) (build-annotated1232 src1984 (list (quote let) (map list vars1985 val-exps1986) body-exp1987))))) (build-sequence1238 (lambda (src1988 exps1989) (if (null? (cdr exps1989)) (build-annotated1232 src1988 (car exps1989)) (build-annotated1232 src1988 (cons (quote begin) exps1989))))) (build-data1237 (lambda (src1990 exp1991) (if (and (self-evaluating? exp1991) (not (vector? exp1991))) (build-annotated1232 src1990 exp1991) (build-annotated1232 src1990 (list (quote quote) exp1991))))) (build-global-assignment1236 (lambda (source1992 var1993 exp1994 mod1995) (let ((ref1996 (build-global-reference1235 source1992 var1993 mod1995))) (build-annotated1232 source1992 (list (quote set!) ref1996 exp1994))))) (build-global-reference1235 (lambda (source1997 var1998 mod1999) (build-annotated1232 source1997 (if (not mod1999) var1998 (let ((make-module-ref2000 (let ((t2003 (fluid-ref *mode*1223))) (if (memv t2003 (quote (c))) (@ (ice-9 expand-support) make-module-ref) (lambda (mod2004 var2005 public?2006) (list (if public?2006 (quote @) (quote @@)) mod2004 var2005))))) (kind2001 (car mod1999)) (mod2002 (cdr mod1999))) (let ((t2007 kind2001)) (if (memv t2007 (quote (public))) (make-module-ref2000 mod2002 var1998 #t) (if (memv t2007 (quote (private))) (if (not (equal? mod2002 (module-name (current-module)))) (make-module-ref2000 mod2002 var1998 #f) var1998) (if (memv t2007 (quote (bare))) var1998 (if (memv t2007 (quote (hygiene))) (if (and (not (equal? mod2002 (module-name (current-module)))) (module-variable (resolve-module mod2002) var1998)) (make-module-ref2000 mod2002 var1998 #f) var1998) (syntax-violation #f "bad module kind" var1998 mod2002))))))))))) (build-lexical-assignment1234 (lambda (source2008 name2009 var2010 exp2011) (build-annotated1232 source2008 (list (quote set!) (build-lexical-reference1233 (quote set) #f name2009 var2010) exp2011)))) (build-lexical-reference1233 (lambda (type2012 source2013 name2014 var2015) (build-annotated1232 source2013 (let ((t2016 (fluid-ref *mode*1223))) (if (memv t2016 (quote (c))) ((@ (ice-9 expand-support) make-lexical) name2014 var2015) var2015))))) (build-annotated1232 (lambda (src2017 exp2018) (if (and src2017 (not (annotation? exp2018))) (make-annotation exp2018 src2017 #t) exp2018))) (get-global-definition-hook1231 (lambda (symbol2019 module2020) (begin (if (and (not module2020) (current-module)) (warn "module system is booted, we should have a module" symbol2019)) (let ((v2021 (module-variable (if module2020 (resolve-module (cdr module2020)) (current-module)) symbol2019))) (and v2021 (variable-bound? v2021) (let ((val2022 (variable-ref v2021))) (and (macro? val2022) (syncase-macro-type val2022) (cons (syncase-macro-type val2022) (syncase-macro-binding val2022))))))))) (put-global-definition-hook1230 (lambda (symbol2023 type2024 val2025) (let ((existing2026 (let ((v2027 (module-variable (current-module) symbol2023))) (and v2027 (variable-bound? v2027) (let ((val2028 (variable-ref v2027))) (and (macro? val2028) (not (syncase-macro-type val2028)) val2028)))))) (module-define! (current-module) symbol2023 (if existing2026 (make-extended-syncase-macro existing2026 type2024 val2025) (make-syncase-macro type2024 val2025)))))) (local-eval-hook1229 (lambda (x2029 mod2030) (primitive-eval (list noexpand1222 (let ((t2031 (fluid-ref *mode*1223))) (if (memv t2031 (quote (c))) ((@ (ice-9 expand-support) strip-expansion-structures) x2029) x2029)))))) (top-level-eval-hook1228 (lambda (x2032 mod2033) (primitive-eval (list noexpand1222 (let ((t2034 (fluid-ref *mode*1223))) (if (memv t2034 (quote (c))) ((@ (ice-9 expand-support) strip-expansion-structures) x2032) x2032)))))) (fx<1227 <) (fx=1226 =) (fx-1225 -) (fx+1224 +) (*mode*1223 (make-fluid)) (noexpand1222 "noexpand")) (begin (global-extend1257 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1257 (quote local-syntax) (quote let-syntax) #f) (global-extend1257 (quote core) (quote fluid-let-syntax) (lambda (e2035 r2036 w2037 s2038 mod2039) ((lambda (tmp2040) ((lambda (tmp2041) (if (if tmp2041 (apply (lambda (_2042 var2043 val2044 e12045 e22046) (valid-bound-ids?1284 var2043)) tmp2041) #f) (apply (lambda (_2048 var2049 val2050 e12051 e22052) (let ((names2053 (map (lambda (x2054) (id-var-name1281 x2054 w2037)) var2049))) (begin (for-each (lambda (id2056 n2057) (let ((t2058 (binding-type1251 (lookup1256 n2057 r2036 mod2039)))) (if (memv t2058 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e2035 (source-wrap1288 id2056 w2037 s2038 mod2039))))) var2049 names2053) (chi-body1299 (cons e12051 e22052) (source-wrap1288 e2035 w2037 s2038 mod2039) (extend-env1253 names2053 (let ((trans-r2061 (macros-only-env1255 r2036))) (map (lambda (x2062) (cons (quote macro) (eval-local-transformer1302 (chi1295 x2062 trans-r2061 w2037 mod2039) mod2039))) val2050)) r2036) w2037 mod2039)))) tmp2041) ((lambda (_2064) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1288 e2035 w2037 s2038 mod2039))) tmp2040))) ($sc-dispatch tmp2040 (quote (any #(each (any any)) any . each-any))))) e2035))) (global-extend1257 (quote core) (quote quote) (lambda (e2065 r2066 w2067 s2068 mod2069) ((lambda (tmp2070) ((lambda (tmp2071) (if tmp2071 (apply (lambda (_2072 e2073) (build-data1237 s2068 (strip1306 e2073 w2067))) tmp2071) ((lambda (_2074) (syntax-violation (quote quote) "bad syntax" (source-wrap1288 e2065 w2067 s2068 mod2069))) tmp2070))) ($sc-dispatch tmp2070 (quote (any any))))) e2065))) (global-extend1257 (quote core) (quote syntax) (letrec ((regen2082 (lambda (x2083) (let ((t2084 (car x2083))) (if (memv t2084 (quote (ref))) (build-lexical-reference1233 (quote value) #f (cadr x2083) (cadr x2083)) (if (memv t2084 (quote (primitive))) (build-annotated1232 #f (cadr x2083)) (if (memv t2084 (quote (quote))) (build-data1237 #f (cadr x2083)) (if (memv t2084 (quote (lambda))) (build-annotated1232 #f (list (quote lambda) (cadr x2083) (regen2082 (caddr x2083)))) (if (memv t2084 (quote (map))) (let ((ls2085 (map regen2082 (cdr x2083)))) (build-annotated1232 #f (cons (if (fx=1226 (length ls2085) 2) (build-annotated1232 #f (quote map)) (build-annotated1232 #f (quote map))) ls2085))) (build-annotated1232 #f (cons (build-annotated1232 #f (car x2083)) (map regen2082 (cdr x2083)))))))))))) (gen-vector2081 (lambda (x2086) (cond ((eq? (car x2086) (quote list)) (cons (quote vector) (cdr x2086))) ((eq? (car x2086) (quote quote)) (list (quote quote) (list->vector (cadr x2086)))) (else (list (quote list->vector) x2086))))) (gen-append2080 (lambda (x2087 y2088) (if (equal? y2088 (quote (quote ()))) x2087 (list (quote append) x2087 y2088)))) (gen-cons2079 (lambda (x2089 y2090) (let ((t2091 (car y2090))) (if (memv t2091 (quote (quote))) (if (eq? (car x2089) (quote quote)) (list (quote quote) (cons (cadr x2089) (cadr y2090))) (if (eq? (cadr y2090) (quote ())) (list (quote list) x2089) (list (quote cons) x2089 y2090))) (if (memv t2091 (quote (list))) (cons (quote list) (cons x2089 (cdr y2090))) (list (quote cons) x2089 y2090)))))) (gen-map2078 (lambda (e2092 map-env2093) (let ((formals2094 (map cdr map-env2093)) (actuals2095 (map (lambda (x2096) (list (quote ref) (car x2096))) map-env2093))) (cond ((eq? (car e2092) (quote ref)) (car actuals2095)) ((and-map (lambda (x2097) (and (eq? (car x2097) (quote ref)) (memq (cadr x2097) formals2094))) (cdr e2092)) (cons (quote map) (cons (list (quote primitive) (car e2092)) (map (let ((r2098 (map cons formals2094 actuals2095))) (lambda (x2099) (cdr (assq (cadr x2099) r2098)))) (cdr e2092))))) (else (cons (quote map) (cons (list (quote lambda) formals2094 e2092) actuals2095))))))) (gen-mappend2077 (lambda (e2100 map-env2101) (list (quote apply) (quote (primitive append)) (gen-map2078 e2100 map-env2101)))) (gen-ref2076 (lambda (src2102 var2103 level2104 maps2105) (if (fx=1226 level2104 0) (values var2103 maps2105) (if (null? maps2105) (syntax-violation (quote syntax) "missing ellipsis" src2102) (call-with-values (lambda () (gen-ref2076 src2102 var2103 (fx-1225 level2104 1) (cdr maps2105))) (lambda (outer-var2106 outer-maps2107) (let ((b2108 (assq outer-var2106 (car maps2105)))) (if b2108 (values (cdr b2108) maps2105) (let ((inner-var2109 (gen-var1307 (quote tmp)))) (values inner-var2109 (cons (cons (cons outer-var2106 inner-var2109) (car maps2105)) outer-maps2107))))))))))) (gen-syntax2075 (lambda (src2110 e2111 r2112 maps2113 ellipsis?2114 mod2115) (if (id?1259 e2111) (let ((label2116 (id-var-name1281 e2111 (quote (()))))) (let ((b2117 (lookup1256 label2116 r2112 mod2115))) (if (eq? (binding-type1251 b2117) (quote syntax)) (call-with-values (lambda () (let ((var.lev2118 (binding-value1252 b2117))) (gen-ref2076 src2110 (car var.lev2118) (cdr var.lev2118) maps2113))) (lambda (var2119 maps2120) (values (list (quote ref) var2119) maps2120))) (if (ellipsis?2114 e2111) (syntax-violation (quote syntax) "misplaced ellipsis" src2110) (values (list (quote quote) e2111) maps2113))))) ((lambda (tmp2121) ((lambda (tmp2122) (if (if tmp2122 (apply (lambda (dots2123 e2124) (ellipsis?2114 dots2123)) tmp2122) #f) (apply (lambda (dots2125 e2126) (gen-syntax2075 src2110 e2126 r2112 maps2113 (lambda (x2127) #f) mod2115)) tmp2122) ((lambda (tmp2128) (if (if tmp2128 (apply (lambda (x2129 dots2130 y2131) (ellipsis?2114 dots2130)) tmp2128) #f) (apply (lambda (x2132 dots2133 y2134) (let f2135 ((y2136 y2134) (k2137 (lambda (maps2138) (call-with-values (lambda () (gen-syntax2075 src2110 x2132 r2112 (cons (quote ()) maps2138) ellipsis?2114 mod2115)) (lambda (x2139 maps2140) (if (null? (car maps2140)) (syntax-violation (quote syntax) "extra ellipsis" src2110) (values (gen-map2078 x2139 (car maps2140)) (cdr maps2140)))))))) ((lambda (tmp2141) ((lambda (tmp2142) (if (if tmp2142 (apply (lambda (dots2143 y2144) (ellipsis?2114 dots2143)) tmp2142) #f) (apply (lambda (dots2145 y2146) (f2135 y2146 (lambda (maps2147) (call-with-values (lambda () (k2137 (cons (quote ()) maps2147))) (lambda (x2148 maps2149) (if (null? (car maps2149)) (syntax-violation (quote syntax) "extra ellipsis" src2110) (values (gen-mappend2077 x2148 (car maps2149)) (cdr maps2149)))))))) tmp2142) ((lambda (_2150) (call-with-values (lambda () (gen-syntax2075 src2110 y2136 r2112 maps2113 ellipsis?2114 mod2115)) (lambda (y2151 maps2152) (call-with-values (lambda () (k2137 maps2152)) (lambda (x2153 maps2154) (values (gen-append2080 x2153 y2151) maps2154)))))) tmp2141))) ($sc-dispatch tmp2141 (quote (any . any))))) y2136))) tmp2128) ((lambda (tmp2155) (if tmp2155 (apply (lambda (x2156 y2157) (call-with-values (lambda () (gen-syntax2075 src2110 x2156 r2112 maps2113 ellipsis?2114 mod2115)) (lambda (x2158 maps2159) (call-with-values (lambda () (gen-syntax2075 src2110 y2157 r2112 maps2159 ellipsis?2114 mod2115)) (lambda (y2160 maps2161) (values (gen-cons2079 x2158 y2160) maps2161)))))) tmp2155) ((lambda (tmp2162) (if tmp2162 (apply (lambda (e12163 e22164) (call-with-values (lambda () (gen-syntax2075 src2110 (cons e12163 e22164) r2112 maps2113 ellipsis?2114 mod2115)) (lambda (e2166 maps2167) (values (gen-vector2081 e2166) maps2167)))) tmp2162) ((lambda (_2168) (values (list (quote quote) e2111) maps2113)) tmp2121))) ($sc-dispatch tmp2121 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2121 (quote (any . any)))))) ($sc-dispatch tmp2121 (quote (any any . any)))))) ($sc-dispatch tmp2121 (quote (any any))))) e2111))))) (lambda (e2169 r2170 w2171 s2172 mod2173) (let ((e2174 (source-wrap1288 e2169 w2171 s2172 mod2173))) ((lambda (tmp2175) ((lambda (tmp2176) (if tmp2176 (apply (lambda (_2177 x2178) (call-with-values (lambda () (gen-syntax2075 e2174 x2178 r2170 (quote ()) ellipsis?1304 mod2173)) (lambda (e2179 maps2180) (regen2082 e2179)))) tmp2176) ((lambda (_2181) (syntax-violation (quote syntax) "bad `syntax' form" e2174)) tmp2175))) ($sc-dispatch tmp2175 (quote (any any))))) e2174))))) (global-extend1257 (quote core) (quote lambda) (lambda (e2182 r2183 w2184 s2185 mod2186) ((lambda (tmp2187) ((lambda (tmp2188) (if tmp2188 (apply (lambda (_2189 c2190) (chi-lambda-clause1300 (source-wrap1288 e2182 w2184 s2185 mod2186) #f c2190 r2183 w2184 mod2186 (lambda (vars2191 docstring2192 body2193) (build-annotated1232 s2185 (cons (quote lambda) (cons vars2191 (append (if docstring2192 (list docstring2192) (quote ())) (list body2193)))))))) tmp2188) (syntax-violation #f "source expression failed to match any pattern" tmp2187))) ($sc-dispatch tmp2187 (quote (any . any))))) e2182))) (global-extend1257 (quote core) (quote let) (letrec ((chi-let2194 (lambda (e2195 r2196 w2197 s2198 mod2199 constructor2200 ids2201 vals2202 exps2203) (if (not (valid-bound-ids?1284 ids2201)) (syntax-violation (quote let) "duplicate bound variable" e2195) (let ((labels2204 (gen-labels1265 ids2201)) (new-vars2205 (map gen-var1307 ids2201))) (let ((nw2206 (make-binding-wrap1276 ids2201 labels2204 w2197)) (nr2207 (extend-var-env1254 labels2204 new-vars2205 r2196))) (constructor2200 s2198 new-vars2205 (map (lambda (x2208) (chi1295 x2208 r2196 w2197 mod2199)) vals2202) (chi-body1299 exps2203 (source-wrap1288 e2195 nw2206 s2198 mod2199) nr2207 nw2206 mod2199)))))))) (lambda (e2209 r2210 w2211 s2212 mod2213) ((lambda (tmp2214) ((lambda (tmp2215) (if tmp2215 (apply (lambda (_2216 id2217 val2218 e12219 e22220) (chi-let2194 e2209 r2210 w2211 s2212 mod2213 build-let1239 id2217 val2218 (cons e12219 e22220))) tmp2215) ((lambda (tmp2224) (if (if tmp2224 (apply (lambda (_2225 f2226 id2227 val2228 e12229 e22230) (id?1259 f2226)) tmp2224) #f) (apply (lambda (_2231 f2232 id2233 val2234 e12235 e22236) (chi-let2194 e2209 r2210 w2211 s2212 mod2213 build-named-let1240 (cons f2232 id2233) val2234 (cons e12235 e22236))) tmp2224) ((lambda (_2240) (syntax-violation (quote let) "bad let" (source-wrap1288 e2209 w2211 s2212 mod2213))) tmp2214))) ($sc-dispatch tmp2214 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2214 (quote (any #(each (any any)) any . each-any))))) e2209)))) (global-extend1257 (quote core) (quote letrec) (lambda (e2241 r2242 w2243 s2244 mod2245) ((lambda (tmp2246) ((lambda (tmp2247) (if tmp2247 (apply (lambda (_2248 id2249 val2250 e12251 e22252) (let ((ids2253 id2249)) (if (not (valid-bound-ids?1284 ids2253)) (syntax-violation (quote letrec) "duplicate bound variable" e2241) (let ((labels2255 (gen-labels1265 ids2253)) (new-vars2256 (map gen-var1307 ids2253))) (let ((w2257 (make-binding-wrap1276 ids2253 labels2255 w2243)) (r2258 (extend-var-env1254 labels2255 new-vars2256 r2242))) (build-letrec1241 s2244 new-vars2256 (map (lambda (x2259) (chi1295 x2259 r2258 w2257 mod2245)) val2250) (chi-body1299 (cons e12251 e22252) (source-wrap1288 e2241 w2257 s2244 mod2245) r2258 w2257 mod2245))))))) tmp2247) ((lambda (_2262) (syntax-violation (quote letrec) "bad letrec" (source-wrap1288 e2241 w2243 s2244 mod2245))) tmp2246))) ($sc-dispatch tmp2246 (quote (any #(each (any any)) any . each-any))))) e2241))) (global-extend1257 (quote core) (quote set!) (lambda (e2263 r2264 w2265 s2266 mod2267) ((lambda (tmp2268) ((lambda (tmp2269) (if (if tmp2269 (apply (lambda (_2270 id2271 val2272) (id?1259 id2271)) tmp2269) #f) (apply (lambda (_2273 id2274 val2275) (let ((val2276 (chi1295 val2275 r2264 w2265 mod2267)) (n2277 (id-var-name1281 id2274 w2265))) (let ((b2278 (lookup1256 n2277 r2264 mod2267))) (let ((t2279 (binding-type1251 b2278))) (if (memv t2279 (quote (lexical))) (build-lexical-assignment1234 s2266 (syntax->datum id2274) (binding-value1252 b2278) val2276) (if (memv t2279 (quote (global))) (build-global-assignment1236 s2266 n2277 val2276 mod2267) (if (memv t2279 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1287 id2274 w2265 mod2267)) (syntax-violation (quote set!) "bad set!" (source-wrap1288 e2263 w2265 s2266 mod2267))))))))) tmp2269) ((lambda (tmp2280) (if tmp2280 (apply (lambda (_2281 head2282 tail2283 val2284) (call-with-values (lambda () (syntax-type1293 head2282 r2264 (quote (())) #f #f mod2267)) (lambda (type2285 value2286 ee2287 ww2288 ss2289 modmod2290) (let ((t2291 type2285)) (if (memv t2291 (quote (module-ref))) (let ((val2292 (chi1295 val2284 r2264 w2265 mod2267))) (call-with-values (lambda () (value2286 (cons head2282 tail2283))) (lambda (id2294 mod2295) (build-global-assignment1236 s2266 id2294 val2292 mod2295)))) (build-annotated1232 s2266 (cons (chi1295 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head2282) r2264 w2265 mod2267) (map (lambda (e2296) (chi1295 e2296 r2264 w2265 mod2267)) (append tail2283 (list val2284)))))))))) tmp2280) ((lambda (_2298) (syntax-violation (quote set!) "bad set!" (source-wrap1288 e2263 w2265 s2266 mod2267))) tmp2268))) ($sc-dispatch tmp2268 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2268 (quote (any any any))))) e2263))) (global-extend1257 (quote module-ref) (quote @) (lambda (e2299) ((lambda (tmp2300) ((lambda (tmp2301) (if (if tmp2301 (apply (lambda (_2302 mod2303 id2304) (and (and-map id?1259 mod2303) (id?1259 id2304))) tmp2301) #f) (apply (lambda (_2306 mod2307 id2308) (values (syntax->datum id2308) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2307)))) tmp2301) (syntax-violation #f "source expression failed to match any pattern" tmp2300))) ($sc-dispatch tmp2300 (quote (any each-any any))))) e2299))) (global-extend1257 (quote module-ref) (quote @@) (lambda (e2310) ((lambda (tmp2311) ((lambda (tmp2312) (if (if tmp2312 (apply (lambda (_2313 mod2314 id2315) (and (and-map id?1259 mod2314) (id?1259 id2315))) tmp2312) #f) (apply (lambda (_2317 mod2318 id2319) (values (syntax->datum id2319) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2318)))) tmp2312) (syntax-violation #f "source expression failed to match any pattern" tmp2311))) ($sc-dispatch tmp2311 (quote (any each-any any))))) e2310))) (global-extend1257 (quote begin) (quote begin) (quote ())) (global-extend1257 (quote define) (quote define) (quote ())) (global-extend1257 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1257 (quote eval-when) (quote eval-when) (quote ())) (global-extend1257 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2324 (lambda (x2325 keys2326 clauses2327 r2328 mod2329) (if (null? clauses2327) (build-annotated1232 #f (list (build-annotated1232 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2325)) ((lambda (tmp2330) ((lambda (tmp2331) (if tmp2331 (apply (lambda (pat2332 exp2333) (if (and (id?1259 pat2332) (and-map (lambda (x2334) (not (free-id=?1282 pat2332 x2334))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys2326))) (let ((labels2335 (list (gen-label1264))) (var2336 (gen-var1307 pat2332))) (build-annotated1232 #f (list (build-annotated1232 #f (list (quote lambda) (list var2336) (chi1295 exp2333 (extend-env1253 labels2335 (list (cons (quote syntax) (cons var2336 0))) r2328) (make-binding-wrap1276 (list pat2332) labels2335 (quote (()))) mod2329))) x2325))) (gen-clause2323 x2325 keys2326 (cdr clauses2327) r2328 pat2332 #t exp2333 mod2329))) tmp2331) ((lambda (tmp2337) (if tmp2337 (apply (lambda (pat2338 fender2339 exp2340) (gen-clause2323 x2325 keys2326 (cdr clauses2327) r2328 pat2338 fender2339 exp2340 mod2329)) tmp2337) ((lambda (_2341) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2327))) tmp2330))) ($sc-dispatch tmp2330 (quote (any any any)))))) ($sc-dispatch tmp2330 (quote (any any))))) (car clauses2327))))) (gen-clause2323 (lambda (x2342 keys2343 clauses2344 r2345 pat2346 fender2347 exp2348 mod2349) (call-with-values (lambda () (convert-pattern2321 pat2346 keys2343)) (lambda (p2350 pvars2351) (cond ((not (distinct-bound-ids?1285 (map car pvars2351))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2346)) ((not (and-map (lambda (x2352) (not (ellipsis?1304 (car x2352)))) pvars2351)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2346)) (else (let ((y2353 (gen-var1307 (quote tmp)))) (build-annotated1232 #f (list (build-annotated1232 #f (list (quote lambda) (list y2353) (let ((y2354 (build-lexical-reference1233 (quote value) #f (quote tmp) y2353))) (build-annotated1232 #f (list (quote if) ((lambda (tmp2355) ((lambda (tmp2356) (if tmp2356 (apply (lambda () y2354) tmp2356) ((lambda (_2357) (build-annotated1232 #f (list (quote if) y2354 (build-dispatch-call2322 pvars2351 fender2347 y2354 r2345 mod2349) (build-data1237 #f #f)))) tmp2355))) ($sc-dispatch tmp2355 (quote #(atom #t))))) fender2347) (build-dispatch-call2322 pvars2351 exp2348 y2354 r2345 mod2349) (gen-syntax-case2324 x2342 keys2343 clauses2344 r2345 mod2349)))))) (if (eq? p2350 (quote any)) (build-annotated1232 #f (list (build-annotated1232 #f (quote list)) x2342)) (build-annotated1232 #f (list (build-annotated1232 #f (quote $sc-dispatch)) x2342 (build-data1237 #f p2350))))))))))))) (build-dispatch-call2322 (lambda (pvars2358 exp2359 y2360 r2361 mod2362) (let ((ids2363 (map car pvars2358)) (levels2364 (map cdr pvars2358))) (let ((labels2365 (gen-labels1265 ids2363)) (new-vars2366 (map gen-var1307 ids2363))) (build-annotated1232 #f (list (build-annotated1232 #f (quote apply)) (build-annotated1232 #f (list (quote lambda) new-vars2366 (chi1295 exp2359 (extend-env1253 labels2365 (map (lambda (var2367 level2368) (cons (quote syntax) (cons var2367 level2368))) new-vars2366 (map cdr pvars2358)) r2361) (make-binding-wrap1276 ids2363 labels2365 (quote (()))) mod2362))) y2360)))))) (convert-pattern2321 (lambda (pattern2369 keys2370) (let cvt2371 ((p2372 pattern2369) (n2373 0) (ids2374 (quote ()))) (if (id?1259 p2372) (if (bound-id-member?1286 p2372 keys2370) (values (vector (quote free-id) p2372) ids2374) (values (quote any) (cons (cons p2372 n2373) ids2374))) ((lambda (tmp2375) ((lambda (tmp2376) (if (if tmp2376 (apply (lambda (x2377 dots2378) (ellipsis?1304 dots2378)) tmp2376) #f) (apply (lambda (x2379 dots2380) (call-with-values (lambda () (cvt2371 x2379 (fx+1224 n2373 1) ids2374)) (lambda (p2381 ids2382) (values (if (eq? p2381 (quote any)) (quote each-any) (vector (quote each) p2381)) ids2382)))) tmp2376) ((lambda (tmp2383) (if tmp2383 (apply (lambda (x2384 y2385) (call-with-values (lambda () (cvt2371 y2385 n2373 ids2374)) (lambda (y2386 ids2387) (call-with-values (lambda () (cvt2371 x2384 n2373 ids2387)) (lambda (x2388 ids2389) (values (cons x2388 y2386) ids2389)))))) tmp2383) ((lambda (tmp2390) (if tmp2390 (apply (lambda () (values (quote ()) ids2374)) tmp2390) ((lambda (tmp2391) (if tmp2391 (apply (lambda (x2392) (call-with-values (lambda () (cvt2371 x2392 n2373 ids2374)) (lambda (p2394 ids2395) (values (vector (quote vector) p2394) ids2395)))) tmp2391) ((lambda (x2396) (values (vector (quote atom) (strip1306 p2372 (quote (())))) ids2374)) tmp2375))) ($sc-dispatch tmp2375 (quote #(vector each-any)))))) ($sc-dispatch tmp2375 (quote ()))))) ($sc-dispatch tmp2375 (quote (any . any)))))) ($sc-dispatch tmp2375 (quote (any any))))) p2372)))))) (lambda (e2397 r2398 w2399 s2400 mod2401) (let ((e2402 (source-wrap1288 e2397 w2399 s2400 mod2401))) ((lambda (tmp2403) ((lambda (tmp2404) (if tmp2404 (apply (lambda (_2405 val2406 key2407 m2408) (if (and-map (lambda (x2409) (and (id?1259 x2409) (not (ellipsis?1304 x2409)))) key2407) (let ((x2411 (gen-var1307 (quote tmp)))) (build-annotated1232 s2400 (list (build-annotated1232 #f (list (quote lambda) (list x2411) (gen-syntax-case2324 (build-lexical-reference1233 (quote value) #f (quote tmp) x2411) key2407 m2408 r2398 mod2401))) (chi1295 val2406 r2398 (quote (())) mod2401)))) (syntax-violation (quote syntax-case) "invalid literals list" e2402))) tmp2404) (syntax-violation #f "source expression failed to match any pattern" tmp2403))) ($sc-dispatch tmp2403 (quote (any any each-any . each-any))))) e2402))))) (set! sc-expand (lambda (x2415 . rest2414) (if (and (pair? x2415) (equal? (car x2415) noexpand1222)) (cadr x2415) (let ((m2416 (if (null? rest2414) (quote e) (car rest2414))) (esew2417 (if (or (null? rest2414) (null? (cdr rest2414))) (quote (eval)) (cadr rest2414)))) (with-fluid* *mode*1223 m2416 (lambda () (chi-top1294 x2415 (quote ()) (quote ((top))) m2416 esew2417 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x2418) (nonsymbol-id?1258 x2418))) (set! datum->syntax (lambda (id2419 datum2420) (make-syntax-object1242 datum2420 (syntax-object-wrap1245 id2419) #f))) (set! syntax->datum (lambda (x2421) (strip1306 x2421 (quote (()))))) (set! generate-temporaries (lambda (ls2422) (begin (let ((x2423 ls2422)) (if (not (list? x2423)) (syntax-violation (quote generate-temporaries) "invalid argument" x2423))) (map (lambda (x2424) (wrap1287 (gensym) (quote ((top))) #f)) ls2422)))) (set! free-identifier=? (lambda (x2425 y2426) (begin (let ((x2427 x2425)) (if (not (nonsymbol-id?1258 x2427)) (syntax-violation (quote free-identifier=?) "invalid argument" x2427))) (let ((x2428 y2426)) (if (not (nonsymbol-id?1258 x2428)) (syntax-violation (quote free-identifier=?) "invalid argument" x2428))) (free-id=?1282 x2425 y2426)))) (set! bound-identifier=? (lambda (x2429 y2430) (begin (let ((x2431 x2429)) (if (not (nonsymbol-id?1258 x2431)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2431))) (let ((x2432 y2430)) (if (not (nonsymbol-id?1258 x2432)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2432))) (bound-id=?1283 x2429 y2430)))) (set! syntax-violation (lambda (who2436 message2435 form2434 . subform2433) (begin (let ((x2437 who2436)) (if (not ((lambda (x2438) (or (not x2438) (string? x2438) (symbol? x2438))) x2437)) (syntax-violation (quote syntax-violation) "invalid argument" x2437))) (let ((x2439 message2435)) (if (not (string? x2439)) (syntax-violation (quote syntax-violation) "invalid argument" x2439))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2436 "~a: " "") "~a " (if (null? subform2433) "in ~a" "in subform `~s' of `~s'")) (let ((tail2440 (cons message2435 (map (lambda (x2441) (strip1306 x2441 (quote (())))) (append subform2433 (list form2434)))))) (if who2436 (cons who2436 tail2440) tail2440)) #f)))) (letrec ((match2446 (lambda (e2447 p2448 w2449 r2450 mod2451) (cond ((not r2450) #f) ((eq? p2448 (quote any)) (cons (wrap1287 e2447 w2449 mod2451) r2450)) ((syntax-object?1243 e2447) (match*2445 (let ((e2452 (syntax-object-expression1244 e2447))) (if (annotation? e2452) (annotation-expression e2452) e2452)) p2448 (join-wraps1278 w2449 (syntax-object-wrap1245 e2447)) r2450 (syntax-object-module1246 e2447))) (else (match*2445 (let ((e2453 e2447)) (if (annotation? e2453) (annotation-expression e2453) e2453)) p2448 w2449 r2450 mod2451))))) (match*2445 (lambda (e2454 p2455 w2456 r2457 mod2458) (cond ((null? p2455) (and (null? e2454) r2457)) ((pair? p2455) (and (pair? e2454) (match2446 (car e2454) (car p2455) w2456 (match2446 (cdr e2454) (cdr p2455) w2456 r2457 mod2458) mod2458))) ((eq? p2455 (quote each-any)) (let ((l2459 (match-each-any2443 e2454 w2456 mod2458))) (and l2459 (cons l2459 r2457)))) (else (let ((t2460 (vector-ref p2455 0))) (if (memv t2460 (quote (each))) (if (null? e2454) (match-empty2444 (vector-ref p2455 1) r2457) (let ((l2461 (match-each2442 e2454 (vector-ref p2455 1) w2456 mod2458))) (and l2461 (let collect2462 ((l2463 l2461)) (if (null? (car l2463)) r2457 (cons (map car l2463) (collect2462 (map cdr l2463)))))))) (if (memv t2460 (quote (free-id))) (and (id?1259 e2454) (free-id=?1282 (wrap1287 e2454 w2456 mod2458) (vector-ref p2455 1)) r2457) (if (memv t2460 (quote (atom))) (and (equal? (vector-ref p2455 1) (strip1306 e2454 w2456)) r2457) (if (memv t2460 (quote (vector))) (and (vector? e2454) (match2446 (vector->list e2454) (vector-ref p2455 1) w2456 r2457 mod2458))))))))))) (match-empty2444 (lambda (p2464 r2465) (cond ((null? p2464) r2465) ((eq? p2464 (quote any)) (cons (quote ()) r2465)) ((pair? p2464) (match-empty2444 (car p2464) (match-empty2444 (cdr p2464) r2465))) ((eq? p2464 (quote each-any)) (cons (quote ()) r2465)) (else (let ((t2466 (vector-ref p2464 0))) (if (memv t2466 (quote (each))) (match-empty2444 (vector-ref p2464 1) r2465) (if (memv t2466 (quote (free-id atom))) r2465 (if (memv t2466 (quote (vector))) (match-empty2444 (vector-ref p2464 1) r2465))))))))) (match-each-any2443 (lambda (e2467 w2468 mod2469) (cond ((annotation? e2467) (match-each-any2443 (annotation-expression e2467) w2468 mod2469)) ((pair? e2467) (let ((l2470 (match-each-any2443 (cdr e2467) w2468 mod2469))) (and l2470 (cons (wrap1287 (car e2467) w2468 mod2469) l2470)))) ((null? e2467) (quote ())) ((syntax-object?1243 e2467) (match-each-any2443 (syntax-object-expression1244 e2467) (join-wraps1278 w2468 (syntax-object-wrap1245 e2467)) mod2469)) (else #f)))) (match-each2442 (lambda (e2471 p2472 w2473 mod2474) (cond ((annotation? e2471) (match-each2442 (annotation-expression e2471) p2472 w2473 mod2474)) ((pair? e2471) (let ((first2475 (match2446 (car e2471) p2472 w2473 (quote ()) mod2474))) (and first2475 (let ((rest2476 (match-each2442 (cdr e2471) p2472 w2473 mod2474))) (and rest2476 (cons first2475 rest2476)))))) ((null? e2471) (quote ())) ((syntax-object?1243 e2471) (match-each2442 (syntax-object-expression1244 e2471) p2472 (join-wraps1278 w2473 (syntax-object-wrap1245 e2471)) (syntax-object-module1246 e2471))) (else #f))))) (set! $sc-dispatch (lambda (e2477 p2478) (cond ((eq? p2478 (quote any)) (list e2477)) ((syntax-object?1243 e2477) (match*2445 (let ((e2479 (syntax-object-expression1244 e2477))) (if (annotation? e2479) (annotation-expression e2479) e2479)) p2478 (syntax-object-wrap1245 e2477) (quote ()) (syntax-object-module1246 e2477))) (else (match*2445 (let ((e2480 e2477)) (if (annotation? e2480) (annotation-expression e2480) e2480)) p2478 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x2481) ((lambda (tmp2482) ((lambda (tmp2483) (if tmp2483 (apply (lambda (_2484 e12485 e22486) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12485 e22486))) tmp2483) ((lambda (tmp2488) (if tmp2488 (apply (lambda (_2489 out2490 in2491 e12492 e22493) (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))) in2491 (quote ()) (list out2490 (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 e12492 e22493))))) tmp2488) ((lambda (tmp2495) (if tmp2495 (apply (lambda (_2496 out2497 in2498 e12499 e22500) (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))) in2498) (quote ()) (list out2497 (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 e12499 e22500))))) tmp2495) (syntax-violation #f "source expression failed to match any pattern" tmp2482))) ($sc-dispatch tmp2482 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2482 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2482 (quote (any () any . each-any))))) x2481))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2504) ((lambda (tmp2505) ((lambda (tmp2506) (if tmp2506 (apply (lambda (_2507 k2508 keyword2509 pattern2510 template2511) (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 k2508 (map (lambda (tmp2514 tmp2513) (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))) tmp2513) (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))) tmp2514))) template2511 pattern2510)))))) tmp2506) (syntax-violation #f "source expression failed to match any pattern" tmp2505))) ($sc-dispatch tmp2505 (quote (any each-any . #(each ((any . any) any))))))) x2504))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2515) ((lambda (tmp2516) ((lambda (tmp2517) (if (if tmp2517 (apply (lambda (let*2518 x2519 v2520 e12521 e22522) (and-map identifier? x2519)) tmp2517) #f) (apply (lambda (let*2524 x2525 v2526 e12527 e22528) (let f2529 ((bindings2530 (map list x2525 v2526))) (if (null? bindings2530) (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 e12527 e22528))) ((lambda (tmp2534) ((lambda (tmp2535) (if tmp2535 (apply (lambda (body2536 binding2537) (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 binding2537) body2536)) tmp2535) (syntax-violation #f "source expression failed to match any pattern" tmp2534))) ($sc-dispatch tmp2534 (quote (any any))))) (list (f2529 (cdr bindings2530)) (car bindings2530)))))) tmp2517) (syntax-violation #f "source expression failed to match any pattern" tmp2516))) ($sc-dispatch tmp2516 (quote (any #(each (any any)) any . each-any))))) x2515))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2538) ((lambda (tmp2539) ((lambda (tmp2540) (if tmp2540 (apply (lambda (_2541 var2542 init2543 step2544 e02545 e12546 c2547) ((lambda (tmp2548) ((lambda (tmp2549) (if tmp2549 (apply (lambda (step2550) ((lambda (tmp2551) ((lambda (tmp2552) (if tmp2552 (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 var2542 init2543) (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))) e02545) (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 c2547 (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))) step2550))))))) tmp2552) ((lambda (tmp2557) (if tmp2557 (apply (lambda (e12558 e22559) (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 var2542 init2543) (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))) e02545 (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 e12558 e22559)) (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 c2547 (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))) step2550))))))) tmp2557) (syntax-violation #f "source expression failed to match any pattern" tmp2551))) ($sc-dispatch tmp2551 (quote (any . each-any)))))) ($sc-dispatch tmp2551 (quote ())))) e12546)) tmp2549) (syntax-violation #f "source expression failed to match any pattern" tmp2548))) ($sc-dispatch tmp2548 (quote each-any)))) (map (lambda (v2566 s2567) ((lambda (tmp2568) ((lambda (tmp2569) (if tmp2569 (apply (lambda () v2566) tmp2569) ((lambda (tmp2570) (if tmp2570 (apply (lambda (e2571) e2571) tmp2570) ((lambda (_2572) (syntax-violation (quote do) "bad step expression" orig-x2538 s2567)) tmp2568))) ($sc-dispatch tmp2568 (quote (any)))))) ($sc-dispatch tmp2568 (quote ())))) s2567)) var2542 step2544))) tmp2540) (syntax-violation #f "source expression failed to match any pattern" tmp2539))) ($sc-dispatch tmp2539 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2538))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2575 (lambda (x2579 y2580) ((lambda (tmp2581) ((lambda (tmp2582) (if tmp2582 (apply (lambda (x2583 y2584) ((lambda (tmp2585) ((lambda (tmp2586) (if tmp2586 (apply (lambda (dy2587) ((lambda (tmp2588) ((lambda (tmp2589) (if tmp2589 (apply (lambda (dx2590) (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 dx2590 dy2587))) tmp2589) ((lambda (_2591) (if (null? dy2587) (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))) x2583) (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))) x2583 y2584))) tmp2588))) ($sc-dispatch tmp2588 (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))))) x2583)) tmp2586) ((lambda (tmp2592) (if tmp2592 (apply (lambda (stuff2593) (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 x2583 stuff2593))) tmp2592) ((lambda (else2594) (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))) x2583 y2584)) tmp2585))) ($sc-dispatch tmp2585 (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 tmp2585 (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))))) y2584)) tmp2582) (syntax-violation #f "source expression failed to match any pattern" tmp2581))) ($sc-dispatch tmp2581 (quote (any any))))) (list x2579 y2580)))) (quasiappend2576 (lambda (x2595 y2596) ((lambda (tmp2597) ((lambda (tmp2598) (if tmp2598 (apply (lambda (x2599 y2600) ((lambda (tmp2601) ((lambda (tmp2602) (if tmp2602 (apply (lambda () x2599) tmp2602) ((lambda (_2603) (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))) x2599 y2600)) tmp2601))) ($sc-dispatch tmp2601 (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))) ()))))) y2600)) tmp2598) (syntax-violation #f "source expression failed to match any pattern" tmp2597))) ($sc-dispatch tmp2597 (quote (any any))))) (list x2595 y2596)))) (quasivector2577 (lambda (x2604) ((lambda (tmp2605) ((lambda (x2606) ((lambda (tmp2607) ((lambda (tmp2608) (if tmp2608 (apply (lambda (x2609) (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 x2609))) tmp2608) ((lambda (tmp2611) (if tmp2611 (apply (lambda (x2612) (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))) x2612)) tmp2611) ((lambda (_2614) (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))) x2606)) tmp2607))) ($sc-dispatch tmp2607 (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 tmp2607 (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))))) x2606)) tmp2605)) x2604))) (quasi2578 (lambda (p2615 lev2616) ((lambda (tmp2617) ((lambda (tmp2618) (if tmp2618 (apply (lambda (p2619) (if (= lev2616 0) p2619 (quasicons2575 (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)))) (quasi2578 (list p2619) (- lev2616 1))))) tmp2618) ((lambda (tmp2620) (if tmp2620 (apply (lambda (p2621 q2622) (if (= lev2616 0) (quasiappend2576 p2621 (quasi2578 q2622 lev2616)) (quasicons2575 (quasicons2575 (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)))) (quasi2578 (list p2621) (- lev2616 1))) (quasi2578 q2622 lev2616)))) tmp2620) ((lambda (tmp2623) (if tmp2623 (apply (lambda (p2624) (quasicons2575 (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)))) (quasi2578 (list p2624) (+ lev2616 1)))) tmp2623) ((lambda (tmp2625) (if tmp2625 (apply (lambda (p2626 q2627) (quasicons2575 (quasi2578 p2626 lev2616) (quasi2578 q2627 lev2616))) tmp2625) ((lambda (tmp2628) (if tmp2628 (apply (lambda (x2629) (quasivector2577 (quasi2578 x2629 lev2616))) tmp2628) ((lambda (p2631) (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))) p2631)) tmp2617))) ($sc-dispatch tmp2617 (quote #(vector each-any)))))) ($sc-dispatch tmp2617 (quote (any . any)))))) ($sc-dispatch tmp2617 (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 tmp2617 (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 tmp2617 (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))))) p2615)))) (lambda (x2632) ((lambda (tmp2633) ((lambda (tmp2634) (if tmp2634 (apply (lambda (_2635 e2636) (quasi2578 e2636 0)) tmp2634) (syntax-violation #f "source expression failed to match any pattern" tmp2633))) ($sc-dispatch tmp2633 (quote (any any))))) x2632)))))
+(define include (make-syncase-macro (quote macro) (lambda (x2637) (letrec ((read-file2638 (lambda (fn2639 k2640) (let ((p2641 (open-input-file fn2639))) (let f2642 ((x2643 (read p2641))) (if (eof-object? x2643) (begin (close-input-port p2641) (quote ())) (cons (datum->syntax k2640 x2643) (f2642 (read p2641))))))))) ((lambda (tmp2644) ((lambda (tmp2645) (if tmp2645 (apply (lambda (k2646 filename2647) (let ((fn2648 (syntax->datum filename2647))) ((lambda (tmp2649) ((lambda (tmp2650) (if tmp2650 (apply (lambda (exp2651) (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))) exp2651)) tmp2650) (syntax-violation #f "source expression failed to match any pattern" tmp2649))) ($sc-dispatch tmp2649 (quote each-any)))) (read-file2638 fn2648 k2646)))) tmp2645) (syntax-violation #f "source expression failed to match any pattern" tmp2644))) ($sc-dispatch tmp2644 (quote (any any))))) x2637)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x2653) ((lambda (tmp2654) ((lambda (tmp2655) (if tmp2655 (apply (lambda (_2656 e2657) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x2653)) tmp2655) (syntax-violation #f "source expression failed to match any pattern" tmp2654))) ($sc-dispatch tmp2654 (quote (any any))))) x2653))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2658) ((lambda (tmp2659) ((lambda (tmp2660) (if tmp2660 (apply (lambda (_2661 e2662) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x2658)) tmp2660) (syntax-violation #f "source expression failed to match any pattern" tmp2659))) ($sc-dispatch tmp2659 (quote (any any))))) x2658))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2663) ((lambda (tmp2664) ((lambda (tmp2665) (if tmp2665 (apply (lambda (_2666 e2667 m12668 m22669) ((lambda (tmp2670) ((lambda (body2671) (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))) e2667)) body2671)) tmp2670)) (let f2672 ((clause2673 m12668) (clauses2674 m22669)) (if (null? clauses2674) ((lambda (tmp2676) ((lambda (tmp2677) (if tmp2677 (apply (lambda (e12678 e22679) (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 e12678 e22679))) tmp2677) ((lambda (tmp2681) (if tmp2681 (apply (lambda (k2682 e12683 e22684) (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))) k2682)) (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 e12683 e22684)))) tmp2681) ((lambda (_2687) (syntax-violation (quote case) "bad clause" x2663 clause2673)) tmp2676))) ($sc-dispatch tmp2676 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2676 (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))))) clause2673) ((lambda (tmp2688) ((lambda (rest2689) ((lambda (tmp2690) ((lambda (tmp2691) (if tmp2691 (apply (lambda (k2692 e12693 e22694) (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))) k2692)) (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 e12693 e22694)) rest2689)) tmp2691) ((lambda (_2697) (syntax-violation (quote case) "bad clause" x2663 clause2673)) tmp2690))) ($sc-dispatch tmp2690 (quote (each-any any . each-any))))) clause2673)) tmp2688)) (f2672 (car clauses2674) (cdr clauses2674))))))) tmp2665) (syntax-violation #f "source expression failed to match any pattern" tmp2664))) ($sc-dispatch tmp2664 (quote (any any any . each-any))))) x2663))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2698) ((lambda (tmp2699) ((lambda (tmp2700) (if tmp2700 (apply (lambda (_2701 e2702) (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))) e2702)) (list (cons _2701 (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 e2702 (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)))))))))) tmp2700) (syntax-violation #f "source expression failed to match any pattern" tmp2699))) ($sc-dispatch tmp2699 (quote (any any))))) x2698))))