allow redefinition of global macros to variables

* module/ice-9/psyntax.scm: Allow the redefinition of keywords to
  variables. Otherwise we can't do (define let #f), which is totally
  useful and stuff.

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

diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
dissimilarity index 77%
index 4a2bc87..9496275 100644 (file)
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,11 +1,11 @@
-(letrec ((lambda-var-list1140 (lambda (vars1339) (let lvl1340 ((vars1341 vars1339) (ls1342 (quote ())) (w1343 (quote (())))) (cond ((pair? vars1341) (lvl1340 (cdr vars1341) (cons (wrap1119 (car vars1341) w1343 #f) ls1342) w1343)) ((id?1091 vars1341) (cons (wrap1119 vars1341 w1343 #f) ls1342)) ((null? vars1341) ls1342) ((syntax-object?1075 vars1341) (lvl1340 (syntax-object-expression1076 vars1341) ls1342 (join-wraps1110 w1343 (syntax-object-wrap1077 vars1341)))) ((annotation? vars1341) (lvl1340 (annotation-expression vars1341) ls1342 w1343)) (else (cons vars1341 ls1342)))))) (gen-var1139 (lambda (id1344) (let ((id1345 (if (syntax-object?1075 id1344) (syntax-object-expression1076 id1344) id1344))) (if (annotation? id1345) (build-annotated1068 (annotation-source id1345) (gensym (symbol->string (annotation-expression id1345)))) (build-annotated1068 #f (gensym (symbol->string id1345))))))) (strip1138 (lambda (x1346 w1347) (if (memq (quote top) (wrap-marks1094 w1347)) (if (or (annotation? x1346) (and (pair? x1346) (annotation? (car x1346)))) (strip-annotation1137 x1346 #f) x1346) (let f1348 ((x1349 x1346)) (cond ((syntax-object?1075 x1349) (strip1138 (syntax-object-expression1076 x1349) (syntax-object-wrap1077 x1349))) ((pair? x1349) (let ((a1350 (f1348 (car x1349))) (d1351 (f1348 (cdr x1349)))) (if (and (eq? a1350 (car x1349)) (eq? d1351 (cdr x1349))) x1349 (cons a1350 d1351)))) ((vector? x1349) (let ((old1352 (vector->list x1349))) (let ((new1353 (map f1348 old1352))) (if (andmap eq? old1352 new1353) x1349 (list->vector new1353))))) (else x1349)))))) (strip-annotation1137 (lambda (x1354 parent1355) (cond ((pair? x1354) (let ((new1356 (cons #f #f))) (begin (if parent1355 (set-annotation-stripped! parent1355 new1356)) (set-car! new1356 (strip-annotation1137 (car x1354) #f)) (set-cdr! new1356 (strip-annotation1137 (cdr x1354) #f)) new1356))) ((annotation? x1354) (or (annotation-stripped x1354) (strip-annotation1137 (annotation-expression x1354) x1354))) ((vector? x1354) (let ((new1357 (make-vector (vector-length x1354)))) (begin (if parent1355 (set-annotation-stripped! parent1355 new1357)) (let loop1358 ((i1359 (- (vector-length x1354) 1))) (unless (fx<1062 i1359 0) (vector-set! new1357 i1359 (strip-annotation1137 (vector-ref x1354 i1359) #f)) (loop1358 (fx-1060 i1359 1)))) new1357))) (else x1354)))) (ellipsis?1136 (lambda (x1360) (and (nonsymbol-id?1090 x1360) (free-id=?1114 x1360 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))))))) (chi-void1135 (lambda () (build-annotated1068 #f (list (build-annotated1068 #f (quote void)))))) (eval-local-transformer1134 (lambda (expanded1361 mod1362) (let ((p1363 (local-eval-hook1064 expanded1361 mod1362))) (if (procedure? p1363) p1363 (syntax-error p1363 "nonprocedure transformer"))))) (chi-local-syntax1133 (lambda (rec?1364 e1365 r1366 w1367 s1368 mod1369 k1370) ((lambda (tmp1371) ((lambda (tmp1372) (if tmp1372 (apply (lambda (_1373 id1374 val1375 e11376 e21377) (let ((ids1378 id1374)) (if (not (valid-bound-ids?1116 ids1378)) (syntax-error e1365 "duplicate bound keyword in") (let ((labels1380 (gen-labels1097 ids1378))) (let ((new-w1381 (make-binding-wrap1108 ids1378 labels1380 w1367))) (k1370 (cons e11376 e21377) (extend-env1085 labels1380 (let ((w1383 (if rec?1364 new-w1381 w1367)) (trans-r1384 (macros-only-env1087 r1366))) (map (lambda (x1385) (cons (quote macro) (eval-local-transformer1134 (chi1127 x1385 trans-r1384 w1383 mod1369) mod1369))) val1375)) r1366) new-w1381 s1368 mod1369)))))) tmp1372) ((lambda (_1387) (syntax-error (source-wrap1120 e1365 w1367 s1368 mod1369))) tmp1371))) (syntax-dispatch tmp1371 (quote (any #(each (any any)) any . each-any))))) e1365))) (chi-lambda-clause1132 (lambda (e1388 c1389 r1390 w1391 mod1392 k1393) ((lambda (tmp1394) ((lambda (tmp1395) (if tmp1395 (apply (lambda (id1396 e11397 e21398) (let ((ids1399 id1396)) (if (not (valid-bound-ids?1116 ids1399)) (syntax-error e1388 "invalid parameter list in") (let ((labels1401 (gen-labels1097 ids1399)) (new-vars1402 (map gen-var1139 ids1399))) (k1393 new-vars1402 (chi-body1131 (cons e11397 e21398) e1388 (extend-var-env1086 labels1401 new-vars1402 r1390) (make-binding-wrap1108 ids1399 labels1401 w1391) mod1392)))))) tmp1395) ((lambda (tmp1404) (if tmp1404 (apply (lambda (ids1405 e11406 e21407) (let ((old-ids1408 (lambda-var-list1140 ids1405))) (if (not (valid-bound-ids?1116 old-ids1408)) (syntax-error e1388 "invalid parameter list in") (let ((labels1409 (gen-labels1097 old-ids1408)) (new-vars1410 (map gen-var1139 old-ids1408))) (k1393 (let f1411 ((ls11412 (cdr new-vars1410)) (ls21413 (car new-vars1410))) (if (null? ls11412) ls21413 (f1411 (cdr ls11412) (cons (car ls11412) ls21413)))) (chi-body1131 (cons e11406 e21407) e1388 (extend-var-env1086 labels1409 new-vars1410 r1390) (make-binding-wrap1108 old-ids1408 labels1409 w1391) mod1392)))))) tmp1404) ((lambda (_1415) (syntax-error e1388)) tmp1394))) (syntax-dispatch tmp1394 (quote (any any . each-any)))))) (syntax-dispatch tmp1394 (quote (each-any any . each-any))))) c1389))) (chi-body1131 (lambda (body1416 outer-form1417 r1418 w1419 mod1420) (let ((r1421 (cons (quote ("placeholder" placeholder)) r1418))) (let ((ribcage1422 (make-ribcage1098 (quote ()) (quote ()) (quote ())))) (let ((w1423 (make-wrap1093 (wrap-marks1094 w1419) (cons ribcage1422 (wrap-subst1095 w1419))))) (let parse1424 ((body1425 (map (lambda (x1431) (cons r1421 (wrap1119 x1431 w1423 mod1420))) body1416)) (ids1426 (quote ())) (labels1427 (quote ())) (vars1428 (quote ())) (vals1429 (quote ())) (bindings1430 (quote ()))) (if (null? body1425) (syntax-error outer-form1417 "no expressions in body") (let ((e1432 (cdar body1425)) (er1433 (caar body1425))) (call-with-values (lambda () (syntax-type1125 e1432 er1433 (quote (())) #f ribcage1422 mod1420)) (lambda (type1434 value1435 e1436 w1437 s1438 mod1439) (let ((t1440 type1434)) (if (memv t1440 (quote (define-form))) (let ((id1441 (wrap1119 value1435 w1437 mod1439)) (label1442 (gen-label1096))) (let ((var1443 (gen-var1139 id1441))) (begin (extend-ribcage!1107 ribcage1422 id1441 label1442) (parse1424 (cdr body1425) (cons id1441 ids1426) (cons label1442 labels1427) (cons var1443 vars1428) (cons (cons er1433 (wrap1119 e1436 w1437 mod1439)) vals1429) (cons (cons (quote lexical) var1443) bindings1430))))) (if (memv t1440 (quote (define-syntax-form))) (let ((id1444 (wrap1119 value1435 w1437 mod1439)) (label1445 (gen-label1096))) (begin (extend-ribcage!1107 ribcage1422 id1444 label1445) (parse1424 (cdr body1425) (cons id1444 ids1426) (cons label1445 labels1427) vars1428 vals1429 (cons (cons (quote macro) (cons er1433 (wrap1119 e1436 w1437 mod1439))) bindings1430)))) (if (memv t1440 (quote (begin-form))) ((lambda (tmp1446) ((lambda (tmp1447) (if tmp1447 (apply (lambda (_1448 e11449) (parse1424 (let f1450 ((forms1451 e11449)) (if (null? forms1451) (cdr body1425) (cons (cons er1433 (wrap1119 (car forms1451) w1437 mod1439)) (f1450 (cdr forms1451))))) ids1426 labels1427 vars1428 vals1429 bindings1430)) tmp1447) (syntax-error tmp1446))) (syntax-dispatch tmp1446 (quote (any . each-any))))) e1436) (if (memv t1440 (quote (local-syntax-form))) (chi-local-syntax1133 value1435 e1436 er1433 w1437 s1438 mod1439 (lambda (forms1453 er1454 w1455 s1456 mod1457) (parse1424 (let f1458 ((forms1459 forms1453)) (if (null? forms1459) (cdr body1425) (cons (cons er1454 (wrap1119 (car forms1459) w1455 mod1457)) (f1458 (cdr forms1459))))) ids1426 labels1427 vars1428 vals1429 bindings1430))) (if (null? ids1426) (build-sequence1070 #f (map (lambda (x1460) (chi1127 (cdr x1460) (car x1460) (quote (())) mod1439)) (cons (cons er1433 (source-wrap1120 e1436 w1437 s1438 mod1439)) (cdr body1425)))) (begin (if (not (valid-bound-ids?1116 ids1426)) (syntax-error outer-form1417 "invalid or duplicate identifier in definition")) (let loop1461 ((bs1462 bindings1430) (er-cache1463 #f) (r-cache1464 #f)) (if (not (null? bs1462)) (let ((b1465 (car bs1462))) (if (eq? (car b1465) (quote macro)) (let ((er1466 (cadr b1465))) (let ((r-cache1467 (if (eq? er1466 er-cache1463) r-cache1464 (macros-only-env1087 er1466)))) (begin (set-cdr! b1465 (eval-local-transformer1134 (chi1127 (cddr b1465) r-cache1467 (quote (())) mod1439) mod1439)) (loop1461 (cdr bs1462) er1466 r-cache1467)))) (loop1461 (cdr bs1462) er-cache1463 r-cache1464))))) (set-cdr! r1421 (extend-env1085 labels1427 bindings1430 (cdr r1421))) (build-letrec1073 #f vars1428 (map (lambda (x1468) (chi1127 (cdr x1468) (car x1468) (quote (())) mod1439)) vals1429) (build-sequence1070 #f (map (lambda (x1469) (chi1127 (cdr x1469) (car x1469) (quote (())) mod1439)) (cons (cons er1433 (source-wrap1120 e1436 w1437 s1438 mod1439)) (cdr body1425)))))))))))))))))))))) (chi-macro1130 (lambda (p1470 e1471 r1472 w1473 rib1474 mod1475) (letrec ((rebuild-macro-output1476 (lambda (x1477 m1478) (cond ((pair? x1477) (cons (rebuild-macro-output1476 (car x1477) m1478) (rebuild-macro-output1476 (cdr x1477) m1478))) ((syntax-object?1075 x1477) (let ((w1479 (syntax-object-wrap1077 x1477))) (let ((ms1480 (wrap-marks1094 w1479)) (s1481 (wrap-subst1095 w1479))) (if (and (pair? ms1480) (eq? (car ms1480) #f)) (make-syntax-object1074 (syntax-object-expression1076 x1477) (make-wrap1093 (cdr ms1480) (if rib1474 (cons rib1474 (cdr s1481)) (cdr s1481))) (syntax-object-module1078 x1477)) (make-syntax-object1074 (syntax-object-expression1076 x1477) (make-wrap1093 (cons m1478 ms1480) (if rib1474 (cons rib1474 (cons (quote shift) s1481)) (cons (quote shift) s1481))) (module-name (procedure-module p1470))))))) ((vector? x1477) (let ((n1482 (vector-length x1477))) (let ((v1483 (make-vector n1482))) (let doloop1484 ((i1485 0)) (if (fx=1061 i1485 n1482) v1483 (begin (vector-set! v1483 i1485 (rebuild-macro-output1476 (vector-ref x1477 i1485) m1478)) (doloop1484 (fx+1059 i1485 1)))))))) ((symbol? x1477) (syntax-error x1477 "encountered raw symbol in macro output")) (else x1477))))) (rebuild-macro-output1476 (p1470 (wrap1119 e1471 (anti-mark1106 w1473) mod1475)) (string #\m))))) (chi-application1129 (lambda (x1486 e1487 r1488 w1489 s1490 mod1491) ((lambda (tmp1492) ((lambda (tmp1493) (if tmp1493 (apply (lambda (e01494 e11495) (build-annotated1068 s1490 (cons x1486 (map (lambda (e1496) (chi1127 e1496 r1488 w1489 mod1491)) e11495)))) tmp1493) (syntax-error tmp1492))) (syntax-dispatch tmp1492 (quote (any . each-any))))) e1487))) (chi-expr1128 (lambda (type1498 value1499 e1500 r1501 w1502 s1503 mod1504) (let ((t1505 type1498)) (if (memv t1505 (quote (lexical))) (build-annotated1068 s1503 value1499) (if (memv t1505 (quote (core external-macro))) (value1499 e1500 r1501 w1502 s1503 mod1504) (if (memv t1505 (quote (module-ref))) (call-with-values (lambda () (value1499 e1500)) (lambda (id1506 mod1507) (build-annotated1068 s1503 (make-module-ref mod1507 id1506 #f)))) (if (memv t1505 (quote (lexical-call))) (chi-application1129 (build-annotated1068 (source-annotation1082 (car e1500)) value1499) e1500 r1501 w1502 s1503 mod1504) (if (memv t1505 (quote (global-call))) (chi-application1129 (build-annotated1068 (source-annotation1082 (car e1500)) (make-module-ref (if (syntax-object?1075 (car e1500)) (syntax-object-module1078 (car e1500)) mod1504) value1499 #f)) e1500 r1501 w1502 s1503 mod1504) (if (memv t1505 (quote (constant))) (build-data1069 s1503 (strip1138 (source-wrap1120 e1500 w1502 s1503 mod1504) (quote (())))) (if (memv t1505 (quote (global))) (build-annotated1068 s1503 (make-module-ref mod1504 value1499 #f)) (if (memv t1505 (quote (call))) (chi-application1129 (chi1127 (car e1500) r1501 w1502 mod1504) e1500 r1501 w1502 s1503 mod1504) (if (memv t1505 (quote (begin-form))) ((lambda (tmp1508) ((lambda (tmp1509) (if tmp1509 (apply (lambda (_1510 e11511 e21512) (chi-sequence1121 (cons e11511 e21512) r1501 w1502 s1503 mod1504)) tmp1509) (syntax-error tmp1508))) (syntax-dispatch tmp1508 (quote (any any . each-any))))) e1500) (if (memv t1505 (quote (local-syntax-form))) (chi-local-syntax1133 value1499 e1500 r1501 w1502 s1503 mod1504 chi-sequence1121) (if (memv t1505 (quote (eval-when-form))) ((lambda (tmp1514) ((lambda (tmp1515) (if tmp1515 (apply (lambda (_1516 x1517 e11518 e21519) (let ((when-list1520 (chi-when-list1124 e1500 x1517 w1502))) (if (memq (quote eval) when-list1520) (chi-sequence1121 (cons e11518 e21519) r1501 w1502 s1503 mod1504) (chi-void1135)))) tmp1515) (syntax-error tmp1514))) (syntax-dispatch tmp1514 (quote (any each-any any . each-any))))) e1500) (if (memv t1505 (quote (define-form define-syntax-form))) (syntax-error (wrap1119 value1499 w1502 mod1504) "invalid context for definition of") (if (memv t1505 (quote (syntax))) (syntax-error (source-wrap1120 e1500 w1502 s1503 mod1504) "reference to pattern variable outside syntax form") (if (memv t1505 (quote (displaced-lexical))) (syntax-error (source-wrap1120 e1500 w1502 s1503 mod1504) "reference to identifier outside its scope") (syntax-error (source-wrap1120 e1500 w1502 s1503 mod1504))))))))))))))))))) (chi1127 (lambda (e1523 r1524 w1525 mod1526) (call-with-values (lambda () (syntax-type1125 e1523 r1524 w1525 #f #f mod1526)) (lambda (type1527 value1528 e1529 w1530 s1531 mod1532) (chi-expr1128 type1527 value1528 e1529 r1524 w1530 s1531 mod1532))))) (chi-top1126 (lambda (e1533 r1534 w1535 m1536 esew1537 mod1538) (call-with-values (lambda () (syntax-type1125 e1533 r1534 w1535 #f #f mod1538)) (lambda (type1546 value1547 e1548 w1549 s1550 mod1551) (let ((t1552 type1546)) (if (memv t1552 (quote (begin-form))) ((lambda (tmp1553) ((lambda (tmp1554) (if tmp1554 (apply (lambda (_1555) (chi-void1135)) tmp1554) ((lambda (tmp1556) (if tmp1556 (apply (lambda (_1557 e11558 e21559) (chi-top-sequence1122 (cons e11558 e21559) r1534 w1549 s1550 m1536 esew1537 mod1551)) tmp1556) (syntax-error tmp1553))) (syntax-dispatch tmp1553 (quote (any any . each-any)))))) (syntax-dispatch tmp1553 (quote (any))))) e1548) (if (memv t1552 (quote (local-syntax-form))) (chi-local-syntax1133 value1547 e1548 r1534 w1549 s1550 mod1551 (lambda (body1561 r1562 w1563 s1564 mod1565) (chi-top-sequence1122 body1561 r1562 w1563 s1564 m1536 esew1537 mod1565))) (if (memv t1552 (quote (eval-when-form))) ((lambda (tmp1566) ((lambda (tmp1567) (if tmp1567 (apply (lambda (_1568 x1569 e11570 e21571) (let ((when-list1572 (chi-when-list1124 e1548 x1569 w1549)) (body1573 (cons e11570 e21571))) (cond ((eq? m1536 (quote e)) (if (memq (quote eval) when-list1572) (chi-top-sequence1122 body1573 r1534 w1549 s1550 (quote e) (quote (eval)) mod1551) (chi-void1135))) ((memq (quote load) when-list1572) (if (or (memq (quote compile) when-list1572) (and (eq? m1536 (quote c&e)) (memq (quote eval) when-list1572))) (chi-top-sequence1122 body1573 r1534 w1549 s1550 (quote c&e) (quote (compile load)) mod1551) (if (memq m1536 (quote (c c&e))) (chi-top-sequence1122 body1573 r1534 w1549 s1550 (quote c) (quote (load)) mod1551) (chi-void1135)))) ((or (memq (quote compile) when-list1572) (and (eq? m1536 (quote c&e)) (memq (quote eval) when-list1572))) (top-level-eval-hook1063 (chi-top-sequence1122 body1573 r1534 w1549 s1550 (quote e) (quote (eval)) mod1551) mod1551) (chi-void1135)) (else (chi-void1135))))) tmp1567) (syntax-error tmp1566))) (syntax-dispatch tmp1566 (quote (any each-any any . each-any))))) e1548) (if (memv t1552 (quote (define-syntax-form))) (let ((n1576 (id-var-name1113 value1547 w1549)) (r1577 (macros-only-env1087 r1534))) (let ((t1578 m1536)) (if (memv t1578 (quote (c))) (if (memq (quote compile) esew1537) (let ((e1579 (chi-install-global1123 n1576 (chi1127 e1548 r1577 w1549 mod1551)))) (begin (top-level-eval-hook1063 e1579 mod1551) (if (memq (quote load) esew1537) e1579 (chi-void1135)))) (if (memq (quote load) esew1537) (chi-install-global1123 n1576 (chi1127 e1548 r1577 w1549 mod1551)) (chi-void1135))) (if (memv t1578 (quote (c&e))) (let ((e1580 (chi-install-global1123 n1576 (chi1127 e1548 r1577 w1549 mod1551)))) (begin (top-level-eval-hook1063 e1580 mod1551) e1580)) (begin (if (memq (quote eval) esew1537) (top-level-eval-hook1063 (chi-install-global1123 n1576 (chi1127 e1548 r1577 w1549 mod1551)) mod1551)) (chi-void1135)))))) (if (memv t1552 (quote (define-form))) (let ((n1581 (id-var-name1113 value1547 w1549))) (let ((type1582 (binding-type1083 (lookup1088 n1581 r1534 mod1551)))) (let ((t1583 type1582)) (if (memv t1583 (quote (global))) (let ((x1584 (build-annotated1068 s1550 (list (quote define) n1581 (chi1127 e1548 r1534 w1549 mod1551))))) (begin (if (eq? m1536 (quote c&e)) (top-level-eval-hook1063 x1584 mod1551)) x1584)) (if (memv t1583 (quote (displaced-lexical))) (syntax-error (wrap1119 value1547 w1549 mod1551) "identifier out of context") (if (eq? type1582 (quote external-macro)) (let ((x1585 (build-annotated1068 s1550 (list (quote define) n1581 (chi1127 e1548 r1534 w1549 mod1551))))) (begin (if (eq? m1536 (quote c&e)) (top-level-eval-hook1063 x1585 mod1551)) x1585)) (syntax-error (wrap1119 value1547 w1549 mod1551) "cannot define keyword at top level"))))))) (let ((x1586 (chi-expr1128 type1546 value1547 e1548 r1534 w1549 s1550 mod1551))) (begin (if (eq? m1536 (quote c&e)) (top-level-eval-hook1063 x1586 mod1551)) x1586)))))))))))) (syntax-type1125 (lambda (e1587 r1588 w1589 s1590 rib1591 mod1592) (cond ((symbol? e1587) (let ((n1593 (id-var-name1113 e1587 w1589))) (let ((b1594 (lookup1088 n1593 r1588 mod1592))) (let ((type1595 (binding-type1083 b1594))) (let ((t1596 type1595)) (if (memv t1596 (quote (lexical))) (values type1595 (binding-value1084 b1594) e1587 w1589 s1590 mod1592) (if (memv t1596 (quote (global))) (values type1595 n1593 e1587 w1589 s1590 mod1592) (if (memv t1596 (quote (macro))) (syntax-type1125 (chi-macro1130 (binding-value1084 b1594) e1587 r1588 w1589 rib1591 mod1592) r1588 (quote (())) s1590 rib1591 mod1592) (values type1595 (binding-value1084 b1594) e1587 w1589 s1590 mod1592))))))))) ((pair? e1587) (let ((first1597 (car e1587))) (if (id?1091 first1597) (let ((n1598 (id-var-name1113 first1597 w1589))) (let ((b1599 (lookup1088 n1598 r1588 (or (and (syntax-object?1075 first1597) (syntax-object-module1078 first1597)) mod1592)))) (let ((type1600 (binding-type1083 b1599))) (let ((t1601 type1600)) (if (memv t1601 (quote (lexical))) (values (quote lexical-call) (binding-value1084 b1599) e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (global))) (values (quote global-call) n1598 e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (macro))) (syntax-type1125 (chi-macro1130 (binding-value1084 b1599) e1587 r1588 w1589 rib1591 mod1592) r1588 (quote (())) s1590 rib1591 mod1592) (if (memv t1601 (quote (core external-macro module-ref))) (values type1600 (binding-value1084 b1599) e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1084 b1599) e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (begin))) (values (quote begin-form) #f e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (eval-when))) (values (quote eval-when-form) #f e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (define))) ((lambda (tmp1602) ((lambda (tmp1603) (if (if tmp1603 (apply (lambda (_1604 name1605 val1606) (id?1091 name1605)) tmp1603) #f) (apply (lambda (_1607 name1608 val1609) (values (quote define-form) name1608 val1609 w1589 s1590 mod1592)) tmp1603) ((lambda (tmp1610) (if (if tmp1610 (apply (lambda (_1611 name1612 args1613 e11614 e21615) (and (id?1091 name1612) (valid-bound-ids?1116 (lambda-var-list1140 args1613)))) tmp1610) #f) (apply (lambda (_1616 name1617 args1618 e11619 e21620) (values (quote define-form) (wrap1119 name1617 w1589 mod1592) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) (wrap1119 (cons args1618 (cons e11619 e21620)) w1589 mod1592)) (quote (())) s1590 mod1592)) tmp1610) ((lambda (tmp1622) (if (if tmp1622 (apply (lambda (_1623 name1624) (id?1091 name1624)) tmp1622) #f) (apply (lambda (_1625 name1626) (values (quote define-form) (wrap1119 name1626 w1589 mod1592) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote (())) s1590 mod1592)) tmp1622) (syntax-error tmp1602))) (syntax-dispatch tmp1602 (quote (any any)))))) (syntax-dispatch tmp1602 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1602 (quote (any any any))))) e1587) (if (memv t1601 (quote (define-syntax))) ((lambda (tmp1627) ((lambda (tmp1628) (if (if tmp1628 (apply (lambda (_1629 name1630 val1631) (id?1091 name1630)) tmp1628) #f) (apply (lambda (_1632 name1633 val1634) (values (quote define-syntax-form) name1633 val1634 w1589 s1590 mod1592)) tmp1628) (syntax-error tmp1627))) (syntax-dispatch tmp1627 (quote (any any any))))) e1587) (values (quote call) #f e1587 w1589 s1590 mod1592)))))))))))))) (values (quote call) #f e1587 w1589 s1590 mod1592)))) ((syntax-object?1075 e1587) (syntax-type1125 (syntax-object-expression1076 e1587) r1588 (join-wraps1110 w1589 (syntax-object-wrap1077 e1587)) #f rib1591 (or (syntax-object-module1078 e1587) mod1592))) ((annotation? e1587) (syntax-type1125 (annotation-expression e1587) r1588 w1589 (annotation-source e1587) rib1591 mod1592)) ((self-evaluating? e1587) (values (quote constant) #f e1587 w1589 s1590 mod1592)) (else (values (quote other) #f e1587 w1589 s1590 mod1592))))) (chi-when-list1124 (lambda (e1635 when-list1636 w1637) (let f1638 ((when-list1639 when-list1636) (situations1640 (quote ()))) (if (null? when-list1639) situations1640 (f1638 (cdr when-list1639) (cons (let ((x1641 (car when-list1639))) (cond ((free-id=?1114 x1641 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote compile)) ((free-id=?1114 x1641 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote load)) ((free-id=?1114 x1641 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote eval)) (else (syntax-error (wrap1119 x1641 w1637 #f) "invalid eval-when situation")))) situations1640)))))) (chi-install-global1123 (lambda (name1642 e1643) (build-annotated1068 #f (list (build-annotated1068 #f (quote install-global-transformer)) (build-data1069 #f name1642) e1643)))) (chi-top-sequence1122 (lambda (body1644 r1645 w1646 s1647 m1648 esew1649 mod1650) (build-sequence1070 s1647 (let dobody1651 ((body1652 body1644) (r1653 r1645) (w1654 w1646) (m1655 m1648) (esew1656 esew1649) (mod1657 mod1650)) (if (null? body1652) (quote ()) (let ((first1658 (chi-top1126 (car body1652) r1653 w1654 m1655 esew1656 mod1657))) (cons first1658 (dobody1651 (cdr body1652) r1653 w1654 m1655 esew1656 mod1657)))))))) (chi-sequence1121 (lambda (body1659 r1660 w1661 s1662 mod1663) (build-sequence1070 s1662 (let dobody1664 ((body1665 body1659) (r1666 r1660) (w1667 w1661) (mod1668 mod1663)) (if (null? body1665) (quote ()) (let ((first1669 (chi1127 (car body1665) r1666 w1667 mod1668))) (cons first1669 (dobody1664 (cdr body1665) r1666 w1667 mod1668)))))))) (source-wrap1120 (lambda (x1670 w1671 s1672 defmod1673) (wrap1119 (if s1672 (make-annotation x1670 s1672 #f) x1670) w1671 defmod1673))) (wrap1119 (lambda (x1674 w1675 defmod1676) (cond ((and (null? (wrap-marks1094 w1675)) (null? (wrap-subst1095 w1675))) x1674) ((syntax-object?1075 x1674) (make-syntax-object1074 (syntax-object-expression1076 x1674) (join-wraps1110 w1675 (syntax-object-wrap1077 x1674)) (syntax-object-module1078 x1674))) ((null? x1674) x1674) (else (make-syntax-object1074 x1674 w1675 defmod1676))))) (bound-id-member?1118 (lambda (x1677 list1678) (and (not (null? list1678)) (or (bound-id=?1115 x1677 (car list1678)) (bound-id-member?1118 x1677 (cdr list1678)))))) (distinct-bound-ids?1117 (lambda (ids1679) (let distinct?1680 ((ids1681 ids1679)) (or (null? ids1681) (and (not (bound-id-member?1118 (car ids1681) (cdr ids1681))) (distinct?1680 (cdr ids1681))))))) (valid-bound-ids?1116 (lambda (ids1682) (and (let all-ids?1683 ((ids1684 ids1682)) (or (null? ids1684) (and (id?1091 (car ids1684)) (all-ids?1683 (cdr ids1684))))) (distinct-bound-ids?1117 ids1682)))) (bound-id=?1115 (lambda (i1685 j1686) (if (and (syntax-object?1075 i1685) (syntax-object?1075 j1686)) (and (eq? (let ((e1687 (syntax-object-expression1076 i1685))) (if (annotation? e1687) (annotation-expression e1687) e1687)) (let ((e1688 (syntax-object-expression1076 j1686))) (if (annotation? e1688) (annotation-expression e1688) e1688))) (same-marks?1112 (wrap-marks1094 (syntax-object-wrap1077 i1685)) (wrap-marks1094 (syntax-object-wrap1077 j1686)))) (eq? (let ((e1689 i1685)) (if (annotation? e1689) (annotation-expression e1689) e1689)) (let ((e1690 j1686)) (if (annotation? e1690) (annotation-expression e1690) e1690)))))) (free-id=?1114 (lambda (i1691 j1692) (and (eq? (let ((x1693 i1691)) (let ((e1694 (if (syntax-object?1075 x1693) (syntax-object-expression1076 x1693) x1693))) (if (annotation? e1694) (annotation-expression e1694) e1694))) (let ((x1695 j1692)) (let ((e1696 (if (syntax-object?1075 x1695) (syntax-object-expression1076 x1695) x1695))) (if (annotation? e1696) (annotation-expression e1696) e1696)))) (eq? (id-var-name1113 i1691 (quote (()))) (id-var-name1113 j1692 (quote (()))))))) (id-var-name1113 (lambda (id1697 w1698) (letrec ((search-vector-rib1701 (lambda (sym1707 subst1708 marks1709 symnames1710 ribcage1711) (let ((n1712 (vector-length symnames1710))) (let f1713 ((i1714 0)) (cond ((fx=1061 i1714 n1712) (search1699 sym1707 (cdr subst1708) marks1709)) ((and (eq? (vector-ref symnames1710 i1714) sym1707) (same-marks?1112 marks1709 (vector-ref (ribcage-marks1101 ribcage1711) i1714))) (values (vector-ref (ribcage-labels1102 ribcage1711) i1714) marks1709)) (else (f1713 (fx+1059 i1714 1)))))))) (search-list-rib1700 (lambda (sym1715 subst1716 marks1717 symnames1718 ribcage1719) (let f1720 ((symnames1721 symnames1718) (i1722 0)) (cond ((null? symnames1721) (search1699 sym1715 (cdr subst1716) marks1717)) ((and (eq? (car symnames1721) sym1715) (same-marks?1112 marks1717 (list-ref (ribcage-marks1101 ribcage1719) i1722))) (values (list-ref (ribcage-labels1102 ribcage1719) i1722) marks1717)) (else (f1720 (cdr symnames1721) (fx+1059 i1722 1))))))) (search1699 (lambda (sym1723 subst1724 marks1725) (if (null? subst1724) (values #f marks1725) (let ((fst1726 (car subst1724))) (if (eq? fst1726 (quote shift)) (search1699 sym1723 (cdr subst1724) (cdr marks1725)) (let ((symnames1727 (ribcage-symnames1100 fst1726))) (if (vector? symnames1727) (search-vector-rib1701 sym1723 subst1724 marks1725 symnames1727 fst1726) (search-list-rib1700 sym1723 subst1724 marks1725 symnames1727 fst1726))))))))) (cond ((symbol? id1697) (or (call-with-values (lambda () (search1699 id1697 (wrap-subst1095 w1698) (wrap-marks1094 w1698))) (lambda (x1729 . ignore1728) x1729)) id1697)) ((syntax-object?1075 id1697) (let ((id1730 (let ((e1732 (syntax-object-expression1076 id1697))) (if (annotation? e1732) (annotation-expression e1732) e1732))) (w11731 (syntax-object-wrap1077 id1697))) (let ((marks1733 (join-marks1111 (wrap-marks1094 w1698) (wrap-marks1094 w11731)))) (call-with-values (lambda () (search1699 id1730 (wrap-subst1095 w1698) marks1733)) (lambda (new-id1734 marks1735) (or new-id1734 (call-with-values (lambda () (search1699 id1730 (wrap-subst1095 w11731) marks1735)) (lambda (x1737 . ignore1736) x1737)) id1730)))))) ((annotation? id1697) (let ((id1738 (let ((e1739 id1697)) (if (annotation? e1739) (annotation-expression e1739) e1739)))) (or (call-with-values (lambda () (search1699 id1738 (wrap-subst1095 w1698) (wrap-marks1094 w1698))) (lambda (x1741 . ignore1740) x1741)) id1738))) (else (error-hook1065 (quote id-var-name) "invalid id" id1697)))))) (same-marks?1112 (lambda (x1742 y1743) (or (eq? x1742 y1743) (and (not (null? x1742)) (not (null? y1743)) (eq? (car x1742) (car y1743)) (same-marks?1112 (cdr x1742) (cdr y1743)))))) (join-marks1111 (lambda (m11744 m21745) (smart-append1109 m11744 m21745))) (join-wraps1110 (lambda (w11746 w21747) (let ((m11748 (wrap-marks1094 w11746)) (s11749 (wrap-subst1095 w11746))) (if (null? m11748) (if (null? s11749) w21747 (make-wrap1093 (wrap-marks1094 w21747) (smart-append1109 s11749 (wrap-subst1095 w21747)))) (make-wrap1093 (smart-append1109 m11748 (wrap-marks1094 w21747)) (smart-append1109 s11749 (wrap-subst1095 w21747))))))) (smart-append1109 (lambda (m11750 m21751) (if (null? m21751) m11750 (append m11750 m21751)))) (make-binding-wrap1108 (lambda (ids1752 labels1753 w1754) (if (null? ids1752) w1754 (make-wrap1093 (wrap-marks1094 w1754) (cons (let ((labelvec1755 (list->vector labels1753))) (let ((n1756 (vector-length labelvec1755))) (let ((symnamevec1757 (make-vector n1756)) (marksvec1758 (make-vector n1756))) (begin (let f1759 ((ids1760 ids1752) (i1761 0)) (if (not (null? ids1760)) (call-with-values (lambda () (id-sym-name&marks1092 (car ids1760) w1754)) (lambda (symname1762 marks1763) (begin (vector-set! symnamevec1757 i1761 symname1762) (vector-set! marksvec1758 i1761 marks1763) (f1759 (cdr ids1760) (fx+1059 i1761 1))))))) (make-ribcage1098 symnamevec1757 marksvec1758 labelvec1755))))) (wrap-subst1095 w1754)))))) (extend-ribcage!1107 (lambda (ribcage1764 id1765 label1766) (begin (set-ribcage-symnames!1103 ribcage1764 (cons (let ((e1767 (syntax-object-expression1076 id1765))) (if (annotation? e1767) (annotation-expression e1767) e1767)) (ribcage-symnames1100 ribcage1764))) (set-ribcage-marks!1104 ribcage1764 (cons (wrap-marks1094 (syntax-object-wrap1077 id1765)) (ribcage-marks1101 ribcage1764))) (set-ribcage-labels!1105 ribcage1764 (cons label1766 (ribcage-labels1102 ribcage1764)))))) (anti-mark1106 (lambda (w1768) (make-wrap1093 (cons #f (wrap-marks1094 w1768)) (cons (quote shift) (wrap-subst1095 w1768))))) (set-ribcage-labels!1105 (lambda (x1769 update1770) (vector-set! x1769 3 update1770))) (set-ribcage-marks!1104 (lambda (x1771 update1772) (vector-set! x1771 2 update1772))) (set-ribcage-symnames!1103 (lambda (x1773 update1774) (vector-set! x1773 1 update1774))) (ribcage-labels1102 (lambda (x1775) (vector-ref x1775 3))) (ribcage-marks1101 (lambda (x1776) (vector-ref x1776 2))) (ribcage-symnames1100 (lambda (x1777) (vector-ref x1777 1))) (ribcage?1099 (lambda (x1778) (and (vector? x1778) (= (vector-length x1778) 4) (eq? (vector-ref x1778 0) (quote ribcage))))) (make-ribcage1098 (lambda (symnames1779 marks1780 labels1781) (vector (quote ribcage) symnames1779 marks1780 labels1781))) (gen-labels1097 (lambda (ls1782) (if (null? ls1782) (quote ()) (cons (gen-label1096) (gen-labels1097 (cdr ls1782)))))) (gen-label1096 (lambda () (string #\i))) (wrap-subst1095 cdr) (wrap-marks1094 car) (make-wrap1093 cons) (id-sym-name&marks1092 (lambda (x1783 w1784) (if (syntax-object?1075 x1783) (values (let ((e1785 (syntax-object-expression1076 x1783))) (if (annotation? e1785) (annotation-expression e1785) e1785)) (join-marks1111 (wrap-marks1094 w1784) (wrap-marks1094 (syntax-object-wrap1077 x1783)))) (values (let ((e1786 x1783)) (if (annotation? e1786) (annotation-expression e1786) e1786)) (wrap-marks1094 w1784))))) (id?1091 (lambda (x1787) (cond ((symbol? x1787) #t) ((syntax-object?1075 x1787) (symbol? (let ((e1788 (syntax-object-expression1076 x1787))) (if (annotation? e1788) (annotation-expression e1788) e1788)))) ((annotation? x1787) (symbol? (annotation-expression x1787))) (else #f)))) (nonsymbol-id?1090 (lambda (x1789) (and (syntax-object?1075 x1789) (symbol? (let ((e1790 (syntax-object-expression1076 x1789))) (if (annotation? e1790) (annotation-expression e1790) e1790)))))) (global-extend1089 (lambda (type1791 sym1792 val1793) (put-global-definition-hook1066 sym1792 (cons type1791 val1793) (module-name (current-module))))) (lookup1088 (lambda (x1794 r1795 mod1796) (cond ((assq x1794 r1795) => cdr) ((symbol? x1794) (or (get-global-definition-hook1067 x1794 mod1796) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1087 (lambda (r1797) (if (null? r1797) (quote ()) (let ((a1798 (car r1797))) (if (eq? (cadr a1798) (quote macro)) (cons a1798 (macros-only-env1087 (cdr r1797))) (macros-only-env1087 (cdr r1797))))))) (extend-var-env1086 (lambda (labels1799 vars1800 r1801) (if (null? labels1799) r1801 (extend-var-env1086 (cdr labels1799) (cdr vars1800) (cons (cons (car labels1799) (cons (quote lexical) (car vars1800))) r1801))))) (extend-env1085 (lambda (labels1802 bindings1803 r1804) (if (null? labels1802) r1804 (extend-env1085 (cdr labels1802) (cdr bindings1803) (cons (cons (car labels1802) (car bindings1803)) r1804))))) (binding-value1084 cdr) (binding-type1083 car) (source-annotation1082 (lambda (x1805) (cond ((annotation? x1805) (annotation-source x1805)) ((syntax-object?1075 x1805) (source-annotation1082 (syntax-object-expression1076 x1805))) (else #f)))) (set-syntax-object-module!1081 (lambda (x1806 update1807) (vector-set! x1806 3 update1807))) (set-syntax-object-wrap!1080 (lambda (x1808 update1809) (vector-set! x1808 2 update1809))) (set-syntax-object-expression!1079 (lambda (x1810 update1811) (vector-set! x1810 1 update1811))) (syntax-object-module1078 (lambda (x1812) (vector-ref x1812 3))) (syntax-object-wrap1077 (lambda (x1813) (vector-ref x1813 2))) (syntax-object-expression1076 (lambda (x1814) (vector-ref x1814 1))) (syntax-object?1075 (lambda (x1815) (and (vector? x1815) (= (vector-length x1815) 4) (eq? (vector-ref x1815 0) (quote syntax-object))))) (make-syntax-object1074 (lambda (expression1816 wrap1817 module1818) (vector (quote syntax-object) expression1816 wrap1817 module1818))) (build-letrec1073 (lambda (src1819 vars1820 val-exps1821 body-exp1822) (if (null? vars1820) (build-annotated1068 src1819 body-exp1822) (build-annotated1068 src1819 (list (quote letrec) (map list vars1820 val-exps1821) body-exp1822))))) (build-named-let1072 (lambda (src1823 vars1824 val-exps1825 body-exp1826) (if (null? vars1824) (build-annotated1068 src1823 body-exp1826) (build-annotated1068 src1823 (list (quote let) (car vars1824) (map list (cdr vars1824) val-exps1825) body-exp1826))))) (build-let1071 (lambda (src1827 vars1828 val-exps1829 body-exp1830) (if (null? vars1828) (build-annotated1068 src1827 body-exp1830) (build-annotated1068 src1827 (list (quote let) (map list vars1828 val-exps1829) body-exp1830))))) (build-sequence1070 (lambda (src1831 exps1832) (if (null? (cdr exps1832)) (build-annotated1068 src1831 (car exps1832)) (build-annotated1068 src1831 (cons (quote begin) exps1832))))) (build-data1069 (lambda (src1833 exp1834) (if (and (self-evaluating? exp1834) (not (vector? exp1834))) (build-annotated1068 src1833 exp1834) (build-annotated1068 src1833 (list (quote quote) exp1834))))) (build-annotated1068 (lambda (src1835 exp1836) (if (and src1835 (not (annotation? exp1836))) (make-annotation exp1836 src1835 #t) exp1836))) (get-global-definition-hook1067 (lambda (symbol1837 module1838) (let ((module1839 (if module1838 (resolve-module module1838) (warn "wha" symbol1837 (current-module))))) (let ((v1840 (module-variable module1839 symbol1837))) (and v1840 (or (object-property v1840 (quote *sc-expander*)) (and (variable-bound? v1840) (macro? (variable-ref v1840)) (macro-transformer (variable-ref v1840)) guile-macro))))))) (put-global-definition-hook1066 (lambda (symbol1841 binding1842 modname1843) (let ((module1844 (if modname1843 (resolve-module modname1843) (current-module)))) (let ((v1845 (or (module-variable module1844 symbol1841) (let ((v1846 (make-variable (quote sc-macro)))) (begin (module-add! module1844 symbol1841 v1846) v1846))))) (begin (if (not (variable-bound? v1845)) (variable-set! v1845 (gensym))) (set-object-property! v1845 (quote *sc-expander*) binding1842)))))) (error-hook1065 (lambda (who1847 why1848 what1849) (error who1847 "~a ~s" why1848 what1849))) (local-eval-hook1064 (lambda (x1850 mod1851) (eval (list noexpand1058 x1850) (if mod1851 (resolve-module mod1851) (interaction-environment))))) (top-level-eval-hook1063 (lambda (x1852 mod1853) (eval (list noexpand1058 x1852) (if mod1853 (resolve-module mod1853) (interaction-environment))))) (fx<1062 <) (fx=1061 =) (fx-1060 -) (fx+1059 +) (noexpand1058 "noexpand")) (begin (global-extend1089 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1089 (quote local-syntax) (quote let-syntax) #f) (global-extend1089 (quote core) (quote fluid-let-syntax) (lambda (e1854 r1855 w1856 s1857 mod1858) ((lambda (tmp1859) ((lambda (tmp1860) (if (if tmp1860 (apply (lambda (_1861 var1862 val1863 e11864 e21865) (valid-bound-ids?1116 var1862)) tmp1860) #f) (apply (lambda (_1867 var1868 val1869 e11870 e21871) (let ((names1872 (map (lambda (x1873) (id-var-name1113 x1873 w1856)) var1868))) (begin (for-each (lambda (id1875 n1876) (let ((t1877 (binding-type1083 (lookup1088 n1876 r1855 mod1858)))) (if (memv t1877 (quote (displaced-lexical))) (syntax-error (source-wrap1120 id1875 w1856 s1857 mod1858) "identifier out of context")))) var1868 names1872) (chi-body1131 (cons e11870 e21871) (source-wrap1120 e1854 w1856 s1857 mod1858) (extend-env1085 names1872 (let ((trans-r1880 (macros-only-env1087 r1855))) (map (lambda (x1881) (cons (quote macro) (eval-local-transformer1134 (chi1127 x1881 trans-r1880 w1856 mod1858) mod1858))) val1869)) r1855) w1856 mod1858)))) tmp1860) ((lambda (_1883) (syntax-error (source-wrap1120 e1854 w1856 s1857 mod1858))) tmp1859))) (syntax-dispatch tmp1859 (quote (any #(each (any any)) any . each-any))))) e1854))) (global-extend1089 (quote core) (quote quote) (lambda (e1884 r1885 w1886 s1887 mod1888) ((lambda (tmp1889) ((lambda (tmp1890) (if tmp1890 (apply (lambda (_1891 e1892) (build-data1069 s1887 (strip1138 e1892 w1886))) tmp1890) ((lambda (_1893) (syntax-error (source-wrap1120 e1884 w1886 s1887 mod1888))) tmp1889))) (syntax-dispatch tmp1889 (quote (any any))))) e1884))) (global-extend1089 (quote core) (quote syntax) (letrec ((regen1901 (lambda (x1902) (let ((t1903 (car x1902))) (if (memv t1903 (quote (ref))) (build-annotated1068 #f (cadr x1902)) (if (memv t1903 (quote (primitive))) (build-annotated1068 #f (cadr x1902)) (if (memv t1903 (quote (quote))) (build-data1069 #f (cadr x1902)) (if (memv t1903 (quote (lambda))) (build-annotated1068 #f (list (quote lambda) (cadr x1902) (regen1901 (caddr x1902)))) (if (memv t1903 (quote (map))) (let ((ls1904 (map regen1901 (cdr x1902)))) (build-annotated1068 #f (cons (if (fx=1061 (length ls1904) 2) (build-annotated1068 #f (quote map)) (build-annotated1068 #f (quote map))) ls1904))) (build-annotated1068 #f (cons (build-annotated1068 #f (car x1902)) (map regen1901 (cdr x1902)))))))))))) (gen-vector1900 (lambda (x1905) (cond ((eq? (car x1905) (quote list)) (cons (quote vector) (cdr x1905))) ((eq? (car x1905) (quote quote)) (list (quote quote) (list->vector (cadr x1905)))) (else (list (quote list->vector) x1905))))) (gen-append1899 (lambda (x1906 y1907) (if (equal? y1907 (quote (quote ()))) x1906 (list (quote append) x1906 y1907)))) (gen-cons1898 (lambda (x1908 y1909) (let ((t1910 (car y1909))) (if (memv t1910 (quote (quote))) (if (eq? (car x1908) (quote quote)) (list (quote quote) (cons (cadr x1908) (cadr y1909))) (if (eq? (cadr y1909) (quote ())) (list (quote list) x1908) (list (quote cons) x1908 y1909))) (if (memv t1910 (quote (list))) (cons (quote list) (cons x1908 (cdr y1909))) (list (quote cons) x1908 y1909)))))) (gen-map1897 (lambda (e1911 map-env1912) (let ((formals1913 (map cdr map-env1912)) (actuals1914 (map (lambda (x1915) (list (quote ref) (car x1915))) map-env1912))) (cond ((eq? (car e1911) (quote ref)) (car actuals1914)) ((andmap (lambda (x1916) (and (eq? (car x1916) (quote ref)) (memq (cadr x1916) formals1913))) (cdr e1911)) (cons (quote map) (cons (list (quote primitive) (car e1911)) (map (let ((r1917 (map cons formals1913 actuals1914))) (lambda (x1918) (cdr (assq (cadr x1918) r1917)))) (cdr e1911))))) (else (cons (quote map) (cons (list (quote lambda) formals1913 e1911) actuals1914))))))) (gen-mappend1896 (lambda (e1919 map-env1920) (list (quote apply) (quote (primitive append)) (gen-map1897 e1919 map-env1920)))) (gen-ref1895 (lambda (src1921 var1922 level1923 maps1924) (if (fx=1061 level1923 0) (values var1922 maps1924) (if (null? maps1924) (syntax-error src1921 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1895 src1921 var1922 (fx-1060 level1923 1) (cdr maps1924))) (lambda (outer-var1925 outer-maps1926) (let ((b1927 (assq outer-var1925 (car maps1924)))) (if b1927 (values (cdr b1927) maps1924) (let ((inner-var1928 (gen-var1139 (quote tmp)))) (values inner-var1928 (cons (cons (cons outer-var1925 inner-var1928) (car maps1924)) outer-maps1926))))))))))) (gen-syntax1894 (lambda (src1929 e1930 r1931 maps1932 ellipsis?1933 mod1934) (if (id?1091 e1930) (let ((label1935 (id-var-name1113 e1930 (quote (()))))) (let ((b1936 (lookup1088 label1935 r1931 mod1934))) (if (eq? (binding-type1083 b1936) (quote syntax)) (call-with-values (lambda () (let ((var.lev1937 (binding-value1084 b1936))) (gen-ref1895 src1929 (car var.lev1937) (cdr var.lev1937) maps1932))) (lambda (var1938 maps1939) (values (list (quote ref) var1938) maps1939))) (if (ellipsis?1933 e1930) (syntax-error src1929 "misplaced ellipsis in syntax form") (values (list (quote quote) e1930) maps1932))))) ((lambda (tmp1940) ((lambda (tmp1941) (if (if tmp1941 (apply (lambda (dots1942 e1943) (ellipsis?1933 dots1942)) tmp1941) #f) (apply (lambda (dots1944 e1945) (gen-syntax1894 src1929 e1945 r1931 maps1932 (lambda (x1946) #f) mod1934)) tmp1941) ((lambda (tmp1947) (if (if tmp1947 (apply (lambda (x1948 dots1949 y1950) (ellipsis?1933 dots1949)) tmp1947) #f) (apply (lambda (x1951 dots1952 y1953) (let f1954 ((y1955 y1953) (k1956 (lambda (maps1957) (call-with-values (lambda () (gen-syntax1894 src1929 x1951 r1931 (cons (quote ()) maps1957) ellipsis?1933 mod1934)) (lambda (x1958 maps1959) (if (null? (car maps1959)) (syntax-error src1929 "extra ellipsis in syntax form") (values (gen-map1897 x1958 (car maps1959)) (cdr maps1959)))))))) ((lambda (tmp1960) ((lambda (tmp1961) (if (if tmp1961 (apply (lambda (dots1962 y1963) (ellipsis?1933 dots1962)) tmp1961) #f) (apply (lambda (dots1964 y1965) (f1954 y1965 (lambda (maps1966) (call-with-values (lambda () (k1956 (cons (quote ()) maps1966))) (lambda (x1967 maps1968) (if (null? (car maps1968)) (syntax-error src1929 "extra ellipsis in syntax form") (values (gen-mappend1896 x1967 (car maps1968)) (cdr maps1968)))))))) tmp1961) ((lambda (_1969) (call-with-values (lambda () (gen-syntax1894 src1929 y1955 r1931 maps1932 ellipsis?1933 mod1934)) (lambda (y1970 maps1971) (call-with-values (lambda () (k1956 maps1971)) (lambda (x1972 maps1973) (values (gen-append1899 x1972 y1970) maps1973)))))) tmp1960))) (syntax-dispatch tmp1960 (quote (any . any))))) y1955))) tmp1947) ((lambda (tmp1974) (if tmp1974 (apply (lambda (x1975 y1976) (call-with-values (lambda () (gen-syntax1894 src1929 x1975 r1931 maps1932 ellipsis?1933 mod1934)) (lambda (x1977 maps1978) (call-with-values (lambda () (gen-syntax1894 src1929 y1976 r1931 maps1978 ellipsis?1933 mod1934)) (lambda (y1979 maps1980) (values (gen-cons1898 x1977 y1979) maps1980)))))) tmp1974) ((lambda (tmp1981) (if tmp1981 (apply (lambda (e11982 e21983) (call-with-values (lambda () (gen-syntax1894 src1929 (cons e11982 e21983) r1931 maps1932 ellipsis?1933 mod1934)) (lambda (e1985 maps1986) (values (gen-vector1900 e1985) maps1986)))) tmp1981) ((lambda (_1987) (values (list (quote quote) e1930) maps1932)) tmp1940))) (syntax-dispatch tmp1940 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1940 (quote (any . any)))))) (syntax-dispatch tmp1940 (quote (any any . any)))))) (syntax-dispatch tmp1940 (quote (any any))))) e1930))))) (lambda (e1988 r1989 w1990 s1991 mod1992) (let ((e1993 (source-wrap1120 e1988 w1990 s1991 mod1992))) ((lambda (tmp1994) ((lambda (tmp1995) (if tmp1995 (apply (lambda (_1996 x1997) (call-with-values (lambda () (gen-syntax1894 e1993 x1997 r1989 (quote ()) ellipsis?1136 mod1992)) (lambda (e1998 maps1999) (regen1901 e1998)))) tmp1995) ((lambda (_2000) (syntax-error e1993)) tmp1994))) (syntax-dispatch tmp1994 (quote (any any))))) e1993))))) (global-extend1089 (quote core) (quote lambda) (lambda (e2001 r2002 w2003 s2004 mod2005) ((lambda (tmp2006) ((lambda (tmp2007) (if tmp2007 (apply (lambda (_2008 c2009) (chi-lambda-clause1132 (source-wrap1120 e2001 w2003 s2004 mod2005) c2009 r2002 w2003 mod2005 (lambda (vars2010 body2011) (build-annotated1068 s2004 (list (quote lambda) vars2010 body2011))))) tmp2007) (syntax-error tmp2006))) (syntax-dispatch tmp2006 (quote (any . any))))) e2001))) (global-extend1089 (quote core) (quote let) (letrec ((chi-let2012 (lambda (e2013 r2014 w2015 s2016 mod2017 constructor2018 ids2019 vals2020 exps2021) (if (not (valid-bound-ids?1116 ids2019)) (syntax-error e2013 "duplicate bound variable in") (let ((labels2022 (gen-labels1097 ids2019)) (new-vars2023 (map gen-var1139 ids2019))) (let ((nw2024 (make-binding-wrap1108 ids2019 labels2022 w2015)) (nr2025 (extend-var-env1086 labels2022 new-vars2023 r2014))) (constructor2018 s2016 new-vars2023 (map (lambda (x2026) (chi1127 x2026 r2014 w2015 mod2017)) vals2020) (chi-body1131 exps2021 (source-wrap1120 e2013 nw2024 s2016 mod2017) nr2025 nw2024 mod2017)))))))) (lambda (e2027 r2028 w2029 s2030 mod2031) ((lambda (tmp2032) ((lambda (tmp2033) (if tmp2033 (apply (lambda (_2034 id2035 val2036 e12037 e22038) (chi-let2012 e2027 r2028 w2029 s2030 mod2031 build-let1071 id2035 val2036 (cons e12037 e22038))) tmp2033) ((lambda (tmp2042) (if (if tmp2042 (apply (lambda (_2043 f2044 id2045 val2046 e12047 e22048) (id?1091 f2044)) tmp2042) #f) (apply (lambda (_2049 f2050 id2051 val2052 e12053 e22054) (chi-let2012 e2027 r2028 w2029 s2030 mod2031 build-named-let1072 (cons f2050 id2051) val2052 (cons e12053 e22054))) tmp2042) ((lambda (_2058) (syntax-error (source-wrap1120 e2027 w2029 s2030 mod2031))) tmp2032))) (syntax-dispatch tmp2032 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2032 (quote (any #(each (any any)) any . each-any))))) e2027)))) (global-extend1089 (quote core) (quote letrec) (lambda (e2059 r2060 w2061 s2062 mod2063) ((lambda (tmp2064) ((lambda (tmp2065) (if tmp2065 (apply (lambda (_2066 id2067 val2068 e12069 e22070) (let ((ids2071 id2067)) (if (not (valid-bound-ids?1116 ids2071)) (syntax-error e2059 "duplicate bound variable in") (let ((labels2073 (gen-labels1097 ids2071)) (new-vars2074 (map gen-var1139 ids2071))) (let ((w2075 (make-binding-wrap1108 ids2071 labels2073 w2061)) (r2076 (extend-var-env1086 labels2073 new-vars2074 r2060))) (build-letrec1073 s2062 new-vars2074 (map (lambda (x2077) (chi1127 x2077 r2076 w2075 mod2063)) val2068) (chi-body1131 (cons e12069 e22070) (source-wrap1120 e2059 w2075 s2062 mod2063) r2076 w2075 mod2063))))))) tmp2065) ((lambda (_2080) (syntax-error (source-wrap1120 e2059 w2061 s2062 mod2063))) tmp2064))) (syntax-dispatch tmp2064 (quote (any #(each (any any)) any . each-any))))) e2059))) (global-extend1089 (quote core) (quote set!) (lambda (e2081 r2082 w2083 s2084 mod2085) ((lambda (tmp2086) ((lambda (tmp2087) (if (if tmp2087 (apply (lambda (_2088 id2089 val2090) (id?1091 id2089)) tmp2087) #f) (apply (lambda (_2091 id2092 val2093) (let ((val2094 (chi1127 val2093 r2082 w2083 mod2085)) (n2095 (id-var-name1113 id2092 w2083))) (let ((b2096 (lookup1088 n2095 r2082 mod2085))) (let ((t2097 (binding-type1083 b2096))) (if (memv t2097 (quote (lexical))) (build-annotated1068 s2084 (list (quote set!) (binding-value1084 b2096) val2094)) (if (memv t2097 (quote (global))) (build-annotated1068 s2084 (list (quote set!) (make-module-ref mod2085 n2095 #f) val2094)) (if (memv t2097 (quote (displaced-lexical))) (syntax-error (wrap1119 id2092 w2083 mod2085) "identifier out of context") (syntax-error (source-wrap1120 e2081 w2083 s2084 mod2085))))))))) tmp2087) ((lambda (tmp2098) (if tmp2098 (apply (lambda (_2099 head2100 tail2101 val2102) (call-with-values (lambda () (syntax-type1125 head2100 r2082 (quote (())) #f #f mod2085)) (lambda (type2103 value2104 ee2105 ww2106 ss2107 modmod2108) (let ((t2109 type2103)) (if (memv t2109 (quote (module-ref))) (call-with-values (lambda () (value2104 (cons head2100 tail2101))) (lambda (id2111 mod2112) (build-annotated1068 s2084 (list (quote set!) (make-module-ref mod2112 id2111 #f) val2102)))) (build-annotated1068 s2084 (cons (chi1127 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) head2100) r2082 w2083 mod2085) (map (lambda (e2113) (chi1127 e2113 r2082 w2083 mod2085)) (append tail2101 (list val2102)))))))))) tmp2098) ((lambda (_2115) (syntax-error (source-wrap1120 e2081 w2083 s2084 mod2085))) tmp2086))) (syntax-dispatch tmp2086 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2086 (quote (any any any))))) e2081))) (global-extend1089 (quote module-ref) (quote @) (lambda (e2116) ((lambda (tmp2117) ((lambda (tmp2118) (if (if tmp2118 (apply (lambda (_2119 mod2120 id2121) (and (andmap id?1091 mod2120) (id?1091 id2121))) tmp2118) #f) (apply (lambda (_2123 mod2124 id2125) (values (syntax-object->datum id2125) (syntax-object->datum (append mod2124 (quote (#(syntax-object %module-public-interface ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))))))) tmp2118) (syntax-error tmp2117))) (syntax-dispatch tmp2117 (quote (any each-any any))))) e2116))) (global-extend1089 (quote module-ref) (quote @@) (lambda (e2127) ((lambda (tmp2128) ((lambda (tmp2129) (if (if tmp2129 (apply (lambda (_2130 mod2131 id2132) (and (andmap id?1091 mod2131) (id?1091 id2132))) tmp2129) #f) (apply (lambda (_2134 mod2135 id2136) (values (syntax-object->datum id2136) (syntax-object->datum mod2135))) tmp2129) (syntax-error tmp2128))) (syntax-dispatch tmp2128 (quote (any each-any any))))) e2127))) (global-extend1089 (quote begin) (quote begin) (quote ())) (global-extend1089 (quote define) (quote define) (quote ())) (global-extend1089 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1089 (quote eval-when) (quote eval-when) (quote ())) (global-extend1089 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2141 (lambda (x2142 keys2143 clauses2144 r2145 mod2146) (if (null? clauses2144) (build-annotated1068 #f (list (build-annotated1068 #f (quote syntax-error)) x2142)) ((lambda (tmp2147) ((lambda (tmp2148) (if tmp2148 (apply (lambda (pat2149 exp2150) (if (and (id?1091 pat2149) (andmap (lambda (x2151) (not (free-id=?1114 pat2149 x2151))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) keys2143))) (let ((labels2152 (list (gen-label1096))) (var2153 (gen-var1139 pat2149))) (build-annotated1068 #f (list (build-annotated1068 #f (list (quote lambda) (list var2153) (chi1127 exp2150 (extend-env1085 labels2152 (list (cons (quote syntax) (cons var2153 0))) r2145) (make-binding-wrap1108 (list pat2149) labels2152 (quote (()))) mod2146))) x2142))) (gen-clause2140 x2142 keys2143 (cdr clauses2144) r2145 pat2149 #t exp2150 mod2146))) tmp2148) ((lambda (tmp2154) (if tmp2154 (apply (lambda (pat2155 fender2156 exp2157) (gen-clause2140 x2142 keys2143 (cdr clauses2144) r2145 pat2155 fender2156 exp2157 mod2146)) tmp2154) ((lambda (_2158) (syntax-error (car clauses2144) "invalid syntax-case clause")) tmp2147))) (syntax-dispatch tmp2147 (quote (any any any)))))) (syntax-dispatch tmp2147 (quote (any any))))) (car clauses2144))))) (gen-clause2140 (lambda (x2159 keys2160 clauses2161 r2162 pat2163 fender2164 exp2165 mod2166) (call-with-values (lambda () (convert-pattern2138 pat2163 keys2160)) (lambda (p2167 pvars2168) (cond ((not (distinct-bound-ids?1117 (map car pvars2168))) (syntax-error pat2163 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2169) (not (ellipsis?1136 (car x2169)))) pvars2168)) (syntax-error pat2163 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2170 (gen-var1139 (quote tmp)))) (build-annotated1068 #f (list (build-annotated1068 #f (list (quote lambda) (list y2170) (let ((y2171 (build-annotated1068 #f y2170))) (build-annotated1068 #f (list (quote if) ((lambda (tmp2172) ((lambda (tmp2173) (if tmp2173 (apply (lambda () y2171) tmp2173) ((lambda (_2174) (build-annotated1068 #f (list (quote if) y2171 (build-dispatch-call2139 pvars2168 fender2164 y2171 r2162 mod2166) (build-data1069 #f #f)))) tmp2172))) (syntax-dispatch tmp2172 (quote #(atom #t))))) fender2164) (build-dispatch-call2139 pvars2168 exp2165 y2171 r2162 mod2166) (gen-syntax-case2141 x2159 keys2160 clauses2161 r2162 mod2166)))))) (if (eq? p2167 (quote any)) (build-annotated1068 #f (list (build-annotated1068 #f (quote list)) x2159)) (build-annotated1068 #f (list (build-annotated1068 #f (quote syntax-dispatch)) x2159 (build-data1069 #f p2167))))))))))))) (build-dispatch-call2139 (lambda (pvars2175 exp2176 y2177 r2178 mod2179) (let ((ids2180 (map car pvars2175)) (levels2181 (map cdr pvars2175))) (let ((labels2182 (gen-labels1097 ids2180)) (new-vars2183 (map gen-var1139 ids2180))) (build-annotated1068 #f (list (build-annotated1068 #f (quote apply)) (build-annotated1068 #f (list (quote lambda) new-vars2183 (chi1127 exp2176 (extend-env1085 labels2182 (map (lambda (var2184 level2185) (cons (quote syntax) (cons var2184 level2185))) new-vars2183 (map cdr pvars2175)) r2178) (make-binding-wrap1108 ids2180 labels2182 (quote (()))) mod2179))) y2177)))))) (convert-pattern2138 (lambda (pattern2186 keys2187) (let cvt2188 ((p2189 pattern2186) (n2190 0) (ids2191 (quote ()))) (if (id?1091 p2189) (if (bound-id-member?1118 p2189 keys2187) (values (vector (quote free-id) p2189) ids2191) (values (quote any) (cons (cons p2189 n2190) ids2191))) ((lambda (tmp2192) ((lambda (tmp2193) (if (if tmp2193 (apply (lambda (x2194 dots2195) (ellipsis?1136 dots2195)) tmp2193) #f) (apply (lambda (x2196 dots2197) (call-with-values (lambda () (cvt2188 x2196 (fx+1059 n2190 1) ids2191)) (lambda (p2198 ids2199) (values (if (eq? p2198 (quote any)) (quote each-any) (vector (quote each) p2198)) ids2199)))) tmp2193) ((lambda (tmp2200) (if tmp2200 (apply (lambda (x2201 y2202) (call-with-values (lambda () (cvt2188 y2202 n2190 ids2191)) (lambda (y2203 ids2204) (call-with-values (lambda () (cvt2188 x2201 n2190 ids2204)) (lambda (x2205 ids2206) (values (cons x2205 y2203) ids2206)))))) tmp2200) ((lambda (tmp2207) (if tmp2207 (apply (lambda () (values (quote ()) ids2191)) tmp2207) ((lambda (tmp2208) (if tmp2208 (apply (lambda (x2209) (call-with-values (lambda () (cvt2188 x2209 n2190 ids2191)) (lambda (p2211 ids2212) (values (vector (quote vector) p2211) ids2212)))) tmp2208) ((lambda (x2213) (values (vector (quote atom) (strip1138 p2189 (quote (())))) ids2191)) tmp2192))) (syntax-dispatch tmp2192 (quote #(vector each-any)))))) (syntax-dispatch tmp2192 (quote ()))))) (syntax-dispatch tmp2192 (quote (any . any)))))) (syntax-dispatch tmp2192 (quote (any any))))) p2189)))))) (lambda (e2214 r2215 w2216 s2217 mod2218) (let ((e2219 (source-wrap1120 e2214 w2216 s2217 mod2218))) ((lambda (tmp2220) ((lambda (tmp2221) (if tmp2221 (apply (lambda (_2222 val2223 key2224 m2225) (if (andmap (lambda (x2226) (and (id?1091 x2226) (not (ellipsis?1136 x2226)))) key2224) (let ((x2228 (gen-var1139 (quote tmp)))) (build-annotated1068 s2217 (list (build-annotated1068 #f (list (quote lambda) (list x2228) (gen-syntax-case2141 (build-annotated1068 #f x2228) key2224 m2225 r2215 mod2218))) (chi1127 val2223 r2215 (quote (())) mod2218)))) (syntax-error e2219 "invalid literals list in"))) tmp2221) (syntax-error tmp2220))) (syntax-dispatch tmp2220 (quote (any any each-any . each-any))))) e2219))))) (set! sc-expand (let ((m2231 (quote e)) (esew2232 (quote (eval)))) (lambda (x2233) (if (and (pair? x2233) (equal? (car x2233) noexpand1058)) (cadr x2233) (chi-top1126 x2233 (quote ()) (quote ((top))) m2231 esew2232 (module-name (current-module))))))) (set! sc-expand3 (let ((m2234 (quote e)) (esew2235 (quote (eval)))) (lambda (x2237 . rest2236) (if (and (pair? x2237) (equal? (car x2237) noexpand1058)) (cadr x2237) (chi-top1126 x2237 (quote ()) (quote ((top))) (if (null? rest2236) m2234 (car rest2236)) (if (or (null? rest2236) (null? (cdr rest2236))) esew2235 (cadr rest2236)) (module-name (current-module))))))) (set! identifier? (lambda (x2238) (nonsymbol-id?1090 x2238))) (set! datum->syntax-object (lambda (id2239 datum2240) (make-syntax-object1074 datum2240 (syntax-object-wrap1077 id2239) #f))) (set! syntax-object->datum (lambda (x2241) (strip1138 x2241 (quote (()))))) (set! generate-temporaries (lambda (ls2242) (begin (let ((x2243 ls2242)) (if (not (list? x2243)) (error-hook1065 (quote generate-temporaries) "invalid argument" x2243))) (map (lambda (x2244) (wrap1119 (gensym) (quote ((top))) #f)) ls2242)))) (set! free-identifier=? (lambda (x2245 y2246) (begin (let ((x2247 x2245)) (if (not (nonsymbol-id?1090 x2247)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2247))) (let ((x2248 y2246)) (if (not (nonsymbol-id?1090 x2248)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2248))) (free-id=?1114 x2245 y2246)))) (set! bound-identifier=? (lambda (x2249 y2250) (begin (let ((x2251 x2249)) (if (not (nonsymbol-id?1090 x2251)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2251))) (let ((x2252 y2250)) (if (not (nonsymbol-id?1090 x2252)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2252))) (bound-id=?1115 x2249 y2250)))) (set! syntax-error (lambda (object2254 . messages2253) (begin (for-each (lambda (x2255) (let ((x2256 x2255)) (if (not (string? x2256)) (error-hook1065 (quote syntax-error) "invalid argument" x2256)))) messages2253) (let ((message2257 (if (null? messages2253) "invalid syntax" (apply string-append messages2253)))) (error-hook1065 #f message2257 (strip1138 object2254 (quote (())))))))) (set! install-global-transformer (lambda (sym2258 v2259) (begin (let ((x2260 sym2258)) (if (not (symbol? x2260)) (error-hook1065 (quote define-syntax) "invalid argument" x2260))) (let ((x2261 v2259)) (if (not (procedure? x2261)) (error-hook1065 (quote define-syntax) "invalid argument" x2261))) (global-extend1089 (quote macro) sym2258 v2259)))) (letrec ((match2266 (lambda (e2267 p2268 w2269 r2270 mod2271) (cond ((not r2270) #f) ((eq? p2268 (quote any)) (cons (wrap1119 e2267 w2269 mod2271) r2270)) ((syntax-object?1075 e2267) (match*2265 (let ((e2272 (syntax-object-expression1076 e2267))) (if (annotation? e2272) (annotation-expression e2272) e2272)) p2268 (join-wraps1110 w2269 (syntax-object-wrap1077 e2267)) r2270 (syntax-object-module1078 e2267))) (else (match*2265 (let ((e2273 e2267)) (if (annotation? e2273) (annotation-expression e2273) e2273)) p2268 w2269 r2270 mod2271))))) (match*2265 (lambda (e2274 p2275 w2276 r2277 mod2278) (cond ((null? p2275) (and (null? e2274) r2277)) ((pair? p2275) (and (pair? e2274) (match2266 (car e2274) (car p2275) w2276 (match2266 (cdr e2274) (cdr p2275) w2276 r2277 mod2278) mod2278))) ((eq? p2275 (quote each-any)) (let ((l2279 (match-each-any2263 e2274 w2276 mod2278))) (and l2279 (cons l2279 r2277)))) (else (let ((t2280 (vector-ref p2275 0))) (if (memv t2280 (quote (each))) (if (null? e2274) (match-empty2264 (vector-ref p2275 1) r2277) (let ((l2281 (match-each2262 e2274 (vector-ref p2275 1) w2276 mod2278))) (and l2281 (let collect2282 ((l2283 l2281)) (if (null? (car l2283)) r2277 (cons (map car l2283) (collect2282 (map cdr l2283)))))))) (if (memv t2280 (quote (free-id))) (and (id?1091 e2274) (free-id=?1114 (wrap1119 e2274 w2276 mod2278) (vector-ref p2275 1)) r2277) (if (memv t2280 (quote (atom))) (and (equal? (vector-ref p2275 1) (strip1138 e2274 w2276)) r2277) (if (memv t2280 (quote (vector))) (and (vector? e2274) (match2266 (vector->list e2274) (vector-ref p2275 1) w2276 r2277 mod2278))))))))))) (match-empty2264 (lambda (p2284 r2285) (cond ((null? p2284) r2285) ((eq? p2284 (quote any)) (cons (quote ()) r2285)) ((pair? p2284) (match-empty2264 (car p2284) (match-empty2264 (cdr p2284) r2285))) ((eq? p2284 (quote each-any)) (cons (quote ()) r2285)) (else (let ((t2286 (vector-ref p2284 0))) (if (memv t2286 (quote (each))) (match-empty2264 (vector-ref p2284 1) r2285) (if (memv t2286 (quote (free-id atom))) r2285 (if (memv t2286 (quote (vector))) (match-empty2264 (vector-ref p2284 1) r2285))))))))) (match-each-any2263 (lambda (e2287 w2288 mod2289) (cond ((annotation? e2287) (match-each-any2263 (annotation-expression e2287) w2288 mod2289)) ((pair? e2287) (let ((l2290 (match-each-any2263 (cdr e2287) w2288 mod2289))) (and l2290 (cons (wrap1119 (car e2287) w2288 mod2289) l2290)))) ((null? e2287) (quote ())) ((syntax-object?1075 e2287) (match-each-any2263 (syntax-object-expression1076 e2287) (join-wraps1110 w2288 (syntax-object-wrap1077 e2287)) mod2289)) (else #f)))) (match-each2262 (lambda (e2291 p2292 w2293 mod2294) (cond ((annotation? e2291) (match-each2262 (annotation-expression e2291) p2292 w2293 mod2294)) ((pair? e2291) (let ((first2295 (match2266 (car e2291) p2292 w2293 (quote ()) mod2294))) (and first2295 (let ((rest2296 (match-each2262 (cdr e2291) p2292 w2293 mod2294))) (and rest2296 (cons first2295 rest2296)))))) ((null? e2291) (quote ())) ((syntax-object?1075 e2291) (match-each2262 (syntax-object-expression1076 e2291) p2292 (join-wraps1110 w2293 (syntax-object-wrap1077 e2291)) (syntax-object-module1078 e2291))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2297 p2298) (cond ((eq? p2298 (quote any)) (list e2297)) ((syntax-object?1075 e2297) (match*2265 (let ((e2299 (syntax-object-expression1076 e2297))) (if (annotation? e2299) (annotation-expression e2299) e2299)) p2298 (syntax-object-wrap1077 e2297) (quote ()) (syntax-object-module1078 e2297))) (else (match*2265 (let ((e2300 e2297)) (if (annotation? e2300) (annotation-expression e2300) e2300)) p2298 (quote (())) (quote ()) #f))))) (set! sc-chi chi1127)))))
-(install-global-transformer (quote with-syntax) (lambda (x2301) ((lambda (tmp2302) ((lambda (tmp2303) (if tmp2303 (apply (lambda (_2304 e12305 e22306) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12305 e22306))) tmp2303) ((lambda (tmp2308) (if tmp2308 (apply (lambda (_2309 out2310 in2311 e12312 e22313) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2311 (quote ()) (list out2310 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12312 e22313))))) tmp2308) ((lambda (tmp2315) (if tmp2315 (apply (lambda (_2316 out2317 in2318 e12319 e22320) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2318) (quote ()) (list out2317 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12319 e22320))))) tmp2315) (syntax-error tmp2302))) (syntax-dispatch tmp2302 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2302 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2302 (quote (any () any . each-any))))) x2301)))
-(install-global-transformer (quote syntax-rules) (lambda (x2324) ((lambda (tmp2325) ((lambda (tmp2326) (if tmp2326 (apply (lambda (_2327 k2328 keyword2329 pattern2330 template2331) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons k2328 (map (lambda (tmp2334 tmp2333) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2333) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2334))) template2331 pattern2330)))))) tmp2326) (syntax-error tmp2325))) (syntax-dispatch tmp2325 (quote (any each-any . #(each ((any . any) any))))))) x2324)))
-(install-global-transformer (quote let*) (lambda (x2335) ((lambda (tmp2336) ((lambda (tmp2337) (if (if tmp2337 (apply (lambda (let*2338 x2339 v2340 e12341 e22342) (andmap identifier? x2339)) tmp2337) #f) (apply (lambda (let*2344 x2345 v2346 e12347 e22348) (let f2349 ((bindings2350 (map list x2345 v2346))) (if (null? bindings2350) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote ()) (cons e12347 e22348))) ((lambda (tmp2354) ((lambda (tmp2355) (if tmp2355 (apply (lambda (body2356 binding2357) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list binding2357) body2356)) tmp2355) (syntax-error tmp2354))) (syntax-dispatch tmp2354 (quote (any any))))) (list (f2349 (cdr bindings2350)) (car bindings2350)))))) tmp2337) (syntax-error tmp2336))) (syntax-dispatch tmp2336 (quote (any #(each (any any)) any . each-any))))) x2335)))
-(install-global-transformer (quote do) (lambda (orig-x2358) ((lambda (tmp2359) ((lambda (tmp2360) (if tmp2360 (apply (lambda (_2361 var2362 init2363 step2364 e02365 e12366 c2367) ((lambda (tmp2368) ((lambda (tmp2369) (if tmp2369 (apply (lambda (step2370) ((lambda (tmp2371) ((lambda (tmp2372) (if tmp2372 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2362 init2363) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02365) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2367 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2370))))))) tmp2372) ((lambda (tmp2377) (if tmp2377 (apply (lambda (e12378 e22379) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2362 init2363) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02365 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (cons e12378 e22379)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2367 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2370))))))) tmp2377) (syntax-error tmp2371))) (syntax-dispatch tmp2371 (quote (any . each-any)))))) (syntax-dispatch tmp2371 (quote ())))) e12366)) tmp2369) (syntax-error tmp2368))) (syntax-dispatch tmp2368 (quote each-any)))) (map (lambda (v2386 s2387) ((lambda (tmp2388) ((lambda (tmp2389) (if tmp2389 (apply (lambda () v2386) tmp2389) ((lambda (tmp2390) (if tmp2390 (apply (lambda (e2391) e2391) tmp2390) ((lambda (_2392) (syntax-error orig-x2358)) tmp2388))) (syntax-dispatch tmp2388 (quote (any)))))) (syntax-dispatch tmp2388 (quote ())))) s2387)) var2362 step2364))) tmp2360) (syntax-error tmp2359))) (syntax-dispatch tmp2359 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2358)))
-(install-global-transformer (quote quasiquote) (letrec ((quasicons2395 (lambda (x2399 y2400) ((lambda (tmp2401) ((lambda (tmp2402) (if tmp2402 (apply (lambda (x2403 y2404) ((lambda (tmp2405) ((lambda (tmp2406) (if tmp2406 (apply (lambda (dy2407) ((lambda (tmp2408) ((lambda (tmp2409) (if tmp2409 (apply (lambda (dx2410) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons dx2410 dy2407))) tmp2409) ((lambda (_2411) (if (null? dy2407) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2403) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2403 y2404))) tmp2408))) (syntax-dispatch tmp2408 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) x2403)) tmp2406) ((lambda (tmp2412) (if tmp2412 (apply (lambda (stuff2413) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons x2403 stuff2413))) tmp2412) ((lambda (else2414) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2403 y2404)) tmp2405))) (syntax-dispatch tmp2405 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . any)))))) (syntax-dispatch tmp2405 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) y2404)) tmp2402) (syntax-error tmp2401))) (syntax-dispatch tmp2401 (quote (any any))))) (list x2399 y2400)))) (quasiappend2396 (lambda (x2415 y2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (x2419 y2420) ((lambda (tmp2421) ((lambda (tmp2422) (if tmp2422 (apply (lambda () x2419) tmp2422) ((lambda (_2423) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2419 y2420)) tmp2421))) (syntax-dispatch tmp2421 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) ()))))) y2420)) tmp2418) (syntax-error tmp2417))) (syntax-dispatch tmp2417 (quote (any any))))) (list x2415 y2416)))) (quasivector2397 (lambda (x2424) ((lambda (tmp2425) ((lambda (x2426) ((lambda (tmp2427) ((lambda (tmp2428) (if tmp2428 (apply (lambda (x2429) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (list->vector x2429))) tmp2428) ((lambda (tmp2431) (if tmp2431 (apply (lambda (x2432) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2432)) tmp2431) ((lambda (_2434) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2426)) tmp2427))) (syntax-dispatch tmp2427 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . each-any)))))) (syntax-dispatch tmp2427 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) each-any))))) x2426)) tmp2425)) x2424))) (quasi2398 (lambda (p2435 lev2436) ((lambda (tmp2437) ((lambda (tmp2438) (if tmp2438 (apply (lambda (p2439) (if (= lev2436 0) p2439 (quasicons2395 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2398 (list p2439) (- lev2436 1))))) tmp2438) ((lambda (tmp2440) (if tmp2440 (apply (lambda (p2441 q2442) (if (= lev2436 0) (quasiappend2396 p2441 (quasi2398 q2442 lev2436)) (quasicons2395 (quasicons2395 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2398 (list p2441) (- lev2436 1))) (quasi2398 q2442 lev2436)))) tmp2440) ((lambda (tmp2443) (if tmp2443 (apply (lambda (p2444) (quasicons2395 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2398 (list p2444) (+ lev2436 1)))) tmp2443) ((lambda (tmp2445) (if tmp2445 (apply (lambda (p2446 q2447) (quasicons2395 (quasi2398 p2446 lev2436) (quasi2398 q2447 lev2436))) tmp2445) ((lambda (tmp2448) (if tmp2448 (apply (lambda (x2449) (quasivector2397 (quasi2398 x2449 lev2436))) tmp2448) ((lambda (p2451) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) p2451)) tmp2437))) (syntax-dispatch tmp2437 (quote #(vector each-any)))))) (syntax-dispatch tmp2437 (quote (any . any)))))) (syntax-dispatch tmp2437 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any)))))) (syntax-dispatch tmp2437 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any) . any)))))) (syntax-dispatch tmp2437 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) p2435)))) (lambda (x2452) ((lambda (tmp2453) ((lambda (tmp2454) (if tmp2454 (apply (lambda (_2455 e2456) (quasi2398 e2456 0)) tmp2454) (syntax-error tmp2453))) (syntax-dispatch tmp2453 (quote (any any))))) x2452))))
-(install-global-transformer (quote include) (lambda (x2457) (letrec ((read-file2458 (lambda (fn2459 k2460) (let ((p2461 (open-input-file fn2459))) (let f2462 ((x2463 (read p2461))) (if (eof-object? x2463) (begin (close-input-port p2461) (quote ())) (cons (datum->syntax-object k2460 x2463) (f2462 (read p2461))))))))) ((lambda (tmp2464) ((lambda (tmp2465) (if tmp2465 (apply (lambda (k2466 filename2467) (let ((fn2468 (syntax-object->datum filename2467))) ((lambda (tmp2469) ((lambda (tmp2470) (if tmp2470 (apply (lambda (exp2471) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (guile))) exp2471)) tmp2470) (syntax-error tmp2469))) (syntax-dispatch tmp2469 (quote each-any)))) (read-file2458 fn2468 k2466)))) tmp2465) (syntax-error tmp2464))) (syntax-dispatch tmp2464 (quote (any any))))) x2457))))
-(install-global-transformer (quote unquote) (lambda (x2473) ((lambda (tmp2474) ((lambda (tmp2475) (if tmp2475 (apply (lambda (_2476 e2477) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2477))) tmp2475) (syntax-error tmp2474))) (syntax-dispatch tmp2474 (quote (any any))))) x2473)))
-(install-global-transformer (quote unquote-splicing) (lambda (x2478) ((lambda (tmp2479) ((lambda (tmp2480) (if tmp2480 (apply (lambda (_2481 e2482) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2482))) tmp2480) (syntax-error tmp2479))) (syntax-dispatch tmp2479 (quote (any any))))) x2478)))
-(install-global-transformer (quote case) (lambda (x2483) ((lambda (tmp2484) ((lambda (tmp2485) (if tmp2485 (apply (lambda (_2486 e2487 m12488 m22489) ((lambda (tmp2490) ((lambda (body2491) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2487)) body2491)) tmp2490)) (let f2492 ((clause2493 m12488) (clauses2494 m22489)) (if (null? clauses2494) ((lambda (tmp2496) ((lambda (tmp2497) (if tmp2497 (apply (lambda (e12498 e22499) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12498 e22499))) tmp2497) ((lambda (tmp2501) (if tmp2501 (apply (lambda (k2502 e12503 e22504) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2502)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12503 e22504)))) tmp2501) ((lambda (_2507) (syntax-error x2483)) tmp2496))) (syntax-dispatch tmp2496 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2496 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) any . each-any))))) clause2493) ((lambda (tmp2508) ((lambda (rest2509) ((lambda (tmp2510) ((lambda (tmp2511) (if tmp2511 (apply (lambda (k2512 e12513 e22514) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2512)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12513 e22514)) rest2509)) tmp2511) ((lambda (_2517) (syntax-error x2483)) tmp2510))) (syntax-dispatch tmp2510 (quote (each-any any . each-any))))) clause2493)) tmp2508)) (f2492 (car clauses2494) (cdr clauses2494))))))) tmp2485) (syntax-error tmp2484))) (syntax-dispatch tmp2484 (quote (any any any . each-any))))) x2483)))
-(install-global-transformer (quote identifier-syntax) (lambda (x2518) ((lambda (tmp2519) ((lambda (tmp2520) (if tmp2520 (apply (lambda (_2521 e2522) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2522)) (list (cons _2521 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e2522 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))))))))) tmp2520) (syntax-error tmp2519))) (syntax-dispatch tmp2519 (quote (any any))))) x2518)))
+(letrec ((lambda-var-list1141 (lambda (vars1340) (let lvl1341 ((vars1342 vars1340) (ls1343 (quote ())) (w1344 (quote (())))) (cond ((pair? vars1342) (lvl1341 (cdr vars1342) (cons (wrap1120 (car vars1342) w1344 #f) ls1343) w1344)) ((id?1092 vars1342) (cons (wrap1120 vars1342 w1344 #f) ls1343)) ((null? vars1342) ls1343) ((syntax-object?1076 vars1342) (lvl1341 (syntax-object-expression1077 vars1342) ls1343 (join-wraps1111 w1344 (syntax-object-wrap1078 vars1342)))) ((annotation? vars1342) (lvl1341 (annotation-expression vars1342) ls1343 w1344)) (else (cons vars1342 ls1343)))))) (gen-var1140 (lambda (id1345) (let ((id1346 (if (syntax-object?1076 id1345) (syntax-object-expression1077 id1345) id1345))) (if (annotation? id1346) (build-annotated1069 (annotation-source id1346) (gensym (symbol->string (annotation-expression id1346)))) (build-annotated1069 #f (gensym (symbol->string id1346))))))) (strip1139 (lambda (x1347 w1348) (if (memq (quote top) (wrap-marks1095 w1348)) (if (or (annotation? x1347) (and (pair? x1347) (annotation? (car x1347)))) (strip-annotation1138 x1347 #f) x1347) (let f1349 ((x1350 x1347)) (cond ((syntax-object?1076 x1350) (strip1139 (syntax-object-expression1077 x1350) (syntax-object-wrap1078 x1350))) ((pair? x1350) (let ((a1351 (f1349 (car x1350))) (d1352 (f1349 (cdr x1350)))) (if (and (eq? a1351 (car x1350)) (eq? d1352 (cdr x1350))) x1350 (cons a1351 d1352)))) ((vector? x1350) (let ((old1353 (vector->list x1350))) (let ((new1354 (map f1349 old1353))) (if (andmap eq? old1353 new1354) x1350 (list->vector new1354))))) (else x1350)))))) (strip-annotation1138 (lambda (x1355 parent1356) (cond ((pair? x1355) (let ((new1357 (cons #f #f))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1357)) (set-car! new1357 (strip-annotation1138 (car x1355) #f)) (set-cdr! new1357 (strip-annotation1138 (cdr x1355) #f)) new1357))) ((annotation? x1355) (or (annotation-stripped x1355) (strip-annotation1138 (annotation-expression x1355) x1355))) ((vector? x1355) (let ((new1358 (make-vector (vector-length x1355)))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1358)) (let loop1359 ((i1360 (- (vector-length x1355) 1))) (unless (fx<1062 i1360 0) (vector-set! new1358 i1360 (strip-annotation1138 (vector-ref x1355 i1360) #f)) (loop1359 (fx-1060 i1360 1)))) new1358))) (else x1355)))) (ellipsis?1137 (lambda (x1361) (and (nonsymbol-id?1091 x1361) (free-id=?1115 x1361 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))))))) (chi-void1136 (lambda () (build-annotated1069 #f (list (build-annotated1069 #f (quote void)))))) (eval-local-transformer1135 (lambda (expanded1362 mod1363) (let ((p1364 (local-eval-hook1064 expanded1362 mod1363))) (if (procedure? p1364) p1364 (syntax-error p1364 "nonprocedure transformer"))))) (chi-local-syntax1134 (lambda (rec?1365 e1366 r1367 w1368 s1369 mod1370 k1371) ((lambda (tmp1372) ((lambda (tmp1373) (if tmp1373 (apply (lambda (_1374 id1375 val1376 e11377 e21378) (let ((ids1379 id1375)) (if (not (valid-bound-ids?1117 ids1379)) (syntax-error e1366 "duplicate bound keyword in") (let ((labels1381 (gen-labels1098 ids1379))) (let ((new-w1382 (make-binding-wrap1109 ids1379 labels1381 w1368))) (k1371 (cons e11377 e21378) (extend-env1086 labels1381 (let ((w1384 (if rec?1365 new-w1382 w1368)) (trans-r1385 (macros-only-env1088 r1367))) (map (lambda (x1386) (cons (quote macro) (eval-local-transformer1135 (chi1128 x1386 trans-r1385 w1384 mod1370) mod1370))) val1376)) r1367) new-w1382 s1369 mod1370)))))) tmp1373) ((lambda (_1388) (syntax-error (source-wrap1121 e1366 w1368 s1369 mod1370))) tmp1372))) (syntax-dispatch tmp1372 (quote (any #(each (any any)) any . each-any))))) e1366))) (chi-lambda-clause1133 (lambda (e1389 c1390 r1391 w1392 mod1393 k1394) ((lambda (tmp1395) ((lambda (tmp1396) (if tmp1396 (apply (lambda (id1397 e11398 e21399) (let ((ids1400 id1397)) (if (not (valid-bound-ids?1117 ids1400)) (syntax-error e1389 "invalid parameter list in") (let ((labels1402 (gen-labels1098 ids1400)) (new-vars1403 (map gen-var1140 ids1400))) (k1394 new-vars1403 (chi-body1132 (cons e11398 e21399) e1389 (extend-var-env1087 labels1402 new-vars1403 r1391) (make-binding-wrap1109 ids1400 labels1402 w1392) mod1393)))))) tmp1396) ((lambda (tmp1405) (if tmp1405 (apply (lambda (ids1406 e11407 e21408) (let ((old-ids1409 (lambda-var-list1141 ids1406))) (if (not (valid-bound-ids?1117 old-ids1409)) (syntax-error e1389 "invalid parameter list in") (let ((labels1410 (gen-labels1098 old-ids1409)) (new-vars1411 (map gen-var1140 old-ids1409))) (k1394 (let f1412 ((ls11413 (cdr new-vars1411)) (ls21414 (car new-vars1411))) (if (null? ls11413) ls21414 (f1412 (cdr ls11413) (cons (car ls11413) ls21414)))) (chi-body1132 (cons e11407 e21408) e1389 (extend-var-env1087 labels1410 new-vars1411 r1391) (make-binding-wrap1109 old-ids1409 labels1410 w1392) mod1393)))))) tmp1405) ((lambda (_1416) (syntax-error e1389)) tmp1395))) (syntax-dispatch tmp1395 (quote (any any . each-any)))))) (syntax-dispatch tmp1395 (quote (each-any any . each-any))))) c1390))) (chi-body1132 (lambda (body1417 outer-form1418 r1419 w1420 mod1421) (let ((r1422 (cons (quote ("placeholder" placeholder)) r1419))) (let ((ribcage1423 (make-ribcage1099 (quote ()) (quote ()) (quote ())))) (let ((w1424 (make-wrap1094 (wrap-marks1095 w1420) (cons ribcage1423 (wrap-subst1096 w1420))))) (let parse1425 ((body1426 (map (lambda (x1432) (cons r1422 (wrap1120 x1432 w1424 mod1421))) body1417)) (ids1427 (quote ())) (labels1428 (quote ())) (vars1429 (quote ())) (vals1430 (quote ())) (bindings1431 (quote ()))) (if (null? body1426) (syntax-error outer-form1418 "no expressions in body") (let ((e1433 (cdar body1426)) (er1434 (caar body1426))) (call-with-values (lambda () (syntax-type1126 e1433 er1434 (quote (())) #f ribcage1423 mod1421)) (lambda (type1435 value1436 e1437 w1438 s1439 mod1440) (let ((t1441 type1435)) (if (memv t1441 (quote (define-form))) (let ((id1442 (wrap1120 value1436 w1438 mod1440)) (label1443 (gen-label1097))) (let ((var1444 (gen-var1140 id1442))) (begin (extend-ribcage!1108 ribcage1423 id1442 label1443) (parse1425 (cdr body1426) (cons id1442 ids1427) (cons label1443 labels1428) (cons var1444 vars1429) (cons (cons er1434 (wrap1120 e1437 w1438 mod1440)) vals1430) (cons (cons (quote lexical) var1444) bindings1431))))) (if (memv t1441 (quote (define-syntax-form))) (let ((id1445 (wrap1120 value1436 w1438 mod1440)) (label1446 (gen-label1097))) (begin (extend-ribcage!1108 ribcage1423 id1445 label1446) (parse1425 (cdr body1426) (cons id1445 ids1427) (cons label1446 labels1428) vars1429 vals1430 (cons (cons (quote macro) (cons er1434 (wrap1120 e1437 w1438 mod1440))) bindings1431)))) (if (memv t1441 (quote (begin-form))) ((lambda (tmp1447) ((lambda (tmp1448) (if tmp1448 (apply (lambda (_1449 e11450) (parse1425 (let f1451 ((forms1452 e11450)) (if (null? forms1452) (cdr body1426) (cons (cons er1434 (wrap1120 (car forms1452) w1438 mod1440)) (f1451 (cdr forms1452))))) ids1427 labels1428 vars1429 vals1430 bindings1431)) tmp1448) (syntax-error tmp1447))) (syntax-dispatch tmp1447 (quote (any . each-any))))) e1437) (if (memv t1441 (quote (local-syntax-form))) (chi-local-syntax1134 value1436 e1437 er1434 w1438 s1439 mod1440 (lambda (forms1454 er1455 w1456 s1457 mod1458) (parse1425 (let f1459 ((forms1460 forms1454)) (if (null? forms1460) (cdr body1426) (cons (cons er1455 (wrap1120 (car forms1460) w1456 mod1458)) (f1459 (cdr forms1460))))) ids1427 labels1428 vars1429 vals1430 bindings1431))) (if (null? ids1427) (build-sequence1071 #f (map (lambda (x1461) (chi1128 (cdr x1461) (car x1461) (quote (())) mod1440)) (cons (cons er1434 (source-wrap1121 e1437 w1438 s1439 mod1440)) (cdr body1426)))) (begin (if (not (valid-bound-ids?1117 ids1427)) (syntax-error outer-form1418 "invalid or duplicate identifier in definition")) (let loop1462 ((bs1463 bindings1431) (er-cache1464 #f) (r-cache1465 #f)) (if (not (null? bs1463)) (let ((b1466 (car bs1463))) (if (eq? (car b1466) (quote macro)) (let ((er1467 (cadr b1466))) (let ((r-cache1468 (if (eq? er1467 er-cache1464) r-cache1465 (macros-only-env1088 er1467)))) (begin (set-cdr! b1466 (eval-local-transformer1135 (chi1128 (cddr b1466) r-cache1468 (quote (())) mod1440) mod1440)) (loop1462 (cdr bs1463) er1467 r-cache1468)))) (loop1462 (cdr bs1463) er-cache1464 r-cache1465))))) (set-cdr! r1422 (extend-env1086 labels1428 bindings1431 (cdr r1422))) (build-letrec1074 #f vars1429 (map (lambda (x1469) (chi1128 (cdr x1469) (car x1469) (quote (())) mod1440)) vals1430) (build-sequence1071 #f (map (lambda (x1470) (chi1128 (cdr x1470) (car x1470) (quote (())) mod1440)) (cons (cons er1434 (source-wrap1121 e1437 w1438 s1439 mod1440)) (cdr body1426)))))))))))))))))))))) (chi-macro1131 (lambda (p1471 e1472 r1473 w1474 rib1475 mod1476) (letrec ((rebuild-macro-output1477 (lambda (x1478 m1479) (cond ((pair? x1478) (cons (rebuild-macro-output1477 (car x1478) m1479) (rebuild-macro-output1477 (cdr x1478) m1479))) ((syntax-object?1076 x1478) (let ((w1480 (syntax-object-wrap1078 x1478))) (let ((ms1481 (wrap-marks1095 w1480)) (s1482 (wrap-subst1096 w1480))) (if (and (pair? ms1481) (eq? (car ms1481) #f)) (make-syntax-object1075 (syntax-object-expression1077 x1478) (make-wrap1094 (cdr ms1481) (if rib1475 (cons rib1475 (cdr s1482)) (cdr s1482))) (syntax-object-module1079 x1478)) (make-syntax-object1075 (syntax-object-expression1077 x1478) (make-wrap1094 (cons m1479 ms1481) (if rib1475 (cons rib1475 (cons (quote shift) s1482)) (cons (quote shift) s1482))) (module-name (procedure-module p1471))))))) ((vector? x1478) (let ((n1483 (vector-length x1478))) (let ((v1484 (make-vector n1483))) (let doloop1485 ((i1486 0)) (if (fx=1061 i1486 n1483) v1484 (begin (vector-set! v1484 i1486 (rebuild-macro-output1477 (vector-ref x1478 i1486) m1479)) (doloop1485 (fx+1059 i1486 1)))))))) ((symbol? x1478) (syntax-error x1478 "encountered raw symbol in macro output")) (else x1478))))) (rebuild-macro-output1477 (p1471 (wrap1120 e1472 (anti-mark1107 w1474) mod1476)) (string #\m))))) (chi-application1130 (lambda (x1487 e1488 r1489 w1490 s1491 mod1492) ((lambda (tmp1493) ((lambda (tmp1494) (if tmp1494 (apply (lambda (e01495 e11496) (build-annotated1069 s1491 (cons x1487 (map (lambda (e1497) (chi1128 e1497 r1489 w1490 mod1492)) e11496)))) tmp1494) (syntax-error tmp1493))) (syntax-dispatch tmp1493 (quote (any . each-any))))) e1488))) (chi-expr1129 (lambda (type1499 value1500 e1501 r1502 w1503 s1504 mod1505) (let ((t1506 type1499)) (if (memv t1506 (quote (lexical))) (build-annotated1069 s1504 value1500) (if (memv t1506 (quote (core external-macro))) (value1500 e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (module-ref))) (call-with-values (lambda () (value1500 e1501)) (lambda (id1507 mod1508) (build-annotated1069 s1504 (make-module-ref mod1508 id1507 #f)))) (if (memv t1506 (quote (lexical-call))) (chi-application1130 (build-annotated1069 (source-annotation1083 (car e1501)) value1500) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (global-call))) (chi-application1130 (build-annotated1069 (source-annotation1083 (car e1501)) (make-module-ref (if (syntax-object?1076 (car e1501)) (syntax-object-module1079 (car e1501)) mod1505) value1500 #f)) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (constant))) (build-data1070 s1504 (strip1139 (source-wrap1121 e1501 w1503 s1504 mod1505) (quote (())))) (if (memv t1506 (quote (global))) (build-annotated1069 s1504 (make-module-ref mod1505 value1500 #f)) (if (memv t1506 (quote (call))) (chi-application1130 (chi1128 (car e1501) r1502 w1503 mod1505) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (begin-form))) ((lambda (tmp1509) ((lambda (tmp1510) (if tmp1510 (apply (lambda (_1511 e11512 e21513) (chi-sequence1122 (cons e11512 e21513) r1502 w1503 s1504 mod1505)) tmp1510) (syntax-error tmp1509))) (syntax-dispatch tmp1509 (quote (any any . each-any))))) e1501) (if (memv t1506 (quote (local-syntax-form))) (chi-local-syntax1134 value1500 e1501 r1502 w1503 s1504 mod1505 chi-sequence1122) (if (memv t1506 (quote (eval-when-form))) ((lambda (tmp1515) ((lambda (tmp1516) (if tmp1516 (apply (lambda (_1517 x1518 e11519 e21520) (let ((when-list1521 (chi-when-list1125 e1501 x1518 w1503))) (if (memq (quote eval) when-list1521) (chi-sequence1122 (cons e11519 e21520) r1502 w1503 s1504 mod1505) (chi-void1136)))) tmp1516) (syntax-error tmp1515))) (syntax-dispatch tmp1515 (quote (any each-any any . each-any))))) e1501) (if (memv t1506 (quote (define-form define-syntax-form))) (syntax-error (wrap1120 value1500 w1503 mod1505) "invalid context for definition of") (if (memv t1506 (quote (syntax))) (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505) "reference to pattern variable outside syntax form") (if (memv t1506 (quote (displaced-lexical))) (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505) "reference to identifier outside its scope") (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505))))))))))))))))))) (chi1128 (lambda (e1524 r1525 w1526 mod1527) (call-with-values (lambda () (syntax-type1126 e1524 r1525 w1526 #f #f mod1527)) (lambda (type1528 value1529 e1530 w1531 s1532 mod1533) (chi-expr1129 type1528 value1529 e1530 r1525 w1531 s1532 mod1533))))) (chi-top1127 (lambda (e1534 r1535 w1536 m1537 esew1538 mod1539) (call-with-values (lambda () (syntax-type1126 e1534 r1535 w1536 #f #f mod1539)) (lambda (type1547 value1548 e1549 w1550 s1551 mod1552) (let ((t1553 type1547)) (if (memv t1553 (quote (begin-form))) ((lambda (tmp1554) ((lambda (tmp1555) (if tmp1555 (apply (lambda (_1556) (chi-void1136)) tmp1555) ((lambda (tmp1557) (if tmp1557 (apply (lambda (_1558 e11559 e21560) (chi-top-sequence1123 (cons e11559 e21560) r1535 w1550 s1551 m1537 esew1538 mod1552)) tmp1557) (syntax-error tmp1554))) (syntax-dispatch tmp1554 (quote (any any . each-any)))))) (syntax-dispatch tmp1554 (quote (any))))) e1549) (if (memv t1553 (quote (local-syntax-form))) (chi-local-syntax1134 value1548 e1549 r1535 w1550 s1551 mod1552 (lambda (body1562 r1563 w1564 s1565 mod1566) (chi-top-sequence1123 body1562 r1563 w1564 s1565 m1537 esew1538 mod1566))) (if (memv t1553 (quote (eval-when-form))) ((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569 x1570 e11571 e21572) (let ((when-list1573 (chi-when-list1125 e1549 x1570 w1550)) (body1574 (cons e11571 e21572))) (cond ((eq? m1537 (quote e)) (if (memq (quote eval) when-list1573) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote e) (quote (eval)) mod1552) (chi-void1136))) ((memq (quote load) when-list1573) (if (or (memq (quote compile) when-list1573) (and (eq? m1537 (quote c&e)) (memq (quote eval) when-list1573))) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote c&e) (quote (compile load)) mod1552) (if (memq m1537 (quote (c c&e))) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote c) (quote (load)) mod1552) (chi-void1136)))) ((or (memq (quote compile) when-list1573) (and (eq? m1537 (quote c&e)) (memq (quote eval) when-list1573))) (top-level-eval-hook1063 (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote e) (quote (eval)) mod1552) mod1552) (chi-void1136)) (else (chi-void1136))))) tmp1568) (syntax-error tmp1567))) (syntax-dispatch tmp1567 (quote (any each-any any . each-any))))) e1549) (if (memv t1553 (quote (define-syntax-form))) (let ((n1577 (id-var-name1114 value1548 w1550)) (r1578 (macros-only-env1088 r1535))) (let ((t1579 m1537)) (if (memv t1579 (quote (c))) (if (memq (quote compile) esew1538) (let ((e1580 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)))) (begin (top-level-eval-hook1063 e1580 mod1552) (if (memq (quote load) esew1538) e1580 (chi-void1136)))) (if (memq (quote load) esew1538) (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)) (chi-void1136))) (if (memv t1579 (quote (c&e))) (let ((e1581 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)))) (begin (top-level-eval-hook1063 e1581 mod1552) e1581)) (begin (if (memq (quote eval) esew1538) (top-level-eval-hook1063 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)) mod1552)) (chi-void1136)))))) (if (memv t1553 (quote (define-form))) (let ((n1582 (id-var-name1114 value1548 w1550))) (let ((type1583 (binding-type1084 (lookup1089 n1582 r1535 mod1552)))) (let ((t1584 type1583)) (if (memv t1584 (quote (global))) (let ((x1585 (build-annotated1069 s1551 (list (quote define) n1582 (chi1128 e1549 r1535 w1550 mod1552))))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1585 mod1552)) x1585)) (if (memv t1584 (quote (displaced-lexical))) (syntax-error (wrap1120 value1548 w1550 mod1552) "identifier out of context") (if (memv t1584 (quote (core macro module-ref))) (begin (remove-global-definition-hook1067 n1582 mod1552) (let ((x1586 (build-annotated1069 s1551 (list (quote define) n1582 (chi1128 e1549 r1535 w1550 mod1552))))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1586 mod1552)) x1586))) (syntax-error (wrap1120 value1548 w1550 mod1552) "cannot define keyword at top level"))))))) (let ((x1587 (chi-expr1129 type1547 value1548 e1549 r1535 w1550 s1551 mod1552))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1587 mod1552)) x1587)))))))))))) (syntax-type1126 (lambda (e1588 r1589 w1590 s1591 rib1592 mod1593) (cond ((symbol? e1588) (let ((n1594 (id-var-name1114 e1588 w1590))) (let ((b1595 (lookup1089 n1594 r1589 mod1593))) (let ((type1596 (binding-type1084 b1595))) (let ((t1597 type1596)) (if (memv t1597 (quote (lexical))) (values type1596 (binding-value1085 b1595) e1588 w1590 s1591 mod1593) (if (memv t1597 (quote (global))) (values type1596 n1594 e1588 w1590 s1591 mod1593) (if (memv t1597 (quote (macro))) (syntax-type1126 (chi-macro1131 (binding-value1085 b1595) e1588 r1589 w1590 rib1592 mod1593) r1589 (quote (())) s1591 rib1592 mod1593) (values type1596 (binding-value1085 b1595) e1588 w1590 s1591 mod1593))))))))) ((pair? e1588) (let ((first1598 (car e1588))) (if (id?1092 first1598) (let ((n1599 (id-var-name1114 first1598 w1590))) (let ((b1600 (lookup1089 n1599 r1589 (or (and (syntax-object?1076 first1598) (syntax-object-module1079 first1598)) mod1593)))) (let ((type1601 (binding-type1084 b1600))) (let ((t1602 type1601)) (if (memv t1602 (quote (lexical))) (values (quote lexical-call) (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (global))) (values (quote global-call) n1599 e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (macro))) (syntax-type1126 (chi-macro1131 (binding-value1085 b1600) e1588 r1589 w1590 rib1592 mod1593) r1589 (quote (())) s1591 rib1592 mod1593) (if (memv t1602 (quote (core external-macro module-ref))) (values type1601 (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (begin))) (values (quote begin-form) #f e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (eval-when))) (values (quote eval-when-form) #f e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (define))) ((lambda (tmp1603) ((lambda (tmp1604) (if (if tmp1604 (apply (lambda (_1605 name1606 val1607) (id?1092 name1606)) tmp1604) #f) (apply (lambda (_1608 name1609 val1610) (values (quote define-form) name1609 val1610 w1590 s1591 mod1593)) tmp1604) ((lambda (tmp1611) (if (if tmp1611 (apply (lambda (_1612 name1613 args1614 e11615 e21616) (and (id?1092 name1613) (valid-bound-ids?1117 (lambda-var-list1141 args1614)))) tmp1611) #f) (apply (lambda (_1617 name1618 args1619 e11620 e21621) (values (quote define-form) (wrap1120 name1618 w1590 mod1593) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) (wrap1120 (cons args1619 (cons e11620 e21621)) w1590 mod1593)) (quote (())) s1591 mod1593)) tmp1611) ((lambda (tmp1623) (if (if tmp1623 (apply (lambda (_1624 name1625) (id?1092 name1625)) tmp1623) #f) (apply (lambda (_1626 name1627) (values (quote define-form) (wrap1120 name1627 w1590 mod1593) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote (())) s1591 mod1593)) tmp1623) (syntax-error tmp1603))) (syntax-dispatch tmp1603 (quote (any any)))))) (syntax-dispatch tmp1603 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1603 (quote (any any any))))) e1588) (if (memv t1602 (quote (define-syntax))) ((lambda (tmp1628) ((lambda (tmp1629) (if (if tmp1629 (apply (lambda (_1630 name1631 val1632) (id?1092 name1631)) tmp1629) #f) (apply (lambda (_1633 name1634 val1635) (values (quote define-syntax-form) name1634 val1635 w1590 s1591 mod1593)) tmp1629) (syntax-error tmp1628))) (syntax-dispatch tmp1628 (quote (any any any))))) e1588) (values (quote call) #f e1588 w1590 s1591 mod1593)))))))))))))) (values (quote call) #f e1588 w1590 s1591 mod1593)))) ((syntax-object?1076 e1588) (syntax-type1126 (syntax-object-expression1077 e1588) r1589 (join-wraps1111 w1590 (syntax-object-wrap1078 e1588)) #f rib1592 (or (syntax-object-module1079 e1588) mod1593))) ((annotation? e1588) (syntax-type1126 (annotation-expression e1588) r1589 w1590 (annotation-source e1588) rib1592 mod1593)) ((self-evaluating? e1588) (values (quote constant) #f e1588 w1590 s1591 mod1593)) (else (values (quote other) #f e1588 w1590 s1591 mod1593))))) (chi-when-list1125 (lambda (e1636 when-list1637 w1638) (let f1639 ((when-list1640 when-list1637) (situations1641 (quote ()))) (if (null? when-list1640) situations1641 (f1639 (cdr when-list1640) (cons (let ((x1642 (car when-list1640))) (cond ((free-id=?1115 x1642 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote compile)) ((free-id=?1115 x1642 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote load)) ((free-id=?1115 x1642 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote eval)) (else (syntax-error (wrap1120 x1642 w1638 #f) "invalid eval-when situation")))) situations1641)))))) (chi-install-global1124 (lambda (name1643 e1644) (build-annotated1069 #f (list (build-annotated1069 #f (quote install-global-transformer)) (build-data1070 #f name1643) e1644)))) (chi-top-sequence1123 (lambda (body1645 r1646 w1647 s1648 m1649 esew1650 mod1651) (build-sequence1071 s1648 (let dobody1652 ((body1653 body1645) (r1654 r1646) (w1655 w1647) (m1656 m1649) (esew1657 esew1650) (mod1658 mod1651)) (if (null? body1653) (quote ()) (let ((first1659 (chi-top1127 (car body1653) r1654 w1655 m1656 esew1657 mod1658))) (cons first1659 (dobody1652 (cdr body1653) r1654 w1655 m1656 esew1657 mod1658)))))))) (chi-sequence1122 (lambda (body1660 r1661 w1662 s1663 mod1664) (build-sequence1071 s1663 (let dobody1665 ((body1666 body1660) (r1667 r1661) (w1668 w1662) (mod1669 mod1664)) (if (null? body1666) (quote ()) (let ((first1670 (chi1128 (car body1666) r1667 w1668 mod1669))) (cons first1670 (dobody1665 (cdr body1666) r1667 w1668 mod1669)))))))) (source-wrap1121 (lambda (x1671 w1672 s1673 defmod1674) (wrap1120 (if s1673 (make-annotation x1671 s1673 #f) x1671) w1672 defmod1674))) (wrap1120 (lambda (x1675 w1676 defmod1677) (cond ((and (null? (wrap-marks1095 w1676)) (null? (wrap-subst1096 w1676))) x1675) ((syntax-object?1076 x1675) (make-syntax-object1075 (syntax-object-expression1077 x1675) (join-wraps1111 w1676 (syntax-object-wrap1078 x1675)) (syntax-object-module1079 x1675))) ((null? x1675) x1675) (else (make-syntax-object1075 x1675 w1676 defmod1677))))) (bound-id-member?1119 (lambda (x1678 list1679) (and (not (null? list1679)) (or (bound-id=?1116 x1678 (car list1679)) (bound-id-member?1119 x1678 (cdr list1679)))))) (distinct-bound-ids?1118 (lambda (ids1680) (let distinct?1681 ((ids1682 ids1680)) (or (null? ids1682) (and (not (bound-id-member?1119 (car ids1682) (cdr ids1682))) (distinct?1681 (cdr ids1682))))))) (valid-bound-ids?1117 (lambda (ids1683) (and (let all-ids?1684 ((ids1685 ids1683)) (or (null? ids1685) (and (id?1092 (car ids1685)) (all-ids?1684 (cdr ids1685))))) (distinct-bound-ids?1118 ids1683)))) (bound-id=?1116 (lambda (i1686 j1687) (if (and (syntax-object?1076 i1686) (syntax-object?1076 j1687)) (and (eq? (let ((e1688 (syntax-object-expression1077 i1686))) (if (annotation? e1688) (annotation-expression e1688) e1688)) (let ((e1689 (syntax-object-expression1077 j1687))) (if (annotation? e1689) (annotation-expression e1689) e1689))) (same-marks?1113 (wrap-marks1095 (syntax-object-wrap1078 i1686)) (wrap-marks1095 (syntax-object-wrap1078 j1687)))) (eq? (let ((e1690 i1686)) (if (annotation? e1690) (annotation-expression e1690) e1690)) (let ((e1691 j1687)) (if (annotation? e1691) (annotation-expression e1691) e1691)))))) (free-id=?1115 (lambda (i1692 j1693) (and (eq? (let ((x1694 i1692)) (let ((e1695 (if (syntax-object?1076 x1694) (syntax-object-expression1077 x1694) x1694))) (if (annotation? e1695) (annotation-expression e1695) e1695))) (let ((x1696 j1693)) (let ((e1697 (if (syntax-object?1076 x1696) (syntax-object-expression1077 x1696) x1696))) (if (annotation? e1697) (annotation-expression e1697) e1697)))) (eq? (id-var-name1114 i1692 (quote (()))) (id-var-name1114 j1693 (quote (()))))))) (id-var-name1114 (lambda (id1698 w1699) (letrec ((search-vector-rib1702 (lambda (sym1708 subst1709 marks1710 symnames1711 ribcage1712) (let ((n1713 (vector-length symnames1711))) (let f1714 ((i1715 0)) (cond ((fx=1061 i1715 n1713) (search1700 sym1708 (cdr subst1709) marks1710)) ((and (eq? (vector-ref symnames1711 i1715) sym1708) (same-marks?1113 marks1710 (vector-ref (ribcage-marks1102 ribcage1712) i1715))) (values (vector-ref (ribcage-labels1103 ribcage1712) i1715) marks1710)) (else (f1714 (fx+1059 i1715 1)))))))) (search-list-rib1701 (lambda (sym1716 subst1717 marks1718 symnames1719 ribcage1720) (let f1721 ((symnames1722 symnames1719) (i1723 0)) (cond ((null? symnames1722) (search1700 sym1716 (cdr subst1717) marks1718)) ((and (eq? (car symnames1722) sym1716) (same-marks?1113 marks1718 (list-ref (ribcage-marks1102 ribcage1720) i1723))) (values (list-ref (ribcage-labels1103 ribcage1720) i1723) marks1718)) (else (f1721 (cdr symnames1722) (fx+1059 i1723 1))))))) (search1700 (lambda (sym1724 subst1725 marks1726) (if (null? subst1725) (values #f marks1726) (let ((fst1727 (car subst1725))) (if (eq? fst1727 (quote shift)) (search1700 sym1724 (cdr subst1725) (cdr marks1726)) (let ((symnames1728 (ribcage-symnames1101 fst1727))) (if (vector? symnames1728) (search-vector-rib1702 sym1724 subst1725 marks1726 symnames1728 fst1727) (search-list-rib1701 sym1724 subst1725 marks1726 symnames1728 fst1727))))))))) (cond ((symbol? id1698) (or (call-with-values (lambda () (search1700 id1698 (wrap-subst1096 w1699) (wrap-marks1095 w1699))) (lambda (x1730 . ignore1729) x1730)) id1698)) ((syntax-object?1076 id1698) (let ((id1731 (let ((e1733 (syntax-object-expression1077 id1698))) (if (annotation? e1733) (annotation-expression e1733) e1733))) (w11732 (syntax-object-wrap1078 id1698))) (let ((marks1734 (join-marks1112 (wrap-marks1095 w1699) (wrap-marks1095 w11732)))) (call-with-values (lambda () (search1700 id1731 (wrap-subst1096 w1699) marks1734)) (lambda (new-id1735 marks1736) (or new-id1735 (call-with-values (lambda () (search1700 id1731 (wrap-subst1096 w11732) marks1736)) (lambda (x1738 . ignore1737) x1738)) id1731)))))) ((annotation? id1698) (let ((id1739 (let ((e1740 id1698)) (if (annotation? e1740) (annotation-expression e1740) e1740)))) (or (call-with-values (lambda () (search1700 id1739 (wrap-subst1096 w1699) (wrap-marks1095 w1699))) (lambda (x1742 . ignore1741) x1742)) id1739))) (else (error-hook1065 (quote id-var-name) "invalid id" id1698)))))) (same-marks?1113 (lambda (x1743 y1744) (or (eq? x1743 y1744) (and (not (null? x1743)) (not (null? y1744)) (eq? (car x1743) (car y1744)) (same-marks?1113 (cdr x1743) (cdr y1744)))))) (join-marks1112 (lambda (m11745 m21746) (smart-append1110 m11745 m21746))) (join-wraps1111 (lambda (w11747 w21748) (let ((m11749 (wrap-marks1095 w11747)) (s11750 (wrap-subst1096 w11747))) (if (null? m11749) (if (null? s11750) w21748 (make-wrap1094 (wrap-marks1095 w21748) (smart-append1110 s11750 (wrap-subst1096 w21748)))) (make-wrap1094 (smart-append1110 m11749 (wrap-marks1095 w21748)) (smart-append1110 s11750 (wrap-subst1096 w21748))))))) (smart-append1110 (lambda (m11751 m21752) (if (null? m21752) m11751 (append m11751 m21752)))) (make-binding-wrap1109 (lambda (ids1753 labels1754 w1755) (if (null? ids1753) w1755 (make-wrap1094 (wrap-marks1095 w1755) (cons (let ((labelvec1756 (list->vector labels1754))) (let ((n1757 (vector-length labelvec1756))) (let ((symnamevec1758 (make-vector n1757)) (marksvec1759 (make-vector n1757))) (begin (let f1760 ((ids1761 ids1753) (i1762 0)) (if (not (null? ids1761)) (call-with-values (lambda () (id-sym-name&marks1093 (car ids1761) w1755)) (lambda (symname1763 marks1764) (begin (vector-set! symnamevec1758 i1762 symname1763) (vector-set! marksvec1759 i1762 marks1764) (f1760 (cdr ids1761) (fx+1059 i1762 1))))))) (make-ribcage1099 symnamevec1758 marksvec1759 labelvec1756))))) (wrap-subst1096 w1755)))))) (extend-ribcage!1108 (lambda (ribcage1765 id1766 label1767) (begin (set-ribcage-symnames!1104 ribcage1765 (cons (let ((e1768 (syntax-object-expression1077 id1766))) (if (annotation? e1768) (annotation-expression e1768) e1768)) (ribcage-symnames1101 ribcage1765))) (set-ribcage-marks!1105 ribcage1765 (cons (wrap-marks1095 (syntax-object-wrap1078 id1766)) (ribcage-marks1102 ribcage1765))) (set-ribcage-labels!1106 ribcage1765 (cons label1767 (ribcage-labels1103 ribcage1765)))))) (anti-mark1107 (lambda (w1769) (make-wrap1094 (cons #f (wrap-marks1095 w1769)) (cons (quote shift) (wrap-subst1096 w1769))))) (set-ribcage-labels!1106 (lambda (x1770 update1771) (vector-set! x1770 3 update1771))) (set-ribcage-marks!1105 (lambda (x1772 update1773) (vector-set! x1772 2 update1773))) (set-ribcage-symnames!1104 (lambda (x1774 update1775) (vector-set! x1774 1 update1775))) (ribcage-labels1103 (lambda (x1776) (vector-ref x1776 3))) (ribcage-marks1102 (lambda (x1777) (vector-ref x1777 2))) (ribcage-symnames1101 (lambda (x1778) (vector-ref x1778 1))) (ribcage?1100 (lambda (x1779) (and (vector? x1779) (= (vector-length x1779) 4) (eq? (vector-ref x1779 0) (quote ribcage))))) (make-ribcage1099 (lambda (symnames1780 marks1781 labels1782) (vector (quote ribcage) symnames1780 marks1781 labels1782))) (gen-labels1098 (lambda (ls1783) (if (null? ls1783) (quote ()) (cons (gen-label1097) (gen-labels1098 (cdr ls1783)))))) (gen-label1097 (lambda () (string #\i))) (wrap-subst1096 cdr) (wrap-marks1095 car) (make-wrap1094 cons) (id-sym-name&marks1093 (lambda (x1784 w1785) (if (syntax-object?1076 x1784) (values (let ((e1786 (syntax-object-expression1077 x1784))) (if (annotation? e1786) (annotation-expression e1786) e1786)) (join-marks1112 (wrap-marks1095 w1785) (wrap-marks1095 (syntax-object-wrap1078 x1784)))) (values (let ((e1787 x1784)) (if (annotation? e1787) (annotation-expression e1787) e1787)) (wrap-marks1095 w1785))))) (id?1092 (lambda (x1788) (cond ((symbol? x1788) #t) ((syntax-object?1076 x1788) (symbol? (let ((e1789 (syntax-object-expression1077 x1788))) (if (annotation? e1789) (annotation-expression e1789) e1789)))) ((annotation? x1788) (symbol? (annotation-expression x1788))) (else #f)))) (nonsymbol-id?1091 (lambda (x1790) (and (syntax-object?1076 x1790) (symbol? (let ((e1791 (syntax-object-expression1077 x1790))) (if (annotation? e1791) (annotation-expression e1791) e1791)))))) (global-extend1090 (lambda (type1792 sym1793 val1794) (put-global-definition-hook1066 sym1793 (cons type1792 val1794) (module-name (current-module))))) (lookup1089 (lambda (x1795 r1796 mod1797) (cond ((assq x1795 r1796) => cdr) ((symbol? x1795) (or (get-global-definition-hook1068 x1795 mod1797) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1088 (lambda (r1798) (if (null? r1798) (quote ()) (let ((a1799 (car r1798))) (if (eq? (cadr a1799) (quote macro)) (cons a1799 (macros-only-env1088 (cdr r1798))) (macros-only-env1088 (cdr r1798))))))) (extend-var-env1087 (lambda (labels1800 vars1801 r1802) (if (null? labels1800) r1802 (extend-var-env1087 (cdr labels1800) (cdr vars1801) (cons (cons (car labels1800) (cons (quote lexical) (car vars1801))) r1802))))) (extend-env1086 (lambda (labels1803 bindings1804 r1805) (if (null? labels1803) r1805 (extend-env1086 (cdr labels1803) (cdr bindings1804) (cons (cons (car labels1803) (car bindings1804)) r1805))))) (binding-value1085 cdr) (binding-type1084 car) (source-annotation1083 (lambda (x1806) (cond ((annotation? x1806) (annotation-source x1806)) ((syntax-object?1076 x1806) (source-annotation1083 (syntax-object-expression1077 x1806))) (else #f)))) (set-syntax-object-module!1082 (lambda (x1807 update1808) (vector-set! x1807 3 update1808))) (set-syntax-object-wrap!1081 (lambda (x1809 update1810) (vector-set! x1809 2 update1810))) (set-syntax-object-expression!1080 (lambda (x1811 update1812) (vector-set! x1811 1 update1812))) (syntax-object-module1079 (lambda (x1813) (vector-ref x1813 3))) (syntax-object-wrap1078 (lambda (x1814) (vector-ref x1814 2))) (syntax-object-expression1077 (lambda (x1815) (vector-ref x1815 1))) (syntax-object?1076 (lambda (x1816) (and (vector? x1816) (= (vector-length x1816) 4) (eq? (vector-ref x1816 0) (quote syntax-object))))) (make-syntax-object1075 (lambda (expression1817 wrap1818 module1819) (vector (quote syntax-object) expression1817 wrap1818 module1819))) (build-letrec1074 (lambda (src1820 vars1821 val-exps1822 body-exp1823) (if (null? vars1821) (build-annotated1069 src1820 body-exp1823) (build-annotated1069 src1820 (list (quote letrec) (map list vars1821 val-exps1822) body-exp1823))))) (build-named-let1073 (lambda (src1824 vars1825 val-exps1826 body-exp1827) (if (null? vars1825) (build-annotated1069 src1824 body-exp1827) (build-annotated1069 src1824 (list (quote let) (car vars1825) (map list (cdr vars1825) val-exps1826) body-exp1827))))) (build-let1072 (lambda (src1828 vars1829 val-exps1830 body-exp1831) (if (null? vars1829) (build-annotated1069 src1828 body-exp1831) (build-annotated1069 src1828 (list (quote let) (map list vars1829 val-exps1830) body-exp1831))))) (build-sequence1071 (lambda (src1832 exps1833) (if (null? (cdr exps1833)) (build-annotated1069 src1832 (car exps1833)) (build-annotated1069 src1832 (cons (quote begin) exps1833))))) (build-data1070 (lambda (src1834 exp1835) (if (and (self-evaluating? exp1835) (not (vector? exp1835))) (build-annotated1069 src1834 exp1835) (build-annotated1069 src1834 (list (quote quote) exp1835))))) (build-annotated1069 (lambda (src1836 exp1837) (if (and src1836 (not (annotation? exp1837))) (make-annotation exp1837 src1836 #t) exp1837))) (get-global-definition-hook1068 (lambda (symbol1838 module1839) (let ((module1840 (if module1839 (resolve-module module1839) (warn "wha" symbol1838 (current-module))))) (let ((v1841 (module-variable module1840 symbol1838))) (and v1841 (or (object-property v1841 (quote *sc-expander*)) (and (variable-bound? v1841) (macro? (variable-ref v1841)) (macro-transformer (variable-ref v1841)) guile-macro))))))) (remove-global-definition-hook1067 (lambda (symbol1842 modname1843) (let ((module1844 (if modname1843 (resolve-module modname1843) (current-module)))) (let ((v1845 (module-local-variable module1844 symbol1842))) (if v1845 (let ((p1846 (assq (quote *sc-expander*) (object-properties v1845)))) (set-object-properties! v1845 (delq p1846 (object-properties v1845))))))))) (put-global-definition-hook1066 (lambda (symbol1847 binding1848 modname1849) (let ((module1850 (if modname1849 (resolve-module modname1849) (current-module)))) (let ((v1851 (or (module-variable module1850 symbol1847) (let ((v1852 (make-variable (quote sc-macro)))) (begin (module-add! module1850 symbol1847 v1852) v1852))))) (begin (if (not (variable-bound? v1851)) (variable-set! v1851 (gensym))) (set-object-property! v1851 (quote *sc-expander*) binding1848)))))) (error-hook1065 (lambda (who1853 why1854 what1855) (error who1853 "~a ~s" why1854 what1855))) (local-eval-hook1064 (lambda (x1856 mod1857) (eval (list noexpand1058 x1856) (if mod1857 (resolve-module mod1857) (interaction-environment))))) (top-level-eval-hook1063 (lambda (x1858 mod1859) (eval (list noexpand1058 x1858) (if mod1859 (resolve-module mod1859) (interaction-environment))))) (fx<1062 <) (fx=1061 =) (fx-1060 -) (fx+1059 +) (noexpand1058 "noexpand")) (begin (global-extend1090 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1090 (quote local-syntax) (quote let-syntax) #f) (global-extend1090 (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?1117 var1868)) tmp1866) #f) (apply (lambda (_1873 var1874 val1875 e11876 e21877) (let ((names1878 (map (lambda (x1879) (id-var-name1114 x1879 w1862)) var1874))) (begin (for-each (lambda (id1881 n1882) (let ((t1883 (binding-type1084 (lookup1089 n1882 r1861 mod1864)))) (if (memv t1883 (quote (displaced-lexical))) (syntax-error (source-wrap1121 id1881 w1862 s1863 mod1864) "identifier out of context")))) var1874 names1878) (chi-body1132 (cons e11876 e21877) (source-wrap1121 e1860 w1862 s1863 mod1864) (extend-env1086 names1878 (let ((trans-r1886 (macros-only-env1088 r1861))) (map (lambda (x1887) (cons (quote macro) (eval-local-transformer1135 (chi1128 x1887 trans-r1886 w1862 mod1864) mod1864))) val1875)) r1861) w1862 mod1864)))) tmp1866) ((lambda (_1889) (syntax-error (source-wrap1121 e1860 w1862 s1863 mod1864))) tmp1865))) (syntax-dispatch tmp1865 (quote (any #(each (any any)) any . each-any))))) e1860))) (global-extend1090 (quote core) (quote quote) (lambda (e1890 r1891 w1892 s1893 mod1894) ((lambda (tmp1895) ((lambda (tmp1896) (if tmp1896 (apply (lambda (_1897 e1898) (build-data1070 s1893 (strip1139 e1898 w1892))) tmp1896) ((lambda (_1899) (syntax-error (source-wrap1121 e1890 w1892 s1893 mod1894))) tmp1895))) (syntax-dispatch tmp1895 (quote (any any))))) e1890))) (global-extend1090 (quote core) (quote syntax) (letrec ((regen1907 (lambda (x1908) (let ((t1909 (car x1908))) (if (memv t1909 (quote (ref))) (build-annotated1069 #f (cadr x1908)) (if (memv t1909 (quote (primitive))) (build-annotated1069 #f (cadr x1908)) (if (memv t1909 (quote (quote))) (build-data1070 #f (cadr x1908)) (if (memv t1909 (quote (lambda))) (build-annotated1069 #f (list (quote lambda) (cadr x1908) (regen1907 (caddr x1908)))) (if (memv t1909 (quote (map))) (let ((ls1910 (map regen1907 (cdr x1908)))) (build-annotated1069 #f (cons (if (fx=1061 (length ls1910) 2) (build-annotated1069 #f (quote map)) (build-annotated1069 #f (quote map))) ls1910))) (build-annotated1069 #f (cons (build-annotated1069 #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=1061 level1929 0) (values var1928 maps1930) (if (null? maps1930) (syntax-error src1927 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1901 src1927 var1928 (fx-1060 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-var1140 (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?1092 e1936) (let ((label1941 (id-var-name1114 e1936 (quote (()))))) (let ((b1942 (lookup1089 label1941 r1937 mod1940))) (if (eq? (binding-type1084 b1942) (quote syntax)) (call-with-values (lambda () (let ((var.lev1943 (binding-value1085 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-error src1935 "misplaced ellipsis in syntax form") (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-error src1935 "extra ellipsis in syntax form") (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-error src1935 "extra ellipsis in syntax form") (values (gen-mappend1902 x1973 (car maps1974)) (cdr maps1974)))))))) tmp1967) ((lambda (_1975) (call-with-values (lambda () (gen-syntax1900 src1935 y1961 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (y1976 maps1977) (call-with-values (lambda () (k1962 maps1977)) (lambda (x1978 maps1979) (values (gen-append1905 x1978 y1976) maps1979)))))) tmp1966))) (syntax-dispatch tmp1966 (quote (any . any))))) y1961))) tmp1953) ((lambda (tmp1980) (if tmp1980 (apply (lambda (x1981 y1982) (call-with-values (lambda () (gen-syntax1900 src1935 x1981 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (x1983 maps1984) (call-with-values (lambda () (gen-syntax1900 src1935 y1982 r1937 maps1984 ellipsis?1939 mod1940)) (lambda (y1985 maps1986) (values (gen-cons1904 x1983 y1985) maps1986)))))) tmp1980) ((lambda (tmp1987) (if tmp1987 (apply (lambda (e11988 e21989) (call-with-values (lambda () (gen-syntax1900 src1935 (cons e11988 e21989) r1937 maps1938 ellipsis?1939 mod1940)) (lambda (e1991 maps1992) (values (gen-vector1906 e1991) maps1992)))) tmp1987) ((lambda (_1993) (values (list (quote quote) e1936) maps1938)) tmp1946))) (syntax-dispatch tmp1946 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1946 (quote (any . any)))))) (syntax-dispatch tmp1946 (quote (any any . any)))))) (syntax-dispatch tmp1946 (quote (any any))))) e1936))))) (lambda (e1994 r1995 w1996 s1997 mod1998) (let ((e1999 (source-wrap1121 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?1137 mod1998)) (lambda (e2004 maps2005) (regen1907 e2004)))) tmp2001) ((lambda (_2006) (syntax-error e1999)) tmp2000))) (syntax-dispatch tmp2000 (quote (any any))))) e1999))))) (global-extend1090 (quote core) (quote lambda) (lambda (e2007 r2008 w2009 s2010 mod2011) ((lambda (tmp2012) ((lambda (tmp2013) (if tmp2013 (apply (lambda (_2014 c2015) (chi-lambda-clause1133 (source-wrap1121 e2007 w2009 s2010 mod2011) c2015 r2008 w2009 mod2011 (lambda (vars2016 body2017) (build-annotated1069 s2010 (list (quote lambda) vars2016 body2017))))) tmp2013) (syntax-error tmp2012))) (syntax-dispatch tmp2012 (quote (any . any))))) e2007))) (global-extend1090 (quote core) (quote let) (letrec ((chi-let2018 (lambda (e2019 r2020 w2021 s2022 mod2023 constructor2024 ids2025 vals2026 exps2027) (if (not (valid-bound-ids?1117 ids2025)) (syntax-error e2019 "duplicate bound variable in") (let ((labels2028 (gen-labels1098 ids2025)) (new-vars2029 (map gen-var1140 ids2025))) (let ((nw2030 (make-binding-wrap1109 ids2025 labels2028 w2021)) (nr2031 (extend-var-env1087 labels2028 new-vars2029 r2020))) (constructor2024 s2022 new-vars2029 (map (lambda (x2032) (chi1128 x2032 r2020 w2021 mod2023)) vals2026) (chi-body1132 exps2027 (source-wrap1121 e2019 nw2030 s2022 mod2023) nr2031 nw2030 mod2023)))))))) (lambda (e2033 r2034 w2035 s2036 mod2037) ((lambda (tmp2038) ((lambda (tmp2039) (if tmp2039 (apply (lambda (_2040 id2041 val2042 e12043 e22044) (chi-let2018 e2033 r2034 w2035 s2036 mod2037 build-let1072 id2041 val2042 (cons e12043 e22044))) tmp2039) ((lambda (tmp2048) (if (if tmp2048 (apply (lambda (_2049 f2050 id2051 val2052 e12053 e22054) (id?1092 f2050)) tmp2048) #f) (apply (lambda (_2055 f2056 id2057 val2058 e12059 e22060) (chi-let2018 e2033 r2034 w2035 s2036 mod2037 build-named-let1073 (cons f2056 id2057) val2058 (cons e12059 e22060))) tmp2048) ((lambda (_2064) (syntax-error (source-wrap1121 e2033 w2035 s2036 mod2037))) tmp2038))) (syntax-dispatch tmp2038 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2038 (quote (any #(each (any any)) any . each-any))))) e2033)))) (global-extend1090 (quote core) (quote letrec) (lambda (e2065 r2066 w2067 s2068 mod2069) ((lambda (tmp2070) ((lambda (tmp2071) (if tmp2071 (apply (lambda (_2072 id2073 val2074 e12075 e22076) (let ((ids2077 id2073)) (if (not (valid-bound-ids?1117 ids2077)) (syntax-error e2065 "duplicate bound variable in") (let ((labels2079 (gen-labels1098 ids2077)) (new-vars2080 (map gen-var1140 ids2077))) (let ((w2081 (make-binding-wrap1109 ids2077 labels2079 w2067)) (r2082 (extend-var-env1087 labels2079 new-vars2080 r2066))) (build-letrec1074 s2068 new-vars2080 (map (lambda (x2083) (chi1128 x2083 r2082 w2081 mod2069)) val2074) (chi-body1132 (cons e12075 e22076) (source-wrap1121 e2065 w2081 s2068 mod2069) r2082 w2081 mod2069))))))) tmp2071) ((lambda (_2086) (syntax-error (source-wrap1121 e2065 w2067 s2068 mod2069))) tmp2070))) (syntax-dispatch tmp2070 (quote (any #(each (any any)) any . each-any))))) e2065))) (global-extend1090 (quote core) (quote set!) (lambda (e2087 r2088 w2089 s2090 mod2091) ((lambda (tmp2092) ((lambda (tmp2093) (if (if tmp2093 (apply (lambda (_2094 id2095 val2096) (id?1092 id2095)) tmp2093) #f) (apply (lambda (_2097 id2098 val2099) (let ((val2100 (chi1128 val2099 r2088 w2089 mod2091)) (n2101 (id-var-name1114 id2098 w2089))) (let ((b2102 (lookup1089 n2101 r2088 mod2091))) (let ((t2103 (binding-type1084 b2102))) (if (memv t2103 (quote (lexical))) (build-annotated1069 s2090 (list (quote set!) (binding-value1085 b2102) val2100)) (if (memv t2103 (quote (global))) (build-annotated1069 s2090 (list (quote set!) (make-module-ref mod2091 n2101 #f) val2100)) (if (memv t2103 (quote (displaced-lexical))) (syntax-error (wrap1120 id2098 w2089 mod2091) "identifier out of context") (syntax-error (source-wrap1121 e2087 w2089 s2090 mod2091))))))))) tmp2093) ((lambda (tmp2104) (if tmp2104 (apply (lambda (_2105 head2106 tail2107 val2108) (call-with-values (lambda () (syntax-type1126 head2106 r2088 (quote (())) #f #f mod2091)) (lambda (type2109 value2110 ee2111 ww2112 ss2113 modmod2114) (let ((t2115 type2109)) (if (memv t2115 (quote (module-ref))) (call-with-values (lambda () (value2110 (cons head2106 tail2107))) (lambda (id2117 mod2118) (build-annotated1069 s2090 (list (quote set!) (make-module-ref mod2118 id2117 #f) val2108)))) (build-annotated1069 s2090 (cons (chi1128 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) head2106) r2088 w2089 mod2091) (map (lambda (e2119) (chi1128 e2119 r2088 w2089 mod2091)) (append tail2107 (list val2108)))))))))) tmp2104) ((lambda (_2121) (syntax-error (source-wrap1121 e2087 w2089 s2090 mod2091))) tmp2092))) (syntax-dispatch tmp2092 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2092 (quote (any any any))))) e2087))) (global-extend1090 (quote module-ref) (quote @) (lambda (e2122) ((lambda (tmp2123) ((lambda (tmp2124) (if (if tmp2124 (apply (lambda (_2125 mod2126 id2127) (and (andmap id?1092 mod2126) (id?1092 id2127))) tmp2124) #f) (apply (lambda (_2129 mod2130 id2131) (values (syntax-object->datum id2131) (syntax-object->datum (append mod2130 (quote (#(syntax-object %module-public-interface ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))))))) tmp2124) (syntax-error tmp2123))) (syntax-dispatch tmp2123 (quote (any each-any any))))) e2122))) (global-extend1090 (quote module-ref) (quote @@) (lambda (e2133) ((lambda (tmp2134) ((lambda (tmp2135) (if (if tmp2135 (apply (lambda (_2136 mod2137 id2138) (and (andmap id?1092 mod2137) (id?1092 id2138))) tmp2135) #f) (apply (lambda (_2140 mod2141 id2142) (values (syntax-object->datum id2142) (syntax-object->datum mod2141))) tmp2135) (syntax-error tmp2134))) (syntax-dispatch tmp2134 (quote (any each-any any))))) e2133))) (global-extend1090 (quote begin) (quote begin) (quote ())) (global-extend1090 (quote define) (quote define) (quote ())) (global-extend1090 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1090 (quote eval-when) (quote eval-when) (quote ())) (global-extend1090 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2147 (lambda (x2148 keys2149 clauses2150 r2151 mod2152) (if (null? clauses2150) (build-annotated1069 #f (list (build-annotated1069 #f (quote syntax-error)) x2148)) ((lambda (tmp2153) ((lambda (tmp2154) (if tmp2154 (apply (lambda (pat2155 exp2156) (if (and (id?1092 pat2155) (andmap (lambda (x2157) (not (free-id=?1115 pat2155 x2157))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) keys2149))) (let ((labels2158 (list (gen-label1097))) (var2159 (gen-var1140 pat2155))) (build-annotated1069 #f (list (build-annotated1069 #f (list (quote lambda) (list var2159) (chi1128 exp2156 (extend-env1086 labels2158 (list (cons (quote syntax) (cons var2159 0))) r2151) (make-binding-wrap1109 (list pat2155) labels2158 (quote (()))) mod2152))) x2148))) (gen-clause2146 x2148 keys2149 (cdr clauses2150) r2151 pat2155 #t exp2156 mod2152))) tmp2154) ((lambda (tmp2160) (if tmp2160 (apply (lambda (pat2161 fender2162 exp2163) (gen-clause2146 x2148 keys2149 (cdr clauses2150) r2151 pat2161 fender2162 exp2163 mod2152)) tmp2160) ((lambda (_2164) (syntax-error (car clauses2150) "invalid syntax-case clause")) tmp2153))) (syntax-dispatch tmp2153 (quote (any any any)))))) (syntax-dispatch tmp2153 (quote (any any))))) (car clauses2150))))) (gen-clause2146 (lambda (x2165 keys2166 clauses2167 r2168 pat2169 fender2170 exp2171 mod2172) (call-with-values (lambda () (convert-pattern2144 pat2169 keys2166)) (lambda (p2173 pvars2174) (cond ((not (distinct-bound-ids?1118 (map car pvars2174))) (syntax-error pat2169 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2175) (not (ellipsis?1137 (car x2175)))) pvars2174)) (syntax-error pat2169 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2176 (gen-var1140 (quote tmp)))) (build-annotated1069 #f (list (build-annotated1069 #f (list (quote lambda) (list y2176) (let ((y2177 (build-annotated1069 #f y2176))) (build-annotated1069 #f (list (quote if) ((lambda (tmp2178) ((lambda (tmp2179) (if tmp2179 (apply (lambda () y2177) tmp2179) ((lambda (_2180) (build-annotated1069 #f (list (quote if) y2177 (build-dispatch-call2145 pvars2174 fender2170 y2177 r2168 mod2172) (build-data1070 #f #f)))) tmp2178))) (syntax-dispatch tmp2178 (quote #(atom #t))))) fender2170) (build-dispatch-call2145 pvars2174 exp2171 y2177 r2168 mod2172) (gen-syntax-case2147 x2165 keys2166 clauses2167 r2168 mod2172)))))) (if (eq? p2173 (quote any)) (build-annotated1069 #f (list (build-annotated1069 #f (quote list)) x2165)) (build-annotated1069 #f (list (build-annotated1069 #f (quote syntax-dispatch)) x2165 (build-data1070 #f p2173))))))))))))) (build-dispatch-call2145 (lambda (pvars2181 exp2182 y2183 r2184 mod2185) (let ((ids2186 (map car pvars2181)) (levels2187 (map cdr pvars2181))) (let ((labels2188 (gen-labels1098 ids2186)) (new-vars2189 (map gen-var1140 ids2186))) (build-annotated1069 #f (list (build-annotated1069 #f (quote apply)) (build-annotated1069 #f (list (quote lambda) new-vars2189 (chi1128 exp2182 (extend-env1086 labels2188 (map (lambda (var2190 level2191) (cons (quote syntax) (cons var2190 level2191))) new-vars2189 (map cdr pvars2181)) r2184) (make-binding-wrap1109 ids2186 labels2188 (quote (()))) mod2185))) y2183)))))) (convert-pattern2144 (lambda (pattern2192 keys2193) (let cvt2194 ((p2195 pattern2192) (n2196 0) (ids2197 (quote ()))) (if (id?1092 p2195) (if (bound-id-member?1119 p2195 keys2193) (values (vector (quote free-id) p2195) ids2197) (values (quote any) (cons (cons p2195 n2196) ids2197))) ((lambda (tmp2198) ((lambda (tmp2199) (if (if tmp2199 (apply (lambda (x2200 dots2201) (ellipsis?1137 dots2201)) tmp2199) #f) (apply (lambda (x2202 dots2203) (call-with-values (lambda () (cvt2194 x2202 (fx+1059 n2196 1) ids2197)) (lambda (p2204 ids2205) (values (if (eq? p2204 (quote any)) (quote each-any) (vector (quote each) p2204)) ids2205)))) tmp2199) ((lambda (tmp2206) (if tmp2206 (apply (lambda (x2207 y2208) (call-with-values (lambda () (cvt2194 y2208 n2196 ids2197)) (lambda (y2209 ids2210) (call-with-values (lambda () (cvt2194 x2207 n2196 ids2210)) (lambda (x2211 ids2212) (values (cons x2211 y2209) ids2212)))))) tmp2206) ((lambda (tmp2213) (if tmp2213 (apply (lambda () (values (quote ()) ids2197)) tmp2213) ((lambda (tmp2214) (if tmp2214 (apply (lambda (x2215) (call-with-values (lambda () (cvt2194 x2215 n2196 ids2197)) (lambda (p2217 ids2218) (values (vector (quote vector) p2217) ids2218)))) tmp2214) ((lambda (x2219) (values (vector (quote atom) (strip1139 p2195 (quote (())))) ids2197)) tmp2198))) (syntax-dispatch tmp2198 (quote #(vector each-any)))))) (syntax-dispatch tmp2198 (quote ()))))) (syntax-dispatch tmp2198 (quote (any . any)))))) (syntax-dispatch tmp2198 (quote (any any))))) p2195)))))) (lambda (e2220 r2221 w2222 s2223 mod2224) (let ((e2225 (source-wrap1121 e2220 w2222 s2223 mod2224))) ((lambda (tmp2226) ((lambda (tmp2227) (if tmp2227 (apply (lambda (_2228 val2229 key2230 m2231) (if (andmap (lambda (x2232) (and (id?1092 x2232) (not (ellipsis?1137 x2232)))) key2230) (let ((x2234 (gen-var1140 (quote tmp)))) (build-annotated1069 s2223 (list (build-annotated1069 #f (list (quote lambda) (list x2234) (gen-syntax-case2147 (build-annotated1069 #f x2234) key2230 m2231 r2221 mod2224))) (chi1128 val2229 r2221 (quote (())) mod2224)))) (syntax-error e2225 "invalid literals list in"))) tmp2227) (syntax-error tmp2226))) (syntax-dispatch tmp2226 (quote (any any each-any . each-any))))) e2225))))) (set! sc-expand (let ((m2237 (quote e)) (esew2238 (quote (eval)))) (lambda (x2239) (if (and (pair? x2239) (equal? (car x2239) noexpand1058)) (cadr x2239) (chi-top1127 x2239 (quote ()) (quote ((top))) m2237 esew2238 (module-name (current-module))))))) (set! sc-expand3 (let ((m2240 (quote e)) (esew2241 (quote (eval)))) (lambda (x2243 . rest2242) (if (and (pair? x2243) (equal? (car x2243) noexpand1058)) (cadr x2243) (chi-top1127 x2243 (quote ()) (quote ((top))) (if (null? rest2242) m2240 (car rest2242)) (if (or (null? rest2242) (null? (cdr rest2242))) esew2241 (cadr rest2242)) (module-name (current-module))))))) (set! identifier? (lambda (x2244) (nonsymbol-id?1091 x2244))) (set! datum->syntax-object (lambda (id2245 datum2246) (make-syntax-object1075 datum2246 (syntax-object-wrap1078 id2245) #f))) (set! syntax-object->datum (lambda (x2247) (strip1139 x2247 (quote (()))))) (set! generate-temporaries (lambda (ls2248) (begin (let ((x2249 ls2248)) (if (not (list? x2249)) (error-hook1065 (quote generate-temporaries) "invalid argument" x2249))) (map (lambda (x2250) (wrap1120 (gensym) (quote ((top))) #f)) ls2248)))) (set! free-identifier=? (lambda (x2251 y2252) (begin (let ((x2253 x2251)) (if (not (nonsymbol-id?1091 x2253)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2253))) (let ((x2254 y2252)) (if (not (nonsymbol-id?1091 x2254)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2254))) (free-id=?1115 x2251 y2252)))) (set! bound-identifier=? (lambda (x2255 y2256) (begin (let ((x2257 x2255)) (if (not (nonsymbol-id?1091 x2257)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2257))) (let ((x2258 y2256)) (if (not (nonsymbol-id?1091 x2258)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2258))) (bound-id=?1116 x2255 y2256)))) (set! syntax-error (lambda (object2260 . messages2259) (begin (for-each (lambda (x2261) (let ((x2262 x2261)) (if (not (string? x2262)) (error-hook1065 (quote syntax-error) "invalid argument" x2262)))) messages2259) (let ((message2263 (if (null? messages2259) "invalid syntax" (apply string-append messages2259)))) (error-hook1065 #f message2263 (strip1139 object2260 (quote (())))))))) (set! install-global-transformer (lambda (sym2264 v2265) (begin (let ((x2266 sym2264)) (if (not (symbol? x2266)) (error-hook1065 (quote define-syntax) "invalid argument" x2266))) (let ((x2267 v2265)) (if (not (procedure? x2267)) (error-hook1065 (quote define-syntax) "invalid argument" x2267))) (global-extend1090 (quote macro) sym2264 v2265)))) (letrec ((match2272 (lambda (e2273 p2274 w2275 r2276 mod2277) (cond ((not r2276) #f) ((eq? p2274 (quote any)) (cons (wrap1120 e2273 w2275 mod2277) r2276)) ((syntax-object?1076 e2273) (match*2271 (let ((e2278 (syntax-object-expression1077 e2273))) (if (annotation? e2278) (annotation-expression e2278) e2278)) p2274 (join-wraps1111 w2275 (syntax-object-wrap1078 e2273)) r2276 (syntax-object-module1079 e2273))) (else (match*2271 (let ((e2279 e2273)) (if (annotation? e2279) (annotation-expression e2279) e2279)) p2274 w2275 r2276 mod2277))))) (match*2271 (lambda (e2280 p2281 w2282 r2283 mod2284) (cond ((null? p2281) (and (null? e2280) r2283)) ((pair? p2281) (and (pair? e2280) (match2272 (car e2280) (car p2281) w2282 (match2272 (cdr e2280) (cdr p2281) w2282 r2283 mod2284) mod2284))) ((eq? p2281 (quote each-any)) (let ((l2285 (match-each-any2269 e2280 w2282 mod2284))) (and l2285 (cons l2285 r2283)))) (else (let ((t2286 (vector-ref p2281 0))) (if (memv t2286 (quote (each))) (if (null? e2280) (match-empty2270 (vector-ref p2281 1) r2283) (let ((l2287 (match-each2268 e2280 (vector-ref p2281 1) w2282 mod2284))) (and l2287 (let collect2288 ((l2289 l2287)) (if (null? (car l2289)) r2283 (cons (map car l2289) (collect2288 (map cdr l2289)))))))) (if (memv t2286 (quote (free-id))) (and (id?1092 e2280) (free-id=?1115 (wrap1120 e2280 w2282 mod2284) (vector-ref p2281 1)) r2283) (if (memv t2286 (quote (atom))) (and (equal? (vector-ref p2281 1) (strip1139 e2280 w2282)) r2283) (if (memv t2286 (quote (vector))) (and (vector? e2280) (match2272 (vector->list e2280) (vector-ref p2281 1) w2282 r2283 mod2284))))))))))) (match-empty2270 (lambda (p2290 r2291) (cond ((null? p2290) r2291) ((eq? p2290 (quote any)) (cons (quote ()) r2291)) ((pair? p2290) (match-empty2270 (car p2290) (match-empty2270 (cdr p2290) r2291))) ((eq? p2290 (quote each-any)) (cons (quote ()) r2291)) (else (let ((t2292 (vector-ref p2290 0))) (if (memv t2292 (quote (each))) (match-empty2270 (vector-ref p2290 1) r2291) (if (memv t2292 (quote (free-id atom))) r2291 (if (memv t2292 (quote (vector))) (match-empty2270 (vector-ref p2290 1) r2291))))))))) (match-each-any2269 (lambda (e2293 w2294 mod2295) (cond ((annotation? e2293) (match-each-any2269 (annotation-expression e2293) w2294 mod2295)) ((pair? e2293) (let ((l2296 (match-each-any2269 (cdr e2293) w2294 mod2295))) (and l2296 (cons (wrap1120 (car e2293) w2294 mod2295) l2296)))) ((null? e2293) (quote ())) ((syntax-object?1076 e2293) (match-each-any2269 (syntax-object-expression1077 e2293) (join-wraps1111 w2294 (syntax-object-wrap1078 e2293)) mod2295)) (else #f)))) (match-each2268 (lambda (e2297 p2298 w2299 mod2300) (cond ((annotation? e2297) (match-each2268 (annotation-expression e2297) p2298 w2299 mod2300)) ((pair? e2297) (let ((first2301 (match2272 (car e2297) p2298 w2299 (quote ()) mod2300))) (and first2301 (let ((rest2302 (match-each2268 (cdr e2297) p2298 w2299 mod2300))) (and rest2302 (cons first2301 rest2302)))))) ((null? e2297) (quote ())) ((syntax-object?1076 e2297) (match-each2268 (syntax-object-expression1077 e2297) p2298 (join-wraps1111 w2299 (syntax-object-wrap1078 e2297)) (syntax-object-module1079 e2297))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2303 p2304) (cond ((eq? p2304 (quote any)) (list e2303)) ((syntax-object?1076 e2303) (match*2271 (let ((e2305 (syntax-object-expression1077 e2303))) (if (annotation? e2305) (annotation-expression e2305) e2305)) p2304 (syntax-object-wrap1078 e2303) (quote ()) (syntax-object-module1079 e2303))) (else (match*2271 (let ((e2306 e2303)) (if (annotation? e2306) (annotation-expression e2306) e2306)) p2304 (quote (())) (quote ()) #f))))) (set! sc-chi chi1128)))))
+(install-global-transformer (quote with-syntax) (lambda (x2307) ((lambda (tmp2308) ((lambda (tmp2309) (if tmp2309 (apply (lambda (_2310 e12311 e22312) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12311 e22312))) tmp2309) ((lambda (tmp2314) (if tmp2314 (apply (lambda (_2315 out2316 in2317 e12318 e22319) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2317 (quote ()) (list out2316 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12318 e22319))))) tmp2314) ((lambda (tmp2321) (if tmp2321 (apply (lambda (_2322 out2323 in2324 e12325 e22326) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2324) (quote ()) (list out2323 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12325 e22326))))) tmp2321) (syntax-error tmp2308))) (syntax-dispatch tmp2308 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2308 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2308 (quote (any () any . each-any))))) x2307)))
+(install-global-transformer (quote syntax-rules) (lambda (x2330) ((lambda (tmp2331) ((lambda (tmp2332) (if tmp2332 (apply (lambda (_2333 k2334 keyword2335 pattern2336 template2337) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons k2334 (map (lambda (tmp2340 tmp2339) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2339) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2340))) template2337 pattern2336)))))) tmp2332) (syntax-error tmp2331))) (syntax-dispatch tmp2331 (quote (any each-any . #(each ((any . any) any))))))) x2330)))
+(install-global-transformer (quote let*) (lambda (x2341) ((lambda (tmp2342) ((lambda (tmp2343) (if (if tmp2343 (apply (lambda (let*2344 x2345 v2346 e12347 e22348) (andmap identifier? x2345)) tmp2343) #f) (apply (lambda (let*2350 x2351 v2352 e12353 e22354) (let f2355 ((bindings2356 (map list x2351 v2352))) (if (null? bindings2356) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote ()) (cons e12353 e22354))) ((lambda (tmp2360) ((lambda (tmp2361) (if tmp2361 (apply (lambda (body2362 binding2363) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list binding2363) body2362)) tmp2361) (syntax-error tmp2360))) (syntax-dispatch tmp2360 (quote (any any))))) (list (f2355 (cdr bindings2356)) (car bindings2356)))))) tmp2343) (syntax-error tmp2342))) (syntax-dispatch tmp2342 (quote (any #(each (any any)) any . each-any))))) x2341)))
+(install-global-transformer (quote do) (lambda (orig-x2364) ((lambda (tmp2365) ((lambda (tmp2366) (if tmp2366 (apply (lambda (_2367 var2368 init2369 step2370 e02371 e12372 c2373) ((lambda (tmp2374) ((lambda (tmp2375) (if tmp2375 (apply (lambda (step2376) ((lambda (tmp2377) ((lambda (tmp2378) (if tmp2378 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2368 init2369) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02371) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2373 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2376))))))) tmp2378) ((lambda (tmp2383) (if tmp2383 (apply (lambda (e12384 e22385) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2368 init2369) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02371 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (cons e12384 e22385)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2373 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2376))))))) tmp2383) (syntax-error tmp2377))) (syntax-dispatch tmp2377 (quote (any . each-any)))))) (syntax-dispatch tmp2377 (quote ())))) e12372)) tmp2375) (syntax-error tmp2374))) (syntax-dispatch tmp2374 (quote each-any)))) (map (lambda (v2392 s2393) ((lambda (tmp2394) ((lambda (tmp2395) (if tmp2395 (apply (lambda () v2392) tmp2395) ((lambda (tmp2396) (if tmp2396 (apply (lambda (e2397) e2397) tmp2396) ((lambda (_2398) (syntax-error orig-x2364)) tmp2394))) (syntax-dispatch tmp2394 (quote (any)))))) (syntax-dispatch tmp2394 (quote ())))) s2393)) var2368 step2370))) tmp2366) (syntax-error tmp2365))) (syntax-dispatch tmp2365 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2364)))
+(install-global-transformer (quote quasiquote) (letrec ((quasicons2401 (lambda (x2405 y2406) ((lambda (tmp2407) ((lambda (tmp2408) (if tmp2408 (apply (lambda (x2409 y2410) ((lambda (tmp2411) ((lambda (tmp2412) (if tmp2412 (apply (lambda (dy2413) ((lambda (tmp2414) ((lambda (tmp2415) (if tmp2415 (apply (lambda (dx2416) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons dx2416 dy2413))) tmp2415) ((lambda (_2417) (if (null? dy2413) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409 y2410))) tmp2414))) (syntax-dispatch tmp2414 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) x2409)) tmp2412) ((lambda (tmp2418) (if tmp2418 (apply (lambda (stuff2419) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons x2409 stuff2419))) tmp2418) ((lambda (else2420) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409 y2410)) tmp2411))) (syntax-dispatch tmp2411 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . any)))))) (syntax-dispatch tmp2411 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) y2410)) tmp2408) (syntax-error tmp2407))) (syntax-dispatch tmp2407 (quote (any any))))) (list x2405 y2406)))) (quasiappend2402 (lambda (x2421 y2422) ((lambda (tmp2423) ((lambda (tmp2424) (if tmp2424 (apply (lambda (x2425 y2426) ((lambda (tmp2427) ((lambda (tmp2428) (if tmp2428 (apply (lambda () x2425) tmp2428) ((lambda (_2429) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2425 y2426)) tmp2427))) (syntax-dispatch tmp2427 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) ()))))) y2426)) tmp2424) (syntax-error tmp2423))) (syntax-dispatch tmp2423 (quote (any any))))) (list x2421 y2422)))) (quasivector2403 (lambda (x2430) ((lambda (tmp2431) ((lambda (x2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda (x2435) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (list->vector x2435))) tmp2434) ((lambda (tmp2437) (if tmp2437 (apply (lambda (x2438) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2438)) tmp2437) ((lambda (_2440) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2432)) tmp2433))) (syntax-dispatch tmp2433 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . each-any)))))) (syntax-dispatch tmp2433 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) each-any))))) x2432)) tmp2431)) x2430))) (quasi2404 (lambda (p2441 lev2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (p2445) (if (= lev2442 0) p2445 (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2445) (- lev2442 1))))) tmp2444) ((lambda (tmp2446) (if tmp2446 (apply (lambda (p2447 q2448) (if (= lev2442 0) (quasiappend2402 p2447 (quasi2404 q2448 lev2442)) (quasicons2401 (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2447) (- lev2442 1))) (quasi2404 q2448 lev2442)))) tmp2446) ((lambda (tmp2449) (if tmp2449 (apply (lambda (p2450) (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2450) (+ lev2442 1)))) tmp2449) ((lambda (tmp2451) (if tmp2451 (apply (lambda (p2452 q2453) (quasicons2401 (quasi2404 p2452 lev2442) (quasi2404 q2453 lev2442))) tmp2451) ((lambda (tmp2454) (if tmp2454 (apply (lambda (x2455) (quasivector2403 (quasi2404 x2455 lev2442))) tmp2454) ((lambda (p2457) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) p2457)) tmp2443))) (syntax-dispatch tmp2443 (quote #(vector each-any)))))) (syntax-dispatch tmp2443 (quote (any . any)))))) (syntax-dispatch tmp2443 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any)))))) (syntax-dispatch tmp2443 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any) . any)))))) (syntax-dispatch tmp2443 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) p2441)))) (lambda (x2458) ((lambda (tmp2459) ((lambda (tmp2460) (if tmp2460 (apply (lambda (_2461 e2462) (quasi2404 e2462 0)) tmp2460) (syntax-error tmp2459))) (syntax-dispatch tmp2459 (quote (any any))))) x2458))))
+(install-global-transformer (quote include) (lambda (x2463) (letrec ((read-file2464 (lambda (fn2465 k2466) (let ((p2467 (open-input-file fn2465))) (let f2468 ((x2469 (read p2467))) (if (eof-object? x2469) (begin (close-input-port p2467) (quote ())) (cons (datum->syntax-object k2466 x2469) (f2468 (read p2467))))))))) ((lambda (tmp2470) ((lambda (tmp2471) (if tmp2471 (apply (lambda (k2472 filename2473) (let ((fn2474 (syntax-object->datum filename2473))) ((lambda (tmp2475) ((lambda (tmp2476) (if tmp2476 (apply (lambda (exp2477) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (guile))) exp2477)) tmp2476) (syntax-error tmp2475))) (syntax-dispatch tmp2475 (quote each-any)))) (read-file2464 fn2474 k2472)))) tmp2471) (syntax-error tmp2470))) (syntax-dispatch tmp2470 (quote (any any))))) x2463))))
+(install-global-transformer (quote unquote) (lambda (x2479) ((lambda (tmp2480) ((lambda (tmp2481) (if tmp2481 (apply (lambda (_2482 e2483) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2483))) tmp2481) (syntax-error tmp2480))) (syntax-dispatch tmp2480 (quote (any any))))) x2479)))
+(install-global-transformer (quote unquote-splicing) (lambda (x2484) ((lambda (tmp2485) ((lambda (tmp2486) (if tmp2486 (apply (lambda (_2487 e2488) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2488))) tmp2486) (syntax-error tmp2485))) (syntax-dispatch tmp2485 (quote (any any))))) x2484)))
+(install-global-transformer (quote case) (lambda (x2489) ((lambda (tmp2490) ((lambda (tmp2491) (if tmp2491 (apply (lambda (_2492 e2493 m12494 m22495) ((lambda (tmp2496) ((lambda (body2497) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2493)) body2497)) tmp2496)) (let f2498 ((clause2499 m12494) (clauses2500 m22495)) (if (null? clauses2500) ((lambda (tmp2502) ((lambda (tmp2503) (if tmp2503 (apply (lambda (e12504 e22505) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12504 e22505))) tmp2503) ((lambda (tmp2507) (if tmp2507 (apply (lambda (k2508 e12509 e22510) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2508)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12509 e22510)))) tmp2507) ((lambda (_2513) (syntax-error x2489)) tmp2502))) (syntax-dispatch tmp2502 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2502 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) any . each-any))))) clause2499) ((lambda (tmp2514) ((lambda (rest2515) ((lambda (tmp2516) ((lambda (tmp2517) (if tmp2517 (apply (lambda (k2518 e12519 e22520) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2518)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12519 e22520)) rest2515)) tmp2517) ((lambda (_2523) (syntax-error x2489)) tmp2516))) (syntax-dispatch tmp2516 (quote (each-any any . each-any))))) clause2499)) tmp2514)) (f2498 (car clauses2500) (cdr clauses2500))))))) tmp2491) (syntax-error tmp2490))) (syntax-dispatch tmp2490 (quote (any any any . each-any))))) x2489)))
+(install-global-transformer (quote identifier-syntax) (lambda (x2524) ((lambda (tmp2525) ((lambda (tmp2526) (if tmp2526 (apply (lambda (_2527 e2528) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2528)) (list (cons _2527 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e2528 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))))))))) tmp2526) (syntax-error tmp2525))) (syntax-dispatch tmp2525 (quote (any any))))) x2524)))

diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 9b65339..5707d5f 100644 (file)
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -350,6 +350,16 @@
       ;; Properties are tied to variable objects
       (set-object-property! v '*sc-expander* binding))))
 
+(define remove-global-definition-hook
+  (lambda (symbol modname)
+    (let* ((module (if modname
+                       (resolve-module modname)
+                       (current-module)))
+           (v (module-local-variable module symbol)))
+      (if v
+          (let ((p (assq '*sc-expander* (object-properties v))))
+            (set-object-properties! v (delq p (object-properties v))))))))
+
 (define get-global-definition-hook
   (lambda (symbol module)
     (let* ((module (if module
@@ -1104,13 +1114,14 @@
                   mod))
                ((displaced-lexical)
                 (syntax-error (wrap value w mod) "identifier out of context"))
+               ((core macro module-ref)
+                (remove-global-definition-hook n mod)
+                (eval-if-c&e m
+                  (build-global-definition s n (chi e r w mod) mod)
+                  mod))
                (else
-               (if (eq? type 'external-macro)
-                   (eval-if-c&e m
-                      (build-global-definition s n (chi e r w mod) mod)
-                      mod)
-                   (syntax-error (wrap value w mod)
-                                 "cannot define keyword at top level"))))))
+                (syntax-error (wrap value w mod)
+                              "cannot define keyword at top level")))))
           (else (eval-if-c&e m (chi-expr type value e r w s mod) mod)))))))
 
 (define chi