[bpt/guile.git] / module / ice-9 / psyntax-pp.scm

(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(void)
(letrec ((and-map*1002 (lambda (f1042 first1041 . rest1040) (or (null? first1041) (if (null? rest1040) (let andmap1043 ((first1044 first1041)) (let ((x1045 (car first1044)) (first1046 (cdr first1044))) (if (null? first1046) (f1042 x1045) (and (f1042 x1045) (andmap1043 first1046))))) (let andmap1047 ((first1048 first1041) (rest1049 rest1040)) (let ((x1050 (car first1048)) (xr1051 (map car rest1049)) (first1052 (cdr first1048)) (rest1053 (map cdr rest1049))) (if (null? first1052) (apply f1042 (cons x1050 xr1051)) (and (apply f1042 (cons x1050 xr1051)) (andmap1047 first1052 rest1053)))))))))) (letrec ((lambda-var-list1136 (lambda (vars1341) (let lvl1342 ((vars1343 vars1341) (ls1344 (quote ())) (w1345 (quote (())))) (cond ((pair? vars1343) (lvl1342 (cdr vars1343) (cons (wrap1115 (car vars1343) w1345 #f) ls1344) w1345)) ((id?1087 vars1343) (cons (wrap1115 vars1343 w1345 #f) ls1344)) ((null? vars1343) ls1344) ((syntax-object?1071 vars1343) (lvl1342 (syntax-object-expression1072 vars1343) ls1344 (join-wraps1106 w1345 (syntax-object-wrap1073 vars1343)))) ((annotation? vars1343) (lvl1342 (annotation-expression vars1343) ls1344 w1345)) (else (cons vars1343 ls1344)))))) (gen-var1135 (lambda (id1346) (let ((id1347 (if (syntax-object?1071 id1346) (syntax-object-expression1072 id1346) id1346))) (if (annotation? id1347) (build-annotated1064 (annotation-source id1347) (gensym (symbol->string (annotation-expression id1347)))) (build-annotated1064 #f (gensym (symbol->string id1347))))))) (strip1134 (lambda (x1348 w1349) (if (memq (quote top) (wrap-marks1090 w1349)) (if (or (annotation? x1348) (and (pair? x1348) (annotation? (car x1348)))) (strip-annotation1133 x1348 #f) x1348) (let f1350 ((x1351 x1348)) (cond ((syntax-object?1071 x1351) (strip1134 (syntax-object-expression1072 x1351) (syntax-object-wrap1073 x1351))) ((pair? x1351) (let ((a1352 (f1350 (car x1351))) (d1353 (f1350 (cdr x1351)))) (if (and (eq? a1352 (car x1351)) (eq? d1353 (cdr x1351))) x1351 (cons a1352 d1353)))) ((vector? x1351) (let ((old1354 (vector->list x1351))) (let ((new1355 (map f1350 old1354))) (if (and-map*1002 eq? old1354 new1355) x1351 (list->vector new1355))))) (else x1351)))))) (strip-annotation1133 (lambda (x1356 parent1357) (cond ((pair? x1356) (let ((new1358 (cons #f #f))) (begin (if parent1357 (set-annotation-stripped! parent1357 new1358)) (set-car! new1358 (strip-annotation1133 (car x1356) #f)) (set-cdr! new1358 (strip-annotation1133 (cdr x1356) #f)) new1358))) ((annotation? x1356) (or (annotation-stripped x1356) (strip-annotation1133 (annotation-expression x1356) x1356))) ((vector? x1356) (let ((new1359 (make-vector (vector-length x1356)))) (begin (if parent1357 (set-annotation-stripped! parent1357 new1359)) (let loop1360 ((i1361 (- (vector-length x1356) 1))) (unless (fx<1058 i1361 0) (vector-set! new1359 i1361 (strip-annotation1133 (vector-ref x1356 i1361) #f)) (loop1360 (fx-1056 i1361 1)))) new1359))) (else x1356)))) (ellipsis?1132 (lambda (x1362) (and (nonsymbol-id?1086 x1362) (free-id=?1110 x1362 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))))))) (chi-void1131 (lambda () (build-annotated1064 #f (list (build-annotated1064 #f (quote void)))))) (eval-local-transformer1130 (lambda (expanded1363 mod1364) (let ((p1365 (local-eval-hook1060 expanded1363 mod1364))) (if (procedure? p1365) p1365 (syntax-violation #f "nonprocedure transformer" p1365))))) (chi-local-syntax1129 (lambda (rec?1366 e1367 r1368 w1369 s1370 mod1371 k1372) ((lambda (tmp1373) ((lambda (tmp1374) (if tmp1374 (apply (lambda (_1375 id1376 val1377 e11378 e21379) (let ((ids1380 id1376)) (if (not (valid-bound-ids?1112 ids1380)) (syntax-violation #f "duplicate bound keyword" e1367) (let ((labels1382 (gen-labels1093 ids1380))) (let ((new-w1383 (make-binding-wrap1104 ids1380 labels1382 w1369))) (k1372 (cons e11378 e21379) (extend-env1081 labels1382 (let ((w1385 (if rec?1366 new-w1383 w1369)) (trans-r1386 (macros-only-env1083 r1368))) (map (lambda (x1387) (cons (quote macro) (eval-local-transformer1130 (chi1123 x1387 trans-r1386 w1385 mod1371) mod1371))) val1377)) r1368) new-w1383 s1370 mod1371)))))) tmp1374) ((lambda (_1389) (syntax-violation #f "bad local syntax definition" (source-wrap1116 e1367 w1369 s1370 mod1371))) tmp1373))) ($sc-dispatch tmp1373 (quote (any #(each (any any)) any . each-any))))) e1367))) (chi-lambda-clause1128 (lambda (e1390 docstring1391 c1392 r1393 w1394 mod1395 k1396) ((lambda (tmp1397) ((lambda (tmp1398) (if (if tmp1398 (apply (lambda (args1399 doc1400 e11401 e21402) (and (string? (syntax->datum doc1400)) (not docstring1391))) tmp1398) #f) (apply (lambda (args1403 doc1404 e11405 e21406) (chi-lambda-clause1128 e1390 doc1404 (cons args1403 (cons e11405 e21406)) r1393 w1394 mod1395 k1396)) tmp1398) ((lambda (tmp1408) (if tmp1408 (apply (lambda (id1409 e11410 e21411) (let ((ids1412 id1409)) (if (not (valid-bound-ids?1112 ids1412)) (syntax-violation (quote lambda) "invalid parameter list" e1390) (let ((labels1414 (gen-labels1093 ids1412)) (new-vars1415 (map gen-var1135 ids1412))) (k1396 new-vars1415 docstring1391 (chi-body1127 (cons e11410 e21411) e1390 (extend-var-env1082 labels1414 new-vars1415 r1393) (make-binding-wrap1104 ids1412 labels1414 w1394) mod1395)))))) tmp1408) ((lambda (tmp1417) (if tmp1417 (apply (lambda (ids1418 e11419 e21420) (let ((old-ids1421 (lambda-var-list1136 ids1418))) (if (not (valid-bound-ids?1112 old-ids1421)) (syntax-violation (quote lambda) "invalid parameter list" e1390) (let ((labels1422 (gen-labels1093 old-ids1421)) (new-vars1423 (map gen-var1135 old-ids1421))) (k1396 (let f1424 ((ls11425 (cdr new-vars1423)) (ls21426 (car new-vars1423))) (if (null? ls11425) ls21426 (f1424 (cdr ls11425) (cons (car ls11425) ls21426)))) docstring1391 (chi-body1127 (cons e11419 e21420) e1390 (extend-var-env1082 labels1422 new-vars1423 r1393) (make-binding-wrap1104 old-ids1421 labels1422 w1394) mod1395)))))) tmp1417) ((lambda (_1428) (syntax-violation (quote lambda) "bad lambda" e1390)) tmp1397))) ($sc-dispatch tmp1397 (quote (any any . each-any)))))) ($sc-dispatch tmp1397 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1397 (quote (any any any . each-any))))) c1392))) (chi-body1127 (lambda (body1429 outer-form1430 r1431 w1432 mod1433) (let ((r1434 (cons (quote ("placeholder" placeholder)) r1431))) (let ((ribcage1435 (make-ribcage1094 (quote ()) (quote ()) (quote ())))) (let ((w1436 (make-wrap1089 (wrap-marks1090 w1432) (cons ribcage1435 (wrap-subst1091 w1432))))) (let parse1437 ((body1438 (map (lambda (x1444) (cons r1434 (wrap1115 x1444 w1436 mod1433))) body1429)) (ids1439 (quote ())) (labels1440 (quote ())) (vars1441 (quote ())) (vals1442 (quote ())) (bindings1443 (quote ()))) (if (null? body1438) (syntax-violation #f "no expressions in body" outer-form1430) (let ((e1445 (cdar body1438)) (er1446 (caar body1438))) (call-with-values (lambda () (syntax-type1121 e1445 er1446 (quote (())) #f ribcage1435 mod1433)) (lambda (type1447 value1448 e1449 w1450 s1451 mod1452) (let ((t1453 type1447)) (if (memv t1453 (quote (define-form))) (let ((id1454 (wrap1115 value1448 w1450 mod1452)) (label1455 (gen-label1092))) (let ((var1456 (gen-var1135 id1454))) (begin (extend-ribcage!1103 ribcage1435 id1454 label1455) (parse1437 (cdr body1438) (cons id1454 ids1439) (cons label1455 labels1440) (cons var1456 vars1441) (cons (cons er1446 (wrap1115 e1449 w1450 mod1452)) vals1442) (cons (cons (quote lexical) var1456) bindings1443))))) (if (memv t1453 (quote (define-syntax-form))) (let ((id1457 (wrap1115 value1448 w1450 mod1452)) (label1458 (gen-label1092))) (begin (extend-ribcage!1103 ribcage1435 id1457 label1458) (parse1437 (cdr body1438) (cons id1457 ids1439) (cons label1458 labels1440) vars1441 vals1442 (cons (cons (quote macro) (cons er1446 (wrap1115 e1449 w1450 mod1452))) bindings1443)))) (if (memv t1453 (quote (begin-form))) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (_1461 e11462) (parse1437 (let f1463 ((forms1464 e11462)) (if (null? forms1464) (cdr body1438) (cons (cons er1446 (wrap1115 (car forms1464) w1450 mod1452)) (f1463 (cdr forms1464))))) ids1439 labels1440 vars1441 vals1442 bindings1443)) tmp1460) (syntax-violation #f "source expression failed to match any pattern" tmp1459))) ($sc-dispatch tmp1459 (quote (any . each-any))))) e1449) (if (memv t1453 (quote (local-syntax-form))) (chi-local-syntax1129 value1448 e1449 er1446 w1450 s1451 mod1452 (lambda (forms1466 er1467 w1468 s1469 mod1470) (parse1437 (let f1471 ((forms1472 forms1466)) (if (null? forms1472) (cdr body1438) (cons (cons er1467 (wrap1115 (car forms1472) w1468 mod1470)) (f1471 (cdr forms1472))))) ids1439 labels1440 vars1441 vals1442 bindings1443))) (if (null? ids1439) (build-sequence1066 #f (map (lambda (x1473) (chi1123 (cdr x1473) (car x1473) (quote (())) mod1452)) (cons (cons er1446 (source-wrap1116 e1449 w1450 s1451 mod1452)) (cdr body1438)))) (begin (if (not (valid-bound-ids?1112 ids1439)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1430)) (let loop1474 ((bs1475 bindings1443) (er-cache1476 #f) (r-cache1477 #f)) (if (not (null? bs1475)) (let ((b1478 (car bs1475))) (if (eq? (car b1478) (quote macro)) (let ((er1479 (cadr b1478))) (let ((r-cache1480 (if (eq? er1479 er-cache1476) r-cache1477 (macros-only-env1083 er1479)))) (begin (set-cdr! b1478 (eval-local-transformer1130 (chi1123 (cddr b1478) r-cache1480 (quote (())) mod1452) mod1452)) (loop1474 (cdr bs1475) er1479 r-cache1480)))) (loop1474 (cdr bs1475) er-cache1476 r-cache1477))))) (set-cdr! r1434 (extend-env1081 labels1440 bindings1443 (cdr r1434))) (build-letrec1069 #f vars1441 (map (lambda (x1481) (chi1123 (cdr x1481) (car x1481) (quote (())) mod1452)) vals1442) (build-sequence1066 #f (map (lambda (x1482) (chi1123 (cdr x1482) (car x1482) (quote (())) mod1452)) (cons (cons er1446 (source-wrap1116 e1449 w1450 s1451 mod1452)) (cdr body1438)))))))))))))))))))))) (chi-macro1126 (lambda (p1483 e1484 r1485 w1486 rib1487 mod1488) (letrec ((rebuild-macro-output1489 (lambda (x1490 m1491) (cond ((pair? x1490) (cons (rebuild-macro-output1489 (car x1490) m1491) (rebuild-macro-output1489 (cdr x1490) m1491))) ((syntax-object?1071 x1490) (let ((w1492 (syntax-object-wrap1073 x1490))) (let ((ms1493 (wrap-marks1090 w1492)) (s1494 (wrap-subst1091 w1492))) (if (and (pair? ms1493) (eq? (car ms1493) #f)) (make-syntax-object1070 (syntax-object-expression1072 x1490) (make-wrap1089 (cdr ms1493) (if rib1487 (cons rib1487 (cdr s1494)) (cdr s1494))) (syntax-object-module1074 x1490)) (make-syntax-object1070 (syntax-object-expression1072 x1490) (make-wrap1089 (cons m1491 ms1493) (if rib1487 (cons rib1487 (cons (quote shift) s1494)) (cons (quote shift) s1494))) (let ((pmod1495 (procedure-module p1483))) (if pmod1495 (cons (quote hygiene) (module-name pmod1495)) (quote (hygiene guile))))))))) ((vector? x1490) (let ((n1496 (vector-length x1490))) (let ((v1497 (make-vector n1496))) (let doloop1498 ((i1499 0)) (if (fx=1057 i1499 n1496) v1497 (begin (vector-set! v1497 i1499 (rebuild-macro-output1489 (vector-ref x1490 i1499) m1491)) (doloop1498 (fx+1055 i1499 1)))))))) ((symbol? x1490) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1116 e1484 w1486 s mod1488) x1490)) (else x1490))))) (rebuild-macro-output1489 (p1483 (wrap1115 e1484 (anti-mark1102 w1486) mod1488)) (string #\m))))) (chi-application1125 (lambda (x1500 e1501 r1502 w1503 s1504 mod1505) ((lambda (tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (e01508 e11509) (build-annotated1064 s1504 (cons x1500 (map (lambda (e1510) (chi1123 e1510 r1502 w1503 mod1505)) e11509)))) tmp1507) (syntax-violation #f "source expression failed to match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any . each-any))))) e1501))) (chi-expr1124 (lambda (type1512 value1513 e1514 r1515 w1516 s1517 mod1518) (let ((t1519 type1512)) (if (memv t1519 (quote (lexical))) (build-annotated1064 s1517 value1513) (if (memv t1519 (quote (core external-macro))) (value1513 e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (module-ref))) (call-with-values (lambda () (value1513 e1514)) (lambda (id1520 mod1521) (build-annotated1064 s1517 (if mod1521 (make-module-ref (cdr mod1521) id1520 (car mod1521)) (make-module-ref mod1521 id1520 (quote bare)))))) (if (memv t1519 (quote (lexical-call))) (chi-application1125 (build-annotated1064 (source-annotation1078 (car e1514)) value1513) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (global-call))) (chi-application1125 (build-annotated1064 (source-annotation1078 (car e1514)) (if (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518) (make-module-ref (cdr (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518)) value1513 (car (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518))) (make-module-ref (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518) value1513 (quote bare)))) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (constant))) (build-data1065 s1517 (strip1134 (source-wrap1116 e1514 w1516 s1517 mod1518) (quote (())))) (if (memv t1519 (quote (global))) (build-annotated1064 s1517 (if mod1518 (make-module-ref (cdr mod1518) value1513 (car mod1518)) (make-module-ref mod1518 value1513 (quote bare)))) (if (memv t1519 (quote (call))) (chi-application1125 (chi1123 (car e1514) r1515 w1516 mod1518) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (begin-form))) ((lambda (tmp1522) ((lambda (tmp1523) (if tmp1523 (apply (lambda (_1524 e11525 e21526) (chi-sequence1117 (cons e11525 e21526) r1515 w1516 s1517 mod1518)) tmp1523) (syntax-violation #f "source expression failed to match any pattern" tmp1522))) ($sc-dispatch tmp1522 (quote (any any . each-any))))) e1514) (if (memv t1519 (quote (local-syntax-form))) (chi-local-syntax1129 value1513 e1514 r1515 w1516 s1517 mod1518 chi-sequence1117) (if (memv t1519 (quote (eval-when-form))) ((lambda (tmp1528) ((lambda (tmp1529) (if tmp1529 (apply (lambda (_1530 x1531 e11532 e21533) (let ((when-list1534 (chi-when-list1120 e1514 x1531 w1516))) (if (memq (quote eval) when-list1534) (chi-sequence1117 (cons e11532 e21533) r1515 w1516 s1517 mod1518) (chi-void1131)))) tmp1529) (syntax-violation #f "source expression failed to match any pattern" tmp1528))) ($sc-dispatch tmp1528 (quote (any each-any any . each-any))))) e1514) (if (memv t1519 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1514 (wrap1115 value1513 w1516 mod1518)) (if (memv t1519 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1116 e1514 w1516 s1517 mod1518)) (if (memv t1519 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1116 e1514 w1516 s1517 mod1518)) (syntax-violation #f "unexpected syntax" (source-wrap1116 e1514 w1516 s1517 mod1518))))))))))))))))))) (chi1123 (lambda (e1537 r1538 w1539 mod1540) (call-with-values (lambda () (syntax-type1121 e1537 r1538 w1539 #f #f mod1540)) (lambda (type1541 value1542 e1543 w1544 s1545 mod1546) (chi-expr1124 type1541 value1542 e1543 r1538 w1544 s1545 mod1546))))) (chi-top1122 (lambda (e1547 r1548 w1549 m1550 esew1551 mod1552) (call-with-values (lambda () (syntax-type1121 e1547 r1548 w1549 #f #f mod1552)) (lambda (type1560 value1561 e1562 w1563 s1564 mod1565) (let ((t1566 type1560)) (if (memv t1566 (quote (begin-form))) ((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569) (chi-void1131)) tmp1568) ((lambda (tmp1570) (if tmp1570 (apply (lambda (_1571 e11572 e21573) (chi-top-sequence1118 (cons e11572 e21573) r1548 w1563 s1564 m1550 esew1551 mod1565)) tmp1570) (syntax-violation #f "source expression failed to match any pattern" tmp1567))) ($sc-dispatch tmp1567 (quote (any any . each-any)))))) ($sc-dispatch tmp1567 (quote (any))))) e1562) (if (memv t1566 (quote (local-syntax-form))) (chi-local-syntax1129 value1561 e1562 r1548 w1563 s1564 mod1565 (lambda (body1575 r1576 w1577 s1578 mod1579) (chi-top-sequence1118 body1575 r1576 w1577 s1578 m1550 esew1551 mod1579))) (if (memv t1566 (quote (eval-when-form))) ((lambda (tmp1580) ((lambda (tmp1581) (if tmp1581 (apply (lambda (_1582 x1583 e11584 e21585) (let ((when-list1586 (chi-when-list1120 e1562 x1583 w1563)) (body1587 (cons e11584 e21585))) (cond ((eq? m1550 (quote e)) (if (memq (quote eval) when-list1586) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote e) (quote (eval)) mod1565) (chi-void1131))) ((memq (quote load) when-list1586) (if (or (memq (quote compile) when-list1586) (and (eq? m1550 (quote c&e)) (memq (quote eval) when-list1586))) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote c&e) (quote (compile load)) mod1565) (if (memq m1550 (quote (c c&e))) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote c) (quote (load)) mod1565) (chi-void1131)))) ((or (memq (quote compile) when-list1586) (and (eq? m1550 (quote c&e)) (memq (quote eval) when-list1586))) (top-level-eval-hook1059 (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote e) (quote (eval)) mod1565) mod1565) (chi-void1131)) (else (chi-void1131))))) tmp1581) (syntax-violation #f "source expression failed to match any pattern" tmp1580))) ($sc-dispatch tmp1580 (quote (any each-any any . each-any))))) e1562) (if (memv t1566 (quote (define-syntax-form))) (let ((n1590 (id-var-name1109 value1561 w1563)) (r1591 (macros-only-env1083 r1548))) (let ((t1592 m1550)) (if (memv t1592 (quote (c))) (if (memq (quote compile) esew1551) (let ((e1593 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)))) (begin (top-level-eval-hook1059 e1593 mod1565) (if (memq (quote load) esew1551) e1593 (chi-void1131)))) (if (memq (quote load) esew1551) (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)) (chi-void1131))) (if (memv t1592 (quote (c&e))) (let ((e1594 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)))) (begin (top-level-eval-hook1059 e1594 mod1565) e1594)) (begin (if (memq (quote eval) esew1551) (top-level-eval-hook1059 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)) mod1565)) (chi-void1131)))))) (if (memv t1566 (quote (define-form))) (let ((n1595 (id-var-name1109 value1561 w1563))) (let ((type1596 (binding-type1079 (lookup1084 n1595 r1548 mod1565)))) (let ((t1597 type1596)) (if (memv t1597 (quote (global core macro module-ref))) (let ((x1598 (build-annotated1064 s1564 (list (quote define) n1595 (chi1123 e1562 r1548 w1563 mod1565))))) (begin (if (eq? m1550 (quote c&e)) (top-level-eval-hook1059 x1598 mod1565)) x1598)) (if (memv t1597 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1562 (wrap1115 value1561 w1563 mod1565)) (syntax-violation #f "cannot define keyword at top level" e1562 (wrap1115 value1561 w1563 mod1565))))))) (let ((x1599 (chi-expr1124 type1560 value1561 e1562 r1548 w1563 s1564 mod1565))) (begin (if (eq? m1550 (quote c&e)) (top-level-eval-hook1059 x1599 mod1565)) x1599)))))))))))) (syntax-type1121 (lambda (e1600 r1601 w1602 s1603 rib1604 mod1605) (cond ((symbol? e1600) (let ((n1606 (id-var-name1109 e1600 w1602))) (let ((b1607 (lookup1084 n1606 r1601 mod1605))) (let ((type1608 (binding-type1079 b1607))) (let ((t1609 type1608)) (if (memv t1609 (quote (lexical))) (values type1608 (binding-value1080 b1607) e1600 w1602 s1603 mod1605) (if (memv t1609 (quote (global))) (values type1608 n1606 e1600 w1602 s1603 mod1605) (if (memv t1609 (quote (macro))) (syntax-type1121 (chi-macro1126 (binding-value1080 b1607) e1600 r1601 w1602 rib1604 mod1605) r1601 (quote (())) s1603 rib1604 mod1605) (values type1608 (binding-value1080 b1607) e1600 w1602 s1603 mod1605))))))))) ((pair? e1600) (let ((first1610 (car e1600))) (if (id?1087 first1610) (let ((n1611 (id-var-name1109 first1610 w1602))) (let ((b1612 (lookup1084 n1611 r1601 (or (and (syntax-object?1071 first1610) (syntax-object-module1074 first1610)) mod1605)))) (let ((type1613 (binding-type1079 b1612))) (let ((t1614 type1613)) (if (memv t1614 (quote (lexical))) (values (quote lexical-call) (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (global))) (values (quote global-call) n1611 e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (macro))) (syntax-type1121 (chi-macro1126 (binding-value1080 b1612) e1600 r1601 w1602 rib1604 mod1605) r1601 (quote (())) s1603 rib1604 mod1605) (if (memv t1614 (quote (core external-macro module-ref))) (values type1613 (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (begin))) (values (quote begin-form) #f e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (eval-when))) (values (quote eval-when-form) #f e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (define))) ((lambda (tmp1615) ((lambda (tmp1616) (if (if tmp1616 (apply (lambda (_1617 name1618 val1619) (id?1087 name1618)) tmp1616) #f) (apply (lambda (_1620 name1621 val1622) (values (quote define-form) name1621 val1622 w1602 s1603 mod1605)) tmp1616) ((lambda (tmp1623) (if (if tmp1623 (apply (lambda (_1624 name1625 args1626 e11627 e21628) (and (id?1087 name1625) (valid-bound-ids?1112 (lambda-var-list1136 args1626)))) tmp1623) #f) (apply (lambda (_1629 name1630 args1631 e11632 e21633) (values (quote define-form) (wrap1115 name1630 w1602 mod1605) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap1115 (cons args1631 (cons e11632 e21633)) w1602 mod1605)) (quote (())) s1603 mod1605)) tmp1623) ((lambda (tmp1635) (if (if tmp1635 (apply (lambda (_1636 name1637) (id?1087 name1637)) tmp1635) #f) (apply (lambda (_1638 name1639) (values (quote define-form) (wrap1115 name1639 w1602 mod1605) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s1603 mod1605)) tmp1635) (syntax-violation #f "source expression failed to match any pattern" tmp1615))) ($sc-dispatch tmp1615 (quote (any any)))))) ($sc-dispatch tmp1615 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1615 (quote (any any any))))) e1600) (if (memv t1614 (quote (define-syntax))) ((lambda (tmp1640) ((lambda (tmp1641) (if (if tmp1641 (apply (lambda (_1642 name1643 val1644) (id?1087 name1643)) tmp1641) #f) (apply (lambda (_1645 name1646 val1647) (values (quote define-syntax-form) name1646 val1647 w1602 s1603 mod1605)) tmp1641) (syntax-violation #f "source expression failed to match any pattern" tmp1640))) ($sc-dispatch tmp1640 (quote (any any any))))) e1600) (values (quote call) #f e1600 w1602 s1603 mod1605)))))))))))))) (values (quote call) #f e1600 w1602 s1603 mod1605)))) ((syntax-object?1071 e1600) (syntax-type1121 (syntax-object-expression1072 e1600) r1601 (join-wraps1106 w1602 (syntax-object-wrap1073 e1600)) #f rib1604 (or (syntax-object-module1074 e1600) mod1605))) ((annotation? e1600) (syntax-type1121 (annotation-expression e1600) r1601 w1602 (annotation-source e1600) rib1604 mod1605)) ((self-evaluating? e1600) (values (quote constant) #f e1600 w1602 s1603 mod1605)) (else (values (quote other) #f e1600 w1602 s1603 mod1605))))) (chi-when-list1120 (lambda (e1648 when-list1649 w1650) (let f1651 ((when-list1652 when-list1649) (situations1653 (quote ()))) (if (null? when-list1652) situations1653 (f1651 (cdr when-list1652) (cons (let ((x1654 (car when-list1652))) (cond ((free-id=?1110 x1654 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile)) ((free-id=?1110 x1654 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load)) ((free-id=?1110 x1654 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1648 (wrap1115 x1654 w1650 #f))))) situations1653)))))) (chi-install-global1119 (lambda (name1655 e1656) (build-annotated1064 #f (list (build-annotated1064 #f (quote define)) name1655 (if (let ((v1657 (module-variable (current-module) name1655))) (and v1657 (variable-bound? v1657) (macro? (variable-ref v1657)) (not (eq? (macro-type (variable-ref v1657)) (quote syncase-macro))))) (build-annotated1064 #f (list (build-annotated1064 #f (quote make-extended-syncase-macro)) (build-annotated1064 #f (list (build-annotated1064 #f (quote module-ref)) (build-annotated1064 #f (quote (current-module))) (build-data1065 #f name1655))) (build-data1065 #f (quote macro)) e1656)) (build-annotated1064 #f (list (build-annotated1064 #f (quote make-syncase-macro)) (build-data1065 #f (quote macro)) e1656))))))) (chi-top-sequence1118 (lambda (body1658 r1659 w1660 s1661 m1662 esew1663 mod1664) (build-sequence1066 s1661 (let dobody1665 ((body1666 body1658) (r1667 r1659) (w1668 w1660) (m1669 m1662) (esew1670 esew1663) (mod1671 mod1664)) (if (null? body1666) (quote ()) (let ((first1672 (chi-top1122 (car body1666) r1667 w1668 m1669 esew1670 mod1671))) (cons first1672 (dobody1665 (cdr body1666) r1667 w1668 m1669 esew1670 mod1671)))))))) (chi-sequence1117 (lambda (body1673 r1674 w1675 s1676 mod1677) (build-sequence1066 s1676 (let dobody1678 ((body1679 body1673) (r1680 r1674) (w1681 w1675) (mod1682 mod1677)) (if (null? body1679) (quote ()) (let ((first1683 (chi1123 (car body1679) r1680 w1681 mod1682))) (cons first1683 (dobody1678 (cdr body1679) r1680 w1681 mod1682)))))))) (source-wrap1116 (lambda (x1684 w1685 s1686 defmod1687) (wrap1115 (if s1686 (make-annotation x1684 s1686 #f) x1684) w1685 defmod1687))) (wrap1115 (lambda (x1688 w1689 defmod1690) (cond ((and (null? (wrap-marks1090 w1689)) (null? (wrap-subst1091 w1689))) x1688) ((syntax-object?1071 x1688) (make-syntax-object1070 (syntax-object-expression1072 x1688) (join-wraps1106 w1689 (syntax-object-wrap1073 x1688)) (syntax-object-module1074 x1688))) ((null? x1688) x1688) (else (make-syntax-object1070 x1688 w1689 defmod1690))))) (bound-id-member?1114 (lambda (x1691 list1692) (and (not (null? list1692)) (or (bound-id=?1111 x1691 (car list1692)) (bound-id-member?1114 x1691 (cdr list1692)))))) (distinct-bound-ids?1113 (lambda (ids1693) (let distinct?1694 ((ids1695 ids1693)) (or (null? ids1695) (and (not (bound-id-member?1114 (car ids1695) (cdr ids1695))) (distinct?1694 (cdr ids1695))))))) (valid-bound-ids?1112 (lambda (ids1696) (and (let all-ids?1697 ((ids1698 ids1696)) (or (null? ids1698) (and (id?1087 (car ids1698)) (all-ids?1697 (cdr ids1698))))) (distinct-bound-ids?1113 ids1696)))) (bound-id=?1111 (lambda (i1699 j1700) (if (and (syntax-object?1071 i1699) (syntax-object?1071 j1700)) (and (eq? (let ((e1701 (syntax-object-expression1072 i1699))) (if (annotation? e1701) (annotation-expression e1701) e1701)) (let ((e1702 (syntax-object-expression1072 j1700))) (if (annotation? e1702) (annotation-expression e1702) e1702))) (same-marks?1108 (wrap-marks1090 (syntax-object-wrap1073 i1699)) (wrap-marks1090 (syntax-object-wrap1073 j1700)))) (eq? (let ((e1703 i1699)) (if (annotation? e1703) (annotation-expression e1703) e1703)) (let ((e1704 j1700)) (if (annotation? e1704) (annotation-expression e1704) e1704)))))) (free-id=?1110 (lambda (i1705 j1706) (and (eq? (let ((x1707 i1705)) (let ((e1708 (if (syntax-object?1071 x1707) (syntax-object-expression1072 x1707) x1707))) (if (annotation? e1708) (annotation-expression e1708) e1708))) (let ((x1709 j1706)) (let ((e1710 (if (syntax-object?1071 x1709) (syntax-object-expression1072 x1709) x1709))) (if (annotation? e1710) (annotation-expression e1710) e1710)))) (eq? (id-var-name1109 i1705 (quote (()))) (id-var-name1109 j1706 (quote (()))))))) (id-var-name1109 (lambda (id1711 w1712) (letrec ((search-vector-rib1715 (lambda (sym1721 subst1722 marks1723 symnames1724 ribcage1725) (let ((n1726 (vector-length symnames1724))) (let f1727 ((i1728 0)) (cond ((fx=1057 i1728 n1726) (search1713 sym1721 (cdr subst1722) marks1723)) ((and (eq? (vector-ref symnames1724 i1728) sym1721) (same-marks?1108 marks1723 (vector-ref (ribcage-marks1097 ribcage1725) i1728))) (values (vector-ref (ribcage-labels1098 ribcage1725) i1728) marks1723)) (else (f1727 (fx+1055 i1728 1)))))))) (search-list-rib1714 (lambda (sym1729 subst1730 marks1731 symnames1732 ribcage1733) (let f1734 ((symnames1735 symnames1732) (i1736 0)) (cond ((null? symnames1735) (search1713 sym1729 (cdr subst1730) marks1731)) ((and (eq? (car symnames1735) sym1729) (same-marks?1108 marks1731 (list-ref (ribcage-marks1097 ribcage1733) i1736))) (values (list-ref (ribcage-labels1098 ribcage1733) i1736) marks1731)) (else (f1734 (cdr symnames1735) (fx+1055 i1736 1))))))) (search1713 (lambda (sym1737 subst1738 marks1739) (if (null? subst1738) (values #f marks1739) (let ((fst1740 (car subst1738))) (if (eq? fst1740 (quote shift)) (search1713 sym1737 (cdr subst1738) (cdr marks1739)) (let ((symnames1741 (ribcage-symnames1096 fst1740))) (if (vector? symnames1741) (search-vector-rib1715 sym1737 subst1738 marks1739 symnames1741 fst1740) (search-list-rib1714 sym1737 subst1738 marks1739 symnames1741 fst1740))))))))) (cond ((symbol? id1711) (or (call-with-values (lambda () (search1713 id1711 (wrap-subst1091 w1712) (wrap-marks1090 w1712))) (lambda (x1743 . ignore1742) x1743)) id1711)) ((syntax-object?1071 id1711) (let ((id1744 (let ((e1746 (syntax-object-expression1072 id1711))) (if (annotation? e1746) (annotation-expression e1746) e1746))) (w11745 (syntax-object-wrap1073 id1711))) (let ((marks1747 (join-marks1107 (wrap-marks1090 w1712) (wrap-marks1090 w11745)))) (call-with-values (lambda () (search1713 id1744 (wrap-subst1091 w1712) marks1747)) (lambda (new-id1748 marks1749) (or new-id1748 (call-with-values (lambda () (search1713 id1744 (wrap-subst1091 w11745) marks1749)) (lambda (x1751 . ignore1750) x1751)) id1744)))))) ((annotation? id1711) (let ((id1752 (let ((e1753 id1711)) (if (annotation? e1753) (annotation-expression e1753) e1753)))) (or (call-with-values (lambda () (search1713 id1752 (wrap-subst1091 w1712) (wrap-marks1090 w1712))) (lambda (x1755 . ignore1754) x1755)) id1752))) (else (error-hook1061 (quote id-var-name) "invalid id" id1711)))))) (same-marks?1108 (lambda (x1756 y1757) (or (eq? x1756 y1757) (and (not (null? x1756)) (not (null? y1757)) (eq? (car x1756) (car y1757)) (same-marks?1108 (cdr x1756) (cdr y1757)))))) (join-marks1107 (lambda (m11758 m21759) (smart-append1105 m11758 m21759))) (join-wraps1106 (lambda (w11760 w21761) (let ((m11762 (wrap-marks1090 w11760)) (s11763 (wrap-subst1091 w11760))) (if (null? m11762) (if (null? s11763) w21761 (make-wrap1089 (wrap-marks1090 w21761) (smart-append1105 s11763 (wrap-subst1091 w21761)))) (make-wrap1089 (smart-append1105 m11762 (wrap-marks1090 w21761)) (smart-append1105 s11763 (wrap-subst1091 w21761))))))) (smart-append1105 (lambda (m11764 m21765) (if (null? m21765) m11764 (append m11764 m21765)))) (make-binding-wrap1104 (lambda (ids1766 labels1767 w1768) (if (null? ids1766) w1768 (make-wrap1089 (wrap-marks1090 w1768) (cons (let ((labelvec1769 (list->vector labels1767))) (let ((n1770 (vector-length labelvec1769))) (let ((symnamevec1771 (make-vector n1770)) (marksvec1772 (make-vector n1770))) (begin (let f1773 ((ids1774 ids1766) (i1775 0)) (if (not (null? ids1774)) (call-with-values (lambda () (id-sym-name&marks1088 (car ids1774) w1768)) (lambda (symname1776 marks1777) (begin (vector-set! symnamevec1771 i1775 symname1776) (vector-set! marksvec1772 i1775 marks1777) (f1773 (cdr ids1774) (fx+1055 i1775 1))))))) (make-ribcage1094 symnamevec1771 marksvec1772 labelvec1769))))) (wrap-subst1091 w1768)))))) (extend-ribcage!1103 (lambda (ribcage1778 id1779 label1780) (begin (set-ribcage-symnames!1099 ribcage1778 (cons (let ((e1781 (syntax-object-expression1072 id1779))) (if (annotation? e1781) (annotation-expression e1781) e1781)) (ribcage-symnames1096 ribcage1778))) (set-ribcage-marks!1100 ribcage1778 (cons (wrap-marks1090 (syntax-object-wrap1073 id1779)) (ribcage-marks1097 ribcage1778))) (set-ribcage-labels!1101 ribcage1778 (cons label1780 (ribcage-labels1098 ribcage1778)))))) (anti-mark1102 (lambda (w1782) (make-wrap1089 (cons #f (wrap-marks1090 w1782)) (cons (quote shift) (wrap-subst1091 w1782))))) (set-ribcage-labels!1101 (lambda (x1783 update1784) (vector-set! x1783 3 update1784))) (set-ribcage-marks!1100 (lambda (x1785 update1786) (vector-set! x1785 2 update1786))) (set-ribcage-symnames!1099 (lambda (x1787 update1788) (vector-set! x1787 1 update1788))) (ribcage-labels1098 (lambda (x1789) (vector-ref x1789 3))) (ribcage-marks1097 (lambda (x1790) (vector-ref x1790 2))) (ribcage-symnames1096 (lambda (x1791) (vector-ref x1791 1))) (ribcage?1095 (lambda (x1792) (and (vector? x1792) (= (vector-length x1792) 4) (eq? (vector-ref x1792 0) (quote ribcage))))) (make-ribcage1094 (lambda (symnames1793 marks1794 labels1795) (vector (quote ribcage) symnames1793 marks1794 labels1795))) (gen-labels1093 (lambda (ls1796) (if (null? ls1796) (quote ()) (cons (gen-label1092) (gen-labels1093 (cdr ls1796)))))) (gen-label1092 (lambda () (string #\i))) (wrap-subst1091 cdr) (wrap-marks1090 car) (make-wrap1089 cons) (id-sym-name&marks1088 (lambda (x1797 w1798) (if (syntax-object?1071 x1797) (values (let ((e1799 (syntax-object-expression1072 x1797))) (if (annotation? e1799) (annotation-expression e1799) e1799)) (join-marks1107 (wrap-marks1090 w1798) (wrap-marks1090 (syntax-object-wrap1073 x1797)))) (values (let ((e1800 x1797)) (if (annotation? e1800) (annotation-expression e1800) e1800)) (wrap-marks1090 w1798))))) (id?1087 (lambda (x1801) (cond ((symbol? x1801) #t) ((syntax-object?1071 x1801) (symbol? (let ((e1802 (syntax-object-expression1072 x1801))) (if (annotation? e1802) (annotation-expression e1802) e1802)))) ((annotation? x1801) (symbol? (annotation-expression x1801))) (else #f)))) (nonsymbol-id?1086 (lambda (x1803) (and (syntax-object?1071 x1803) (symbol? (let ((e1804 (syntax-object-expression1072 x1803))) (if (annotation? e1804) (annotation-expression e1804) e1804)))))) (global-extend1085 (lambda (type1805 sym1806 val1807) (put-global-definition-hook1062 sym1806 type1805 val1807))) (lookup1084 (lambda (x1808 r1809 mod1810) (cond ((assq x1808 r1809) => cdr) ((symbol? x1808) (or (get-global-definition-hook1063 x1808 mod1810) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1083 (lambda (r1811) (if (null? r1811) (quote ()) (let ((a1812 (car r1811))) (if (eq? (cadr a1812) (quote macro)) (cons a1812 (macros-only-env1083 (cdr r1811))) (macros-only-env1083 (cdr r1811))))))) (extend-var-env1082 (lambda (labels1813 vars1814 r1815) (if (null? labels1813) r1815 (extend-var-env1082 (cdr labels1813) (cdr vars1814) (cons (cons (car labels1813) (cons (quote lexical) (car vars1814))) r1815))))) (extend-env1081 (lambda (labels1816 bindings1817 r1818) (if (null? labels1816) r1818 (extend-env1081 (cdr labels1816) (cdr bindings1817) (cons (cons (car labels1816) (car bindings1817)) r1818))))) (binding-value1080 cdr) (binding-type1079 car) (source-annotation1078 (lambda (x1819) (cond ((annotation? x1819) (annotation-source x1819)) ((syntax-object?1071 x1819) (source-annotation1078 (syntax-object-expression1072 x1819))) (else #f)))) (set-syntax-object-module!1077 (lambda (x1820 update1821) (vector-set! x1820 3 update1821))) (set-syntax-object-wrap!1076 (lambda (x1822 update1823) (vector-set! x1822 2 update1823))) (set-syntax-object-expression!1075 (lambda (x1824 update1825) (vector-set! x1824 1 update1825))) (syntax-object-module1074 (lambda (x1826) (vector-ref x1826 3))) (syntax-object-wrap1073 (lambda (x1827) (vector-ref x1827 2))) (syntax-object-expression1072 (lambda (x1828) (vector-ref x1828 1))) (syntax-object?1071 (lambda (x1829) (and (vector? x1829) (= (vector-length x1829) 4) (eq? (vector-ref x1829 0) (quote syntax-object))))) (make-syntax-object1070 (lambda (expression1830 wrap1831 module1832) (vector (quote syntax-object) expression1830 wrap1831 module1832))) (build-letrec1069 (lambda (src1833 vars1834 val-exps1835 body-exp1836) (if (null? vars1834) (build-annotated1064 src1833 body-exp1836) (build-annotated1064 src1833 (list (quote letrec) (map list vars1834 val-exps1835) body-exp1836))))) (build-named-let1068 (lambda (src1837 vars1838 val-exps1839 body-exp1840) (if (null? vars1838) (build-annotated1064 src1837 body-exp1840) (build-annotated1064 src1837 (list (quote let) (car vars1838) (map list (cdr vars1838) val-exps1839) body-exp1840))))) (build-let1067 (lambda (src1841 vars1842 val-exps1843 body-exp1844) (if (null? vars1842) (build-annotated1064 src1841 body-exp1844) (build-annotated1064 src1841 (list (quote let) (map list vars1842 val-exps1843) body-exp1844))))) (build-sequence1066 (lambda (src1845 exps1846) (if (null? (cdr exps1846)) (build-annotated1064 src1845 (car exps1846)) (build-annotated1064 src1845 (cons (quote begin) exps1846))))) (build-data1065 (lambda (src1847 exp1848) (if (and (self-evaluating? exp1848) (not (vector? exp1848))) (build-annotated1064 src1847 exp1848) (build-annotated1064 src1847 (list (quote quote) exp1848))))) (build-annotated1064 (lambda (src1849 exp1850) (if (and src1849 (not (annotation? exp1850))) (make-annotation exp1850 src1849 #t) exp1850))) (get-global-definition-hook1063 (lambda (symbol1851 module1852) (begin (if (and (not module1852) (current-module)) (warn "module system is booted, we should have a module" symbol1851)) (let ((v1853 (module-variable (if module1852 (resolve-module (cdr module1852)) (current-module)) symbol1851))) (and v1853 (variable-bound? v1853) (let ((val1854 (variable-ref v1853))) (and (macro? val1854) (syncase-macro-type val1854) (cons (syncase-macro-type val1854) (syncase-macro-binding val1854))))))))) (put-global-definition-hook1062 (lambda (symbol1855 type1856 val1857) (let ((existing1858 (let ((v1859 (module-variable (current-module) symbol1855))) (and v1859 (variable-bound? v1859) (let ((val1860 (variable-ref v1859))) (and (macro? val1860) (not (syncase-macro-type val1860)) val1860)))))) (module-define! (current-module) symbol1855 (if existing1858 (make-extended-syncase-macro existing1858 type1856 val1857) (make-syncase-macro type1856 val1857)))))) (error-hook1061 (lambda (who1861 why1862 what1863) (error who1861 "~a ~s" why1862 what1863))) (local-eval-hook1060 (lambda (x1864 mod1865) (primitive-eval (list noexpand1054 x1864)))) (top-level-eval-hook1059 (lambda (x1866 mod1867) (primitive-eval (list noexpand1054 x1866)))) (fx<1058 <) (fx=1057 =) (fx-1056 -) (fx+1055 +) (noexpand1054 "noexpand")) (begin (global-extend1085 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1085 (quote local-syntax) (quote let-syntax) #f) (global-extend1085 (quote core) (quote fluid-let-syntax) (lambda (e1868 r1869 w1870 s1871 mod1872) ((lambda (tmp1873) ((lambda (tmp1874) (if (if tmp1874 (apply (lambda (_1875 var1876 val1877 e11878 e21879) (valid-bound-ids?1112 var1876)) tmp1874) #f) (apply (lambda (_1881 var1882 val1883 e11884 e21885) (let ((names1886 (map (lambda (x1887) (id-var-name1109 x1887 w1870)) var1882))) (begin (for-each (lambda (id1889 n1890) (let ((t1891 (binding-type1079 (lookup1084 n1890 r1869 mod1872)))) (if (memv t1891 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1868 (source-wrap1116 id1889 w1870 s1871 mod1872))))) var1882 names1886) (chi-body1127 (cons e11884 e21885) (source-wrap1116 e1868 w1870 s1871 mod1872) (extend-env1081 names1886 (let ((trans-r1894 (macros-only-env1083 r1869))) (map (lambda (x1895) (cons (quote macro) (eval-local-transformer1130 (chi1123 x1895 trans-r1894 w1870 mod1872) mod1872))) val1883)) r1869) w1870 mod1872)))) tmp1874) ((lambda (_1897) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1116 e1868 w1870 s1871 mod1872))) tmp1873))) ($sc-dispatch tmp1873 (quote (any #(each (any any)) any . each-any))))) e1868))) (global-extend1085 (quote core) (quote quote) (lambda (e1898 r1899 w1900 s1901 mod1902) ((lambda (tmp1903) ((lambda (tmp1904) (if tmp1904 (apply (lambda (_1905 e1906) (build-data1065 s1901 (strip1134 e1906 w1900))) tmp1904) ((lambda (_1907) (syntax-violation (quote quote) "bad syntax" (source-wrap1116 e1898 w1900 s1901 mod1902))) tmp1903))) ($sc-dispatch tmp1903 (quote (any any))))) e1898))) (global-extend1085 (quote core) (quote syntax) (letrec ((regen1915 (lambda (x1916) (let ((t1917 (car x1916))) (if (memv t1917 (quote (ref))) (build-annotated1064 #f (cadr x1916)) (if (memv t1917 (quote (primitive))) (build-annotated1064 #f (cadr x1916)) (if (memv t1917 (quote (quote))) (build-data1065 #f (cadr x1916)) (if (memv t1917 (quote (lambda))) (build-annotated1064 #f (list (quote lambda) (cadr x1916) (regen1915 (caddr x1916)))) (if (memv t1917 (quote (map))) (let ((ls1918 (map regen1915 (cdr x1916)))) (build-annotated1064 #f (cons (if (fx=1057 (length ls1918) 2) (build-annotated1064 #f (quote map)) (build-annotated1064 #f (quote map))) ls1918))) (build-annotated1064 #f (cons (build-annotated1064 #f (car x1916)) (map regen1915 (cdr x1916)))))))))))) (gen-vector1914 (lambda (x1919) (cond ((eq? (car x1919) (quote list)) (cons (quote vector) (cdr x1919))) ((eq? (car x1919) (quote quote)) (list (quote quote) (list->vector (cadr x1919)))) (else (list (quote list->vector) x1919))))) (gen-append1913 (lambda (x1920 y1921) (if (equal? y1921 (quote (quote ()))) x1920 (list (quote append) x1920 y1921)))) (gen-cons1912 (lambda (x1922 y1923) (let ((t1924 (car y1923))) (if (memv t1924 (quote (quote))) (if (eq? (car x1922) (quote quote)) (list (quote quote) (cons (cadr x1922) (cadr y1923))) (if (eq? (cadr y1923) (quote ())) (list (quote list) x1922) (list (quote cons) x1922 y1923))) (if (memv t1924 (quote (list))) (cons (quote list) (cons x1922 (cdr y1923))) (list (quote cons) x1922 y1923)))))) (gen-map1911 (lambda (e1925 map-env1926) (let ((formals1927 (map cdr map-env1926)) (actuals1928 (map (lambda (x1929) (list (quote ref) (car x1929))) map-env1926))) (cond ((eq? (car e1925) (quote ref)) (car actuals1928)) ((and-map (lambda (x1930) (and (eq? (car x1930) (quote ref)) (memq (cadr x1930) formals1927))) (cdr e1925)) (cons (quote map) (cons (list (quote primitive) (car e1925)) (map (let ((r1931 (map cons formals1927 actuals1928))) (lambda (x1932) (cdr (assq (cadr x1932) r1931)))) (cdr e1925))))) (else (cons (quote map) (cons (list (quote lambda) formals1927 e1925) actuals1928))))))) (gen-mappend1910 (lambda (e1933 map-env1934) (list (quote apply) (quote (primitive append)) (gen-map1911 e1933 map-env1934)))) (gen-ref1909 (lambda (src1935 var1936 level1937 maps1938) (if (fx=1057 level1937 0) (values var1936 maps1938) (if (null? maps1938) (syntax-violation (quote syntax) "missing ellipsis" src1935) (call-with-values (lambda () (gen-ref1909 src1935 var1936 (fx-1056 level1937 1) (cdr maps1938))) (lambda (outer-var1939 outer-maps1940) (let ((b1941 (assq outer-var1939 (car maps1938)))) (if b1941 (values (cdr b1941) maps1938) (let ((inner-var1942 (gen-var1135 (quote tmp)))) (values inner-var1942 (cons (cons (cons outer-var1939 inner-var1942) (car maps1938)) outer-maps1940))))))))))) (gen-syntax1908 (lambda (src1943 e1944 r1945 maps1946 ellipsis?1947 mod1948) (if (id?1087 e1944) (let ((label1949 (id-var-name1109 e1944 (quote (()))))) (let ((b1950 (lookup1084 label1949 r1945 mod1948))) (if (eq? (binding-type1079 b1950) (quote syntax)) (call-with-values (lambda () (let ((var.lev1951 (binding-value1080 b1950))) (gen-ref1909 src1943 (car var.lev1951) (cdr var.lev1951) maps1946))) (lambda (var1952 maps1953) (values (list (quote ref) var1952) maps1953))) (if (ellipsis?1947 e1944) (syntax-violation (quote syntax) "misplaced ellipsis" src1943) (values (list (quote quote) e1944) maps1946))))) ((lambda (tmp1954) ((lambda (tmp1955) (if (if tmp1955 (apply (lambda (dots1956 e1957) (ellipsis?1947 dots1956)) tmp1955) #f) (apply (lambda (dots1958 e1959) (gen-syntax1908 src1943 e1959 r1945 maps1946 (lambda (x1960) #f) mod1948)) tmp1955) ((lambda (tmp1961) (if (if tmp1961 (apply (lambda (x1962 dots1963 y1964) (ellipsis?1947 dots1963)) tmp1961) #f) (apply (lambda (x1965 dots1966 y1967) (let f1968 ((y1969 y1967) (k1970 (lambda (maps1971) (call-with-values (lambda () (gen-syntax1908 src1943 x1965 r1945 (cons (quote ()) maps1971) ellipsis?1947 mod1948)) (lambda (x1972 maps1973) (if (null? (car maps1973)) (syntax-violation (quote syntax) "extra ellipsis" src1943) (values (gen-map1911 x1972 (car maps1973)) (cdr maps1973)))))))) ((lambda (tmp1974) ((lambda (tmp1975) (if (if tmp1975 (apply (lambda (dots1976 y1977) (ellipsis?1947 dots1976)) tmp1975) #f) (apply (lambda (dots1978 y1979) (f1968 y1979 (lambda (maps1980) (call-with-values (lambda () (k1970 (cons (quote ()) maps1980))) (lambda (x1981 maps1982) (if (null? (car maps1982)) (syntax-violation (quote syntax) "extra ellipsis" src1943) (values (gen-mappend1910 x1981 (car maps1982)) (cdr maps1982)))))))) tmp1975) ((lambda (_1983) (call-with-values (lambda () (gen-syntax1908 src1943 y1969 r1945 maps1946 ellipsis?1947 mod1948)) (lambda (y1984 maps1985) (call-with-values (lambda () (k1970 maps1985)) (lambda (x1986 maps1987) (values (gen-append1913 x1986 y1984) maps1987)))))) tmp1974))) ($sc-dispatch tmp1974 (quote (any . any))))) y1969))) tmp1961) ((lambda (tmp1988) (if tmp1988 (apply (lambda (x1989 y1990) (call-with-values (lambda () (gen-syntax1908 src1943 x1989 r1945 maps1946 ellipsis?1947 mod1948)) (lambda (x1991 maps1992) (call-with-values (lambda () (gen-syntax1908 src1943 y1990 r1945 maps1992 ellipsis?1947 mod1948)) (lambda (y1993 maps1994) (values (gen-cons1912 x1991 y1993) maps1994)))))) tmp1988) ((lambda (tmp1995) (if tmp1995 (apply (lambda (e11996 e21997) (call-with-values (lambda () (gen-syntax1908 src1943 (cons e11996 e21997) r1945 maps1946 ellipsis?1947 mod1948)) (lambda (e1999 maps2000) (values (gen-vector1914 e1999) maps2000)))) tmp1995) ((lambda (_2001) (values (list (quote quote) e1944) maps1946)) tmp1954))) ($sc-dispatch tmp1954 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1954 (quote (any . any)))))) ($sc-dispatch tmp1954 (quote (any any . any)))))) ($sc-dispatch tmp1954 (quote (any any))))) e1944))))) (lambda (e2002 r2003 w2004 s2005 mod2006) (let ((e2007 (source-wrap1116 e2002 w2004 s2005 mod2006))) ((lambda (tmp2008) ((lambda (tmp2009) (if tmp2009 (apply (lambda (_2010 x2011) (call-with-values (lambda () (gen-syntax1908 e2007 x2011 r2003 (quote ()) ellipsis?1132 mod2006)) (lambda (e2012 maps2013) (regen1915 e2012)))) tmp2009) ((lambda (_2014) (syntax-violation (quote syntax) "bad `syntax' form" e2007)) tmp2008))) ($sc-dispatch tmp2008 (quote (any any))))) e2007))))) (global-extend1085 (quote core) (quote lambda) (lambda (e2015 r2016 w2017 s2018 mod2019) ((lambda (tmp2020) ((lambda (tmp2021) (if tmp2021 (apply (lambda (_2022 c2023) (chi-lambda-clause1128 (source-wrap1116 e2015 w2017 s2018 mod2019) #f c2023 r2016 w2017 mod2019 (lambda (vars2024 docstring2025 body2026) (build-annotated1064 s2018 (cons (quote lambda) (cons vars2024 (append (if docstring2025 (list docstring2025) (quote ())) (list body2026)))))))) tmp2021) (syntax-violation #f "source expression failed to match any pattern" tmp2020))) ($sc-dispatch tmp2020 (quote (any . any))))) e2015))) (global-extend1085 (quote core) (quote let) (letrec ((chi-let2027 (lambda (e2028 r2029 w2030 s2031 mod2032 constructor2033 ids2034 vals2035 exps2036) (if (not (valid-bound-ids?1112 ids2034)) (syntax-violation (quote let) "duplicate bound variable" e2028) (let ((labels2037 (gen-labels1093 ids2034)) (new-vars2038 (map gen-var1135 ids2034))) (let ((nw2039 (make-binding-wrap1104 ids2034 labels2037 w2030)) (nr2040 (extend-var-env1082 labels2037 new-vars2038 r2029))) (constructor2033 s2031 new-vars2038 (map (lambda (x2041) (chi1123 x2041 r2029 w2030 mod2032)) vals2035) (chi-body1127 exps2036 (source-wrap1116 e2028 nw2039 s2031 mod2032) nr2040 nw2039 mod2032)))))))) (lambda (e2042 r2043 w2044 s2045 mod2046) ((lambda (tmp2047) ((lambda (tmp2048) (if tmp2048 (apply (lambda (_2049 id2050 val2051 e12052 e22053) (chi-let2027 e2042 r2043 w2044 s2045 mod2046 build-let1067 id2050 val2051 (cons e12052 e22053))) tmp2048) ((lambda (tmp2057) (if (if tmp2057 (apply (lambda (_2058 f2059 id2060 val2061 e12062 e22063) (id?1087 f2059)) tmp2057) #f) (apply (lambda (_2064 f2065 id2066 val2067 e12068 e22069) (chi-let2027 e2042 r2043 w2044 s2045 mod2046 build-named-let1068 (cons f2065 id2066) val2067 (cons e12068 e22069))) tmp2057) ((lambda (_2073) (syntax-violation (quote let) "bad let" (source-wrap1116 e2042 w2044 s2045 mod2046))) tmp2047))) ($sc-dispatch tmp2047 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2047 (quote (any #(each (any any)) any . each-any))))) e2042)))) (global-extend1085 (quote core) (quote letrec) (lambda (e2074 r2075 w2076 s2077 mod2078) ((lambda (tmp2079) ((lambda (tmp2080) (if tmp2080 (apply (lambda (_2081 id2082 val2083 e12084 e22085) (let ((ids2086 id2082)) (if (not (valid-bound-ids?1112 ids2086)) (syntax-violation (quote letrec) "duplicate bound variable" e2074) (let ((labels2088 (gen-labels1093 ids2086)) (new-vars2089 (map gen-var1135 ids2086))) (let ((w2090 (make-binding-wrap1104 ids2086 labels2088 w2076)) (r2091 (extend-var-env1082 labels2088 new-vars2089 r2075))) (build-letrec1069 s2077 new-vars2089 (map (lambda (x2092) (chi1123 x2092 r2091 w2090 mod2078)) val2083) (chi-body1127 (cons e12084 e22085) (source-wrap1116 e2074 w2090 s2077 mod2078) r2091 w2090 mod2078))))))) tmp2080) ((lambda (_2095) (syntax-violation (quote letrec) "bad letrec" (source-wrap1116 e2074 w2076 s2077 mod2078))) tmp2079))) ($sc-dispatch tmp2079 (quote (any #(each (any any)) any . each-any))))) e2074))) (global-extend1085 (quote core) (quote set!) (lambda (e2096 r2097 w2098 s2099 mod2100) ((lambda (tmp2101) ((lambda (tmp2102) (if (if tmp2102 (apply (lambda (_2103 id2104 val2105) (id?1087 id2104)) tmp2102) #f) (apply (lambda (_2106 id2107 val2108) (let ((val2109 (chi1123 val2108 r2097 w2098 mod2100)) (n2110 (id-var-name1109 id2107 w2098))) (let ((b2111 (lookup1084 n2110 r2097 mod2100))) (let ((t2112 (binding-type1079 b2111))) (if (memv t2112 (quote (lexical))) (build-annotated1064 s2099 (list (quote set!) (binding-value1080 b2111) val2109)) (if (memv t2112 (quote (global))) (build-annotated1064 s2099 (list (quote set!) (if mod2100 (make-module-ref (cdr mod2100) n2110 (car mod2100)) (make-module-ref mod2100 n2110 (quote bare))) val2109)) (if (memv t2112 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1115 id2107 w2098 mod2100)) (syntax-violation (quote set!) "bad set!" (source-wrap1116 e2096 w2098 s2099 mod2100))))))))) tmp2102) ((lambda (tmp2113) (if tmp2113 (apply (lambda (_2114 head2115 tail2116 val2117) (call-with-values (lambda () (syntax-type1121 head2115 r2097 (quote (())) #f #f mod2100)) (lambda (type2118 value2119 ee2120 ww2121 ss2122 modmod2123) (let ((t2124 type2118)) (if (memv t2124 (quote (module-ref))) (let ((val2125 (chi1123 val2117 r2097 w2098 mod2100))) (call-with-values (lambda () (value2119 (cons head2115 tail2116))) (lambda (id2127 mod2128) (build-annotated1064 s2099 (list (quote set!) (if mod2128 (make-module-ref (cdr mod2128) id2127 (car mod2128)) (make-module-ref mod2128 id2127 (quote bare))) val2125))))) (build-annotated1064 s2099 (cons (chi1123 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head2115) r2097 w2098 mod2100) (map (lambda (e2129) (chi1123 e2129 r2097 w2098 mod2100)) (append tail2116 (list val2117)))))))))) tmp2113) ((lambda (_2131) (syntax-violation (quote set!) "bad set!" (source-wrap1116 e2096 w2098 s2099 mod2100))) tmp2101))) ($sc-dispatch tmp2101 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2101 (quote (any any any))))) e2096))) (global-extend1085 (quote module-ref) (quote @) (lambda (e2132) ((lambda (tmp2133) ((lambda (tmp2134) (if (if tmp2134 (apply (lambda (_2135 mod2136 id2137) (and (and-map id?1087 mod2136) (id?1087 id2137))) tmp2134) #f) (apply (lambda (_2139 mod2140 id2141) (values (syntax->datum id2141) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2140)))) tmp2134) (syntax-violation #f "source expression failed to match any pattern" tmp2133))) ($sc-dispatch tmp2133 (quote (any each-any any))))) e2132))) (global-extend1085 (quote module-ref) (quote @@) (lambda (e2143) ((lambda (tmp2144) ((lambda (tmp2145) (if (if tmp2145 (apply (lambda (_2146 mod2147 id2148) (and (and-map id?1087 mod2147) (id?1087 id2148))) tmp2145) #f) (apply (lambda (_2150 mod2151 id2152) (values (syntax->datum id2152) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2151)))) tmp2145) (syntax-violation #f "source expression failed to match any pattern" tmp2144))) ($sc-dispatch tmp2144 (quote (any each-any any))))) e2143))) (global-extend1085 (quote begin) (quote begin) (quote ())) (global-extend1085 (quote define) (quote define) (quote ())) (global-extend1085 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1085 (quote eval-when) (quote eval-when) (quote ())) (global-extend1085 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2157 (lambda (x2158 keys2159 clauses2160 r2161 mod2162) (if (null? clauses2160) (build-annotated1064 #f (list (build-annotated1064 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2158)) ((lambda (tmp2163) ((lambda (tmp2164) (if tmp2164 (apply (lambda (pat2165 exp2166) (if (and (id?1087 pat2165) (and-map (lambda (x2167) (not (free-id=?1110 pat2165 x2167))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys2159))) (let ((labels2168 (list (gen-label1092))) (var2169 (gen-var1135 pat2165))) (build-annotated1064 #f (list (build-annotated1064 #f (list (quote lambda) (list var2169) (chi1123 exp2166 (extend-env1081 labels2168 (list (cons (quote syntax) (cons var2169 0))) r2161) (make-binding-wrap1104 (list pat2165) labels2168 (quote (()))) mod2162))) x2158))) (gen-clause2156 x2158 keys2159 (cdr clauses2160) r2161 pat2165 #t exp2166 mod2162))) tmp2164) ((lambda (tmp2170) (if tmp2170 (apply (lambda (pat2171 fender2172 exp2173) (gen-clause2156 x2158 keys2159 (cdr clauses2160) r2161 pat2171 fender2172 exp2173 mod2162)) tmp2170) ((lambda (_2174) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2160))) tmp2163))) ($sc-dispatch tmp2163 (quote (any any any)))))) ($sc-dispatch tmp2163 (quote (any any))))) (car clauses2160))))) (gen-clause2156 (lambda (x2175 keys2176 clauses2177 r2178 pat2179 fender2180 exp2181 mod2182) (call-with-values (lambda () (convert-pattern2154 pat2179 keys2176)) (lambda (p2183 pvars2184) (cond ((not (distinct-bound-ids?1113 (map car pvars2184))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2179)) ((not (and-map (lambda (x2185) (not (ellipsis?1132 (car x2185)))) pvars2184)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2179)) (else (let ((y2186 (gen-var1135 (quote tmp)))) (build-annotated1064 #f (list (build-annotated1064 #f (list (quote lambda) (list y2186) (let ((y2187 (build-annotated1064 #f y2186))) (build-annotated1064 #f (list (quote if) ((lambda (tmp2188) ((lambda (tmp2189) (if tmp2189 (apply (lambda () y2187) tmp2189) ((lambda (_2190) (build-annotated1064 #f (list (quote if) y2187 (build-dispatch-call2155 pvars2184 fender2180 y2187 r2178 mod2182) (build-data1065 #f #f)))) tmp2188))) ($sc-dispatch tmp2188 (quote #(atom #t))))) fender2180) (build-dispatch-call2155 pvars2184 exp2181 y2187 r2178 mod2182) (gen-syntax-case2157 x2175 keys2176 clauses2177 r2178 mod2182)))))) (if (eq? p2183 (quote any)) (build-annotated1064 #f (list (build-annotated1064 #f (quote list)) x2175)) (build-annotated1064 #f (list (build-annotated1064 #f (quote $sc-dispatch)) x2175 (build-data1065 #f p2183))))))))))))) (build-dispatch-call2155 (lambda (pvars2191 exp2192 y2193 r2194 mod2195) (let ((ids2196 (map car pvars2191)) (levels2197 (map cdr pvars2191))) (let ((labels2198 (gen-labels1093 ids2196)) (new-vars2199 (map gen-var1135 ids2196))) (build-annotated1064 #f (list (build-annotated1064 #f (quote apply)) (build-annotated1064 #f (list (quote lambda) new-vars2199 (chi1123 exp2192 (extend-env1081 labels2198 (map (lambda (var2200 level2201) (cons (quote syntax) (cons var2200 level2201))) new-vars2199 (map cdr pvars2191)) r2194) (make-binding-wrap1104 ids2196 labels2198 (quote (()))) mod2195))) y2193)))))) (convert-pattern2154 (lambda (pattern2202 keys2203) (let cvt2204 ((p2205 pattern2202) (n2206 0) (ids2207 (quote ()))) (if (id?1087 p2205) (if (bound-id-member?1114 p2205 keys2203) (values (vector (quote free-id) p2205) ids2207) (values (quote any) (cons (cons p2205 n2206) ids2207))) ((lambda (tmp2208) ((lambda (tmp2209) (if (if tmp2209 (apply (lambda (x2210 dots2211) (ellipsis?1132 dots2211)) tmp2209) #f) (apply (lambda (x2212 dots2213) (call-with-values (lambda () (cvt2204 x2212 (fx+1055 n2206 1) ids2207)) (lambda (p2214 ids2215) (values (if (eq? p2214 (quote any)) (quote each-any) (vector (quote each) p2214)) ids2215)))) tmp2209) ((lambda (tmp2216) (if tmp2216 (apply (lambda (x2217 y2218) (call-with-values (lambda () (cvt2204 y2218 n2206 ids2207)) (lambda (y2219 ids2220) (call-with-values (lambda () (cvt2204 x2217 n2206 ids2220)) (lambda (x2221 ids2222) (values (cons x2221 y2219) ids2222)))))) tmp2216) ((lambda (tmp2223) (if tmp2223 (apply (lambda () (values (quote ()) ids2207)) tmp2223) ((lambda (tmp2224) (if tmp2224 (apply (lambda (x2225) (call-with-values (lambda () (cvt2204 x2225 n2206 ids2207)) (lambda (p2227 ids2228) (values (vector (quote vector) p2227) ids2228)))) tmp2224) ((lambda (x2229) (values (vector (quote atom) (strip1134 p2205 (quote (())))) ids2207)) tmp2208))) ($sc-dispatch tmp2208 (quote #(vector each-any)))))) ($sc-dispatch tmp2208 (quote ()))))) ($sc-dispatch tmp2208 (quote (any . any)))))) ($sc-dispatch tmp2208 (quote (any any))))) p2205)))))) (lambda (e2230 r2231 w2232 s2233 mod2234) (let ((e2235 (source-wrap1116 e2230 w2232 s2233 mod2234))) ((lambda (tmp2236) ((lambda (tmp2237) (if tmp2237 (apply (lambda (_2238 val2239 key2240 m2241) (if (and-map (lambda (x2242) (and (id?1087 x2242) (not (ellipsis?1132 x2242)))) key2240) (let ((x2244 (gen-var1135 (quote tmp)))) (build-annotated1064 s2233 (list (build-annotated1064 #f (list (quote lambda) (list x2244) (gen-syntax-case2157 (build-annotated1064 #f x2244) key2240 m2241 r2231 mod2234))) (chi1123 val2239 r2231 (quote (())) mod2234)))) (syntax-violation (quote syntax-case) "invalid literals list" e2235))) tmp2237) (syntax-violation #f "source expression failed to match any pattern" tmp2236))) ($sc-dispatch tmp2236 (quote (any any each-any . each-any))))) e2235))))) (set! sc-expand (let ((m2247 (quote e)) (esew2248 (quote (eval)))) (lambda (x2249) (if (and (pair? x2249) (equal? (car x2249) noexpand1054)) (cadr x2249) (chi-top1122 x2249 (quote ()) (quote ((top))) m2247 esew2248 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2250 (quote e)) (esew2251 (quote (eval)))) (lambda (x2253 . rest2252) (if (and (pair? x2253) (equal? (car x2253) noexpand1054)) (cadr x2253) (chi-top1122 x2253 (quote ()) (quote ((top))) (if (null? rest2252) m2250 (car rest2252)) (if (or (null? rest2252) (null? (cdr rest2252))) esew2251 (cadr rest2252)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2254) (nonsymbol-id?1086 x2254))) (set! datum->syntax (lambda (id2255 datum2256) (make-syntax-object1070 datum2256 (syntax-object-wrap1073 id2255) #f))) (set! syntax->datum (lambda (x2257) (strip1134 x2257 (quote (()))))) (set! generate-temporaries (lambda (ls2258) (begin (let ((x2259 ls2258)) (if (not (list? x2259)) (error-hook1061 (quote generate-temporaries) "invalid argument" x2259))) (map (lambda (x2260) (wrap1115 (gensym) (quote ((top))) #f)) ls2258)))) (set! free-identifier=? (lambda (x2261 y2262) (begin (let ((x2263 x2261)) (if (not (nonsymbol-id?1086 x2263)) (error-hook1061 (quote free-identifier=?) "invalid argument" x2263))) (let ((x2264 y2262)) (if (not (nonsymbol-id?1086 x2264)) (error-hook1061 (quote free-identifier=?) "invalid argument" x2264))) (free-id=?1110 x2261 y2262)))) (set! bound-identifier=? (lambda (x2265 y2266) (begin (let ((x2267 x2265)) (if (not (nonsymbol-id?1086 x2267)) (error-hook1061 (quote bound-identifier=?) "invalid argument" x2267))) (let ((x2268 y2266)) (if (not (nonsymbol-id?1086 x2268)) (error-hook1061 (quote bound-identifier=?) "invalid argument" x2268))) (bound-id=?1111 x2265 y2266)))) (set! syntax-violation (lambda (who2272 message2271 form2270 . subform2269) (begin (let ((x2273 who2272)) (if (not ((lambda (x2274) (or (not x2274) (string? x2274) (symbol? x2274))) x2273)) (error-hook1061 (quote syntax-violation) "invalid argument" x2273))) (let ((x2275 message2271)) (if (not (string? x2275)) (error-hook1061 (quote syntax-violation) "invalid argument" x2275))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2272 "~a: " "") "~a " (if (null? subform2269) "in ~a" "in subform `~s' of `~s'")) (let ((tail2276 (cons message2271 (map (lambda (x2277) (strip1134 x2277 (quote (())))) (append subform2269 (list form2270)))))) (if who2272 (cons who2272 tail2276) tail2276)) #f)))) (letrec ((match2282 (lambda (e2283 p2284 w2285 r2286 mod2287) (cond ((not r2286) #f) ((eq? p2284 (quote any)) (cons (wrap1115 e2283 w2285 mod2287) r2286)) ((syntax-object?1071 e2283) (match*2281 (let ((e2288 (syntax-object-expression1072 e2283))) (if (annotation? e2288) (annotation-expression e2288) e2288)) p2284 (join-wraps1106 w2285 (syntax-object-wrap1073 e2283)) r2286 (syntax-object-module1074 e2283))) (else (match*2281 (let ((e2289 e2283)) (if (annotation? e2289) (annotation-expression e2289) e2289)) p2284 w2285 r2286 mod2287))))) (match*2281 (lambda (e2290 p2291 w2292 r2293 mod2294) (cond ((null? p2291) (and (null? e2290) r2293)) ((pair? p2291) (and (pair? e2290) (match2282 (car e2290) (car p2291) w2292 (match2282 (cdr e2290) (cdr p2291) w2292 r2293 mod2294) mod2294))) ((eq? p2291 (quote each-any)) (let ((l2295 (match-each-any2279 e2290 w2292 mod2294))) (and l2295 (cons l2295 r2293)))) (else (let ((t2296 (vector-ref p2291 0))) (if (memv t2296 (quote (each))) (if (null? e2290) (match-empty2280 (vector-ref p2291 1) r2293) (let ((l2297 (match-each2278 e2290 (vector-ref p2291 1) w2292 mod2294))) (and l2297 (let collect2298 ((l2299 l2297)) (if (null? (car l2299)) r2293 (cons (map car l2299) (collect2298 (map cdr l2299)))))))) (if (memv t2296 (quote (free-id))) (and (id?1087 e2290) (free-id=?1110 (wrap1115 e2290 w2292 mod2294) (vector-ref p2291 1)) r2293) (if (memv t2296 (quote (atom))) (and (equal? (vector-ref p2291 1) (strip1134 e2290 w2292)) r2293) (if (memv t2296 (quote (vector))) (and (vector? e2290) (match2282 (vector->list e2290) (vector-ref p2291 1) w2292 r2293 mod2294))))))))))) (match-empty2280 (lambda (p2300 r2301) (cond ((null? p2300) r2301) ((eq? p2300 (quote any)) (cons (quote ()) r2301)) ((pair? p2300) (match-empty2280 (car p2300) (match-empty2280 (cdr p2300) r2301))) ((eq? p2300 (quote each-any)) (cons (quote ()) r2301)) (else (let ((t2302 (vector-ref p2300 0))) (if (memv t2302 (quote (each))) (match-empty2280 (vector-ref p2300 1) r2301) (if (memv t2302 (quote (free-id atom))) r2301 (if (memv t2302 (quote (vector))) (match-empty2280 (vector-ref p2300 1) r2301))))))))) (match-each-any2279 (lambda (e2303 w2304 mod2305) (cond ((annotation? e2303) (match-each-any2279 (annotation-expression e2303) w2304 mod2305)) ((pair? e2303) (let ((l2306 (match-each-any2279 (cdr e2303) w2304 mod2305))) (and l2306 (cons (wrap1115 (car e2303) w2304 mod2305) l2306)))) ((null? e2303) (quote ())) ((syntax-object?1071 e2303) (match-each-any2279 (syntax-object-expression1072 e2303) (join-wraps1106 w2304 (syntax-object-wrap1073 e2303)) mod2305)) (else #f)))) (match-each2278 (lambda (e2307 p2308 w2309 mod2310) (cond ((annotation? e2307) (match-each2278 (annotation-expression e2307) p2308 w2309 mod2310)) ((pair? e2307) (let ((first2311 (match2282 (car e2307) p2308 w2309 (quote ()) mod2310))) (and first2311 (let ((rest2312 (match-each2278 (cdr e2307) p2308 w2309 mod2310))) (and rest2312 (cons first2311 rest2312)))))) ((null? e2307) (quote ())) ((syntax-object?1071 e2307) (match-each2278 (syntax-object-expression1072 e2307) p2308 (join-wraps1106 w2309 (syntax-object-wrap1073 e2307)) (syntax-object-module1074 e2307))) (else #f))))) (set! $sc-dispatch (lambda (e2313 p2314) (cond ((eq? p2314 (quote any)) (list e2313)) ((syntax-object?1071 e2313) (match*2281 (let ((e2315 (syntax-object-expression1072 e2313))) (if (annotation? e2315) (annotation-expression e2315) e2315)) p2314 (syntax-object-wrap1073 e2313) (quote ()) (syntax-object-module1074 e2313))) (else (match*2281 (let ((e2316 e2313)) (if (annotation? e2316) (annotation-expression e2316) e2316)) p2314 (quote (())) (quote ()) #f)))))))))
(define with-syntax (make-syncase-macro (quote macro) (lambda (x2317) ((lambda (tmp2318) ((lambda (tmp2319) (if tmp2319 (apply (lambda (_2320 e12321 e22322) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12321 e22322))) tmp2319) ((lambda (tmp2324) (if tmp2324 (apply (lambda (_2325 out2326 in2327 e12328 e22329) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2327 (quote ()) (list out2326 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12328 e22329))))) tmp2324) ((lambda (tmp2331) (if tmp2331 (apply (lambda (_2332 out2333 in2334 e12335 e22336) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2334) (quote ()) (list out2333 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12335 e22336))))) tmp2331) (syntax-violation #f "source expression failed to match any pattern" tmp2318))) ($sc-dispatch tmp2318 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2318 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2318 (quote (any () any . each-any))))) x2317))))
(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2340) ((lambda (tmp2341) ((lambda (tmp2342) (if tmp2342 (apply (lambda (_2343 k2344 keyword2345 pattern2346 template2347) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k2344 (map (lambda (tmp2350 tmp2349) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2349) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2350))) template2347 pattern2346)))))) tmp2342) (syntax-violation #f "source expression failed to match any pattern" tmp2341))) ($sc-dispatch tmp2341 (quote (any each-any . #(each ((any . any) any))))))) x2340))))
(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2351) ((lambda (tmp2352) ((lambda (tmp2353) (if (if tmp2353 (apply (lambda (let*2354 x2355 v2356 e12357 e22358) (and-map identifier? x2355)) tmp2353) #f) (apply (lambda (let*2360 x2361 v2362 e12363 e22364) (let f2365 ((bindings2366 (map list x2361 v2362))) (if (null? bindings2366) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e12363 e22364))) ((lambda (tmp2370) ((lambda (tmp2371) (if tmp2371 (apply (lambda (body2372 binding2373) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding2373) body2372)) tmp2371) (syntax-violation #f "source expression failed to match any pattern" tmp2370))) ($sc-dispatch tmp2370 (quote (any any))))) (list (f2365 (cdr bindings2366)) (car bindings2366)))))) tmp2353) (syntax-violation #f "source expression failed to match any pattern" tmp2352))) ($sc-dispatch tmp2352 (quote (any #(each (any any)) any . each-any))))) x2351))))
(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2374) ((lambda (tmp2375) ((lambda (tmp2376) (if tmp2376 (apply (lambda (_2377 var2378 init2379 step2380 e02381 e12382 c2383) ((lambda (tmp2384) ((lambda (tmp2385) (if tmp2385 (apply (lambda (step2386) ((lambda (tmp2387) ((lambda (tmp2388) (if tmp2388 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2378 init2379) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02381) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2383 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2386))))))) tmp2388) ((lambda (tmp2393) (if tmp2393 (apply (lambda (e12394 e22395) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2378 init2379) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02381 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e12394 e22395)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2383 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2386))))))) tmp2393) (syntax-violation #f "source expression failed to match any pattern" tmp2387))) ($sc-dispatch tmp2387 (quote (any . each-any)))))) ($sc-dispatch tmp2387 (quote ())))) e12382)) tmp2385) (syntax-violation #f "source expression failed to match any pattern" tmp2384))) ($sc-dispatch tmp2384 (quote each-any)))) (map (lambda (v2402 s2403) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda () v2402) tmp2405) ((lambda (tmp2406) (if tmp2406 (apply (lambda (e2407) e2407) tmp2406) ((lambda (_2408) (syntax-violation (quote do) "bad step expression" orig-x2374 s2403)) tmp2404))) ($sc-dispatch tmp2404 (quote (any)))))) ($sc-dispatch tmp2404 (quote ())))) s2403)) var2378 step2380))) tmp2376) (syntax-violation #f "source expression failed to match any pattern" tmp2375))) ($sc-dispatch tmp2375 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2374))))
(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2411 (lambda (x2415 y2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (x2419 y2420) ((lambda (tmp2421) ((lambda (tmp2422) (if tmp2422 (apply (lambda (dy2423) ((lambda (tmp2424) ((lambda (tmp2425) (if tmp2425 (apply (lambda (dx2426) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx2426 dy2423))) tmp2425) ((lambda (_2427) (if (null? dy2423) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2419) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2419 y2420))) tmp2424))) ($sc-dispatch tmp2424 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x2419)) tmp2422) ((lambda (tmp2428) (if tmp2428 (apply (lambda (stuff2429) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x2419 stuff2429))) tmp2428) ((lambda (else2430) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2419 y2420)) tmp2421))) ($sc-dispatch tmp2421 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp2421 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y2420)) tmp2418) (syntax-violation #f "source expression failed to match any pattern" tmp2417))) ($sc-dispatch tmp2417 (quote (any any))))) (list x2415 y2416)))) (quasiappend2412 (lambda (x2431 y2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda (x2435 y2436) ((lambda (tmp2437) ((lambda (tmp2438) (if tmp2438 (apply (lambda () x2435) tmp2438) ((lambda (_2439) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2435 y2436)) tmp2437))) ($sc-dispatch tmp2437 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y2436)) tmp2434) (syntax-violation #f "source expression failed to match any pattern" tmp2433))) ($sc-dispatch tmp2433 (quote (any any))))) (list x2431 y2432)))) (quasivector2413 (lambda (x2440) ((lambda (tmp2441) ((lambda (x2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (x2445) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x2445))) tmp2444) ((lambda (tmp2447) (if tmp2447 (apply (lambda (x2448) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2448)) tmp2447) ((lambda (_2450) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2442)) tmp2443))) ($sc-dispatch tmp2443 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp2443 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x2442)) tmp2441)) x2440))) (quasi2414 (lambda (p2451 lev2452) ((lambda (tmp2453) ((lambda (tmp2454) (if tmp2454 (apply (lambda (p2455) (if (= lev2452 0) p2455 (quasicons2411 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2414 (list p2455) (- lev2452 1))))) tmp2454) ((lambda (tmp2456) (if tmp2456 (apply (lambda (p2457 q2458) (if (= lev2452 0) (quasiappend2412 p2457 (quasi2414 q2458 lev2452)) (quasicons2411 (quasicons2411 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2414 (list p2457) (- lev2452 1))) (quasi2414 q2458 lev2452)))) tmp2456) ((lambda (tmp2459) (if tmp2459 (apply (lambda (p2460) (quasicons2411 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2414 (list p2460) (+ lev2452 1)))) tmp2459) ((lambda (tmp2461) (if tmp2461 (apply (lambda (p2462 q2463) (quasicons2411 (quasi2414 p2462 lev2452) (quasi2414 q2463 lev2452))) tmp2461) ((lambda (tmp2464) (if tmp2464 (apply (lambda (x2465) (quasivector2413 (quasi2414 x2465 lev2452))) tmp2464) ((lambda (p2467) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p2467)) tmp2453))) ($sc-dispatch tmp2453 (quote #(vector each-any)))))) ($sc-dispatch tmp2453 (quote (any . any)))))) ($sc-dispatch tmp2453 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp2453 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp2453 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p2451)))) (lambda (x2468) ((lambda (tmp2469) ((lambda (tmp2470) (if tmp2470 (apply (lambda (_2471 e2472) (quasi2414 e2472 0)) tmp2470) (syntax-violation #f "source expression failed to match any pattern" tmp2469))) ($sc-dispatch tmp2469 (quote (any any))))) x2468)))))
(define include (make-syncase-macro (quote macro) (lambda (x2473) (letrec ((read-file2474 (lambda (fn2475 k2476) (let ((p2477 (open-input-file fn2475))) (let f2478 ((x2479 (read p2477))) (if (eof-object? x2479) (begin (close-input-port p2477) (quote ())) (cons (datum->syntax k2476 x2479) (f2478 (read p2477))))))))) ((lambda (tmp2480) ((lambda (tmp2481) (if tmp2481 (apply (lambda (k2482 filename2483) (let ((fn2484 (syntax->datum filename2483))) ((lambda (tmp2485) ((lambda (tmp2486) (if tmp2486 (apply (lambda (exp2487) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp2487)) tmp2486) (syntax-violation #f "source expression failed to match any pattern" tmp2485))) ($sc-dispatch tmp2485 (quote each-any)))) (read-file2474 fn2484 k2482)))) tmp2481) (syntax-violation #f "source expression failed to match any pattern" tmp2480))) ($sc-dispatch tmp2480 (quote (any any))))) x2473)))))
(define unquote (make-syncase-macro (quote macro) (lambda (x2489) ((lambda (tmp2490) ((lambda (tmp2491) (if tmp2491 (apply (lambda (_2492 e2493) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2493))) tmp2491) (syntax-violation #f "source expression failed to match any pattern" tmp2490))) ($sc-dispatch tmp2490 (quote (any any))))) x2489))))
(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2494) ((lambda (tmp2495) ((lambda (tmp2496) (if tmp2496 (apply (lambda (_2497 e2498) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2498))) tmp2496) (syntax-violation #f "source expression failed to match any pattern" tmp2495))) ($sc-dispatch tmp2495 (quote (any any))))) x2494))))
(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2499) ((lambda (tmp2500) ((lambda (tmp2501) (if tmp2501 (apply (lambda (_2502 e2503 m12504 m22505) ((lambda (tmp2506) ((lambda (body2507) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2503)) body2507)) tmp2506)) (let f2508 ((clause2509 m12504) (clauses2510 m22505)) (if (null? clauses2510) ((lambda (tmp2512) ((lambda (tmp2513) (if tmp2513 (apply (lambda (e12514 e22515) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12514 e22515))) tmp2513) ((lambda (tmp2517) (if tmp2517 (apply (lambda (k2518 e12519 e22520) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2518)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12519 e22520)))) tmp2517) ((lambda (_2523) (syntax-violation (quote case) "bad clause" x2499 clause2509)) tmp2512))) ($sc-dispatch tmp2512 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2512 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause2509) ((lambda (tmp2524) ((lambda (rest2525) ((lambda (tmp2526) ((lambda (tmp2527) (if tmp2527 (apply (lambda (k2528 e12529 e22530) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2528)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12529 e22530)) rest2525)) tmp2527) ((lambda (_2533) (syntax-violation (quote case) "bad clause" x2499 clause2509)) tmp2526))) ($sc-dispatch tmp2526 (quote (each-any any . each-any))))) clause2509)) tmp2524)) (f2508 (car clauses2510) (cdr clauses2510))))))) tmp2501) (syntax-violation #f "source expression failed to match any pattern" tmp2500))) ($sc-dispatch tmp2500 (quote (any any any . each-any))))) x2499))))
(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2534) ((lambda (tmp2535) ((lambda (tmp2536) (if tmp2536 (apply (lambda (_2537 e2538) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2538)) (list (cons _2537 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e2538 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp2536) (syntax-violation #f "source expression failed to match any pattern" tmp2535))) ($sc-dispatch tmp2535 (quote (any any))))) x2534))))