1 (eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
3 (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-list1135 (lambda (vars1340) (let lvl1341 ((vars1342 vars1340) (ls1343 (quote ())) (w1344 (quote (())))) (cond ((pair? vars1342) (lvl1341 (cdr vars1342) (cons (wrap1114 (car vars1342) w1344 #f) ls1343) w1344)) ((id?1086 vars1342) (cons (wrap1114 vars1342 w1344 #f) ls1343)) ((null? vars1342) ls1343) ((syntax-object?1070 vars1342) (lvl1341 (syntax-object-expression1071 vars1342) ls1343 (join-wraps1105 w1344 (syntax-object-wrap1072 vars1342)))) ((annotation? vars1342) (lvl1341 (annotation-expression vars1342) ls1343 w1344)) (else (cons vars1342 ls1343)))))) (gen-var1134 (lambda (id1345) (let ((id1346 (if (syntax-object?1070 id1345) (syntax-object-expression1071 id1345) id1345))) (if (annotation? id1346) (build-annotated1063 (annotation-source id1346) (gensym (symbol->string (annotation-expression id1346)))) (build-annotated1063 #f (gensym (symbol->string id1346))))))) (strip1133 (lambda (x1347 w1348) (if (memq (quote top) (wrap-marks1089 w1348)) (if (or (annotation? x1347) (and (pair? x1347) (annotation? (car x1347)))) (strip-annotation1132 x1347 #f) x1347) (let f1349 ((x1350 x1347)) (cond ((syntax-object?1070 x1350) (strip1133 (syntax-object-expression1071 x1350) (syntax-object-wrap1072 x1350))) ((pair? x1350) (let ((a1351 (f1349 (car x1350))) (d1352 (f1349 (cdr x1350)))) (if (and (eq? a1351 (car x1350)) (eq? d1352 (cdr x1350))) x1350 (cons a1351 d1352)))) ((vector? x1350) (let ((old1353 (vector->list x1350))) (let ((new1354 (map f1349 old1353))) (if (and-map*1002 eq? old1353 new1354) x1350 (list->vector new1354))))) (else x1350)))))) (strip-annotation1132 (lambda (x1355 parent1356) (cond ((pair? x1355) (let ((new1357 (cons #f #f))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1357)) (set-car! new1357 (strip-annotation1132 (car x1355) #f)) (set-cdr! new1357 (strip-annotation1132 (cdr x1355) #f)) new1357))) ((annotation? x1355) (or (annotation-stripped x1355) (strip-annotation1132 (annotation-expression x1355) x1355))) ((vector? x1355) (let ((new1358 (make-vector (vector-length x1355)))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1358)) (let loop1359 ((i1360 (- (vector-length x1355) 1))) (unless (fx<1058 i1360 0) (vector-set! new1358 i1360 (strip-annotation1132 (vector-ref x1355 i1360) #f)) (loop1359 (fx-1056 i1360 1)))) new1358))) (else x1355)))) (ellipsis?1131 (lambda (x1361) (and (nonsymbol-id?1085 x1361) (free-id=?1109 x1361 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-void1130 (lambda () (build-annotated1063 #f (cons (build-annotated1063 #f (quote if)) (quote (#f #f)))))) (eval-local-transformer1129 (lambda (expanded1362 mod1363) (let ((p1364 (local-eval-hook1060 expanded1362 mod1363))) (if (procedure? p1364) p1364 (syntax-violation #f "nonprocedure transformer" p1364))))) (chi-local-syntax1128 (lambda (rec?1365 e1366 r1367 w1368 s1369 mod1370 k1371) ((lambda (tmp1372) ((lambda (tmp1373) (if tmp1373 (apply (lambda (_1374 id1375 val1376 e11377 e21378) (let ((ids1379 id1375)) (if (not (valid-bound-ids?1111 ids1379)) (syntax-violation #f "duplicate bound keyword" e1366) (let ((labels1381 (gen-labels1092 ids1379))) (let ((new-w1382 (make-binding-wrap1103 ids1379 labels1381 w1368))) (k1371 (cons e11377 e21378) (extend-env1080 labels1381 (let ((w1384 (if rec?1365 new-w1382 w1368)) (trans-r1385 (macros-only-env1082 r1367))) (map (lambda (x1386) (cons (quote macro) (eval-local-transformer1129 (chi1122 x1386 trans-r1385 w1384 mod1370) mod1370))) val1376)) r1367) new-w1382 s1369 mod1370)))))) tmp1373) ((lambda (_1388) (syntax-violation #f "bad local syntax definition" (source-wrap1115 e1366 w1368 s1369 mod1370))) tmp1372))) ($sc-dispatch tmp1372 (quote (any #(each (any any)) any . each-any))))) e1366))) (chi-lambda-clause1127 (lambda (e1389 docstring1390 c1391 r1392 w1393 mod1394 k1395) ((lambda (tmp1396) ((lambda (tmp1397) (if (if tmp1397 (apply (lambda (args1398 doc1399 e11400 e21401) (and (string? (syntax->datum doc1399)) (not docstring1390))) tmp1397) #f) (apply (lambda (args1402 doc1403 e11404 e21405) (chi-lambda-clause1127 e1389 doc1403 (cons args1402 (cons e11404 e21405)) r1392 w1393 mod1394 k1395)) tmp1397) ((lambda (tmp1407) (if tmp1407 (apply (lambda (id1408 e11409 e21410) (let ((ids1411 id1408)) (if (not (valid-bound-ids?1111 ids1411)) (syntax-violation (quote lambda) "invalid parameter list" e1389) (let ((labels1413 (gen-labels1092 ids1411)) (new-vars1414 (map gen-var1134 ids1411))) (k1395 new-vars1414 docstring1390 (chi-body1126 (cons e11409 e21410) e1389 (extend-var-env1081 labels1413 new-vars1414 r1392) (make-binding-wrap1103 ids1411 labels1413 w1393) mod1394)))))) tmp1407) ((lambda (tmp1416) (if tmp1416 (apply (lambda (ids1417 e11418 e21419) (let ((old-ids1420 (lambda-var-list1135 ids1417))) (if (not (valid-bound-ids?1111 old-ids1420)) (syntax-violation (quote lambda) "invalid parameter list" e1389) (let ((labels1421 (gen-labels1092 old-ids1420)) (new-vars1422 (map gen-var1134 old-ids1420))) (k1395 (let f1423 ((ls11424 (cdr new-vars1422)) (ls21425 (car new-vars1422))) (if (null? ls11424) ls21425 (f1423 (cdr ls11424) (cons (car ls11424) ls21425)))) docstring1390 (chi-body1126 (cons e11418 e21419) e1389 (extend-var-env1081 labels1421 new-vars1422 r1392) (make-binding-wrap1103 old-ids1420 labels1421 w1393) mod1394)))))) tmp1416) ((lambda (_1427) (syntax-violation (quote lambda) "bad lambda" e1389)) tmp1396))) ($sc-dispatch tmp1396 (quote (any any . each-any)))))) ($sc-dispatch tmp1396 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1396 (quote (any any any . each-any))))) c1391))) (chi-body1126 (lambda (body1428 outer-form1429 r1430 w1431 mod1432) (let ((r1433 (cons (quote ("placeholder" placeholder)) r1430))) (let ((ribcage1434 (make-ribcage1093 (quote ()) (quote ()) (quote ())))) (let ((w1435 (make-wrap1088 (wrap-marks1089 w1431) (cons ribcage1434 (wrap-subst1090 w1431))))) (let parse1436 ((body1437 (map (lambda (x1443) (cons r1433 (wrap1114 x1443 w1435 mod1432))) body1428)) (ids1438 (quote ())) (labels1439 (quote ())) (vars1440 (quote ())) (vals1441 (quote ())) (bindings1442 (quote ()))) (if (null? body1437) (syntax-violation #f "no expressions in body" outer-form1429) (let ((e1444 (cdar body1437)) (er1445 (caar body1437))) (call-with-values (lambda () (syntax-type1120 e1444 er1445 (quote (())) #f ribcage1434 mod1432)) (lambda (type1446 value1447 e1448 w1449 s1450 mod1451) (let ((t1452 type1446)) (if (memv t1452 (quote (define-form))) (let ((id1453 (wrap1114 value1447 w1449 mod1451)) (label1454 (gen-label1091))) (let ((var1455 (gen-var1134 id1453))) (begin (extend-ribcage!1102 ribcage1434 id1453 label1454) (parse1436 (cdr body1437) (cons id1453 ids1438) (cons label1454 labels1439) (cons var1455 vars1440) (cons (cons er1445 (wrap1114 e1448 w1449 mod1451)) vals1441) (cons (cons (quote lexical) var1455) bindings1442))))) (if (memv t1452 (quote (define-syntax-form))) (let ((id1456 (wrap1114 value1447 w1449 mod1451)) (label1457 (gen-label1091))) (begin (extend-ribcage!1102 ribcage1434 id1456 label1457) (parse1436 (cdr body1437) (cons id1456 ids1438) (cons label1457 labels1439) vars1440 vals1441 (cons (cons (quote macro) (cons er1445 (wrap1114 e1448 w1449 mod1451))) bindings1442)))) (if (memv t1452 (quote (begin-form))) ((lambda (tmp1458) ((lambda (tmp1459) (if tmp1459 (apply (lambda (_1460 e11461) (parse1436 (let f1462 ((forms1463 e11461)) (if (null? forms1463) (cdr body1437) (cons (cons er1445 (wrap1114 (car forms1463) w1449 mod1451)) (f1462 (cdr forms1463))))) ids1438 labels1439 vars1440 vals1441 bindings1442)) tmp1459) (syntax-violation #f "source expression failed to match any pattern" tmp1458))) ($sc-dispatch tmp1458 (quote (any . each-any))))) e1448) (if (memv t1452 (quote (local-syntax-form))) (chi-local-syntax1128 value1447 e1448 er1445 w1449 s1450 mod1451 (lambda (forms1465 er1466 w1467 s1468 mod1469) (parse1436 (let f1470 ((forms1471 forms1465)) (if (null? forms1471) (cdr body1437) (cons (cons er1466 (wrap1114 (car forms1471) w1467 mod1469)) (f1470 (cdr forms1471))))) ids1438 labels1439 vars1440 vals1441 bindings1442))) (if (null? ids1438) (build-sequence1065 #f (map (lambda (x1472) (chi1122 (cdr x1472) (car x1472) (quote (())) mod1451)) (cons (cons er1445 (source-wrap1115 e1448 w1449 s1450 mod1451)) (cdr body1437)))) (begin (if (not (valid-bound-ids?1111 ids1438)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1429)) (let loop1473 ((bs1474 bindings1442) (er-cache1475 #f) (r-cache1476 #f)) (if (not (null? bs1474)) (let ((b1477 (car bs1474))) (if (eq? (car b1477) (quote macro)) (let ((er1478 (cadr b1477))) (let ((r-cache1479 (if (eq? er1478 er-cache1475) r-cache1476 (macros-only-env1082 er1478)))) (begin (set-cdr! b1477 (eval-local-transformer1129 (chi1122 (cddr b1477) r-cache1479 (quote (())) mod1451) mod1451)) (loop1473 (cdr bs1474) er1478 r-cache1479)))) (loop1473 (cdr bs1474) er-cache1475 r-cache1476))))) (set-cdr! r1433 (extend-env1080 labels1439 bindings1442 (cdr r1433))) (build-letrec1068 #f vars1440 (map (lambda (x1480) (chi1122 (cdr x1480) (car x1480) (quote (())) mod1451)) vals1441) (build-sequence1065 #f (map (lambda (x1481) (chi1122 (cdr x1481) (car x1481) (quote (())) mod1451)) (cons (cons er1445 (source-wrap1115 e1448 w1449 s1450 mod1451)) (cdr body1437)))))))))))))))))))))) (chi-macro1125 (lambda (p1482 e1483 r1484 w1485 rib1486 mod1487) (letrec ((rebuild-macro-output1488 (lambda (x1489 m1490) (cond ((pair? x1489) (cons (rebuild-macro-output1488 (car x1489) m1490) (rebuild-macro-output1488 (cdr x1489) m1490))) ((syntax-object?1070 x1489) (let ((w1491 (syntax-object-wrap1072 x1489))) (let ((ms1492 (wrap-marks1089 w1491)) (s1493 (wrap-subst1090 w1491))) (if (and (pair? ms1492) (eq? (car ms1492) #f)) (make-syntax-object1069 (syntax-object-expression1071 x1489) (make-wrap1088 (cdr ms1492) (if rib1486 (cons rib1486 (cdr s1493)) (cdr s1493))) (syntax-object-module1073 x1489)) (make-syntax-object1069 (syntax-object-expression1071 x1489) (make-wrap1088 (cons m1490 ms1492) (if rib1486 (cons rib1486 (cons (quote shift) s1493)) (cons (quote shift) s1493))) (let ((pmod1494 (procedure-module p1482))) (if pmod1494 (cons (quote hygiene) (module-name pmod1494)) (quote (hygiene guile))))))))) ((vector? x1489) (let ((n1495 (vector-length x1489))) (let ((v1496 (make-vector n1495))) (let doloop1497 ((i1498 0)) (if (fx=1057 i1498 n1495) v1496 (begin (vector-set! v1496 i1498 (rebuild-macro-output1488 (vector-ref x1489 i1498) m1490)) (doloop1497 (fx+1055 i1498 1)))))))) ((symbol? x1489) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1115 e1483 w1485 s mod1487) x1489)) (else x1489))))) (rebuild-macro-output1488 (p1482 (wrap1114 e1483 (anti-mark1101 w1485) mod1487)) (string #\m))))) (chi-application1124 (lambda (x1499 e1500 r1501 w1502 s1503 mod1504) ((lambda (tmp1505) ((lambda (tmp1506) (if tmp1506 (apply (lambda (e01507 e11508) (build-annotated1063 s1503 (cons x1499 (map (lambda (e1509) (chi1122 e1509 r1501 w1502 mod1504)) e11508)))) tmp1506) (syntax-violation #f "source expression failed to match any pattern" tmp1505))) ($sc-dispatch tmp1505 (quote (any . each-any))))) e1500))) (chi-expr1123 (lambda (type1511 value1512 e1513 r1514 w1515 s1516 mod1517) (let ((t1518 type1511)) (if (memv t1518 (quote (lexical))) (build-annotated1063 s1516 value1512) (if (memv t1518 (quote (core external-macro))) (value1512 e1513 r1514 w1515 s1516 mod1517) (if (memv t1518 (quote (module-ref))) (call-with-values (lambda () (value1512 e1513)) (lambda (id1519 mod1520) (build-annotated1063 s1516 (if mod1520 (make-module-ref (cdr mod1520) id1519 (car mod1520)) (make-module-ref mod1520 id1519 (quote bare)))))) (if (memv t1518 (quote (lexical-call))) (chi-application1124 (build-annotated1063 (source-annotation1077 (car e1513)) value1512) e1513 r1514 w1515 s1516 mod1517) (if (memv t1518 (quote (global-call))) (chi-application1124 (build-annotated1063 (source-annotation1077 (car e1513)) (if (if (syntax-object?1070 (car e1513)) (syntax-object-module1073 (car e1513)) mod1517) (make-module-ref (cdr (if (syntax-object?1070 (car e1513)) (syntax-object-module1073 (car e1513)) mod1517)) value1512 (car (if (syntax-object?1070 (car e1513)) (syntax-object-module1073 (car e1513)) mod1517))) (make-module-ref (if (syntax-object?1070 (car e1513)) (syntax-object-module1073 (car e1513)) mod1517) value1512 (quote bare)))) e1513 r1514 w1515 s1516 mod1517) (if (memv t1518 (quote (constant))) (build-data1064 s1516 (strip1133 (source-wrap1115 e1513 w1515 s1516 mod1517) (quote (())))) (if (memv t1518 (quote (global))) (build-annotated1063 s1516 (if mod1517 (make-module-ref (cdr mod1517) value1512 (car mod1517)) (make-module-ref mod1517 value1512 (quote bare)))) (if (memv t1518 (quote (call))) (chi-application1124 (chi1122 (car e1513) r1514 w1515 mod1517) e1513 r1514 w1515 s1516 mod1517) (if (memv t1518 (quote (begin-form))) ((lambda (tmp1521) ((lambda (tmp1522) (if tmp1522 (apply (lambda (_1523 e11524 e21525) (chi-sequence1116 (cons e11524 e21525) r1514 w1515 s1516 mod1517)) tmp1522) (syntax-violation #f "source expression failed to match any pattern" tmp1521))) ($sc-dispatch tmp1521 (quote (any any . each-any))))) e1513) (if (memv t1518 (quote (local-syntax-form))) (chi-local-syntax1128 value1512 e1513 r1514 w1515 s1516 mod1517 chi-sequence1116) (if (memv t1518 (quote (eval-when-form))) ((lambda (tmp1527) ((lambda (tmp1528) (if tmp1528 (apply (lambda (_1529 x1530 e11531 e21532) (let ((when-list1533 (chi-when-list1119 e1513 x1530 w1515))) (if (memq (quote eval) when-list1533) (chi-sequence1116 (cons e11531 e21532) r1514 w1515 s1516 mod1517) (chi-void1130)))) tmp1528) (syntax-violation #f "source expression failed to match any pattern" tmp1527))) ($sc-dispatch tmp1527 (quote (any each-any any . each-any))))) e1513) (if (memv t1518 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1513 (wrap1114 value1512 w1515 mod1517)) (if (memv t1518 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1115 e1513 w1515 s1516 mod1517)) (if (memv t1518 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1115 e1513 w1515 s1516 mod1517)) (syntax-violation #f "unexpected syntax" (source-wrap1115 e1513 w1515 s1516 mod1517))))))))))))))))))) (chi1122 (lambda (e1536 r1537 w1538 mod1539) (call-with-values (lambda () (syntax-type1120 e1536 r1537 w1538 #f #f mod1539)) (lambda (type1540 value1541 e1542 w1543 s1544 mod1545) (chi-expr1123 type1540 value1541 e1542 r1537 w1543 s1544 mod1545))))) (chi-top1121 (lambda (e1546 r1547 w1548 m1549 esew1550 mod1551) (call-with-values (lambda () (syntax-type1120 e1546 r1547 w1548 #f #f mod1551)) (lambda (type1559 value1560 e1561 w1562 s1563 mod1564) (let ((t1565 type1559)) (if (memv t1565 (quote (begin-form))) ((lambda (tmp1566) ((lambda (tmp1567) (if tmp1567 (apply (lambda (_1568) (chi-void1130)) tmp1567) ((lambda (tmp1569) (if tmp1569 (apply (lambda (_1570 e11571 e21572) (chi-top-sequence1117 (cons e11571 e21572) r1547 w1562 s1563 m1549 esew1550 mod1564)) tmp1569) (syntax-violation #f "source expression failed to match any pattern" tmp1566))) ($sc-dispatch tmp1566 (quote (any any . each-any)))))) ($sc-dispatch tmp1566 (quote (any))))) e1561) (if (memv t1565 (quote (local-syntax-form))) (chi-local-syntax1128 value1560 e1561 r1547 w1562 s1563 mod1564 (lambda (body1574 r1575 w1576 s1577 mod1578) (chi-top-sequence1117 body1574 r1575 w1576 s1577 m1549 esew1550 mod1578))) (if (memv t1565 (quote (eval-when-form))) ((lambda (tmp1579) ((lambda (tmp1580) (if tmp1580 (apply (lambda (_1581 x1582 e11583 e21584) (let ((when-list1585 (chi-when-list1119 e1561 x1582 w1562)) (body1586 (cons e11583 e21584))) (cond ((eq? m1549 (quote e)) (if (memq (quote eval) when-list1585) (chi-top-sequence1117 body1586 r1547 w1562 s1563 (quote e) (quote (eval)) mod1564) (chi-void1130))) ((memq (quote load) when-list1585) (if (or (memq (quote compile) when-list1585) (and (eq? m1549 (quote c&e)) (memq (quote eval) when-list1585))) (chi-top-sequence1117 body1586 r1547 w1562 s1563 (quote c&e) (quote (compile load)) mod1564) (if (memq m1549 (quote (c c&e))) (chi-top-sequence1117 body1586 r1547 w1562 s1563 (quote c) (quote (load)) mod1564) (chi-void1130)))) ((or (memq (quote compile) when-list1585) (and (eq? m1549 (quote c&e)) (memq (quote eval) when-list1585))) (top-level-eval-hook1059 (chi-top-sequence1117 body1586 r1547 w1562 s1563 (quote e) (quote (eval)) mod1564) mod1564) (chi-void1130)) (else (chi-void1130))))) tmp1580) (syntax-violation #f "source expression failed to match any pattern" tmp1579))) ($sc-dispatch tmp1579 (quote (any each-any any . each-any))))) e1561) (if (memv t1565 (quote (define-syntax-form))) (let ((n1589 (id-var-name1108 value1560 w1562)) (r1590 (macros-only-env1082 r1547))) (let ((t1591 m1549)) (if (memv t1591 (quote (c))) (if (memq (quote compile) esew1550) (let ((e1592 (chi-install-global1118 n1589 (chi1122 e1561 r1590 w1562 mod1564)))) (begin (top-level-eval-hook1059 e1592 mod1564) (if (memq (quote load) esew1550) e1592 (chi-void1130)))) (if (memq (quote load) esew1550) (chi-install-global1118 n1589 (chi1122 e1561 r1590 w1562 mod1564)) (chi-void1130))) (if (memv t1591 (quote (c&e))) (let ((e1593 (chi-install-global1118 n1589 (chi1122 e1561 r1590 w1562 mod1564)))) (begin (top-level-eval-hook1059 e1593 mod1564) e1593)) (begin (if (memq (quote eval) esew1550) (top-level-eval-hook1059 (chi-install-global1118 n1589 (chi1122 e1561 r1590 w1562 mod1564)) mod1564)) (chi-void1130)))))) (if (memv t1565 (quote (define-form))) (let ((n1594 (id-var-name1108 value1560 w1562))) (let ((type1595 (binding-type1078 (lookup1083 n1594 r1547 mod1564)))) (let ((t1596 type1595)) (if (memv t1596 (quote (global core macro module-ref))) (let ((x1597 (build-annotated1063 s1563 (list (quote define) n1594 (chi1122 e1561 r1547 w1562 mod1564))))) (begin (if (eq? m1549 (quote c&e)) (top-level-eval-hook1059 x1597 mod1564)) x1597)) (if (memv t1596 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1561 (wrap1114 value1560 w1562 mod1564)) (syntax-violation #f "cannot define keyword at top level" e1561 (wrap1114 value1560 w1562 mod1564))))))) (let ((x1598 (chi-expr1123 type1559 value1560 e1561 r1547 w1562 s1563 mod1564))) (begin (if (eq? m1549 (quote c&e)) (top-level-eval-hook1059 x1598 mod1564)) x1598)))))))))))) (syntax-type1120 (lambda (e1599 r1600 w1601 s1602 rib1603 mod1604) (cond ((symbol? e1599) (let ((n1605 (id-var-name1108 e1599 w1601))) (let ((b1606 (lookup1083 n1605 r1600 mod1604))) (let ((type1607 (binding-type1078 b1606))) (let ((t1608 type1607)) (if (memv t1608 (quote (lexical))) (values type1607 (binding-value1079 b1606) e1599 w1601 s1602 mod1604) (if (memv t1608 (quote (global))) (values type1607 n1605 e1599 w1601 s1602 mod1604) (if (memv t1608 (quote (macro))) (syntax-type1120 (chi-macro1125 (binding-value1079 b1606) e1599 r1600 w1601 rib1603 mod1604) r1600 (quote (())) s1602 rib1603 mod1604) (values type1607 (binding-value1079 b1606) e1599 w1601 s1602 mod1604))))))))) ((pair? e1599) (let ((first1609 (car e1599))) (if (id?1086 first1609) (let ((n1610 (id-var-name1108 first1609 w1601))) (let ((b1611 (lookup1083 n1610 r1600 (or (and (syntax-object?1070 first1609) (syntax-object-module1073 first1609)) mod1604)))) (let ((type1612 (binding-type1078 b1611))) (let ((t1613 type1612)) (if (memv t1613 (quote (lexical))) (values (quote lexical-call) (binding-value1079 b1611) e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (global))) (values (quote global-call) n1610 e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (macro))) (syntax-type1120 (chi-macro1125 (binding-value1079 b1611) e1599 r1600 w1601 rib1603 mod1604) r1600 (quote (())) s1602 rib1603 mod1604) (if (memv t1613 (quote (core external-macro module-ref))) (values type1612 (binding-value1079 b1611) e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1079 b1611) e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (begin))) (values (quote begin-form) #f e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (eval-when))) (values (quote eval-when-form) #f e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (define))) ((lambda (tmp1614) ((lambda (tmp1615) (if (if tmp1615 (apply (lambda (_1616 name1617 val1618) (id?1086 name1617)) tmp1615) #f) (apply (lambda (_1619 name1620 val1621) (values (quote define-form) name1620 val1621 w1601 s1602 mod1604)) tmp1615) ((lambda (tmp1622) (if (if tmp1622 (apply (lambda (_1623 name1624 args1625 e11626 e21627) (and (id?1086 name1624) (valid-bound-ids?1111 (lambda-var-list1135 args1625)))) tmp1622) #f) (apply (lambda (_1628 name1629 args1630 e11631 e21632) (values (quote define-form) (wrap1114 name1629 w1601 mod1604) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) (wrap1114 (cons args1630 (cons e11631 e21632)) w1601 mod1604)) (quote (())) s1602 mod1604)) tmp1622) ((lambda (tmp1634) (if (if tmp1634 (apply (lambda (_1635 name1636) (id?1086 name1636)) tmp1634) #f) (apply (lambda (_1637 name1638) (values (quote define-form) (wrap1114 name1638 w1601 mod1604) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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 (())) s1602 mod1604)) tmp1634) (syntax-violation #f "source expression failed to match any pattern" tmp1614))) ($sc-dispatch tmp1614 (quote (any any)))))) ($sc-dispatch tmp1614 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1614 (quote (any any any))))) e1599) (if (memv t1613 (quote (define-syntax))) ((lambda (tmp1639) ((lambda (tmp1640) (if (if tmp1640 (apply (lambda (_1641 name1642 val1643) (id?1086 name1642)) tmp1640) #f) (apply (lambda (_1644 name1645 val1646) (values (quote define-syntax-form) name1645 val1646 w1601 s1602 mod1604)) tmp1640) (syntax-violation #f "source expression failed to match any pattern" tmp1639))) ($sc-dispatch tmp1639 (quote (any any any))))) e1599) (values (quote call) #f e1599 w1601 s1602 mod1604)))))))))))))) (values (quote call) #f e1599 w1601 s1602 mod1604)))) ((syntax-object?1070 e1599) (syntax-type1120 (syntax-object-expression1071 e1599) r1600 (join-wraps1105 w1601 (syntax-object-wrap1072 e1599)) #f rib1603 (or (syntax-object-module1073 e1599) mod1604))) ((annotation? e1599) (syntax-type1120 (annotation-expression e1599) r1600 w1601 (annotation-source e1599) rib1603 mod1604)) ((self-evaluating? e1599) (values (quote constant) #f e1599 w1601 s1602 mod1604)) (else (values (quote other) #f e1599 w1601 s1602 mod1604))))) (chi-when-list1119 (lambda (e1647 when-list1648 w1649) (let f1650 ((when-list1651 when-list1648) (situations1652 (quote ()))) (if (null? when-list1651) situations1652 (f1650 (cdr when-list1651) (cons (let ((x1653 (car when-list1651))) (cond ((free-id=?1109 x1653 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?1109 x1653 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?1109 x1653 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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" e1647 (wrap1114 x1653 w1649 #f))))) situations1652)))))) (chi-install-global1118 (lambda (name1654 e1655) (build-annotated1063 #f (list (build-annotated1063 #f (quote define)) name1654 (if (let ((v1656 (module-variable (current-module) name1654))) (and v1656 (variable-bound? v1656) (macro? (variable-ref v1656)) (not (eq? (macro-type (variable-ref v1656)) (quote syncase-macro))))) (build-annotated1063 #f (list (build-annotated1063 #f (quote make-extended-syncase-macro)) (build-annotated1063 #f (list (build-annotated1063 #f (quote module-ref)) (build-annotated1063 #f (quote (current-module))) (build-data1064 #f name1654))) (build-data1064 #f (quote macro)) e1655)) (build-annotated1063 #f (list (build-annotated1063 #f (quote make-syncase-macro)) (build-data1064 #f (quote macro)) e1655))))))) (chi-top-sequence1117 (lambda (body1657 r1658 w1659 s1660 m1661 esew1662 mod1663) (build-sequence1065 s1660 (let dobody1664 ((body1665 body1657) (r1666 r1658) (w1667 w1659) (m1668 m1661) (esew1669 esew1662) (mod1670 mod1663)) (if (null? body1665) (quote ()) (let ((first1671 (chi-top1121 (car body1665) r1666 w1667 m1668 esew1669 mod1670))) (cons first1671 (dobody1664 (cdr body1665) r1666 w1667 m1668 esew1669 mod1670)))))))) (chi-sequence1116 (lambda (body1672 r1673 w1674 s1675 mod1676) (build-sequence1065 s1675 (let dobody1677 ((body1678 body1672) (r1679 r1673) (w1680 w1674) (mod1681 mod1676)) (if (null? body1678) (quote ()) (let ((first1682 (chi1122 (car body1678) r1679 w1680 mod1681))) (cons first1682 (dobody1677 (cdr body1678) r1679 w1680 mod1681)))))))) (source-wrap1115 (lambda (x1683 w1684 s1685 defmod1686) (wrap1114 (if s1685 (make-annotation x1683 s1685 #f) x1683) w1684 defmod1686))) (wrap1114 (lambda (x1687 w1688 defmod1689) (cond ((and (null? (wrap-marks1089 w1688)) (null? (wrap-subst1090 w1688))) x1687) ((syntax-object?1070 x1687) (make-syntax-object1069 (syntax-object-expression1071 x1687) (join-wraps1105 w1688 (syntax-object-wrap1072 x1687)) (syntax-object-module1073 x1687))) ((null? x1687) x1687) (else (make-syntax-object1069 x1687 w1688 defmod1689))))) (bound-id-member?1113 (lambda (x1690 list1691) (and (not (null? list1691)) (or (bound-id=?1110 x1690 (car list1691)) (bound-id-member?1113 x1690 (cdr list1691)))))) (distinct-bound-ids?1112 (lambda (ids1692) (let distinct?1693 ((ids1694 ids1692)) (or (null? ids1694) (and (not (bound-id-member?1113 (car ids1694) (cdr ids1694))) (distinct?1693 (cdr ids1694))))))) (valid-bound-ids?1111 (lambda (ids1695) (and (let all-ids?1696 ((ids1697 ids1695)) (or (null? ids1697) (and (id?1086 (car ids1697)) (all-ids?1696 (cdr ids1697))))) (distinct-bound-ids?1112 ids1695)))) (bound-id=?1110 (lambda (i1698 j1699) (if (and (syntax-object?1070 i1698) (syntax-object?1070 j1699)) (and (eq? (let ((e1700 (syntax-object-expression1071 i1698))) (if (annotation? e1700) (annotation-expression e1700) e1700)) (let ((e1701 (syntax-object-expression1071 j1699))) (if (annotation? e1701) (annotation-expression e1701) e1701))) (same-marks?1107 (wrap-marks1089 (syntax-object-wrap1072 i1698)) (wrap-marks1089 (syntax-object-wrap1072 j1699)))) (eq? (let ((e1702 i1698)) (if (annotation? e1702) (annotation-expression e1702) e1702)) (let ((e1703 j1699)) (if (annotation? e1703) (annotation-expression e1703) e1703)))))) (free-id=?1109 (lambda (i1704 j1705) (and (eq? (let ((x1706 i1704)) (let ((e1707 (if (syntax-object?1070 x1706) (syntax-object-expression1071 x1706) x1706))) (if (annotation? e1707) (annotation-expression e1707) e1707))) (let ((x1708 j1705)) (let ((e1709 (if (syntax-object?1070 x1708) (syntax-object-expression1071 x1708) x1708))) (if (annotation? e1709) (annotation-expression e1709) e1709)))) (eq? (id-var-name1108 i1704 (quote (()))) (id-var-name1108 j1705 (quote (()))))))) (id-var-name1108 (lambda (id1710 w1711) (letrec ((search-vector-rib1714 (lambda (sym1720 subst1721 marks1722 symnames1723 ribcage1724) (let ((n1725 (vector-length symnames1723))) (let f1726 ((i1727 0)) (cond ((fx=1057 i1727 n1725) (search1712 sym1720 (cdr subst1721) marks1722)) ((and (eq? (vector-ref symnames1723 i1727) sym1720) (same-marks?1107 marks1722 (vector-ref (ribcage-marks1096 ribcage1724) i1727))) (values (vector-ref (ribcage-labels1097 ribcage1724) i1727) marks1722)) (else (f1726 (fx+1055 i1727 1)))))))) (search-list-rib1713 (lambda (sym1728 subst1729 marks1730 symnames1731 ribcage1732) (let f1733 ((symnames1734 symnames1731) (i1735 0)) (cond ((null? symnames1734) (search1712 sym1728 (cdr subst1729) marks1730)) ((and (eq? (car symnames1734) sym1728) (same-marks?1107 marks1730 (list-ref (ribcage-marks1096 ribcage1732) i1735))) (values (list-ref (ribcage-labels1097 ribcage1732) i1735) marks1730)) (else (f1733 (cdr symnames1734) (fx+1055 i1735 1))))))) (search1712 (lambda (sym1736 subst1737 marks1738) (if (null? subst1737) (values #f marks1738) (let ((fst1739 (car subst1737))) (if (eq? fst1739 (quote shift)) (search1712 sym1736 (cdr subst1737) (cdr marks1738)) (let ((symnames1740 (ribcage-symnames1095 fst1739))) (if (vector? symnames1740) (search-vector-rib1714 sym1736 subst1737 marks1738 symnames1740 fst1739) (search-list-rib1713 sym1736 subst1737 marks1738 symnames1740 fst1739))))))))) (cond ((symbol? id1710) (or (call-with-values (lambda () (search1712 id1710 (wrap-subst1090 w1711) (wrap-marks1089 w1711))) (lambda (x1742 . ignore1741) x1742)) id1710)) ((syntax-object?1070 id1710) (let ((id1743 (let ((e1745 (syntax-object-expression1071 id1710))) (if (annotation? e1745) (annotation-expression e1745) e1745))) (w11744 (syntax-object-wrap1072 id1710))) (let ((marks1746 (join-marks1106 (wrap-marks1089 w1711) (wrap-marks1089 w11744)))) (call-with-values (lambda () (search1712 id1743 (wrap-subst1090 w1711) marks1746)) (lambda (new-id1747 marks1748) (or new-id1747 (call-with-values (lambda () (search1712 id1743 (wrap-subst1090 w11744) marks1748)) (lambda (x1750 . ignore1749) x1750)) id1743)))))) ((annotation? id1710) (let ((id1751 (let ((e1752 id1710)) (if (annotation? e1752) (annotation-expression e1752) e1752)))) (or (call-with-values (lambda () (search1712 id1751 (wrap-subst1090 w1711) (wrap-marks1089 w1711))) (lambda (x1754 . ignore1753) x1754)) id1751))) (else (syntax-violation (quote id-var-name) "invalid id" id1710)))))) (same-marks?1107 (lambda (x1755 y1756) (or (eq? x1755 y1756) (and (not (null? x1755)) (not (null? y1756)) (eq? (car x1755) (car y1756)) (same-marks?1107 (cdr x1755) (cdr y1756)))))) (join-marks1106 (lambda (m11757 m21758) (smart-append1104 m11757 m21758))) (join-wraps1105 (lambda (w11759 w21760) (let ((m11761 (wrap-marks1089 w11759)) (s11762 (wrap-subst1090 w11759))) (if (null? m11761) (if (null? s11762) w21760 (make-wrap1088 (wrap-marks1089 w21760) (smart-append1104 s11762 (wrap-subst1090 w21760)))) (make-wrap1088 (smart-append1104 m11761 (wrap-marks1089 w21760)) (smart-append1104 s11762 (wrap-subst1090 w21760))))))) (smart-append1104 (lambda (m11763 m21764) (if (null? m21764) m11763 (append m11763 m21764)))) (make-binding-wrap1103 (lambda (ids1765 labels1766 w1767) (if (null? ids1765) w1767 (make-wrap1088 (wrap-marks1089 w1767) (cons (let ((labelvec1768 (list->vector labels1766))) (let ((n1769 (vector-length labelvec1768))) (let ((symnamevec1770 (make-vector n1769)) (marksvec1771 (make-vector n1769))) (begin (let f1772 ((ids1773 ids1765) (i1774 0)) (if (not (null? ids1773)) (call-with-values (lambda () (id-sym-name&marks1087 (car ids1773) w1767)) (lambda (symname1775 marks1776) (begin (vector-set! symnamevec1770 i1774 symname1775) (vector-set! marksvec1771 i1774 marks1776) (f1772 (cdr ids1773) (fx+1055 i1774 1))))))) (make-ribcage1093 symnamevec1770 marksvec1771 labelvec1768))))) (wrap-subst1090 w1767)))))) (extend-ribcage!1102 (lambda (ribcage1777 id1778 label1779) (begin (set-ribcage-symnames!1098 ribcage1777 (cons (let ((e1780 (syntax-object-expression1071 id1778))) (if (annotation? e1780) (annotation-expression e1780) e1780)) (ribcage-symnames1095 ribcage1777))) (set-ribcage-marks!1099 ribcage1777 (cons (wrap-marks1089 (syntax-object-wrap1072 id1778)) (ribcage-marks1096 ribcage1777))) (set-ribcage-labels!1100 ribcage1777 (cons label1779 (ribcage-labels1097 ribcage1777)))))) (anti-mark1101 (lambda (w1781) (make-wrap1088 (cons #f (wrap-marks1089 w1781)) (cons (quote shift) (wrap-subst1090 w1781))))) (set-ribcage-labels!1100 (lambda (x1782 update1783) (vector-set! x1782 3 update1783))) (set-ribcage-marks!1099 (lambda (x1784 update1785) (vector-set! x1784 2 update1785))) (set-ribcage-symnames!1098 (lambda (x1786 update1787) (vector-set! x1786 1 update1787))) (ribcage-labels1097 (lambda (x1788) (vector-ref x1788 3))) (ribcage-marks1096 (lambda (x1789) (vector-ref x1789 2))) (ribcage-symnames1095 (lambda (x1790) (vector-ref x1790 1))) (ribcage?1094 (lambda (x1791) (and (vector? x1791) (= (vector-length x1791) 4) (eq? (vector-ref x1791 0) (quote ribcage))))) (make-ribcage1093 (lambda (symnames1792 marks1793 labels1794) (vector (quote ribcage) symnames1792 marks1793 labels1794))) (gen-labels1092 (lambda (ls1795) (if (null? ls1795) (quote ()) (cons (gen-label1091) (gen-labels1092 (cdr ls1795)))))) (gen-label1091 (lambda () (string #\i))) (wrap-subst1090 cdr) (wrap-marks1089 car) (make-wrap1088 cons) (id-sym-name&marks1087 (lambda (x1796 w1797) (if (syntax-object?1070 x1796) (values (let ((e1798 (syntax-object-expression1071 x1796))) (if (annotation? e1798) (annotation-expression e1798) e1798)) (join-marks1106 (wrap-marks1089 w1797) (wrap-marks1089 (syntax-object-wrap1072 x1796)))) (values (let ((e1799 x1796)) (if (annotation? e1799) (annotation-expression e1799) e1799)) (wrap-marks1089 w1797))))) (id?1086 (lambda (x1800) (cond ((symbol? x1800) #t) ((syntax-object?1070 x1800) (symbol? (let ((e1801 (syntax-object-expression1071 x1800))) (if (annotation? e1801) (annotation-expression e1801) e1801)))) ((annotation? x1800) (symbol? (annotation-expression x1800))) (else #f)))) (nonsymbol-id?1085 (lambda (x1802) (and (syntax-object?1070 x1802) (symbol? (let ((e1803 (syntax-object-expression1071 x1802))) (if (annotation? e1803) (annotation-expression e1803) e1803)))))) (global-extend1084 (lambda (type1804 sym1805 val1806) (put-global-definition-hook1061 sym1805 type1804 val1806))) (lookup1083 (lambda (x1807 r1808 mod1809) (cond ((assq x1807 r1808) => cdr) ((symbol? x1807) (or (get-global-definition-hook1062 x1807 mod1809) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1082 (lambda (r1810) (if (null? r1810) (quote ()) (let ((a1811 (car r1810))) (if (eq? (cadr a1811) (quote macro)) (cons a1811 (macros-only-env1082 (cdr r1810))) (macros-only-env1082 (cdr r1810))))))) (extend-var-env1081 (lambda (labels1812 vars1813 r1814) (if (null? labels1812) r1814 (extend-var-env1081 (cdr labels1812) (cdr vars1813) (cons (cons (car labels1812) (cons (quote lexical) (car vars1813))) r1814))))) (extend-env1080 (lambda (labels1815 bindings1816 r1817) (if (null? labels1815) r1817 (extend-env1080 (cdr labels1815) (cdr bindings1816) (cons (cons (car labels1815) (car bindings1816)) r1817))))) (binding-value1079 cdr) (binding-type1078 car) (source-annotation1077 (lambda (x1818) (cond ((annotation? x1818) (annotation-source x1818)) ((syntax-object?1070 x1818) (source-annotation1077 (syntax-object-expression1071 x1818))) (else #f)))) (set-syntax-object-module!1076 (lambda (x1819 update1820) (vector-set! x1819 3 update1820))) (set-syntax-object-wrap!1075 (lambda (x1821 update1822) (vector-set! x1821 2 update1822))) (set-syntax-object-expression!1074 (lambda (x1823 update1824) (vector-set! x1823 1 update1824))) (syntax-object-module1073 (lambda (x1825) (vector-ref x1825 3))) (syntax-object-wrap1072 (lambda (x1826) (vector-ref x1826 2))) (syntax-object-expression1071 (lambda (x1827) (vector-ref x1827 1))) (syntax-object?1070 (lambda (x1828) (and (vector? x1828) (= (vector-length x1828) 4) (eq? (vector-ref x1828 0) (quote syntax-object))))) (make-syntax-object1069 (lambda (expression1829 wrap1830 module1831) (vector (quote syntax-object) expression1829 wrap1830 module1831))) (build-letrec1068 (lambda (src1832 vars1833 val-exps1834 body-exp1835) (if (null? vars1833) (build-annotated1063 src1832 body-exp1835) (build-annotated1063 src1832 (list (quote letrec) (map list vars1833 val-exps1834) body-exp1835))))) (build-named-let1067 (lambda (src1836 vars1837 val-exps1838 body-exp1839) (if (null? vars1837) (build-annotated1063 src1836 body-exp1839) (build-annotated1063 src1836 (list (quote let) (car vars1837) (map list (cdr vars1837) val-exps1838) body-exp1839))))) (build-let1066 (lambda (src1840 vars1841 val-exps1842 body-exp1843) (if (null? vars1841) (build-annotated1063 src1840 body-exp1843) (build-annotated1063 src1840 (list (quote let) (map list vars1841 val-exps1842) body-exp1843))))) (build-sequence1065 (lambda (src1844 exps1845) (if (null? (cdr exps1845)) (build-annotated1063 src1844 (car exps1845)) (build-annotated1063 src1844 (cons (quote begin) exps1845))))) (build-data1064 (lambda (src1846 exp1847) (if (and (self-evaluating? exp1847) (not (vector? exp1847))) (build-annotated1063 src1846 exp1847) (build-annotated1063 src1846 (list (quote quote) exp1847))))) (build-annotated1063 (lambda (src1848 exp1849) (if (and src1848 (not (annotation? exp1849))) (make-annotation exp1849 src1848 #t) exp1849))) (get-global-definition-hook1062 (lambda (symbol1850 module1851) (begin (if (and (not module1851) (current-module)) (warn "module system is booted, we should have a module" symbol1850)) (let ((v1852 (module-variable (if module1851 (resolve-module (cdr module1851)) (current-module)) symbol1850))) (and v1852 (variable-bound? v1852) (let ((val1853 (variable-ref v1852))) (and (macro? val1853) (syncase-macro-type val1853) (cons (syncase-macro-type val1853) (syncase-macro-binding val1853))))))))) (put-global-definition-hook1061 (lambda (symbol1854 type1855 val1856) (let ((existing1857 (let ((v1858 (module-variable (current-module) symbol1854))) (and v1858 (variable-bound? v1858) (let ((val1859 (variable-ref v1858))) (and (macro? val1859) (not (syncase-macro-type val1859)) val1859)))))) (module-define! (current-module) symbol1854 (if existing1857 (make-extended-syncase-macro existing1857 type1855 val1856) (make-syncase-macro type1855 val1856)))))) (local-eval-hook1060 (lambda (x1860 mod1861) (primitive-eval (list noexpand1054 x1860)))) (top-level-eval-hook1059 (lambda (x1862 mod1863) (primitive-eval (list noexpand1054 x1862)))) (fx<1058 <) (fx=1057 =) (fx-1056 -) (fx+1055 +) (noexpand1054 "noexpand")) (begin (global-extend1084 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1084 (quote local-syntax) (quote let-syntax) #f) (global-extend1084 (quote core) (quote fluid-let-syntax) (lambda (e1864 r1865 w1866 s1867 mod1868) ((lambda (tmp1869) ((lambda (tmp1870) (if (if tmp1870 (apply (lambda (_1871 var1872 val1873 e11874 e21875) (valid-bound-ids?1111 var1872)) tmp1870) #f) (apply (lambda (_1877 var1878 val1879 e11880 e21881) (let ((names1882 (map (lambda (x1883) (id-var-name1108 x1883 w1866)) var1878))) (begin (for-each (lambda (id1885 n1886) (let ((t1887 (binding-type1078 (lookup1083 n1886 r1865 mod1868)))) (if (memv t1887 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1864 (source-wrap1115 id1885 w1866 s1867 mod1868))))) var1878 names1882) (chi-body1126 (cons e11880 e21881) (source-wrap1115 e1864 w1866 s1867 mod1868) (extend-env1080 names1882 (let ((trans-r1890 (macros-only-env1082 r1865))) (map (lambda (x1891) (cons (quote macro) (eval-local-transformer1129 (chi1122 x1891 trans-r1890 w1866 mod1868) mod1868))) val1879)) r1865) w1866 mod1868)))) tmp1870) ((lambda (_1893) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1115 e1864 w1866 s1867 mod1868))) tmp1869))) ($sc-dispatch tmp1869 (quote (any #(each (any any)) any . each-any))))) e1864))) (global-extend1084 (quote core) (quote quote) (lambda (e1894 r1895 w1896 s1897 mod1898) ((lambda (tmp1899) ((lambda (tmp1900) (if tmp1900 (apply (lambda (_1901 e1902) (build-data1064 s1897 (strip1133 e1902 w1896))) tmp1900) ((lambda (_1903) (syntax-violation (quote quote) "bad syntax" (source-wrap1115 e1894 w1896 s1897 mod1898))) tmp1899))) ($sc-dispatch tmp1899 (quote (any any))))) e1894))) (global-extend1084 (quote core) (quote syntax) (letrec ((regen1911 (lambda (x1912) (let ((t1913 (car x1912))) (if (memv t1913 (quote (ref))) (build-annotated1063 #f (cadr x1912)) (if (memv t1913 (quote (primitive))) (build-annotated1063 #f (cadr x1912)) (if (memv t1913 (quote (quote))) (build-data1064 #f (cadr x1912)) (if (memv t1913 (quote (lambda))) (build-annotated1063 #f (list (quote lambda) (cadr x1912) (regen1911 (caddr x1912)))) (if (memv t1913 (quote (map))) (let ((ls1914 (map regen1911 (cdr x1912)))) (build-annotated1063 #f (cons (if (fx=1057 (length ls1914) 2) (build-annotated1063 #f (quote map)) (build-annotated1063 #f (quote map))) ls1914))) (build-annotated1063 #f (cons (build-annotated1063 #f (car x1912)) (map regen1911 (cdr x1912)))))))))))) (gen-vector1910 (lambda (x1915) (cond ((eq? (car x1915) (quote list)) (cons (quote vector) (cdr x1915))) ((eq? (car x1915) (quote quote)) (list (quote quote) (list->vector (cadr x1915)))) (else (list (quote list->vector) x1915))))) (gen-append1909 (lambda (x1916 y1917) (if (equal? y1917 (quote (quote ()))) x1916 (list (quote append) x1916 y1917)))) (gen-cons1908 (lambda (x1918 y1919) (let ((t1920 (car y1919))) (if (memv t1920 (quote (quote))) (if (eq? (car x1918) (quote quote)) (list (quote quote) (cons (cadr x1918) (cadr y1919))) (if (eq? (cadr y1919) (quote ())) (list (quote list) x1918) (list (quote cons) x1918 y1919))) (if (memv t1920 (quote (list))) (cons (quote list) (cons x1918 (cdr y1919))) (list (quote cons) x1918 y1919)))))) (gen-map1907 (lambda (e1921 map-env1922) (let ((formals1923 (map cdr map-env1922)) (actuals1924 (map (lambda (x1925) (list (quote ref) (car x1925))) map-env1922))) (cond ((eq? (car e1921) (quote ref)) (car actuals1924)) ((and-map (lambda (x1926) (and (eq? (car x1926) (quote ref)) (memq (cadr x1926) formals1923))) (cdr e1921)) (cons (quote map) (cons (list (quote primitive) (car e1921)) (map (let ((r1927 (map cons formals1923 actuals1924))) (lambda (x1928) (cdr (assq (cadr x1928) r1927)))) (cdr e1921))))) (else (cons (quote map) (cons (list (quote lambda) formals1923 e1921) actuals1924))))))) (gen-mappend1906 (lambda (e1929 map-env1930) (list (quote apply) (quote (primitive append)) (gen-map1907 e1929 map-env1930)))) (gen-ref1905 (lambda (src1931 var1932 level1933 maps1934) (if (fx=1057 level1933 0) (values var1932 maps1934) (if (null? maps1934) (syntax-violation (quote syntax) "missing ellipsis" src1931) (call-with-values (lambda () (gen-ref1905 src1931 var1932 (fx-1056 level1933 1) (cdr maps1934))) (lambda (outer-var1935 outer-maps1936) (let ((b1937 (assq outer-var1935 (car maps1934)))) (if b1937 (values (cdr b1937) maps1934) (let ((inner-var1938 (gen-var1134 (quote tmp)))) (values inner-var1938 (cons (cons (cons outer-var1935 inner-var1938) (car maps1934)) outer-maps1936))))))))))) (gen-syntax1904 (lambda (src1939 e1940 r1941 maps1942 ellipsis?1943 mod1944) (if (id?1086 e1940) (let ((label1945 (id-var-name1108 e1940 (quote (()))))) (let ((b1946 (lookup1083 label1945 r1941 mod1944))) (if (eq? (binding-type1078 b1946) (quote syntax)) (call-with-values (lambda () (let ((var.lev1947 (binding-value1079 b1946))) (gen-ref1905 src1939 (car var.lev1947) (cdr var.lev1947) maps1942))) (lambda (var1948 maps1949) (values (list (quote ref) var1948) maps1949))) (if (ellipsis?1943 e1940) (syntax-violation (quote syntax) "misplaced ellipsis" src1939) (values (list (quote quote) e1940) maps1942))))) ((lambda (tmp1950) ((lambda (tmp1951) (if (if tmp1951 (apply (lambda (dots1952 e1953) (ellipsis?1943 dots1952)) tmp1951) #f) (apply (lambda (dots1954 e1955) (gen-syntax1904 src1939 e1955 r1941 maps1942 (lambda (x1956) #f) mod1944)) tmp1951) ((lambda (tmp1957) (if (if tmp1957 (apply (lambda (x1958 dots1959 y1960) (ellipsis?1943 dots1959)) tmp1957) #f) (apply (lambda (x1961 dots1962 y1963) (let f1964 ((y1965 y1963) (k1966 (lambda (maps1967) (call-with-values (lambda () (gen-syntax1904 src1939 x1961 r1941 (cons (quote ()) maps1967) ellipsis?1943 mod1944)) (lambda (x1968 maps1969) (if (null? (car maps1969)) (syntax-violation (quote syntax) "extra ellipsis" src1939) (values (gen-map1907 x1968 (car maps1969)) (cdr maps1969)))))))) ((lambda (tmp1970) ((lambda (tmp1971) (if (if tmp1971 (apply (lambda (dots1972 y1973) (ellipsis?1943 dots1972)) tmp1971) #f) (apply (lambda (dots1974 y1975) (f1964 y1975 (lambda (maps1976) (call-with-values (lambda () (k1966 (cons (quote ()) maps1976))) (lambda (x1977 maps1978) (if (null? (car maps1978)) (syntax-violation (quote syntax) "extra ellipsis" src1939) (values (gen-mappend1906 x1977 (car maps1978)) (cdr maps1978)))))))) tmp1971) ((lambda (_1979) (call-with-values (lambda () (gen-syntax1904 src1939 y1965 r1941 maps1942 ellipsis?1943 mod1944)) (lambda (y1980 maps1981) (call-with-values (lambda () (k1966 maps1981)) (lambda (x1982 maps1983) (values (gen-append1909 x1982 y1980) maps1983)))))) tmp1970))) ($sc-dispatch tmp1970 (quote (any . any))))) y1965))) tmp1957) ((lambda (tmp1984) (if tmp1984 (apply (lambda (x1985 y1986) (call-with-values (lambda () (gen-syntax1904 src1939 x1985 r1941 maps1942 ellipsis?1943 mod1944)) (lambda (x1987 maps1988) (call-with-values (lambda () (gen-syntax1904 src1939 y1986 r1941 maps1988 ellipsis?1943 mod1944)) (lambda (y1989 maps1990) (values (gen-cons1908 x1987 y1989) maps1990)))))) tmp1984) ((lambda (tmp1991) (if tmp1991 (apply (lambda (e11992 e21993) (call-with-values (lambda () (gen-syntax1904 src1939 (cons e11992 e21993) r1941 maps1942 ellipsis?1943 mod1944)) (lambda (e1995 maps1996) (values (gen-vector1910 e1995) maps1996)))) tmp1991) ((lambda (_1997) (values (list (quote quote) e1940) maps1942)) tmp1950))) ($sc-dispatch tmp1950 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1950 (quote (any . any)))))) ($sc-dispatch tmp1950 (quote (any any . any)))))) ($sc-dispatch tmp1950 (quote (any any))))) e1940))))) (lambda (e1998 r1999 w2000 s2001 mod2002) (let ((e2003 (source-wrap1115 e1998 w2000 s2001 mod2002))) ((lambda (tmp2004) ((lambda (tmp2005) (if tmp2005 (apply (lambda (_2006 x2007) (call-with-values (lambda () (gen-syntax1904 e2003 x2007 r1999 (quote ()) ellipsis?1131 mod2002)) (lambda (e2008 maps2009) (regen1911 e2008)))) tmp2005) ((lambda (_2010) (syntax-violation (quote syntax) "bad `syntax' form" e2003)) tmp2004))) ($sc-dispatch tmp2004 (quote (any any))))) e2003))))) (global-extend1084 (quote core) (quote lambda) (lambda (e2011 r2012 w2013 s2014 mod2015) ((lambda (tmp2016) ((lambda (tmp2017) (if tmp2017 (apply (lambda (_2018 c2019) (chi-lambda-clause1127 (source-wrap1115 e2011 w2013 s2014 mod2015) #f c2019 r2012 w2013 mod2015 (lambda (vars2020 docstring2021 body2022) (build-annotated1063 s2014 (cons (quote lambda) (cons vars2020 (append (if docstring2021 (list docstring2021) (quote ())) (list body2022)))))))) tmp2017) (syntax-violation #f "source expression failed to match any pattern" tmp2016))) ($sc-dispatch tmp2016 (quote (any . any))))) e2011))) (global-extend1084 (quote core) (quote let) (letrec ((chi-let2023 (lambda (e2024 r2025 w2026 s2027 mod2028 constructor2029 ids2030 vals2031 exps2032) (if (not (valid-bound-ids?1111 ids2030)) (syntax-violation (quote let) "duplicate bound variable" e2024) (let ((labels2033 (gen-labels1092 ids2030)) (new-vars2034 (map gen-var1134 ids2030))) (let ((nw2035 (make-binding-wrap1103 ids2030 labels2033 w2026)) (nr2036 (extend-var-env1081 labels2033 new-vars2034 r2025))) (constructor2029 s2027 new-vars2034 (map (lambda (x2037) (chi1122 x2037 r2025 w2026 mod2028)) vals2031) (chi-body1126 exps2032 (source-wrap1115 e2024 nw2035 s2027 mod2028) nr2036 nw2035 mod2028)))))))) (lambda (e2038 r2039 w2040 s2041 mod2042) ((lambda (tmp2043) ((lambda (tmp2044) (if tmp2044 (apply (lambda (_2045 id2046 val2047 e12048 e22049) (chi-let2023 e2038 r2039 w2040 s2041 mod2042 build-let1066 id2046 val2047 (cons e12048 e22049))) tmp2044) ((lambda (tmp2053) (if (if tmp2053 (apply (lambda (_2054 f2055 id2056 val2057 e12058 e22059) (id?1086 f2055)) tmp2053) #f) (apply (lambda (_2060 f2061 id2062 val2063 e12064 e22065) (chi-let2023 e2038 r2039 w2040 s2041 mod2042 build-named-let1067 (cons f2061 id2062) val2063 (cons e12064 e22065))) tmp2053) ((lambda (_2069) (syntax-violation (quote let) "bad let" (source-wrap1115 e2038 w2040 s2041 mod2042))) tmp2043))) ($sc-dispatch tmp2043 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2043 (quote (any #(each (any any)) any . each-any))))) e2038)))) (global-extend1084 (quote core) (quote letrec) (lambda (e2070 r2071 w2072 s2073 mod2074) ((lambda (tmp2075) ((lambda (tmp2076) (if tmp2076 (apply (lambda (_2077 id2078 val2079 e12080 e22081) (let ((ids2082 id2078)) (if (not (valid-bound-ids?1111 ids2082)) (syntax-violation (quote letrec) "duplicate bound variable" e2070) (let ((labels2084 (gen-labels1092 ids2082)) (new-vars2085 (map gen-var1134 ids2082))) (let ((w2086 (make-binding-wrap1103 ids2082 labels2084 w2072)) (r2087 (extend-var-env1081 labels2084 new-vars2085 r2071))) (build-letrec1068 s2073 new-vars2085 (map (lambda (x2088) (chi1122 x2088 r2087 w2086 mod2074)) val2079) (chi-body1126 (cons e12080 e22081) (source-wrap1115 e2070 w2086 s2073 mod2074) r2087 w2086 mod2074))))))) tmp2076) ((lambda (_2091) (syntax-violation (quote letrec) "bad letrec" (source-wrap1115 e2070 w2072 s2073 mod2074))) tmp2075))) ($sc-dispatch tmp2075 (quote (any #(each (any any)) any . each-any))))) e2070))) (global-extend1084 (quote core) (quote set!) (lambda (e2092 r2093 w2094 s2095 mod2096) ((lambda (tmp2097) ((lambda (tmp2098) (if (if tmp2098 (apply (lambda (_2099 id2100 val2101) (id?1086 id2100)) tmp2098) #f) (apply (lambda (_2102 id2103 val2104) (let ((val2105 (chi1122 val2104 r2093 w2094 mod2096)) (n2106 (id-var-name1108 id2103 w2094))) (let ((b2107 (lookup1083 n2106 r2093 mod2096))) (let ((t2108 (binding-type1078 b2107))) (if (memv t2108 (quote (lexical))) (build-annotated1063 s2095 (list (quote set!) (binding-value1079 b2107) val2105)) (if (memv t2108 (quote (global))) (build-annotated1063 s2095 (list (quote set!) (if mod2096 (make-module-ref (cdr mod2096) n2106 (car mod2096)) (make-module-ref mod2096 n2106 (quote bare))) val2105)) (if (memv t2108 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1114 id2103 w2094 mod2096)) (syntax-violation (quote set!) "bad set!" (source-wrap1115 e2092 w2094 s2095 mod2096))))))))) tmp2098) ((lambda (tmp2109) (if tmp2109 (apply (lambda (_2110 head2111 tail2112 val2113) (call-with-values (lambda () (syntax-type1120 head2111 r2093 (quote (())) #f #f mod2096)) (lambda (type2114 value2115 ee2116 ww2117 ss2118 modmod2119) (let ((t2120 type2114)) (if (memv t2120 (quote (module-ref))) (let ((val2121 (chi1122 val2113 r2093 w2094 mod2096))) (call-with-values (lambda () (value2115 (cons head2111 tail2112))) (lambda (id2123 mod2124) (build-annotated1063 s2095 (list (quote set!) (if mod2124 (make-module-ref (cdr mod2124) id2123 (car mod2124)) (make-module-ref mod2124 id2123 (quote bare))) val2121))))) (build-annotated1063 s2095 (cons (chi1122 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) head2111) r2093 w2094 mod2096) (map (lambda (e2125) (chi1122 e2125 r2093 w2094 mod2096)) (append tail2112 (list val2113)))))))))) tmp2109) ((lambda (_2127) (syntax-violation (quote set!) "bad set!" (source-wrap1115 e2092 w2094 s2095 mod2096))) tmp2097))) ($sc-dispatch tmp2097 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2097 (quote (any any any))))) e2092))) (global-extend1084 (quote module-ref) (quote @) (lambda (e2128) ((lambda (tmp2129) ((lambda (tmp2130) (if (if tmp2130 (apply (lambda (_2131 mod2132 id2133) (and (and-map id?1086 mod2132) (id?1086 id2133))) tmp2130) #f) (apply (lambda (_2135 mod2136 id2137) (values (syntax->datum id2137) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) mod2136)))) tmp2130) (syntax-violation #f "source expression failed to match any pattern" tmp2129))) ($sc-dispatch tmp2129 (quote (any each-any any))))) e2128))) (global-extend1084 (quote module-ref) (quote @@) (lambda (e2139) ((lambda (tmp2140) ((lambda (tmp2141) (if (if tmp2141 (apply (lambda (_2142 mod2143 id2144) (and (and-map id?1086 mod2143) (id?1086 id2144))) tmp2141) #f) (apply (lambda (_2146 mod2147 id2148) (values (syntax->datum id2148) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) mod2147)))) tmp2141) (syntax-violation #f "source expression failed to match any pattern" tmp2140))) ($sc-dispatch tmp2140 (quote (any each-any any))))) e2139))) (global-extend1084 (quote begin) (quote begin) (quote ())) (global-extend1084 (quote define) (quote define) (quote ())) (global-extend1084 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1084 (quote eval-when) (quote eval-when) (quote ())) (global-extend1084 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2153 (lambda (x2154 keys2155 clauses2156 r2157 mod2158) (if (null? clauses2156) (build-annotated1063 #f (list (build-annotated1063 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2154)) ((lambda (tmp2159) ((lambda (tmp2160) (if tmp2160 (apply (lambda (pat2161 exp2162) (if (and (id?1086 pat2161) (and-map (lambda (x2163) (not (free-id=?1109 pat2161 x2163))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) keys2155))) (let ((labels2164 (list (gen-label1091))) (var2165 (gen-var1134 pat2161))) (build-annotated1063 #f (list (build-annotated1063 #f (list (quote lambda) (list var2165) (chi1122 exp2162 (extend-env1080 labels2164 (list (cons (quote syntax) (cons var2165 0))) r2157) (make-binding-wrap1103 (list pat2161) labels2164 (quote (()))) mod2158))) x2154))) (gen-clause2152 x2154 keys2155 (cdr clauses2156) r2157 pat2161 #t exp2162 mod2158))) tmp2160) ((lambda (tmp2166) (if tmp2166 (apply (lambda (pat2167 fender2168 exp2169) (gen-clause2152 x2154 keys2155 (cdr clauses2156) r2157 pat2167 fender2168 exp2169 mod2158)) tmp2166) ((lambda (_2170) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2156))) tmp2159))) ($sc-dispatch tmp2159 (quote (any any any)))))) ($sc-dispatch tmp2159 (quote (any any))))) (car clauses2156))))) (gen-clause2152 (lambda (x2171 keys2172 clauses2173 r2174 pat2175 fender2176 exp2177 mod2178) (call-with-values (lambda () (convert-pattern2150 pat2175 keys2172)) (lambda (p2179 pvars2180) (cond ((not (distinct-bound-ids?1112 (map car pvars2180))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2175)) ((not (and-map (lambda (x2181) (not (ellipsis?1131 (car x2181)))) pvars2180)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2175)) (else (let ((y2182 (gen-var1134 (quote tmp)))) (build-annotated1063 #f (list (build-annotated1063 #f (list (quote lambda) (list y2182) (let ((y2183 (build-annotated1063 #f y2182))) (build-annotated1063 #f (list (quote if) ((lambda (tmp2184) ((lambda (tmp2185) (if tmp2185 (apply (lambda () y2183) tmp2185) ((lambda (_2186) (build-annotated1063 #f (list (quote if) y2183 (build-dispatch-call2151 pvars2180 fender2176 y2183 r2174 mod2178) (build-data1064 #f #f)))) tmp2184))) ($sc-dispatch tmp2184 (quote #(atom #t))))) fender2176) (build-dispatch-call2151 pvars2180 exp2177 y2183 r2174 mod2178) (gen-syntax-case2153 x2171 keys2172 clauses2173 r2174 mod2178)))))) (if (eq? p2179 (quote any)) (build-annotated1063 #f (list (build-annotated1063 #f (quote list)) x2171)) (build-annotated1063 #f (list (build-annotated1063 #f (quote $sc-dispatch)) x2171 (build-data1064 #f p2179))))))))))))) (build-dispatch-call2151 (lambda (pvars2187 exp2188 y2189 r2190 mod2191) (let ((ids2192 (map car pvars2187)) (levels2193 (map cdr pvars2187))) (let ((labels2194 (gen-labels1092 ids2192)) (new-vars2195 (map gen-var1134 ids2192))) (build-annotated1063 #f (list (build-annotated1063 #f (quote apply)) (build-annotated1063 #f (list (quote lambda) new-vars2195 (chi1122 exp2188 (extend-env1080 labels2194 (map (lambda (var2196 level2197) (cons (quote syntax) (cons var2196 level2197))) new-vars2195 (map cdr pvars2187)) r2190) (make-binding-wrap1103 ids2192 labels2194 (quote (()))) mod2191))) y2189)))))) (convert-pattern2150 (lambda (pattern2198 keys2199) (let cvt2200 ((p2201 pattern2198) (n2202 0) (ids2203 (quote ()))) (if (id?1086 p2201) (if (bound-id-member?1113 p2201 keys2199) (values (vector (quote free-id) p2201) ids2203) (values (quote any) (cons (cons p2201 n2202) ids2203))) ((lambda (tmp2204) ((lambda (tmp2205) (if (if tmp2205 (apply (lambda (x2206 dots2207) (ellipsis?1131 dots2207)) tmp2205) #f) (apply (lambda (x2208 dots2209) (call-with-values (lambda () (cvt2200 x2208 (fx+1055 n2202 1) ids2203)) (lambda (p2210 ids2211) (values (if (eq? p2210 (quote any)) (quote each-any) (vector (quote each) p2210)) ids2211)))) tmp2205) ((lambda (tmp2212) (if tmp2212 (apply (lambda (x2213 y2214) (call-with-values (lambda () (cvt2200 y2214 n2202 ids2203)) (lambda (y2215 ids2216) (call-with-values (lambda () (cvt2200 x2213 n2202 ids2216)) (lambda (x2217 ids2218) (values (cons x2217 y2215) ids2218)))))) tmp2212) ((lambda (tmp2219) (if tmp2219 (apply (lambda () (values (quote ()) ids2203)) tmp2219) ((lambda (tmp2220) (if tmp2220 (apply (lambda (x2221) (call-with-values (lambda () (cvt2200 x2221 n2202 ids2203)) (lambda (p2223 ids2224) (values (vector (quote vector) p2223) ids2224)))) tmp2220) ((lambda (x2225) (values (vector (quote atom) (strip1133 p2201 (quote (())))) ids2203)) tmp2204))) ($sc-dispatch tmp2204 (quote #(vector each-any)))))) ($sc-dispatch tmp2204 (quote ()))))) ($sc-dispatch tmp2204 (quote (any . any)))))) ($sc-dispatch tmp2204 (quote (any any))))) p2201)))))) (lambda (e2226 r2227 w2228 s2229 mod2230) (let ((e2231 (source-wrap1115 e2226 w2228 s2229 mod2230))) ((lambda (tmp2232) ((lambda (tmp2233) (if tmp2233 (apply (lambda (_2234 val2235 key2236 m2237) (if (and-map (lambda (x2238) (and (id?1086 x2238) (not (ellipsis?1131 x2238)))) key2236) (let ((x2240 (gen-var1134 (quote tmp)))) (build-annotated1063 s2229 (list (build-annotated1063 #f (list (quote lambda) (list x2240) (gen-syntax-case2153 (build-annotated1063 #f x2240) key2236 m2237 r2227 mod2230))) (chi1122 val2235 r2227 (quote (())) mod2230)))) (syntax-violation (quote syntax-case) "invalid literals list" e2231))) tmp2233) (syntax-violation #f "source expression failed to match any pattern" tmp2232))) ($sc-dispatch tmp2232 (quote (any any each-any . each-any))))) e2231))))) (set! sc-expand (let ((m2243 (quote e)) (esew2244 (quote (eval)))) (lambda (x2246 . rest2245) (if (and (pair? x2246) (equal? (car x2246) noexpand1054)) (cadr x2246) (chi-top1121 x2246 (quote ()) (quote ((top))) (if (null? rest2245) m2243 (car rest2245)) (if (or (null? rest2245) (null? (cdr rest2245))) esew2244 (cadr rest2245)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2247) (nonsymbol-id?1085 x2247))) (set! datum->syntax (lambda (id2248 datum2249) (make-syntax-object1069 datum2249 (syntax-object-wrap1072 id2248) #f))) (set! syntax->datum (lambda (x2250) (strip1133 x2250 (quote (()))))) (set! generate-temporaries (lambda (ls2251) (begin (let ((x2252 ls2251)) (if (not (list? x2252)) (syntax-violation (quote generate-temporaries) "invalid argument" x2252))) (map (lambda (x2253) (wrap1114 (gensym) (quote ((top))) #f)) ls2251)))) (set! free-identifier=? (lambda (x2254 y2255) (begin (let ((x2256 x2254)) (if (not (nonsymbol-id?1085 x2256)) (syntax-violation (quote free-identifier=?) "invalid argument" x2256))) (let ((x2257 y2255)) (if (not (nonsymbol-id?1085 x2257)) (syntax-violation (quote free-identifier=?) "invalid argument" x2257))) (free-id=?1109 x2254 y2255)))) (set! bound-identifier=? (lambda (x2258 y2259) (begin (let ((x2260 x2258)) (if (not (nonsymbol-id?1085 x2260)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2260))) (let ((x2261 y2259)) (if (not (nonsymbol-id?1085 x2261)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2261))) (bound-id=?1110 x2258 y2259)))) (set! syntax-violation (lambda (who2265 message2264 form2263 . subform2262) (begin (let ((x2266 who2265)) (if (not ((lambda (x2267) (or (not x2267) (string? x2267) (symbol? x2267))) x2266)) (syntax-violation (quote syntax-violation) "invalid argument" x2266))) (let ((x2268 message2264)) (if (not (string? x2268)) (syntax-violation (quote syntax-violation) "invalid argument" x2268))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2265 "~a: " "") "~a " (if (null? subform2262) "in ~a" "in subform `~s' of `~s'")) (let ((tail2269 (cons message2264 (map (lambda (x2270) (strip1133 x2270 (quote (())))) (append subform2262 (list form2263)))))) (if who2265 (cons who2265 tail2269) tail2269)) #f)))) (letrec ((match2275 (lambda (e2276 p2277 w2278 r2279 mod2280) (cond ((not r2279) #f) ((eq? p2277 (quote any)) (cons (wrap1114 e2276 w2278 mod2280) r2279)) ((syntax-object?1070 e2276) (match*2274 (let ((e2281 (syntax-object-expression1071 e2276))) (if (annotation? e2281) (annotation-expression e2281) e2281)) p2277 (join-wraps1105 w2278 (syntax-object-wrap1072 e2276)) r2279 (syntax-object-module1073 e2276))) (else (match*2274 (let ((e2282 e2276)) (if (annotation? e2282) (annotation-expression e2282) e2282)) p2277 w2278 r2279 mod2280))))) (match*2274 (lambda (e2283 p2284 w2285 r2286 mod2287) (cond ((null? p2284) (and (null? e2283) r2286)) ((pair? p2284) (and (pair? e2283) (match2275 (car e2283) (car p2284) w2285 (match2275 (cdr e2283) (cdr p2284) w2285 r2286 mod2287) mod2287))) ((eq? p2284 (quote each-any)) (let ((l2288 (match-each-any2272 e2283 w2285 mod2287))) (and l2288 (cons l2288 r2286)))) (else (let ((t2289 (vector-ref p2284 0))) (if (memv t2289 (quote (each))) (if (null? e2283) (match-empty2273 (vector-ref p2284 1) r2286) (let ((l2290 (match-each2271 e2283 (vector-ref p2284 1) w2285 mod2287))) (and l2290 (let collect2291 ((l2292 l2290)) (if (null? (car l2292)) r2286 (cons (map car l2292) (collect2291 (map cdr l2292)))))))) (if (memv t2289 (quote (free-id))) (and (id?1086 e2283) (free-id=?1109 (wrap1114 e2283 w2285 mod2287) (vector-ref p2284 1)) r2286) (if (memv t2289 (quote (atom))) (and (equal? (vector-ref p2284 1) (strip1133 e2283 w2285)) r2286) (if (memv t2289 (quote (vector))) (and (vector? e2283) (match2275 (vector->list e2283) (vector-ref p2284 1) w2285 r2286 mod2287))))))))))) (match-empty2273 (lambda (p2293 r2294) (cond ((null? p2293) r2294) ((eq? p2293 (quote any)) (cons (quote ()) r2294)) ((pair? p2293) (match-empty2273 (car p2293) (match-empty2273 (cdr p2293) r2294))) ((eq? p2293 (quote each-any)) (cons (quote ()) r2294)) (else (let ((t2295 (vector-ref p2293 0))) (if (memv t2295 (quote (each))) (match-empty2273 (vector-ref p2293 1) r2294) (if (memv t2295 (quote (free-id atom))) r2294 (if (memv t2295 (quote (vector))) (match-empty2273 (vector-ref p2293 1) r2294))))))))) (match-each-any2272 (lambda (e2296 w2297 mod2298) (cond ((annotation? e2296) (match-each-any2272 (annotation-expression e2296) w2297 mod2298)) ((pair? e2296) (let ((l2299 (match-each-any2272 (cdr e2296) w2297 mod2298))) (and l2299 (cons (wrap1114 (car e2296) w2297 mod2298) l2299)))) ((null? e2296) (quote ())) ((syntax-object?1070 e2296) (match-each-any2272 (syntax-object-expression1071 e2296) (join-wraps1105 w2297 (syntax-object-wrap1072 e2296)) mod2298)) (else #f)))) (match-each2271 (lambda (e2300 p2301 w2302 mod2303) (cond ((annotation? e2300) (match-each2271 (annotation-expression e2300) p2301 w2302 mod2303)) ((pair? e2300) (let ((first2304 (match2275 (car e2300) p2301 w2302 (quote ()) mod2303))) (and first2304 (let ((rest2305 (match-each2271 (cdr e2300) p2301 w2302 mod2303))) (and rest2305 (cons first2304 rest2305)))))) ((null? e2300) (quote ())) ((syntax-object?1070 e2300) (match-each2271 (syntax-object-expression1071 e2300) p2301 (join-wraps1105 w2302 (syntax-object-wrap1072 e2300)) (syntax-object-module1073 e2300))) (else #f))))) (set! $sc-dispatch (lambda (e2306 p2307) (cond ((eq? p2307 (quote any)) (list e2306)) ((syntax-object?1070 e2306) (match*2274 (let ((e2308 (syntax-object-expression1071 e2306))) (if (annotation? e2308) (annotation-expression e2308) e2308)) p2307 (syntax-object-wrap1072 e2306) (quote ()) (syntax-object-module1073 e2306))) (else (match*2274 (let ((e2309 e2306)) (if (annotation? e2309) (annotation-expression e2309) e2309)) p2307 (quote (())) (quote ()) #f)))))))))
4 (define with-syntax (make-syncase-macro (quote macro) (lambda (x2310) ((lambda (tmp2311) ((lambda (tmp2312) (if tmp2312 (apply (lambda (_2313 e12314 e22315) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12314 e22315))) tmp2312) ((lambda (tmp2317) (if tmp2317 (apply (lambda (_2318 out2319 in2320 e12321 e22322) (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))) in2320 (quote ()) (list out2319 (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 e12321 e22322))))) tmp2317) ((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))) (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))) 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) (syntax-violation #f "source expression failed to match any pattern" tmp2311))) ($sc-dispatch tmp2311 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2311 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2311 (quote (any () any . each-any))))) x2310))))
5 (define syntax-rules (make-syncase-macro (quote macro) (lambda (x2333) ((lambda (tmp2334) ((lambda (tmp2335) (if tmp2335 (apply (lambda (_2336 k2337 keyword2338 pattern2339 template2340) (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 k2337 (map (lambda (tmp2343 tmp2342) (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))) tmp2342) (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))) tmp2343))) template2340 pattern2339)))))) tmp2335) (syntax-violation #f "source expression failed to match any pattern" tmp2334))) ($sc-dispatch tmp2334 (quote (any each-any . #(each ((any . any) any))))))) x2333))))
6 (define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2344) ((lambda (tmp2345) ((lambda (tmp2346) (if (if tmp2346 (apply (lambda (let*2347 x2348 v2349 e12350 e22351) (and-map identifier? x2348)) tmp2346) #f) (apply (lambda (let*2353 x2354 v2355 e12356 e22357) (let f2358 ((bindings2359 (map list x2354 v2355))) (if (null? bindings2359) (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 e12356 e22357))) ((lambda (tmp2363) ((lambda (tmp2364) (if tmp2364 (apply (lambda (body2365 binding2366) (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 binding2366) body2365)) tmp2364) (syntax-violation #f "source expression failed to match any pattern" tmp2363))) ($sc-dispatch tmp2363 (quote (any any))))) (list (f2358 (cdr bindings2359)) (car bindings2359)))))) tmp2346) (syntax-violation #f "source expression failed to match any pattern" tmp2345))) ($sc-dispatch tmp2345 (quote (any #(each (any any)) any . each-any))))) x2344))))
7 (define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2367) ((lambda (tmp2368) ((lambda (tmp2369) (if tmp2369 (apply (lambda (_2370 var2371 init2372 step2373 e02374 e12375 c2376) ((lambda (tmp2377) ((lambda (tmp2378) (if tmp2378 (apply (lambda (step2379) ((lambda (tmp2380) ((lambda (tmp2381) (if tmp2381 (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 var2371 init2372) (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))) e02374) (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 c2376 (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))) step2379))))))) tmp2381) ((lambda (tmp2386) (if tmp2386 (apply (lambda (e12387 e22388) (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 var2371 init2372) (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))) e02374 (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 e12387 e22388)) (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 c2376 (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))) step2379))))))) tmp2386) (syntax-violation #f "source expression failed to match any pattern" tmp2380))) ($sc-dispatch tmp2380 (quote (any . each-any)))))) ($sc-dispatch tmp2380 (quote ())))) e12375)) tmp2378) (syntax-violation #f "source expression failed to match any pattern" tmp2377))) ($sc-dispatch tmp2377 (quote each-any)))) (map (lambda (v2395 s2396) ((lambda (tmp2397) ((lambda (tmp2398) (if tmp2398 (apply (lambda () v2395) tmp2398) ((lambda (tmp2399) (if tmp2399 (apply (lambda (e2400) e2400) tmp2399) ((lambda (_2401) (syntax-violation (quote do) "bad step expression" orig-x2367 s2396)) tmp2397))) ($sc-dispatch tmp2397 (quote (any)))))) ($sc-dispatch tmp2397 (quote ())))) s2396)) var2371 step2373))) tmp2369) (syntax-violation #f "source expression failed to match any pattern" tmp2368))) ($sc-dispatch tmp2368 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2367))))
8 (define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2404 (lambda (x2408 y2409) ((lambda (tmp2410) ((lambda (tmp2411) (if tmp2411 (apply (lambda (x2412 y2413) ((lambda (tmp2414) ((lambda (tmp2415) (if tmp2415 (apply (lambda (dy2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (dx2419) (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 dx2419 dy2416))) tmp2418) ((lambda (_2420) (if (null? dy2416) (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))) x2412) (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))) x2412 y2413))) tmp2417))) ($sc-dispatch tmp2417 (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))))) x2412)) tmp2415) ((lambda (tmp2421) (if tmp2421 (apply (lambda (stuff2422) (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 x2412 stuff2422))) tmp2421) ((lambda (else2423) (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))) x2412 y2413)) tmp2414))) ($sc-dispatch tmp2414 (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 tmp2414 (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))))) y2413)) tmp2411) (syntax-violation #f "source expression failed to match any pattern" tmp2410))) ($sc-dispatch tmp2410 (quote (any any))))) (list x2408 y2409)))) (quasiappend2405 (lambda (x2424 y2425) ((lambda (tmp2426) ((lambda (tmp2427) (if tmp2427 (apply (lambda (x2428 y2429) ((lambda (tmp2430) ((lambda (tmp2431) (if tmp2431 (apply (lambda () x2428) tmp2431) ((lambda (_2432) (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))) x2428 y2429)) tmp2430))) ($sc-dispatch tmp2430 (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))) ()))))) y2429)) tmp2427) (syntax-violation #f "source expression failed to match any pattern" tmp2426))) ($sc-dispatch tmp2426 (quote (any any))))) (list x2424 y2425)))) (quasivector2406 (lambda (x2433) ((lambda (tmp2434) ((lambda (x2435) ((lambda (tmp2436) ((lambda (tmp2437) (if tmp2437 (apply (lambda (x2438) (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 x2438))) tmp2437) ((lambda (tmp2440) (if tmp2440 (apply (lambda (x2441) (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))) x2441)) tmp2440) ((lambda (_2443) (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))) x2435)) tmp2436))) ($sc-dispatch tmp2436 (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 tmp2436 (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))))) x2435)) tmp2434)) x2433))) (quasi2407 (lambda (p2444 lev2445) ((lambda (tmp2446) ((lambda (tmp2447) (if tmp2447 (apply (lambda (p2448) (if (= lev2445 0) p2448 (quasicons2404 (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)))) (quasi2407 (list p2448) (- lev2445 1))))) tmp2447) ((lambda (tmp2449) (if tmp2449 (apply (lambda (p2450 q2451) (if (= lev2445 0) (quasiappend2405 p2450 (quasi2407 q2451 lev2445)) (quasicons2404 (quasicons2404 (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)))) (quasi2407 (list p2450) (- lev2445 1))) (quasi2407 q2451 lev2445)))) tmp2449) ((lambda (tmp2452) (if tmp2452 (apply (lambda (p2453) (quasicons2404 (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)))) (quasi2407 (list p2453) (+ lev2445 1)))) tmp2452) ((lambda (tmp2454) (if tmp2454 (apply (lambda (p2455 q2456) (quasicons2404 (quasi2407 p2455 lev2445) (quasi2407 q2456 lev2445))) tmp2454) ((lambda (tmp2457) (if tmp2457 (apply (lambda (x2458) (quasivector2406 (quasi2407 x2458 lev2445))) tmp2457) ((lambda (p2460) (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))) p2460)) tmp2446))) ($sc-dispatch tmp2446 (quote #(vector each-any)))))) ($sc-dispatch tmp2446 (quote (any . any)))))) ($sc-dispatch tmp2446 (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 tmp2446 (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 tmp2446 (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))))) p2444)))) (lambda (x2461) ((lambda (tmp2462) ((lambda (tmp2463) (if tmp2463 (apply (lambda (_2464 e2465) (quasi2407 e2465 0)) tmp2463) (syntax-violation #f "source expression failed to match any pattern" tmp2462))) ($sc-dispatch tmp2462 (quote (any any))))) x2461)))))
9 (define include (make-syncase-macro (quote macro) (lambda (x2466) (letrec ((read-file2467 (lambda (fn2468 k2469) (let ((p2470 (open-input-file fn2468))) (let f2471 ((x2472 (read p2470))) (if (eof-object? x2472) (begin (close-input-port p2470) (quote ())) (cons (datum->syntax k2469 x2472) (f2471 (read p2470))))))))) ((lambda (tmp2473) ((lambda (tmp2474) (if tmp2474 (apply (lambda (k2475 filename2476) (let ((fn2477 (syntax->datum filename2476))) ((lambda (tmp2478) ((lambda (tmp2479) (if tmp2479 (apply (lambda (exp2480) (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))) exp2480)) tmp2479) (syntax-violation #f "source expression failed to match any pattern" tmp2478))) ($sc-dispatch tmp2478 (quote each-any)))) (read-file2467 fn2477 k2475)))) tmp2474) (syntax-violation #f "source expression failed to match any pattern" tmp2473))) ($sc-dispatch tmp2473 (quote (any any))))) x2466)))))
10 (define unquote (make-syncase-macro (quote macro) (lambda (x2482) ((lambda (tmp2483) ((lambda (tmp2484) (if tmp2484 (apply (lambda (_2485 e2486) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x2482)) tmp2484) (syntax-violation #f "source expression failed to match any pattern" tmp2483))) ($sc-dispatch tmp2483 (quote (any any))))) x2482))))
11 (define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2487) ((lambda (tmp2488) ((lambda (tmp2489) (if tmp2489 (apply (lambda (_2490 e2491) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x2487)) tmp2489) (syntax-violation #f "source expression failed to match any pattern" tmp2488))) ($sc-dispatch tmp2488 (quote (any any))))) x2487))))
12 (define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2492) ((lambda (tmp2493) ((lambda (tmp2494) (if tmp2494 (apply (lambda (_2495 e2496 m12497 m22498) ((lambda (tmp2499) ((lambda (body2500) (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))) e2496)) body2500)) tmp2499)) (let f2501 ((clause2502 m12497) (clauses2503 m22498)) (if (null? clauses2503) ((lambda (tmp2505) ((lambda (tmp2506) (if tmp2506 (apply (lambda (e12507 e22508) (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 e12507 e22508))) tmp2506) ((lambda (tmp2510) (if tmp2510 (apply (lambda (k2511 e12512 e22513) (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))) k2511)) (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 e12512 e22513)))) tmp2510) ((lambda (_2516) (syntax-violation (quote case) "bad clause" x2492 clause2502)) tmp2505))) ($sc-dispatch tmp2505 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2505 (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))))) clause2502) ((lambda (tmp2517) ((lambda (rest2518) ((lambda (tmp2519) ((lambda (tmp2520) (if tmp2520 (apply (lambda (k2521 e12522 e22523) (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))) k2521)) (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 e12522 e22523)) rest2518)) tmp2520) ((lambda (_2526) (syntax-violation (quote case) "bad clause" x2492 clause2502)) tmp2519))) ($sc-dispatch tmp2519 (quote (each-any any . each-any))))) clause2502)) tmp2517)) (f2501 (car clauses2503) (cdr clauses2503))))))) tmp2494) (syntax-violation #f "source expression failed to match any pattern" tmp2493))) ($sc-dispatch tmp2493 (quote (any any any . each-any))))) x2492))))
13 (define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2527) ((lambda (tmp2528) ((lambda (tmp2529) (if tmp2529 (apply (lambda (_2530 e2531) (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))) e2531)) (list (cons _2530 (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 e2531 (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)))))))))) tmp2529) (syntax-violation #f "source expression failed to match any pattern" tmp2528))) ($sc-dispatch tmp2528 (quote (any any))))) x2527))))
HCoop / bpt / guile.git / blob