-(letrec ((lambda-var-list1141 (lambda (vars1340) (let lvl1341 ((vars1342 vars1340) (ls1343 (quote ())) (w1344 (quote (())))) (cond ((pair? vars1342) (lvl1341 (cdr vars1342) (cons (wrap1120 (car vars1342) w1344 #f) ls1343) w1344)) ((id?1092 vars1342) (cons (wrap1120 vars1342 w1344 #f) ls1343)) ((null? vars1342) ls1343) ((syntax-object?1076 vars1342) (lvl1341 (syntax-object-expression1077 vars1342) ls1343 (join-wraps1111 w1344 (syntax-object-wrap1078 vars1342)))) ((annotation? vars1342) (lvl1341 (annotation-expression vars1342) ls1343 w1344)) (else (cons vars1342 ls1343)))))) (gen-var1140 (lambda (id1345) (let ((id1346 (if (syntax-object?1076 id1345) (syntax-object-expression1077 id1345) id1345))) (if (annotation? id1346) (build-annotated1069 (annotation-source id1346) (gensym (symbol->string (annotation-expression id1346)))) (build-annotated1069 #f (gensym (symbol->string id1346))))))) (strip1139 (lambda (x1347 w1348) (if (memq (quote top) (wrap-marks1095 w1348)) (if (or (annotation? x1347) (and (pair? x1347) (annotation? (car x1347)))) (strip-annotation1138 x1347 #f) x1347) (let f1349 ((x1350 x1347)) (cond ((syntax-object?1076 x1350) (strip1139 (syntax-object-expression1077 x1350) (syntax-object-wrap1078 x1350))) ((pair? x1350) (let ((a1351 (f1349 (car x1350))) (d1352 (f1349 (cdr x1350)))) (if (and (eq? a1351 (car x1350)) (eq? d1352 (cdr x1350))) x1350 (cons a1351 d1352)))) ((vector? x1350) (let ((old1353 (vector->list x1350))) (let ((new1354 (map f1349 old1353))) (if (andmap eq? old1353 new1354) x1350 (list->vector new1354))))) (else x1350)))))) (strip-annotation1138 (lambda (x1355 parent1356) (cond ((pair? x1355) (let ((new1357 (cons #f #f))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1357)) (set-car! new1357 (strip-annotation1138 (car x1355) #f)) (set-cdr! new1357 (strip-annotation1138 (cdr x1355) #f)) new1357))) ((annotation? x1355) (or (annotation-stripped x1355) (strip-annotation1138 (annotation-expression x1355) x1355))) ((vector? x1355) (let ((new1358 (make-vector (vector-length x1355)))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1358)) (let loop1359 ((i1360 (- (vector-length x1355) 1))) (unless (fx<1062 i1360 0) (vector-set! new1358 i1360 (strip-annotation1138 (vector-ref x1355 i1360) #f)) (loop1359 (fx-1060 i1360 1)))) new1358))) (else x1355)))) (ellipsis?1137 (lambda (x1361) (and (nonsymbol-id?1091 x1361) (free-id=?1115 x1361 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))))))) (chi-void1136 (lambda () (build-annotated1069 #f (list (build-annotated1069 #f (quote void)))))) (eval-local-transformer1135 (lambda (expanded1362 mod1363) (let ((p1364 (local-eval-hook1064 expanded1362 mod1363))) (if (procedure? p1364) p1364 (syntax-error p1364 "nonprocedure transformer"))))) (chi-local-syntax1134 (lambda (rec?1365 e1366 r1367 w1368 s1369 mod1370 k1371) ((lambda (tmp1372) ((lambda (tmp1373) (if tmp1373 (apply (lambda (_1374 id1375 val1376 e11377 e21378) (let ((ids1379 id1375)) (if (not (valid-bound-ids?1117 ids1379)) (syntax-error e1366 "duplicate bound keyword in") (let ((labels1381 (gen-labels1098 ids1379))) (let ((new-w1382 (make-binding-wrap1109 ids1379 labels1381 w1368))) (k1371 (cons e11377 e21378) (extend-env1086 labels1381 (let ((w1384 (if rec?1365 new-w1382 w1368)) (trans-r1385 (macros-only-env1088 r1367))) (map (lambda (x1386) (cons (quote macro) (eval-local-transformer1135 (chi1128 x1386 trans-r1385 w1384 mod1370) mod1370))) val1376)) r1367) new-w1382 s1369 mod1370)))))) tmp1373) ((lambda (_1388) (syntax-error (source-wrap1121 e1366 w1368 s1369 mod1370))) tmp1372))) (syntax-dispatch tmp1372 (quote (any #(each (any any)) any . each-any))))) e1366))) (chi-lambda-clause1133 (lambda (e1389 c1390 r1391 w1392 mod1393 k1394) ((lambda (tmp1395) ((lambda (tmp1396) (if tmp1396 (apply (lambda (id1397 e11398 e21399) (let ((ids1400 id1397)) (if (not (valid-bound-ids?1117 ids1400)) (syntax-error e1389 "invalid parameter list in") (let ((labels1402 (gen-labels1098 ids1400)) (new-vars1403 (map gen-var1140 ids1400))) (k1394 new-vars1403 (chi-body1132 (cons e11398 e21399) e1389 (extend-var-env1087 labels1402 new-vars1403 r1391) (make-binding-wrap1109 ids1400 labels1402 w1392) mod1393)))))) tmp1396) ((lambda (tmp1405) (if tmp1405 (apply (lambda (ids1406 e11407 e21408) (let ((old-ids1409 (lambda-var-list1141 ids1406))) (if (not (valid-bound-ids?1117 old-ids1409)) (syntax-error e1389 "invalid parameter list in") (let ((labels1410 (gen-labels1098 old-ids1409)) (new-vars1411 (map gen-var1140 old-ids1409))) (k1394 (let f1412 ((ls11413 (cdr new-vars1411)) (ls21414 (car new-vars1411))) (if (null? ls11413) ls21414 (f1412 (cdr ls11413) (cons (car ls11413) ls21414)))) (chi-body1132 (cons e11407 e21408) e1389 (extend-var-env1087 labels1410 new-vars1411 r1391) (make-binding-wrap1109 old-ids1409 labels1410 w1392) mod1393)))))) tmp1405) ((lambda (_1416) (syntax-error e1389)) tmp1395))) (syntax-dispatch tmp1395 (quote (any any . each-any)))))) (syntax-dispatch tmp1395 (quote (each-any any . each-any))))) c1390))) (chi-body1132 (lambda (body1417 outer-form1418 r1419 w1420 mod1421) (let ((r1422 (cons (quote ("placeholder" placeholder)) r1419))) (let ((ribcage1423 (make-ribcage1099 (quote ()) (quote ()) (quote ())))) (let ((w1424 (make-wrap1094 (wrap-marks1095 w1420) (cons ribcage1423 (wrap-subst1096 w1420))))) (let parse1425 ((body1426 (map (lambda (x1432) (cons r1422 (wrap1120 x1432 w1424 mod1421))) body1417)) (ids1427 (quote ())) (labels1428 (quote ())) (vars1429 (quote ())) (vals1430 (quote ())) (bindings1431 (quote ()))) (if (null? body1426) (syntax-error outer-form1418 "no expressions in body") (let ((e1433 (cdar body1426)) (er1434 (caar body1426))) (call-with-values (lambda () (syntax-type1126 e1433 er1434 (quote (())) #f ribcage1423 mod1421)) (lambda (type1435 value1436 e1437 w1438 s1439 mod1440) (let ((t1441 type1435)) (if (memv t1441 (quote (define-form))) (let ((id1442 (wrap1120 value1436 w1438 mod1440)) (label1443 (gen-label1097))) (let ((var1444 (gen-var1140 id1442))) (begin (extend-ribcage!1108 ribcage1423 id1442 label1443) (parse1425 (cdr body1426) (cons id1442 ids1427) (cons label1443 labels1428) (cons var1444 vars1429) (cons (cons er1434 (wrap1120 e1437 w1438 mod1440)) vals1430) (cons (cons (quote lexical) var1444) bindings1431))))) (if (memv t1441 (quote (define-syntax-form))) (let ((id1445 (wrap1120 value1436 w1438 mod1440)) (label1446 (gen-label1097))) (begin (extend-ribcage!1108 ribcage1423 id1445 label1446) (parse1425 (cdr body1426) (cons id1445 ids1427) (cons label1446 labels1428) vars1429 vals1430 (cons (cons (quote macro) (cons er1434 (wrap1120 e1437 w1438 mod1440))) bindings1431)))) (if (memv t1441 (quote (begin-form))) ((lambda (tmp1447) ((lambda (tmp1448) (if tmp1448 (apply (lambda (_1449 e11450) (parse1425 (let f1451 ((forms1452 e11450)) (if (null? forms1452) (cdr body1426) (cons (cons er1434 (wrap1120 (car forms1452) w1438 mod1440)) (f1451 (cdr forms1452))))) ids1427 labels1428 vars1429 vals1430 bindings1431)) tmp1448) (syntax-error tmp1447))) (syntax-dispatch tmp1447 (quote (any . each-any))))) e1437) (if (memv t1441 (quote (local-syntax-form))) (chi-local-syntax1134 value1436 e1437 er1434 w1438 s1439 mod1440 (lambda (forms1454 er1455 w1456 s1457 mod1458) (parse1425 (let f1459 ((forms1460 forms1454)) (if (null? forms1460) (cdr body1426) (cons (cons er1455 (wrap1120 (car forms1460) w1456 mod1458)) (f1459 (cdr forms1460))))) ids1427 labels1428 vars1429 vals1430 bindings1431))) (if (null? ids1427) (build-sequence1071 #f (map (lambda (x1461) (chi1128 (cdr x1461) (car x1461) (quote (())) mod1440)) (cons (cons er1434 (source-wrap1121 e1437 w1438 s1439 mod1440)) (cdr body1426)))) (begin (if (not (valid-bound-ids?1117 ids1427)) (syntax-error outer-form1418 "invalid or duplicate identifier in definition")) (let loop1462 ((bs1463 bindings1431) (er-cache1464 #f) (r-cache1465 #f)) (if (not (null? bs1463)) (let ((b1466 (car bs1463))) (if (eq? (car b1466) (quote macro)) (let ((er1467 (cadr b1466))) (let ((r-cache1468 (if (eq? er1467 er-cache1464) r-cache1465 (macros-only-env1088 er1467)))) (begin (set-cdr! b1466 (eval-local-transformer1135 (chi1128 (cddr b1466) r-cache1468 (quote (())) mod1440) mod1440)) (loop1462 (cdr bs1463) er1467 r-cache1468)))) (loop1462 (cdr bs1463) er-cache1464 r-cache1465))))) (set-cdr! r1422 (extend-env1086 labels1428 bindings1431 (cdr r1422))) (build-letrec1074 #f vars1429 (map (lambda (x1469) (chi1128 (cdr x1469) (car x1469) (quote (())) mod1440)) vals1430) (build-sequence1071 #f (map (lambda (x1470) (chi1128 (cdr x1470) (car x1470) (quote (())) mod1440)) (cons (cons er1434 (source-wrap1121 e1437 w1438 s1439 mod1440)) (cdr body1426)))))))))))))))))))))) (chi-macro1131 (lambda (p1471 e1472 r1473 w1474 rib1475 mod1476) (letrec ((rebuild-macro-output1477 (lambda (x1478 m1479) (cond ((pair? x1478) (cons (rebuild-macro-output1477 (car x1478) m1479) (rebuild-macro-output1477 (cdr x1478) m1479))) ((syntax-object?1076 x1478) (let ((w1480 (syntax-object-wrap1078 x1478))) (let ((ms1481 (wrap-marks1095 w1480)) (s1482 (wrap-subst1096 w1480))) (if (and (pair? ms1481) (eq? (car ms1481) #f)) (make-syntax-object1075 (syntax-object-expression1077 x1478) (make-wrap1094 (cdr ms1481) (if rib1475 (cons rib1475 (cdr s1482)) (cdr s1482))) (syntax-object-module1079 x1478)) (make-syntax-object1075 (syntax-object-expression1077 x1478) (make-wrap1094 (cons m1479 ms1481) (if rib1475 (cons rib1475 (cons (quote shift) s1482)) (cons (quote shift) s1482))) (module-name (procedure-module p1471))))))) ((vector? x1478) (let ((n1483 (vector-length x1478))) (let ((v1484 (make-vector n1483))) (let doloop1485 ((i1486 0)) (if (fx=1061 i1486 n1483) v1484 (begin (vector-set! v1484 i1486 (rebuild-macro-output1477 (vector-ref x1478 i1486) m1479)) (doloop1485 (fx+1059 i1486 1)))))))) ((symbol? x1478) (syntax-error x1478 "encountered raw symbol in macro output")) (else x1478))))) (rebuild-macro-output1477 (p1471 (wrap1120 e1472 (anti-mark1107 w1474) mod1476)) (string #\m))))) (chi-application1130 (lambda (x1487 e1488 r1489 w1490 s1491 mod1492) ((lambda (tmp1493) ((lambda (tmp1494) (if tmp1494 (apply (lambda (e01495 e11496) (build-annotated1069 s1491 (cons x1487 (map (lambda (e1497) (chi1128 e1497 r1489 w1490 mod1492)) e11496)))) tmp1494) (syntax-error tmp1493))) (syntax-dispatch tmp1493 (quote (any . each-any))))) e1488))) (chi-expr1129 (lambda (type1499 value1500 e1501 r1502 w1503 s1504 mod1505) (let ((t1506 type1499)) (if (memv t1506 (quote (lexical))) (build-annotated1069 s1504 value1500) (if (memv t1506 (quote (core external-macro))) (value1500 e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (module-ref))) (call-with-values (lambda () (value1500 e1501)) (lambda (id1507 mod1508) (build-annotated1069 s1504 (make-module-ref mod1508 id1507 #f)))) (if (memv t1506 (quote (lexical-call))) (chi-application1130 (build-annotated1069 (source-annotation1083 (car e1501)) value1500) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (global-call))) (chi-application1130 (build-annotated1069 (source-annotation1083 (car e1501)) (make-module-ref (if (syntax-object?1076 (car e1501)) (syntax-object-module1079 (car e1501)) mod1505) value1500 #f)) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (constant))) (build-data1070 s1504 (strip1139 (source-wrap1121 e1501 w1503 s1504 mod1505) (quote (())))) (if (memv t1506 (quote (global))) (build-annotated1069 s1504 (make-module-ref mod1505 value1500 #f)) (if (memv t1506 (quote (call))) (chi-application1130 (chi1128 (car e1501) r1502 w1503 mod1505) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (begin-form))) ((lambda (tmp1509) ((lambda (tmp1510) (if tmp1510 (apply (lambda (_1511 e11512 e21513) (chi-sequence1122 (cons e11512 e21513) r1502 w1503 s1504 mod1505)) tmp1510) (syntax-error tmp1509))) (syntax-dispatch tmp1509 (quote (any any . each-any))))) e1501) (if (memv t1506 (quote (local-syntax-form))) (chi-local-syntax1134 value1500 e1501 r1502 w1503 s1504 mod1505 chi-sequence1122) (if (memv t1506 (quote (eval-when-form))) ((lambda (tmp1515) ((lambda (tmp1516) (if tmp1516 (apply (lambda (_1517 x1518 e11519 e21520) (let ((when-list1521 (chi-when-list1125 e1501 x1518 w1503))) (if (memq (quote eval) when-list1521) (chi-sequence1122 (cons e11519 e21520) r1502 w1503 s1504 mod1505) (chi-void1136)))) tmp1516) (syntax-error tmp1515))) (syntax-dispatch tmp1515 (quote (any each-any any . each-any))))) e1501) (if (memv t1506 (quote (define-form define-syntax-form))) (syntax-error (wrap1120 value1500 w1503 mod1505) "invalid context for definition of") (if (memv t1506 (quote (syntax))) (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505) "reference to pattern variable outside syntax form") (if (memv t1506 (quote (displaced-lexical))) (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505) "reference to identifier outside its scope") (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505))))))))))))))))))) (chi1128 (lambda (e1524 r1525 w1526 mod1527) (call-with-values (lambda () (syntax-type1126 e1524 r1525 w1526 #f #f mod1527)) (lambda (type1528 value1529 e1530 w1531 s1532 mod1533) (chi-expr1129 type1528 value1529 e1530 r1525 w1531 s1532 mod1533))))) (chi-top1127 (lambda (e1534 r1535 w1536 m1537 esew1538 mod1539) (call-with-values (lambda () (syntax-type1126 e1534 r1535 w1536 #f #f mod1539)) (lambda (type1547 value1548 e1549 w1550 s1551 mod1552) (let ((t1553 type1547)) (if (memv t1553 (quote (begin-form))) ((lambda (tmp1554) ((lambda (tmp1555) (if tmp1555 (apply (lambda (_1556) (chi-void1136)) tmp1555) ((lambda (tmp1557) (if tmp1557 (apply (lambda (_1558 e11559 e21560) (chi-top-sequence1123 (cons e11559 e21560) r1535 w1550 s1551 m1537 esew1538 mod1552)) tmp1557) (syntax-error tmp1554))) (syntax-dispatch tmp1554 (quote (any any . each-any)))))) (syntax-dispatch tmp1554 (quote (any))))) e1549) (if (memv t1553 (quote (local-syntax-form))) (chi-local-syntax1134 value1548 e1549 r1535 w1550 s1551 mod1552 (lambda (body1562 r1563 w1564 s1565 mod1566) (chi-top-sequence1123 body1562 r1563 w1564 s1565 m1537 esew1538 mod1566))) (if (memv t1553 (quote (eval-when-form))) ((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569 x1570 e11571 e21572) (let ((when-list1573 (chi-when-list1125 e1549 x1570 w1550)) (body1574 (cons e11571 e21572))) (cond ((eq? m1537 (quote e)) (if (memq (quote eval) when-list1573) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote e) (quote (eval)) mod1552) (chi-void1136))) ((memq (quote load) when-list1573) (if (or (memq (quote compile) when-list1573) (and (eq? m1537 (quote c&e)) (memq (quote eval) when-list1573))) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote c&e) (quote (compile load)) mod1552) (if (memq m1537 (quote (c c&e))) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote c) (quote (load)) mod1552) (chi-void1136)))) ((or (memq (quote compile) when-list1573) (and (eq? m1537 (quote c&e)) (memq (quote eval) when-list1573))) (top-level-eval-hook1063 (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote e) (quote (eval)) mod1552) mod1552) (chi-void1136)) (else (chi-void1136))))) tmp1568) (syntax-error tmp1567))) (syntax-dispatch tmp1567 (quote (any each-any any . each-any))))) e1549) (if (memv t1553 (quote (define-syntax-form))) (let ((n1577 (id-var-name1114 value1548 w1550)) (r1578 (macros-only-env1088 r1535))) (let ((t1579 m1537)) (if (memv t1579 (quote (c))) (if (memq (quote compile) esew1538) (let ((e1580 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)))) (begin (top-level-eval-hook1063 e1580 mod1552) (if (memq (quote load) esew1538) e1580 (chi-void1136)))) (if (memq (quote load) esew1538) (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)) (chi-void1136))) (if (memv t1579 (quote (c&e))) (let ((e1581 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)))) (begin (top-level-eval-hook1063 e1581 mod1552) e1581)) (begin (if (memq (quote eval) esew1538) (top-level-eval-hook1063 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)) mod1552)) (chi-void1136)))))) (if (memv t1553 (quote (define-form))) (let ((n1582 (id-var-name1114 value1548 w1550))) (let ((type1583 (binding-type1084 (lookup1089 n1582 r1535 mod1552)))) (let ((t1584 type1583)) (if (memv t1584 (quote (global))) (let ((x1585 (build-annotated1069 s1551 (list (quote define) n1582 (chi1128 e1549 r1535 w1550 mod1552))))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1585 mod1552)) x1585)) (if (memv t1584 (quote (displaced-lexical))) (syntax-error (wrap1120 value1548 w1550 mod1552) "identifier out of context") (if (memv t1584 (quote (core macro module-ref))) (begin (remove-global-definition-hook1067 n1582 mod1552) (let ((x1586 (build-annotated1069 s1551 (list (quote define) n1582 (chi1128 e1549 r1535 w1550 mod1552))))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1586 mod1552)) x1586))) (syntax-error (wrap1120 value1548 w1550 mod1552) "cannot define keyword at top level"))))))) (let ((x1587 (chi-expr1129 type1547 value1548 e1549 r1535 w1550 s1551 mod1552))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1587 mod1552)) x1587)))))))))))) (syntax-type1126 (lambda (e1588 r1589 w1590 s1591 rib1592 mod1593) (cond ((symbol? e1588) (let ((n1594 (id-var-name1114 e1588 w1590))) (let ((b1595 (lookup1089 n1594 r1589 mod1593))) (let ((type1596 (binding-type1084 b1595))) (let ((t1597 type1596)) (if (memv t1597 (quote (lexical))) (values type1596 (binding-value1085 b1595) e1588 w1590 s1591 mod1593) (if (memv t1597 (quote (global))) (values type1596 n1594 e1588 w1590 s1591 mod1593) (if (memv t1597 (quote (macro))) (syntax-type1126 (chi-macro1131 (binding-value1085 b1595) e1588 r1589 w1590 rib1592 mod1593) r1589 (quote (())) s1591 rib1592 mod1593) (values type1596 (binding-value1085 b1595) e1588 w1590 s1591 mod1593))))))))) ((pair? e1588) (let ((first1598 (car e1588))) (if (id?1092 first1598) (let ((n1599 (id-var-name1114 first1598 w1590))) (let ((b1600 (lookup1089 n1599 r1589 (or (and (syntax-object?1076 first1598) (syntax-object-module1079 first1598)) mod1593)))) (let ((type1601 (binding-type1084 b1600))) (let ((t1602 type1601)) (if (memv t1602 (quote (lexical))) (values (quote lexical-call) (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (global))) (values (quote global-call) n1599 e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (macro))) (syntax-type1126 (chi-macro1131 (binding-value1085 b1600) e1588 r1589 w1590 rib1592 mod1593) r1589 (quote (())) s1591 rib1592 mod1593) (if (memv t1602 (quote (core external-macro module-ref))) (values type1601 (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (begin))) (values (quote begin-form) #f e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (eval-when))) (values (quote eval-when-form) #f e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (define))) ((lambda (tmp1603) ((lambda (tmp1604) (if (if tmp1604 (apply (lambda (_1605 name1606 val1607) (id?1092 name1606)) tmp1604) #f) (apply (lambda (_1608 name1609 val1610) (values (quote define-form) name1609 val1610 w1590 s1591 mod1593)) tmp1604) ((lambda (tmp1611) (if (if tmp1611 (apply (lambda (_1612 name1613 args1614 e11615 e21616) (and (id?1092 name1613) (valid-bound-ids?1117 (lambda-var-list1141 args1614)))) tmp1611) #f) (apply (lambda (_1617 name1618 args1619 e11620 e21621) (values (quote define-form) (wrap1120 name1618 w1590 mod1593) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) (wrap1120 (cons args1619 (cons e11620 e21621)) w1590 mod1593)) (quote (())) s1591 mod1593)) tmp1611) ((lambda (tmp1623) (if (if tmp1623 (apply (lambda (_1624 name1625) (id?1092 name1625)) tmp1623) #f) (apply (lambda (_1626 name1627) (values (quote define-form) (wrap1120 name1627 w1590 mod1593) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote (())) s1591 mod1593)) tmp1623) (syntax-error tmp1603))) (syntax-dispatch tmp1603 (quote (any any)))))) (syntax-dispatch tmp1603 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1603 (quote (any any any))))) e1588) (if (memv t1602 (quote (define-syntax))) ((lambda (tmp1628) ((lambda (tmp1629) (if (if tmp1629 (apply (lambda (_1630 name1631 val1632) (id?1092 name1631)) tmp1629) #f) (apply (lambda (_1633 name1634 val1635) (values (quote define-syntax-form) name1634 val1635 w1590 s1591 mod1593)) tmp1629) (syntax-error tmp1628))) (syntax-dispatch tmp1628 (quote (any any any))))) e1588) (values (quote call) #f e1588 w1590 s1591 mod1593)))))))))))))) (values (quote call) #f e1588 w1590 s1591 mod1593)))) ((syntax-object?1076 e1588) (syntax-type1126 (syntax-object-expression1077 e1588) r1589 (join-wraps1111 w1590 (syntax-object-wrap1078 e1588)) #f rib1592 (or (syntax-object-module1079 e1588) mod1593))) ((annotation? e1588) (syntax-type1126 (annotation-expression e1588) r1589 w1590 (annotation-source e1588) rib1592 mod1593)) ((self-evaluating? e1588) (values (quote constant) #f e1588 w1590 s1591 mod1593)) (else (values (quote other) #f e1588 w1590 s1591 mod1593))))) (chi-when-list1125 (lambda (e1636 when-list1637 w1638) (let f1639 ((when-list1640 when-list1637) (situations1641 (quote ()))) (if (null? when-list1640) situations1641 (f1639 (cdr when-list1640) (cons (let ((x1642 (car when-list1640))) (cond ((free-id=?1115 x1642 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote compile)) ((free-id=?1115 x1642 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote load)) ((free-id=?1115 x1642 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote eval)) (else (syntax-error (wrap1120 x1642 w1638 #f) "invalid eval-when situation")))) situations1641)))))) (chi-install-global1124 (lambda (name1643 e1644) (build-annotated1069 #f (list (build-annotated1069 #f (quote install-global-transformer)) (build-data1070 #f name1643) e1644)))) (chi-top-sequence1123 (lambda (body1645 r1646 w1647 s1648 m1649 esew1650 mod1651) (build-sequence1071 s1648 (let dobody1652 ((body1653 body1645) (r1654 r1646) (w1655 w1647) (m1656 m1649) (esew1657 esew1650) (mod1658 mod1651)) (if (null? body1653) (quote ()) (let ((first1659 (chi-top1127 (car body1653) r1654 w1655 m1656 esew1657 mod1658))) (cons first1659 (dobody1652 (cdr body1653) r1654 w1655 m1656 esew1657 mod1658)))))))) (chi-sequence1122 (lambda (body1660 r1661 w1662 s1663 mod1664) (build-sequence1071 s1663 (let dobody1665 ((body1666 body1660) (r1667 r1661) (w1668 w1662) (mod1669 mod1664)) (if (null? body1666) (quote ()) (let ((first1670 (chi1128 (car body1666) r1667 w1668 mod1669))) (cons first1670 (dobody1665 (cdr body1666) r1667 w1668 mod1669)))))))) (source-wrap1121 (lambda (x1671 w1672 s1673 defmod1674) (wrap1120 (if s1673 (make-annotation x1671 s1673 #f) x1671) w1672 defmod1674))) (wrap1120 (lambda (x1675 w1676 defmod1677) (cond ((and (null? (wrap-marks1095 w1676)) (null? (wrap-subst1096 w1676))) x1675) ((syntax-object?1076 x1675) (make-syntax-object1075 (syntax-object-expression1077 x1675) (join-wraps1111 w1676 (syntax-object-wrap1078 x1675)) (syntax-object-module1079 x1675))) ((null? x1675) x1675) (else (make-syntax-object1075 x1675 w1676 defmod1677))))) (bound-id-member?1119 (lambda (x1678 list1679) (and (not (null? list1679)) (or (bound-id=?1116 x1678 (car list1679)) (bound-id-member?1119 x1678 (cdr list1679)))))) (distinct-bound-ids?1118 (lambda (ids1680) (let distinct?1681 ((ids1682 ids1680)) (or (null? ids1682) (and (not (bound-id-member?1119 (car ids1682) (cdr ids1682))) (distinct?1681 (cdr ids1682))))))) (valid-bound-ids?1117 (lambda (ids1683) (and (let all-ids?1684 ((ids1685 ids1683)) (or (null? ids1685) (and (id?1092 (car ids1685)) (all-ids?1684 (cdr ids1685))))) (distinct-bound-ids?1118 ids1683)))) (bound-id=?1116 (lambda (i1686 j1687) (if (and (syntax-object?1076 i1686) (syntax-object?1076 j1687)) (and (eq? (let ((e1688 (syntax-object-expression1077 i1686))) (if (annotation? e1688) (annotation-expression e1688) e1688)) (let ((e1689 (syntax-object-expression1077 j1687))) (if (annotation? e1689) (annotation-expression e1689) e1689))) (same-marks?1113 (wrap-marks1095 (syntax-object-wrap1078 i1686)) (wrap-marks1095 (syntax-object-wrap1078 j1687)))) (eq? (let ((e1690 i1686)) (if (annotation? e1690) (annotation-expression e1690) e1690)) (let ((e1691 j1687)) (if (annotation? e1691) (annotation-expression e1691) e1691)))))) (free-id=?1115 (lambda (i1692 j1693) (and (eq? (let ((x1694 i1692)) (let ((e1695 (if (syntax-object?1076 x1694) (syntax-object-expression1077 x1694) x1694))) (if (annotation? e1695) (annotation-expression e1695) e1695))) (let ((x1696 j1693)) (let ((e1697 (if (syntax-object?1076 x1696) (syntax-object-expression1077 x1696) x1696))) (if (annotation? e1697) (annotation-expression e1697) e1697)))) (eq? (id-var-name1114 i1692 (quote (()))) (id-var-name1114 j1693 (quote (()))))))) (id-var-name1114 (lambda (id1698 w1699) (letrec ((search-vector-rib1702 (lambda (sym1708 subst1709 marks1710 symnames1711 ribcage1712) (let ((n1713 (vector-length symnames1711))) (let f1714 ((i1715 0)) (cond ((fx=1061 i1715 n1713) (search1700 sym1708 (cdr subst1709) marks1710)) ((and (eq? (vector-ref symnames1711 i1715) sym1708) (same-marks?1113 marks1710 (vector-ref (ribcage-marks1102 ribcage1712) i1715))) (values (vector-ref (ribcage-labels1103 ribcage1712) i1715) marks1710)) (else (f1714 (fx+1059 i1715 1)))))))) (search-list-rib1701 (lambda (sym1716 subst1717 marks1718 symnames1719 ribcage1720) (let f1721 ((symnames1722 symnames1719) (i1723 0)) (cond ((null? symnames1722) (search1700 sym1716 (cdr subst1717) marks1718)) ((and (eq? (car symnames1722) sym1716) (same-marks?1113 marks1718 (list-ref (ribcage-marks1102 ribcage1720) i1723))) (values (list-ref (ribcage-labels1103 ribcage1720) i1723) marks1718)) (else (f1721 (cdr symnames1722) (fx+1059 i1723 1))))))) (search1700 (lambda (sym1724 subst1725 marks1726) (if (null? subst1725) (values #f marks1726) (let ((fst1727 (car subst1725))) (if (eq? fst1727 (quote shift)) (search1700 sym1724 (cdr subst1725) (cdr marks1726)) (let ((symnames1728 (ribcage-symnames1101 fst1727))) (if (vector? symnames1728) (search-vector-rib1702 sym1724 subst1725 marks1726 symnames1728 fst1727) (search-list-rib1701 sym1724 subst1725 marks1726 symnames1728 fst1727))))))))) (cond ((symbol? id1698) (or (call-with-values (lambda () (search1700 id1698 (wrap-subst1096 w1699) (wrap-marks1095 w1699))) (lambda (x1730 . ignore1729) x1730)) id1698)) ((syntax-object?1076 id1698) (let ((id1731 (let ((e1733 (syntax-object-expression1077 id1698))) (if (annotation? e1733) (annotation-expression e1733) e1733))) (w11732 (syntax-object-wrap1078 id1698))) (let ((marks1734 (join-marks1112 (wrap-marks1095 w1699) (wrap-marks1095 w11732)))) (call-with-values (lambda () (search1700 id1731 (wrap-subst1096 w1699) marks1734)) (lambda (new-id1735 marks1736) (or new-id1735 (call-with-values (lambda () (search1700 id1731 (wrap-subst1096 w11732) marks1736)) (lambda (x1738 . ignore1737) x1738)) id1731)))))) ((annotation? id1698) (let ((id1739 (let ((e1740 id1698)) (if (annotation? e1740) (annotation-expression e1740) e1740)))) (or (call-with-values (lambda () (search1700 id1739 (wrap-subst1096 w1699) (wrap-marks1095 w1699))) (lambda (x1742 . ignore1741) x1742)) id1739))) (else (error-hook1065 (quote id-var-name) "invalid id" id1698)))))) (same-marks?1113 (lambda (x1743 y1744) (or (eq? x1743 y1744) (and (not (null? x1743)) (not (null? y1744)) (eq? (car x1743) (car y1744)) (same-marks?1113 (cdr x1743) (cdr y1744)))))) (join-marks1112 (lambda (m11745 m21746) (smart-append1110 m11745 m21746))) (join-wraps1111 (lambda (w11747 w21748) (let ((m11749 (wrap-marks1095 w11747)) (s11750 (wrap-subst1096 w11747))) (if (null? m11749) (if (null? s11750) w21748 (make-wrap1094 (wrap-marks1095 w21748) (smart-append1110 s11750 (wrap-subst1096 w21748)))) (make-wrap1094 (smart-append1110 m11749 (wrap-marks1095 w21748)) (smart-append1110 s11750 (wrap-subst1096 w21748))))))) (smart-append1110 (lambda (m11751 m21752) (if (null? m21752) m11751 (append m11751 m21752)))) (make-binding-wrap1109 (lambda (ids1753 labels1754 w1755) (if (null? ids1753) w1755 (make-wrap1094 (wrap-marks1095 w1755) (cons (let ((labelvec1756 (list->vector labels1754))) (let ((n1757 (vector-length labelvec1756))) (let ((symnamevec1758 (make-vector n1757)) (marksvec1759 (make-vector n1757))) (begin (let f1760 ((ids1761 ids1753) (i1762 0)) (if (not (null? ids1761)) (call-with-values (lambda () (id-sym-name&marks1093 (car ids1761) w1755)) (lambda (symname1763 marks1764) (begin (vector-set! symnamevec1758 i1762 symname1763) (vector-set! marksvec1759 i1762 marks1764) (f1760 (cdr ids1761) (fx+1059 i1762 1))))))) (make-ribcage1099 symnamevec1758 marksvec1759 labelvec1756))))) (wrap-subst1096 w1755)))))) (extend-ribcage!1108 (lambda (ribcage1765 id1766 label1767) (begin (set-ribcage-symnames!1104 ribcage1765 (cons (let ((e1768 (syntax-object-expression1077 id1766))) (if (annotation? e1768) (annotation-expression e1768) e1768)) (ribcage-symnames1101 ribcage1765))) (set-ribcage-marks!1105 ribcage1765 (cons (wrap-marks1095 (syntax-object-wrap1078 id1766)) (ribcage-marks1102 ribcage1765))) (set-ribcage-labels!1106 ribcage1765 (cons label1767 (ribcage-labels1103 ribcage1765)))))) (anti-mark1107 (lambda (w1769) (make-wrap1094 (cons #f (wrap-marks1095 w1769)) (cons (quote shift) (wrap-subst1096 w1769))))) (set-ribcage-labels!1106 (lambda (x1770 update1771) (vector-set! x1770 3 update1771))) (set-ribcage-marks!1105 (lambda (x1772 update1773) (vector-set! x1772 2 update1773))) (set-ribcage-symnames!1104 (lambda (x1774 update1775) (vector-set! x1774 1 update1775))) (ribcage-labels1103 (lambda (x1776) (vector-ref x1776 3))) (ribcage-marks1102 (lambda (x1777) (vector-ref x1777 2))) (ribcage-symnames1101 (lambda (x1778) (vector-ref x1778 1))) (ribcage?1100 (lambda (x1779) (and (vector? x1779) (= (vector-length x1779) 4) (eq? (vector-ref x1779 0) (quote ribcage))))) (make-ribcage1099 (lambda (symnames1780 marks1781 labels1782) (vector (quote ribcage) symnames1780 marks1781 labels1782))) (gen-labels1098 (lambda (ls1783) (if (null? ls1783) (quote ()) (cons (gen-label1097) (gen-labels1098 (cdr ls1783)))))) (gen-label1097 (lambda () (string #\i))) (wrap-subst1096 cdr) (wrap-marks1095 car) (make-wrap1094 cons) (id-sym-name&marks1093 (lambda (x1784 w1785) (if (syntax-object?1076 x1784) (values (let ((e1786 (syntax-object-expression1077 x1784))) (if (annotation? e1786) (annotation-expression e1786) e1786)) (join-marks1112 (wrap-marks1095 w1785) (wrap-marks1095 (syntax-object-wrap1078 x1784)))) (values (let ((e1787 x1784)) (if (annotation? e1787) (annotation-expression e1787) e1787)) (wrap-marks1095 w1785))))) (id?1092 (lambda (x1788) (cond ((symbol? x1788) #t) ((syntax-object?1076 x1788) (symbol? (let ((e1789 (syntax-object-expression1077 x1788))) (if (annotation? e1789) (annotation-expression e1789) e1789)))) ((annotation? x1788) (symbol? (annotation-expression x1788))) (else #f)))) (nonsymbol-id?1091 (lambda (x1790) (and (syntax-object?1076 x1790) (symbol? (let ((e1791 (syntax-object-expression1077 x1790))) (if (annotation? e1791) (annotation-expression e1791) e1791)))))) (global-extend1090 (lambda (type1792 sym1793 val1794) (put-global-definition-hook1066 sym1793 (cons type1792 val1794) (module-name (current-module))))) (lookup1089 (lambda (x1795 r1796 mod1797) (cond ((assq x1795 r1796) => cdr) ((symbol? x1795) (or (get-global-definition-hook1068 x1795 mod1797) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1088 (lambda (r1798) (if (null? r1798) (quote ()) (let ((a1799 (car r1798))) (if (eq? (cadr a1799) (quote macro)) (cons a1799 (macros-only-env1088 (cdr r1798))) (macros-only-env1088 (cdr r1798))))))) (extend-var-env1087 (lambda (labels1800 vars1801 r1802) (if (null? labels1800) r1802 (extend-var-env1087 (cdr labels1800) (cdr vars1801) (cons (cons (car labels1800) (cons (quote lexical) (car vars1801))) r1802))))) (extend-env1086 (lambda (labels1803 bindings1804 r1805) (if (null? labels1803) r1805 (extend-env1086 (cdr labels1803) (cdr bindings1804) (cons (cons (car labels1803) (car bindings1804)) r1805))))) (binding-value1085 cdr) (binding-type1084 car) (source-annotation1083 (lambda (x1806) (cond ((annotation? x1806) (annotation-source x1806)) ((syntax-object?1076 x1806) (source-annotation1083 (syntax-object-expression1077 x1806))) (else #f)))) (set-syntax-object-module!1082 (lambda (x1807 update1808) (vector-set! x1807 3 update1808))) (set-syntax-object-wrap!1081 (lambda (x1809 update1810) (vector-set! x1809 2 update1810))) (set-syntax-object-expression!1080 (lambda (x1811 update1812) (vector-set! x1811 1 update1812))) (syntax-object-module1079 (lambda (x1813) (vector-ref x1813 3))) (syntax-object-wrap1078 (lambda (x1814) (vector-ref x1814 2))) (syntax-object-expression1077 (lambda (x1815) (vector-ref x1815 1))) (syntax-object?1076 (lambda (x1816) (and (vector? x1816) (= (vector-length x1816) 4) (eq? (vector-ref x1816 0) (quote syntax-object))))) (make-syntax-object1075 (lambda (expression1817 wrap1818 module1819) (vector (quote syntax-object) expression1817 wrap1818 module1819))) (build-letrec1074 (lambda (src1820 vars1821 val-exps1822 body-exp1823) (if (null? vars1821) (build-annotated1069 src1820 body-exp1823) (build-annotated1069 src1820 (list (quote letrec) (map list vars1821 val-exps1822) body-exp1823))))) (build-named-let1073 (lambda (src1824 vars1825 val-exps1826 body-exp1827) (if (null? vars1825) (build-annotated1069 src1824 body-exp1827) (build-annotated1069 src1824 (list (quote let) (car vars1825) (map list (cdr vars1825) val-exps1826) body-exp1827))))) (build-let1072 (lambda (src1828 vars1829 val-exps1830 body-exp1831) (if (null? vars1829) (build-annotated1069 src1828 body-exp1831) (build-annotated1069 src1828 (list (quote let) (map list vars1829 val-exps1830) body-exp1831))))) (build-sequence1071 (lambda (src1832 exps1833) (if (null? (cdr exps1833)) (build-annotated1069 src1832 (car exps1833)) (build-annotated1069 src1832 (cons (quote begin) exps1833))))) (build-data1070 (lambda (src1834 exp1835) (if (and (self-evaluating? exp1835) (not (vector? exp1835))) (build-annotated1069 src1834 exp1835) (build-annotated1069 src1834 (list (quote quote) exp1835))))) (build-annotated1069 (lambda (src1836 exp1837) (if (and src1836 (not (annotation? exp1837))) (make-annotation exp1837 src1836 #t) exp1837))) (get-global-definition-hook1068 (lambda (symbol1838 module1839) (let ((module1840 (if module1839 (resolve-module module1839) (warn "wha" symbol1838 (current-module))))) (let ((v1841 (module-variable module1840 symbol1838))) (and v1841 (or (object-property v1841 (quote *sc-expander*)) (and (variable-bound? v1841) (macro? (variable-ref v1841)) (macro-transformer (variable-ref v1841)) guile-macro))))))) (remove-global-definition-hook1067 (lambda (symbol1842 modname1843) (let ((module1844 (if modname1843 (resolve-module modname1843) (current-module)))) (let ((v1845 (module-local-variable module1844 symbol1842))) (if v1845 (let ((p1846 (assq (quote *sc-expander*) (object-properties v1845)))) (set-object-properties! v1845 (delq p1846 (object-properties v1845))))))))) (put-global-definition-hook1066 (lambda (symbol1847 binding1848 modname1849) (let ((module1850 (if modname1849 (resolve-module modname1849) (current-module)))) (let ((v1851 (or (module-variable module1850 symbol1847) (let ((v1852 (make-variable (quote sc-macro)))) (begin (module-add! module1850 symbol1847 v1852) v1852))))) (begin (if (not (variable-bound? v1851)) (variable-set! v1851 (gensym))) (set-object-property! v1851 (quote *sc-expander*) binding1848)))))) (error-hook1065 (lambda (who1853 why1854 what1855) (error who1853 "~a ~s" why1854 what1855))) (local-eval-hook1064 (lambda (x1856 mod1857) (eval (list noexpand1058 x1856) (if mod1857 (resolve-module mod1857) (interaction-environment))))) (top-level-eval-hook1063 (lambda (x1858 mod1859) (eval (list noexpand1058 x1858) (if mod1859 (resolve-module mod1859) (interaction-environment))))) (fx<1062 <) (fx=1061 =) (fx-1060 -) (fx+1059 +) (noexpand1058 "noexpand")) (begin (global-extend1090 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1090 (quote local-syntax) (quote let-syntax) #f) (global-extend1090 (quote core) (quote fluid-let-syntax) (lambda (e1860 r1861 w1862 s1863 mod1864) ((lambda (tmp1865) ((lambda (tmp1866) (if (if tmp1866 (apply (lambda (_1867 var1868 val1869 e11870 e21871) (valid-bound-ids?1117 var1868)) tmp1866) #f) (apply (lambda (_1873 var1874 val1875 e11876 e21877) (let ((names1878 (map (lambda (x1879) (id-var-name1114 x1879 w1862)) var1874))) (begin (for-each (lambda (id1881 n1882) (let ((t1883 (binding-type1084 (lookup1089 n1882 r1861 mod1864)))) (if (memv t1883 (quote (displaced-lexical))) (syntax-error (source-wrap1121 id1881 w1862 s1863 mod1864) "identifier out of context")))) var1874 names1878) (chi-body1132 (cons e11876 e21877) (source-wrap1121 e1860 w1862 s1863 mod1864) (extend-env1086 names1878 (let ((trans-r1886 (macros-only-env1088 r1861))) (map (lambda (x1887) (cons (quote macro) (eval-local-transformer1135 (chi1128 x1887 trans-r1886 w1862 mod1864) mod1864))) val1875)) r1861) w1862 mod1864)))) tmp1866) ((lambda (_1889) (syntax-error (source-wrap1121 e1860 w1862 s1863 mod1864))) tmp1865))) (syntax-dispatch tmp1865 (quote (any #(each (any any)) any . each-any))))) e1860))) (global-extend1090 (quote core) (quote quote) (lambda (e1890 r1891 w1892 s1893 mod1894) ((lambda (tmp1895) ((lambda (tmp1896) (if tmp1896 (apply (lambda (_1897 e1898) (build-data1070 s1893 (strip1139 e1898 w1892))) tmp1896) ((lambda (_1899) (syntax-error (source-wrap1121 e1890 w1892 s1893 mod1894))) tmp1895))) (syntax-dispatch tmp1895 (quote (any any))))) e1890))) (global-extend1090 (quote core) (quote syntax) (letrec ((regen1907 (lambda (x1908) (let ((t1909 (car x1908))) (if (memv t1909 (quote (ref))) (build-annotated1069 #f (cadr x1908)) (if (memv t1909 (quote (primitive))) (build-annotated1069 #f (cadr x1908)) (if (memv t1909 (quote (quote))) (build-data1070 #f (cadr x1908)) (if (memv t1909 (quote (lambda))) (build-annotated1069 #f (list (quote lambda) (cadr x1908) (regen1907 (caddr x1908)))) (if (memv t1909 (quote (map))) (let ((ls1910 (map regen1907 (cdr x1908)))) (build-annotated1069 #f (cons (if (fx=1061 (length ls1910) 2) (build-annotated1069 #f (quote map)) (build-annotated1069 #f (quote map))) ls1910))) (build-annotated1069 #f (cons (build-annotated1069 #f (car x1908)) (map regen1907 (cdr x1908)))))))))))) (gen-vector1906 (lambda (x1911) (cond ((eq? (car x1911) (quote list)) (cons (quote vector) (cdr x1911))) ((eq? (car x1911) (quote quote)) (list (quote quote) (list->vector (cadr x1911)))) (else (list (quote list->vector) x1911))))) (gen-append1905 (lambda (x1912 y1913) (if (equal? y1913 (quote (quote ()))) x1912 (list (quote append) x1912 y1913)))) (gen-cons1904 (lambda (x1914 y1915) (let ((t1916 (car y1915))) (if (memv t1916 (quote (quote))) (if (eq? (car x1914) (quote quote)) (list (quote quote) (cons (cadr x1914) (cadr y1915))) (if (eq? (cadr y1915) (quote ())) (list (quote list) x1914) (list (quote cons) x1914 y1915))) (if (memv t1916 (quote (list))) (cons (quote list) (cons x1914 (cdr y1915))) (list (quote cons) x1914 y1915)))))) (gen-map1903 (lambda (e1917 map-env1918) (let ((formals1919 (map cdr map-env1918)) (actuals1920 (map (lambda (x1921) (list (quote ref) (car x1921))) map-env1918))) (cond ((eq? (car e1917) (quote ref)) (car actuals1920)) ((andmap (lambda (x1922) (and (eq? (car x1922) (quote ref)) (memq (cadr x1922) formals1919))) (cdr e1917)) (cons (quote map) (cons (list (quote primitive) (car e1917)) (map (let ((r1923 (map cons formals1919 actuals1920))) (lambda (x1924) (cdr (assq (cadr x1924) r1923)))) (cdr e1917))))) (else (cons (quote map) (cons (list (quote lambda) formals1919 e1917) actuals1920))))))) (gen-mappend1902 (lambda (e1925 map-env1926) (list (quote apply) (quote (primitive append)) (gen-map1903 e1925 map-env1926)))) (gen-ref1901 (lambda (src1927 var1928 level1929 maps1930) (if (fx=1061 level1929 0) (values var1928 maps1930) (if (null? maps1930) (syntax-error src1927 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1901 src1927 var1928 (fx-1060 level1929 1) (cdr maps1930))) (lambda (outer-var1931 outer-maps1932) (let ((b1933 (assq outer-var1931 (car maps1930)))) (if b1933 (values (cdr b1933) maps1930) (let ((inner-var1934 (gen-var1140 (quote tmp)))) (values inner-var1934 (cons (cons (cons outer-var1931 inner-var1934) (car maps1930)) outer-maps1932))))))))))) (gen-syntax1900 (lambda (src1935 e1936 r1937 maps1938 ellipsis?1939 mod1940) (if (id?1092 e1936) (let ((label1941 (id-var-name1114 e1936 (quote (()))))) (let ((b1942 (lookup1089 label1941 r1937 mod1940))) (if (eq? (binding-type1084 b1942) (quote syntax)) (call-with-values (lambda () (let ((var.lev1943 (binding-value1085 b1942))) (gen-ref1901 src1935 (car var.lev1943) (cdr var.lev1943) maps1938))) (lambda (var1944 maps1945) (values (list (quote ref) var1944) maps1945))) (if (ellipsis?1939 e1936) (syntax-error src1935 "misplaced ellipsis in syntax form") (values (list (quote quote) e1936) maps1938))))) ((lambda (tmp1946) ((lambda (tmp1947) (if (if tmp1947 (apply (lambda (dots1948 e1949) (ellipsis?1939 dots1948)) tmp1947) #f) (apply (lambda (dots1950 e1951) (gen-syntax1900 src1935 e1951 r1937 maps1938 (lambda (x1952) #f) mod1940)) tmp1947) ((lambda (tmp1953) (if (if tmp1953 (apply (lambda (x1954 dots1955 y1956) (ellipsis?1939 dots1955)) tmp1953) #f) (apply (lambda (x1957 dots1958 y1959) (let f1960 ((y1961 y1959) (k1962 (lambda (maps1963) (call-with-values (lambda () (gen-syntax1900 src1935 x1957 r1937 (cons (quote ()) maps1963) ellipsis?1939 mod1940)) (lambda (x1964 maps1965) (if (null? (car maps1965)) (syntax-error src1935 "extra ellipsis in syntax form") (values (gen-map1903 x1964 (car maps1965)) (cdr maps1965)))))))) ((lambda (tmp1966) ((lambda (tmp1967) (if (if tmp1967 (apply (lambda (dots1968 y1969) (ellipsis?1939 dots1968)) tmp1967) #f) (apply (lambda (dots1970 y1971) (f1960 y1971 (lambda (maps1972) (call-with-values (lambda () (k1962 (cons (quote ()) maps1972))) (lambda (x1973 maps1974) (if (null? (car maps1974)) (syntax-error src1935 "extra ellipsis in syntax form") (values (gen-mappend1902 x1973 (car maps1974)) (cdr maps1974)))))))) tmp1967) ((lambda (_1975) (call-with-values (lambda () (gen-syntax1900 src1935 y1961 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (y1976 maps1977) (call-with-values (lambda () (k1962 maps1977)) (lambda (x1978 maps1979) (values (gen-append1905 x1978 y1976) maps1979)))))) tmp1966))) (syntax-dispatch tmp1966 (quote (any . any))))) y1961))) tmp1953) ((lambda (tmp1980) (if tmp1980 (apply (lambda (x1981 y1982) (call-with-values (lambda () (gen-syntax1900 src1935 x1981 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (x1983 maps1984) (call-with-values (lambda () (gen-syntax1900 src1935 y1982 r1937 maps1984 ellipsis?1939 mod1940)) (lambda (y1985 maps1986) (values (gen-cons1904 x1983 y1985) maps1986)))))) tmp1980) ((lambda (tmp1987) (if tmp1987 (apply (lambda (e11988 e21989) (call-with-values (lambda () (gen-syntax1900 src1935 (cons e11988 e21989) r1937 maps1938 ellipsis?1939 mod1940)) (lambda (e1991 maps1992) (values (gen-vector1906 e1991) maps1992)))) tmp1987) ((lambda (_1993) (values (list (quote quote) e1936) maps1938)) tmp1946))) (syntax-dispatch tmp1946 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1946 (quote (any . any)))))) (syntax-dispatch tmp1946 (quote (any any . any)))))) (syntax-dispatch tmp1946 (quote (any any))))) e1936))))) (lambda (e1994 r1995 w1996 s1997 mod1998) (let ((e1999 (source-wrap1121 e1994 w1996 s1997 mod1998))) ((lambda (tmp2000) ((lambda (tmp2001) (if tmp2001 (apply (lambda (_2002 x2003) (call-with-values (lambda () (gen-syntax1900 e1999 x2003 r1995 (quote ()) ellipsis?1137 mod1998)) (lambda (e2004 maps2005) (regen1907 e2004)))) tmp2001) ((lambda (_2006) (syntax-error e1999)) tmp2000))) (syntax-dispatch tmp2000 (quote (any any))))) e1999))))) (global-extend1090 (quote core) (quote lambda) (lambda (e2007 r2008 w2009 s2010 mod2011) ((lambda (tmp2012) ((lambda (tmp2013) (if tmp2013 (apply (lambda (_2014 c2015) (chi-lambda-clause1133 (source-wrap1121 e2007 w2009 s2010 mod2011) c2015 r2008 w2009 mod2011 (lambda (vars2016 body2017) (build-annotated1069 s2010 (list (quote lambda) vars2016 body2017))))) tmp2013) (syntax-error tmp2012))) (syntax-dispatch tmp2012 (quote (any . any))))) e2007))) (global-extend1090 (quote core) (quote let) (letrec ((chi-let2018 (lambda (e2019 r2020 w2021 s2022 mod2023 constructor2024 ids2025 vals2026 exps2027) (if (not (valid-bound-ids?1117 ids2025)) (syntax-error e2019 "duplicate bound variable in") (let ((labels2028 (gen-labels1098 ids2025)) (new-vars2029 (map gen-var1140 ids2025))) (let ((nw2030 (make-binding-wrap1109 ids2025 labels2028 w2021)) (nr2031 (extend-var-env1087 labels2028 new-vars2029 r2020))) (constructor2024 s2022 new-vars2029 (map (lambda (x2032) (chi1128 x2032 r2020 w2021 mod2023)) vals2026) (chi-body1132 exps2027 (source-wrap1121 e2019 nw2030 s2022 mod2023) nr2031 nw2030 mod2023)))))))) (lambda (e2033 r2034 w2035 s2036 mod2037) ((lambda (tmp2038) ((lambda (tmp2039) (if tmp2039 (apply (lambda (_2040 id2041 val2042 e12043 e22044) (chi-let2018 e2033 r2034 w2035 s2036 mod2037 build-let1072 id2041 val2042 (cons e12043 e22044))) tmp2039) ((lambda (tmp2048) (if (if tmp2048 (apply (lambda (_2049 f2050 id2051 val2052 e12053 e22054) (id?1092 f2050)) tmp2048) #f) (apply (lambda (_2055 f2056 id2057 val2058 e12059 e22060) (chi-let2018 e2033 r2034 w2035 s2036 mod2037 build-named-let1073 (cons f2056 id2057) val2058 (cons e12059 e22060))) tmp2048) ((lambda (_2064) (syntax-error (source-wrap1121 e2033 w2035 s2036 mod2037))) tmp2038))) (syntax-dispatch tmp2038 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2038 (quote (any #(each (any any)) any . each-any))))) e2033)))) (global-extend1090 (quote core) (quote letrec) (lambda (e2065 r2066 w2067 s2068 mod2069) ((lambda (tmp2070) ((lambda (tmp2071) (if tmp2071 (apply (lambda (_2072 id2073 val2074 e12075 e22076) (let ((ids2077 id2073)) (if (not (valid-bound-ids?1117 ids2077)) (syntax-error e2065 "duplicate bound variable in") (let ((labels2079 (gen-labels1098 ids2077)) (new-vars2080 (map gen-var1140 ids2077))) (let ((w2081 (make-binding-wrap1109 ids2077 labels2079 w2067)) (r2082 (extend-var-env1087 labels2079 new-vars2080 r2066))) (build-letrec1074 s2068 new-vars2080 (map (lambda (x2083) (chi1128 x2083 r2082 w2081 mod2069)) val2074) (chi-body1132 (cons e12075 e22076) (source-wrap1121 e2065 w2081 s2068 mod2069) r2082 w2081 mod2069))))))) tmp2071) ((lambda (_2086) (syntax-error (source-wrap1121 e2065 w2067 s2068 mod2069))) tmp2070))) (syntax-dispatch tmp2070 (quote (any #(each (any any)) any . each-any))))) e2065))) (global-extend1090 (quote core) (quote set!) (lambda (e2087 r2088 w2089 s2090 mod2091) ((lambda (tmp2092) ((lambda (tmp2093) (if (if tmp2093 (apply (lambda (_2094 id2095 val2096) (id?1092 id2095)) tmp2093) #f) (apply (lambda (_2097 id2098 val2099) (let ((val2100 (chi1128 val2099 r2088 w2089 mod2091)) (n2101 (id-var-name1114 id2098 w2089))) (let ((b2102 (lookup1089 n2101 r2088 mod2091))) (let ((t2103 (binding-type1084 b2102))) (if (memv t2103 (quote (lexical))) (build-annotated1069 s2090 (list (quote set!) (binding-value1085 b2102) val2100)) (if (memv t2103 (quote (global))) (build-annotated1069 s2090 (list (quote set!) (make-module-ref mod2091 n2101 #f) val2100)) (if (memv t2103 (quote (displaced-lexical))) (syntax-error (wrap1120 id2098 w2089 mod2091) "identifier out of context") (syntax-error (source-wrap1121 e2087 w2089 s2090 mod2091))))))))) tmp2093) ((lambda (tmp2104) (if tmp2104 (apply (lambda (_2105 head2106 tail2107 val2108) (call-with-values (lambda () (syntax-type1126 head2106 r2088 (quote (())) #f #f mod2091)) (lambda (type2109 value2110 ee2111 ww2112 ss2113 modmod2114) (let ((t2115 type2109)) (if (memv t2115 (quote (module-ref))) (call-with-values (lambda () (value2110 (cons head2106 tail2107))) (lambda (id2117 mod2118) (build-annotated1069 s2090 (list (quote set!) (make-module-ref mod2118 id2117 #f) val2108)))) (build-annotated1069 s2090 (cons (chi1128 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) head2106) r2088 w2089 mod2091) (map (lambda (e2119) (chi1128 e2119 r2088 w2089 mod2091)) (append tail2107 (list val2108)))))))))) tmp2104) ((lambda (_2121) (syntax-error (source-wrap1121 e2087 w2089 s2090 mod2091))) tmp2092))) (syntax-dispatch tmp2092 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2092 (quote (any any any))))) e2087))) (global-extend1090 (quote module-ref) (quote @) (lambda (e2122) ((lambda (tmp2123) ((lambda (tmp2124) (if (if tmp2124 (apply (lambda (_2125 mod2126 id2127) (and (andmap id?1092 mod2126) (id?1092 id2127))) tmp2124) #f) (apply (lambda (_2129 mod2130 id2131) (values (syntax-object->datum id2131) (syntax-object->datum (append mod2130 (quote (#(syntax-object %module-public-interface ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))))))) tmp2124) (syntax-error tmp2123))) (syntax-dispatch tmp2123 (quote (any each-any any))))) e2122))) (global-extend1090 (quote module-ref) (quote @@) (lambda (e2133) ((lambda (tmp2134) ((lambda (tmp2135) (if (if tmp2135 (apply (lambda (_2136 mod2137 id2138) (and (andmap id?1092 mod2137) (id?1092 id2138))) tmp2135) #f) (apply (lambda (_2140 mod2141 id2142) (values (syntax-object->datum id2142) (syntax-object->datum mod2141))) tmp2135) (syntax-error tmp2134))) (syntax-dispatch tmp2134 (quote (any each-any any))))) e2133))) (global-extend1090 (quote begin) (quote begin) (quote ())) (global-extend1090 (quote define) (quote define) (quote ())) (global-extend1090 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1090 (quote eval-when) (quote eval-when) (quote ())) (global-extend1090 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2147 (lambda (x2148 keys2149 clauses2150 r2151 mod2152) (if (null? clauses2150) (build-annotated1069 #f (list (build-annotated1069 #f (quote syntax-error)) x2148)) ((lambda (tmp2153) ((lambda (tmp2154) (if tmp2154 (apply (lambda (pat2155 exp2156) (if (and (id?1092 pat2155) (andmap (lambda (x2157) (not (free-id=?1115 pat2155 x2157))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) keys2149))) (let ((labels2158 (list (gen-label1097))) (var2159 (gen-var1140 pat2155))) (build-annotated1069 #f (list (build-annotated1069 #f (list (quote lambda) (list var2159) (chi1128 exp2156 (extend-env1086 labels2158 (list (cons (quote syntax) (cons var2159 0))) r2151) (make-binding-wrap1109 (list pat2155) labels2158 (quote (()))) mod2152))) x2148))) (gen-clause2146 x2148 keys2149 (cdr clauses2150) r2151 pat2155 #t exp2156 mod2152))) tmp2154) ((lambda (tmp2160) (if tmp2160 (apply (lambda (pat2161 fender2162 exp2163) (gen-clause2146 x2148 keys2149 (cdr clauses2150) r2151 pat2161 fender2162 exp2163 mod2152)) tmp2160) ((lambda (_2164) (syntax-error (car clauses2150) "invalid syntax-case clause")) tmp2153))) (syntax-dispatch tmp2153 (quote (any any any)))))) (syntax-dispatch tmp2153 (quote (any any))))) (car clauses2150))))) (gen-clause2146 (lambda (x2165 keys2166 clauses2167 r2168 pat2169 fender2170 exp2171 mod2172) (call-with-values (lambda () (convert-pattern2144 pat2169 keys2166)) (lambda (p2173 pvars2174) (cond ((not (distinct-bound-ids?1118 (map car pvars2174))) (syntax-error pat2169 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2175) (not (ellipsis?1137 (car x2175)))) pvars2174)) (syntax-error pat2169 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2176 (gen-var1140 (quote tmp)))) (build-annotated1069 #f (list (build-annotated1069 #f (list (quote lambda) (list y2176) (let ((y2177 (build-annotated1069 #f y2176))) (build-annotated1069 #f (list (quote if) ((lambda (tmp2178) ((lambda (tmp2179) (if tmp2179 (apply (lambda () y2177) tmp2179) ((lambda (_2180) (build-annotated1069 #f (list (quote if) y2177 (build-dispatch-call2145 pvars2174 fender2170 y2177 r2168 mod2172) (build-data1070 #f #f)))) tmp2178))) (syntax-dispatch tmp2178 (quote #(atom #t))))) fender2170) (build-dispatch-call2145 pvars2174 exp2171 y2177 r2168 mod2172) (gen-syntax-case2147 x2165 keys2166 clauses2167 r2168 mod2172)))))) (if (eq? p2173 (quote any)) (build-annotated1069 #f (list (build-annotated1069 #f (quote list)) x2165)) (build-annotated1069 #f (list (build-annotated1069 #f (quote syntax-dispatch)) x2165 (build-data1070 #f p2173))))))))))))) (build-dispatch-call2145 (lambda (pvars2181 exp2182 y2183 r2184 mod2185) (let ((ids2186 (map car pvars2181)) (levels2187 (map cdr pvars2181))) (let ((labels2188 (gen-labels1098 ids2186)) (new-vars2189 (map gen-var1140 ids2186))) (build-annotated1069 #f (list (build-annotated1069 #f (quote apply)) (build-annotated1069 #f (list (quote lambda) new-vars2189 (chi1128 exp2182 (extend-env1086 labels2188 (map (lambda (var2190 level2191) (cons (quote syntax) (cons var2190 level2191))) new-vars2189 (map cdr pvars2181)) r2184) (make-binding-wrap1109 ids2186 labels2188 (quote (()))) mod2185))) y2183)))))) (convert-pattern2144 (lambda (pattern2192 keys2193) (let cvt2194 ((p2195 pattern2192) (n2196 0) (ids2197 (quote ()))) (if (id?1092 p2195) (if (bound-id-member?1119 p2195 keys2193) (values (vector (quote free-id) p2195) ids2197) (values (quote any) (cons (cons p2195 n2196) ids2197))) ((lambda (tmp2198) ((lambda (tmp2199) (if (if tmp2199 (apply (lambda (x2200 dots2201) (ellipsis?1137 dots2201)) tmp2199) #f) (apply (lambda (x2202 dots2203) (call-with-values (lambda () (cvt2194 x2202 (fx+1059 n2196 1) ids2197)) (lambda (p2204 ids2205) (values (if (eq? p2204 (quote any)) (quote each-any) (vector (quote each) p2204)) ids2205)))) tmp2199) ((lambda (tmp2206) (if tmp2206 (apply (lambda (x2207 y2208) (call-with-values (lambda () (cvt2194 y2208 n2196 ids2197)) (lambda (y2209 ids2210) (call-with-values (lambda () (cvt2194 x2207 n2196 ids2210)) (lambda (x2211 ids2212) (values (cons x2211 y2209) ids2212)))))) tmp2206) ((lambda (tmp2213) (if tmp2213 (apply (lambda () (values (quote ()) ids2197)) tmp2213) ((lambda (tmp2214) (if tmp2214 (apply (lambda (x2215) (call-with-values (lambda () (cvt2194 x2215 n2196 ids2197)) (lambda (p2217 ids2218) (values (vector (quote vector) p2217) ids2218)))) tmp2214) ((lambda (x2219) (values (vector (quote atom) (strip1139 p2195 (quote (())))) ids2197)) tmp2198))) (syntax-dispatch tmp2198 (quote #(vector each-any)))))) (syntax-dispatch tmp2198 (quote ()))))) (syntax-dispatch tmp2198 (quote (any . any)))))) (syntax-dispatch tmp2198 (quote (any any))))) p2195)))))) (lambda (e2220 r2221 w2222 s2223 mod2224) (let ((e2225 (source-wrap1121 e2220 w2222 s2223 mod2224))) ((lambda (tmp2226) ((lambda (tmp2227) (if tmp2227 (apply (lambda (_2228 val2229 key2230 m2231) (if (andmap (lambda (x2232) (and (id?1092 x2232) (not (ellipsis?1137 x2232)))) key2230) (let ((x2234 (gen-var1140 (quote tmp)))) (build-annotated1069 s2223 (list (build-annotated1069 #f (list (quote lambda) (list x2234) (gen-syntax-case2147 (build-annotated1069 #f x2234) key2230 m2231 r2221 mod2224))) (chi1128 val2229 r2221 (quote (())) mod2224)))) (syntax-error e2225 "invalid literals list in"))) tmp2227) (syntax-error tmp2226))) (syntax-dispatch tmp2226 (quote (any any each-any . each-any))))) e2225))))) (set! sc-expand (let ((m2237 (quote e)) (esew2238 (quote (eval)))) (lambda (x2239) (if (and (pair? x2239) (equal? (car x2239) noexpand1058)) (cadr x2239) (chi-top1127 x2239 (quote ()) (quote ((top))) m2237 esew2238 (module-name (current-module))))))) (set! sc-expand3 (let ((m2240 (quote e)) (esew2241 (quote (eval)))) (lambda (x2243 . rest2242) (if (and (pair? x2243) (equal? (car x2243) noexpand1058)) (cadr x2243) (chi-top1127 x2243 (quote ()) (quote ((top))) (if (null? rest2242) m2240 (car rest2242)) (if (or (null? rest2242) (null? (cdr rest2242))) esew2241 (cadr rest2242)) (module-name (current-module))))))) (set! identifier? (lambda (x2244) (nonsymbol-id?1091 x2244))) (set! datum->syntax-object (lambda (id2245 datum2246) (make-syntax-object1075 datum2246 (syntax-object-wrap1078 id2245) #f))) (set! syntax-object->datum (lambda (x2247) (strip1139 x2247 (quote (()))))) (set! generate-temporaries (lambda (ls2248) (begin (let ((x2249 ls2248)) (if (not (list? x2249)) (error-hook1065 (quote generate-temporaries) "invalid argument" x2249))) (map (lambda (x2250) (wrap1120 (gensym) (quote ((top))) #f)) ls2248)))) (set! free-identifier=? (lambda (x2251 y2252) (begin (let ((x2253 x2251)) (if (not (nonsymbol-id?1091 x2253)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2253))) (let ((x2254 y2252)) (if (not (nonsymbol-id?1091 x2254)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2254))) (free-id=?1115 x2251 y2252)))) (set! bound-identifier=? (lambda (x2255 y2256) (begin (let ((x2257 x2255)) (if (not (nonsymbol-id?1091 x2257)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2257))) (let ((x2258 y2256)) (if (not (nonsymbol-id?1091 x2258)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2258))) (bound-id=?1116 x2255 y2256)))) (set! syntax-error (lambda (object2260 . messages2259) (begin (for-each (lambda (x2261) (let ((x2262 x2261)) (if (not (string? x2262)) (error-hook1065 (quote syntax-error) "invalid argument" x2262)))) messages2259) (let ((message2263 (if (null? messages2259) "invalid syntax" (apply string-append messages2259)))) (error-hook1065 #f message2263 (strip1139 object2260 (quote (())))))))) (set! install-global-transformer (lambda (sym2264 v2265) (begin (let ((x2266 sym2264)) (if (not (symbol? x2266)) (error-hook1065 (quote define-syntax) "invalid argument" x2266))) (let ((x2267 v2265)) (if (not (procedure? x2267)) (error-hook1065 (quote define-syntax) "invalid argument" x2267))) (global-extend1090 (quote macro) sym2264 v2265)))) (letrec ((match2272 (lambda (e2273 p2274 w2275 r2276 mod2277) (cond ((not r2276) #f) ((eq? p2274 (quote any)) (cons (wrap1120 e2273 w2275 mod2277) r2276)) ((syntax-object?1076 e2273) (match*2271 (let ((e2278 (syntax-object-expression1077 e2273))) (if (annotation? e2278) (annotation-expression e2278) e2278)) p2274 (join-wraps1111 w2275 (syntax-object-wrap1078 e2273)) r2276 (syntax-object-module1079 e2273))) (else (match*2271 (let ((e2279 e2273)) (if (annotation? e2279) (annotation-expression e2279) e2279)) p2274 w2275 r2276 mod2277))))) (match*2271 (lambda (e2280 p2281 w2282 r2283 mod2284) (cond ((null? p2281) (and (null? e2280) r2283)) ((pair? p2281) (and (pair? e2280) (match2272 (car e2280) (car p2281) w2282 (match2272 (cdr e2280) (cdr p2281) w2282 r2283 mod2284) mod2284))) ((eq? p2281 (quote each-any)) (let ((l2285 (match-each-any2269 e2280 w2282 mod2284))) (and l2285 (cons l2285 r2283)))) (else (let ((t2286 (vector-ref p2281 0))) (if (memv t2286 (quote (each))) (if (null? e2280) (match-empty2270 (vector-ref p2281 1) r2283) (let ((l2287 (match-each2268 e2280 (vector-ref p2281 1) w2282 mod2284))) (and l2287 (let collect2288 ((l2289 l2287)) (if (null? (car l2289)) r2283 (cons (map car l2289) (collect2288 (map cdr l2289)))))))) (if (memv t2286 (quote (free-id))) (and (id?1092 e2280) (free-id=?1115 (wrap1120 e2280 w2282 mod2284) (vector-ref p2281 1)) r2283) (if (memv t2286 (quote (atom))) (and (equal? (vector-ref p2281 1) (strip1139 e2280 w2282)) r2283) (if (memv t2286 (quote (vector))) (and (vector? e2280) (match2272 (vector->list e2280) (vector-ref p2281 1) w2282 r2283 mod2284))))))))))) (match-empty2270 (lambda (p2290 r2291) (cond ((null? p2290) r2291) ((eq? p2290 (quote any)) (cons (quote ()) r2291)) ((pair? p2290) (match-empty2270 (car p2290) (match-empty2270 (cdr p2290) r2291))) ((eq? p2290 (quote each-any)) (cons (quote ()) r2291)) (else (let ((t2292 (vector-ref p2290 0))) (if (memv t2292 (quote (each))) (match-empty2270 (vector-ref p2290 1) r2291) (if (memv t2292 (quote (free-id atom))) r2291 (if (memv t2292 (quote (vector))) (match-empty2270 (vector-ref p2290 1) r2291))))))))) (match-each-any2269 (lambda (e2293 w2294 mod2295) (cond ((annotation? e2293) (match-each-any2269 (annotation-expression e2293) w2294 mod2295)) ((pair? e2293) (let ((l2296 (match-each-any2269 (cdr e2293) w2294 mod2295))) (and l2296 (cons (wrap1120 (car e2293) w2294 mod2295) l2296)))) ((null? e2293) (quote ())) ((syntax-object?1076 e2293) (match-each-any2269 (syntax-object-expression1077 e2293) (join-wraps1111 w2294 (syntax-object-wrap1078 e2293)) mod2295)) (else #f)))) (match-each2268 (lambda (e2297 p2298 w2299 mod2300) (cond ((annotation? e2297) (match-each2268 (annotation-expression e2297) p2298 w2299 mod2300)) ((pair? e2297) (let ((first2301 (match2272 (car e2297) p2298 w2299 (quote ()) mod2300))) (and first2301 (let ((rest2302 (match-each2268 (cdr e2297) p2298 w2299 mod2300))) (and rest2302 (cons first2301 rest2302)))))) ((null? e2297) (quote ())) ((syntax-object?1076 e2297) (match-each2268 (syntax-object-expression1077 e2297) p2298 (join-wraps1111 w2299 (syntax-object-wrap1078 e2297)) (syntax-object-module1079 e2297))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2303 p2304) (cond ((eq? p2304 (quote any)) (list e2303)) ((syntax-object?1076 e2303) (match*2271 (let ((e2305 (syntax-object-expression1077 e2303))) (if (annotation? e2305) (annotation-expression e2305) e2305)) p2304 (syntax-object-wrap1078 e2303) (quote ()) (syntax-object-module1079 e2303))) (else (match*2271 (let ((e2306 e2303)) (if (annotation? e2306) (annotation-expression e2306) e2306)) p2304 (quote (())) (quote ()) #f))))) (set! sc-chi chi1128)))))
-(install-global-transformer (quote with-syntax) (lambda (x2307) ((lambda (tmp2308) ((lambda (tmp2309) (if tmp2309 (apply (lambda (_2310 e12311 e22312) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12311 e22312))) tmp2309) ((lambda (tmp2314) (if tmp2314 (apply (lambda (_2315 out2316 in2317 e12318 e22319) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2317 (quote ()) (list out2316 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12318 e22319))))) tmp2314) ((lambda (tmp2321) (if tmp2321 (apply (lambda (_2322 out2323 in2324 e12325 e22326) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2324) (quote ()) (list out2323 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12325 e22326))))) tmp2321) (syntax-error tmp2308))) (syntax-dispatch tmp2308 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2308 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2308 (quote (any () any . each-any))))) x2307)))
-(install-global-transformer (quote syntax-rules) (lambda (x2330) ((lambda (tmp2331) ((lambda (tmp2332) (if tmp2332 (apply (lambda (_2333 k2334 keyword2335 pattern2336 template2337) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons k2334 (map (lambda (tmp2340 tmp2339) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2339) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2340))) template2337 pattern2336)))))) tmp2332) (syntax-error tmp2331))) (syntax-dispatch tmp2331 (quote (any each-any . #(each ((any . any) any))))))) x2330)))
-(install-global-transformer (quote let*) (lambda (x2341) ((lambda (tmp2342) ((lambda (tmp2343) (if (if tmp2343 (apply (lambda (let*2344 x2345 v2346 e12347 e22348) (andmap identifier? x2345)) tmp2343) #f) (apply (lambda (let*2350 x2351 v2352 e12353 e22354) (let f2355 ((bindings2356 (map list x2351 v2352))) (if (null? bindings2356) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote ()) (cons e12353 e22354))) ((lambda (tmp2360) ((lambda (tmp2361) (if tmp2361 (apply (lambda (body2362 binding2363) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list binding2363) body2362)) tmp2361) (syntax-error tmp2360))) (syntax-dispatch tmp2360 (quote (any any))))) (list (f2355 (cdr bindings2356)) (car bindings2356)))))) tmp2343) (syntax-error tmp2342))) (syntax-dispatch tmp2342 (quote (any #(each (any any)) any . each-any))))) x2341)))
-(install-global-transformer (quote do) (lambda (orig-x2364) ((lambda (tmp2365) ((lambda (tmp2366) (if tmp2366 (apply (lambda (_2367 var2368 init2369 step2370 e02371 e12372 c2373) ((lambda (tmp2374) ((lambda (tmp2375) (if tmp2375 (apply (lambda (step2376) ((lambda (tmp2377) ((lambda (tmp2378) (if tmp2378 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2368 init2369) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02371) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2373 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2376))))))) tmp2378) ((lambda (tmp2383) (if tmp2383 (apply (lambda (e12384 e22385) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2368 init2369) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02371 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (cons e12384 e22385)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2373 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2376))))))) tmp2383) (syntax-error tmp2377))) (syntax-dispatch tmp2377 (quote (any . each-any)))))) (syntax-dispatch tmp2377 (quote ())))) e12372)) tmp2375) (syntax-error tmp2374))) (syntax-dispatch tmp2374 (quote each-any)))) (map (lambda (v2392 s2393) ((lambda (tmp2394) ((lambda (tmp2395) (if tmp2395 (apply (lambda () v2392) tmp2395) ((lambda (tmp2396) (if tmp2396 (apply (lambda (e2397) e2397) tmp2396) ((lambda (_2398) (syntax-error orig-x2364)) tmp2394))) (syntax-dispatch tmp2394 (quote (any)))))) (syntax-dispatch tmp2394 (quote ())))) s2393)) var2368 step2370))) tmp2366) (syntax-error tmp2365))) (syntax-dispatch tmp2365 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2364)))
-(install-global-transformer (quote quasiquote) (letrec ((quasicons2401 (lambda (x2405 y2406) ((lambda (tmp2407) ((lambda (tmp2408) (if tmp2408 (apply (lambda (x2409 y2410) ((lambda (tmp2411) ((lambda (tmp2412) (if tmp2412 (apply (lambda (dy2413) ((lambda (tmp2414) ((lambda (tmp2415) (if tmp2415 (apply (lambda (dx2416) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons dx2416 dy2413))) tmp2415) ((lambda (_2417) (if (null? dy2413) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409 y2410))) tmp2414))) (syntax-dispatch tmp2414 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) x2409)) tmp2412) ((lambda (tmp2418) (if tmp2418 (apply (lambda (stuff2419) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons x2409 stuff2419))) tmp2418) ((lambda (else2420) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409 y2410)) tmp2411))) (syntax-dispatch tmp2411 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . any)))))) (syntax-dispatch tmp2411 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) y2410)) tmp2408) (syntax-error tmp2407))) (syntax-dispatch tmp2407 (quote (any any))))) (list x2405 y2406)))) (quasiappend2402 (lambda (x2421 y2422) ((lambda (tmp2423) ((lambda (tmp2424) (if tmp2424 (apply (lambda (x2425 y2426) ((lambda (tmp2427) ((lambda (tmp2428) (if tmp2428 (apply (lambda () x2425) tmp2428) ((lambda (_2429) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2425 y2426)) tmp2427))) (syntax-dispatch tmp2427 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) ()))))) y2426)) tmp2424) (syntax-error tmp2423))) (syntax-dispatch tmp2423 (quote (any any))))) (list x2421 y2422)))) (quasivector2403 (lambda (x2430) ((lambda (tmp2431) ((lambda (x2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda (x2435) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (list->vector x2435))) tmp2434) ((lambda (tmp2437) (if tmp2437 (apply (lambda (x2438) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2438)) tmp2437) ((lambda (_2440) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2432)) tmp2433))) (syntax-dispatch tmp2433 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . each-any)))))) (syntax-dispatch tmp2433 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) each-any))))) x2432)) tmp2431)) x2430))) (quasi2404 (lambda (p2441 lev2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (p2445) (if (= lev2442 0) p2445 (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2445) (- lev2442 1))))) tmp2444) ((lambda (tmp2446) (if tmp2446 (apply (lambda (p2447 q2448) (if (= lev2442 0) (quasiappend2402 p2447 (quasi2404 q2448 lev2442)) (quasicons2401 (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2447) (- lev2442 1))) (quasi2404 q2448 lev2442)))) tmp2446) ((lambda (tmp2449) (if tmp2449 (apply (lambda (p2450) (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2450) (+ lev2442 1)))) tmp2449) ((lambda (tmp2451) (if tmp2451 (apply (lambda (p2452 q2453) (quasicons2401 (quasi2404 p2452 lev2442) (quasi2404 q2453 lev2442))) tmp2451) ((lambda (tmp2454) (if tmp2454 (apply (lambda (x2455) (quasivector2403 (quasi2404 x2455 lev2442))) tmp2454) ((lambda (p2457) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) p2457)) tmp2443))) (syntax-dispatch tmp2443 (quote #(vector each-any)))))) (syntax-dispatch tmp2443 (quote (any . any)))))) (syntax-dispatch tmp2443 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any)))))) (syntax-dispatch tmp2443 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any) . any)))))) (syntax-dispatch tmp2443 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) p2441)))) (lambda (x2458) ((lambda (tmp2459) ((lambda (tmp2460) (if tmp2460 (apply (lambda (_2461 e2462) (quasi2404 e2462 0)) tmp2460) (syntax-error tmp2459))) (syntax-dispatch tmp2459 (quote (any any))))) x2458))))
-(install-global-transformer (quote include) (lambda (x2463) (letrec ((read-file2464 (lambda (fn2465 k2466) (let ((p2467 (open-input-file fn2465))) (let f2468 ((x2469 (read p2467))) (if (eof-object? x2469) (begin (close-input-port p2467) (quote ())) (cons (datum->syntax-object k2466 x2469) (f2468 (read p2467))))))))) ((lambda (tmp2470) ((lambda (tmp2471) (if tmp2471 (apply (lambda (k2472 filename2473) (let ((fn2474 (syntax-object->datum filename2473))) ((lambda (tmp2475) ((lambda (tmp2476) (if tmp2476 (apply (lambda (exp2477) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (guile))) exp2477)) tmp2476) (syntax-error tmp2475))) (syntax-dispatch tmp2475 (quote each-any)))) (read-file2464 fn2474 k2472)))) tmp2471) (syntax-error tmp2470))) (syntax-dispatch tmp2470 (quote (any any))))) x2463))))
-(install-global-transformer (quote unquote) (lambda (x2479) ((lambda (tmp2480) ((lambda (tmp2481) (if tmp2481 (apply (lambda (_2482 e2483) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2483))) tmp2481) (syntax-error tmp2480))) (syntax-dispatch tmp2480 (quote (any any))))) x2479)))
-(install-global-transformer (quote unquote-splicing) (lambda (x2484) ((lambda (tmp2485) ((lambda (tmp2486) (if tmp2486 (apply (lambda (_2487 e2488) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2488))) tmp2486) (syntax-error tmp2485))) (syntax-dispatch tmp2485 (quote (any any))))) x2484)))
-(install-global-transformer (quote case) (lambda (x2489) ((lambda (tmp2490) ((lambda (tmp2491) (if tmp2491 (apply (lambda (_2492 e2493 m12494 m22495) ((lambda (tmp2496) ((lambda (body2497) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2493)) body2497)) tmp2496)) (let f2498 ((clause2499 m12494) (clauses2500 m22495)) (if (null? clauses2500) ((lambda (tmp2502) ((lambda (tmp2503) (if tmp2503 (apply (lambda (e12504 e22505) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12504 e22505))) tmp2503) ((lambda (tmp2507) (if tmp2507 (apply (lambda (k2508 e12509 e22510) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2508)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12509 e22510)))) tmp2507) ((lambda (_2513) (syntax-error x2489)) tmp2502))) (syntax-dispatch tmp2502 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2502 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) any . each-any))))) clause2499) ((lambda (tmp2514) ((lambda (rest2515) ((lambda (tmp2516) ((lambda (tmp2517) (if tmp2517 (apply (lambda (k2518 e12519 e22520) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2518)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12519 e22520)) rest2515)) tmp2517) ((lambda (_2523) (syntax-error x2489)) tmp2516))) (syntax-dispatch tmp2516 (quote (each-any any . each-any))))) clause2499)) tmp2514)) (f2498 (car clauses2500) (cdr clauses2500))))))) tmp2491) (syntax-error tmp2490))) (syntax-dispatch tmp2490 (quote (any any any . each-any))))) x2489)))
-(install-global-transformer (quote identifier-syntax) (lambda (x2524) ((lambda (tmp2525) ((lambda (tmp2526) (if tmp2526 (apply (lambda (_2527 e2528) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2528)) (list (cons _2527 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e2528 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))))))))) tmp2526) (syntax-error tmp2525))) (syntax-dispatch tmp2525 (quote (any any))))) x2524)))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(if #f #f)
+(letrec ((and-map*1170 (lambda (f1210 first1209 . rest1208) (or (null? first1209) (if (null? rest1208) (let andmap1211 ((first1212 first1209)) (let ((x1213 (car first1212)) (first1214 (cdr first1212))) (if (null? first1214) (f1210 x1213) (and (f1210 x1213) (andmap1211 first1214))))) (let andmap1215 ((first1216 first1209) (rest1217 rest1208)) (let ((x1218 (car first1216)) (xr1219 (map car rest1217)) (first1220 (cdr first1216)) (rest1221 (map cdr rest1217))) (if (null? first1220) (apply f1210 (cons x1218 xr1219)) (and (apply f1210 (cons x1218 xr1219)) (andmap1215 first1220 rest1221)))))))))) (letrec ((lambda-var-list1308 (lambda (vars1484) (let lvl1485 ((vars1486 vars1484) (ls1487 (quote ())) (w1488 (quote (())))) (cond ((pair? vars1486) (lvl1485 (cdr vars1486) (cons (wrap1287 (car vars1486) w1488 #f) ls1487) w1488)) ((id?1259 vars1486) (cons (wrap1287 vars1486 w1488 #f) ls1487)) ((null? vars1486) ls1487) ((syntax-object?1243 vars1486) (lvl1485 (syntax-object-expression1244 vars1486) ls1487 (join-wraps1278 w1488 (syntax-object-wrap1245 vars1486)))) ((annotation? vars1486) (lvl1485 (annotation-expression vars1486) ls1487 w1488)) (else (cons vars1486 ls1487)))))) (gen-var1307 (lambda (id1489) (let ((id1490 (if (syntax-object?1243 id1489) (syntax-object-expression1244 id1489) id1489))) (if (annotation? id1490) (build-annotated1232 (annotation-source id1490) (gensym (symbol->string (annotation-expression id1490)))) (build-annotated1232 #f (gensym (symbol->string id1490))))))) (strip1306 (lambda (x1491 w1492) (if (memq (quote top) (wrap-marks1262 w1492)) (if (or (annotation? x1491) (and (pair? x1491) (annotation? (car x1491)))) (strip-annotation1305 x1491 #f) x1491) (let f1493 ((x1494 x1491)) (cond ((syntax-object?1243 x1494) (strip1306 (syntax-object-expression1244 x1494) (syntax-object-wrap1245 x1494))) ((pair? x1494) (let ((a1495 (f1493 (car x1494))) (d1496 (f1493 (cdr x1494)))) (if (and (eq? a1495 (car x1494)) (eq? d1496 (cdr x1494))) x1494 (cons a1495 d1496)))) ((vector? x1494) (let ((old1497 (vector->list x1494))) (let ((new1498 (map f1493 old1497))) (if (and-map*1170 eq? old1497 new1498) x1494 (list->vector new1498))))) (else x1494)))))) (strip-annotation1305 (lambda (x1499 parent1500) (cond ((pair? x1499) (let ((new1501 (cons #f #f))) (begin (if parent1500 (set-annotation-stripped! parent1500 new1501)) (set-car! new1501 (strip-annotation1305 (car x1499) #f)) (set-cdr! new1501 (strip-annotation1305 (cdr x1499) #f)) new1501))) ((annotation? x1499) (or (annotation-stripped x1499) (strip-annotation1305 (annotation-expression x1499) x1499))) ((vector? x1499) (let ((new1502 (make-vector (vector-length x1499)))) (begin (if parent1500 (set-annotation-stripped! parent1500 new1502)) (let loop1503 ((i1504 (- (vector-length x1499) 1))) (unless (fx<1227 i1504 0) (vector-set! new1502 i1504 (strip-annotation1305 (vector-ref x1499 i1504) #f)) (loop1503 (fx-1225 i1504 1)))) new1502))) (else x1499)))) (ellipsis?1304 (lambda (x1505) (and (nonsymbol-id?1258 x1505) (free-id=?1282 x1505 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))))))) (chi-void1303 (lambda () (build-annotated1232 #f (cons (build-annotated1232 #f (quote if)) (quote (#f #f)))))) (eval-local-transformer1302 (lambda (expanded1506 mod1507) (let ((p1508 (local-eval-hook1229 expanded1506 mod1507))) (if (procedure? p1508) p1508 (syntax-violation #f "nonprocedure transformer" p1508))))) (chi-local-syntax1301 (lambda (rec?1509 e1510 r1511 w1512 s1513 mod1514 k1515) ((lambda (tmp1516) ((lambda (tmp1517) (if tmp1517 (apply (lambda (_1518 id1519 val1520 e11521 e21522) (let ((ids1523 id1519)) (if (not (valid-bound-ids?1284 ids1523)) (syntax-violation #f "duplicate bound keyword" e1510) (let ((labels1525 (gen-labels1265 ids1523))) (let ((new-w1526 (make-binding-wrap1276 ids1523 labels1525 w1512))) (k1515 (cons e11521 e21522) (extend-env1253 labels1525 (let ((w1528 (if rec?1509 new-w1526 w1512)) (trans-r1529 (macros-only-env1255 r1511))) (map (lambda (x1530) (cons (quote macro) (eval-local-transformer1302 (chi1295 x1530 trans-r1529 w1528 mod1514) mod1514))) val1520)) r1511) new-w1526 s1513 mod1514)))))) tmp1517) ((lambda (_1532) (syntax-violation #f "bad local syntax definition" (source-wrap1288 e1510 w1512 s1513 mod1514))) tmp1516))) ($sc-dispatch tmp1516 (quote (any #(each (any any)) any . each-any))))) e1510))) (chi-lambda-clause1300 (lambda (e1533 docstring1534 c1535 r1536 w1537 mod1538 k1539) ((lambda (tmp1540) ((lambda (tmp1541) (if (if tmp1541 (apply (lambda (args1542 doc1543 e11544 e21545) (and (string? (syntax->datum doc1543)) (not docstring1534))) tmp1541) #f) (apply (lambda (args1546 doc1547 e11548 e21549) (chi-lambda-clause1300 e1533 doc1547 (cons args1546 (cons e11548 e21549)) r1536 w1537 mod1538 k1539)) tmp1541) ((lambda (tmp1551) (if tmp1551 (apply (lambda (id1552 e11553 e21554) (let ((ids1555 id1552)) (if (not (valid-bound-ids?1284 ids1555)) (syntax-violation (quote lambda) "invalid parameter list" e1533) (let ((labels1557 (gen-labels1265 ids1555)) (new-vars1558 (map gen-var1307 ids1555))) (k1539 new-vars1558 docstring1534 (chi-body1299 (cons e11553 e21554) e1533 (extend-var-env1254 labels1557 new-vars1558 r1536) (make-binding-wrap1276 ids1555 labels1557 w1537) mod1538)))))) tmp1551) ((lambda (tmp1560) (if tmp1560 (apply (lambda (ids1561 e11562 e21563) (let ((old-ids1564 (lambda-var-list1308 ids1561))) (if (not (valid-bound-ids?1284 old-ids1564)) (syntax-violation (quote lambda) "invalid parameter list" e1533) (let ((labels1565 (gen-labels1265 old-ids1564)) (new-vars1566 (map gen-var1307 old-ids1564))) (k1539 (let f1567 ((ls11568 (cdr new-vars1566)) (ls21569 (car new-vars1566))) (if (null? ls11568) ls21569 (f1567 (cdr ls11568) (cons (car ls11568) ls21569)))) docstring1534 (chi-body1299 (cons e11562 e21563) e1533 (extend-var-env1254 labels1565 new-vars1566 r1536) (make-binding-wrap1276 old-ids1564 labels1565 w1537) mod1538)))))) tmp1560) ((lambda (_1571) (syntax-violation (quote lambda) "bad lambda" e1533)) tmp1540))) ($sc-dispatch tmp1540 (quote (any any . each-any)))))) ($sc-dispatch tmp1540 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1540 (quote (any any any . each-any))))) c1535))) (chi-body1299 (lambda (body1572 outer-form1573 r1574 w1575 mod1576) (let ((r1577 (cons (quote ("placeholder" placeholder)) r1574))) (let ((ribcage1578 (make-ribcage1266 (quote ()) (quote ()) (quote ())))) (let ((w1579 (make-wrap1261 (wrap-marks1262 w1575) (cons ribcage1578 (wrap-subst1263 w1575))))) (let parse1580 ((body1581 (map (lambda (x1587) (cons r1577 (wrap1287 x1587 w1579 mod1576))) body1572)) (ids1582 (quote ())) (labels1583 (quote ())) (vars1584 (quote ())) (vals1585 (quote ())) (bindings1586 (quote ()))) (if (null? body1581) (syntax-violation #f "no expressions in body" outer-form1573) (let ((e1588 (cdar body1581)) (er1589 (caar body1581))) (call-with-values (lambda () (syntax-type1293 e1588 er1589 (quote (())) #f ribcage1578 mod1576)) (lambda (type1590 value1591 e1592 w1593 s1594 mod1595) (let ((t1596 type1590)) (if (memv t1596 (quote (define-form))) (let ((id1597 (wrap1287 value1591 w1593 mod1595)) (label1598 (gen-label1264))) (let ((var1599 (gen-var1307 id1597))) (begin (extend-ribcage!1275 ribcage1578 id1597 label1598) (parse1580 (cdr body1581) (cons id1597 ids1582) (cons label1598 labels1583) (cons var1599 vars1584) (cons (cons er1589 (wrap1287 e1592 w1593 mod1595)) vals1585) (cons (cons (quote lexical) var1599) bindings1586))))) (if (memv t1596 (quote (define-syntax-form))) (let ((id1600 (wrap1287 value1591 w1593 mod1595)) (label1601 (gen-label1264))) (begin (extend-ribcage!1275 ribcage1578 id1600 label1601) (parse1580 (cdr body1581) (cons id1600 ids1582) (cons label1601 labels1583) vars1584 vals1585 (cons (cons (quote macro) (cons er1589 (wrap1287 e1592 w1593 mod1595))) bindings1586)))) (if (memv t1596 (quote (begin-form))) ((lambda (tmp1602) ((lambda (tmp1603) (if tmp1603 (apply (lambda (_1604 e11605) (parse1580 (let f1606 ((forms1607 e11605)) (if (null? forms1607) (cdr body1581) (cons (cons er1589 (wrap1287 (car forms1607) w1593 mod1595)) (f1606 (cdr forms1607))))) ids1582 labels1583 vars1584 vals1585 bindings1586)) tmp1603) (syntax-violation #f "source expression failed to match any pattern" tmp1602))) ($sc-dispatch tmp1602 (quote (any . each-any))))) e1592) (if (memv t1596 (quote (local-syntax-form))) (chi-local-syntax1301 value1591 e1592 er1589 w1593 s1594 mod1595 (lambda (forms1609 er1610 w1611 s1612 mod1613) (parse1580 (let f1614 ((forms1615 forms1609)) (if (null? forms1615) (cdr body1581) (cons (cons er1610 (wrap1287 (car forms1615) w1611 mod1613)) (f1614 (cdr forms1615))))) ids1582 labels1583 vars1584 vals1585 bindings1586))) (if (null? ids1582) (build-sequence1238 #f (map (lambda (x1616) (chi1295 (cdr x1616) (car x1616) (quote (())) mod1595)) (cons (cons er1589 (source-wrap1288 e1592 w1593 s1594 mod1595)) (cdr body1581)))) (begin (if (not (valid-bound-ids?1284 ids1582)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1573)) (let loop1617 ((bs1618 bindings1586) (er-cache1619 #f) (r-cache1620 #f)) (if (not (null? bs1618)) (let ((b1621 (car bs1618))) (if (eq? (car b1621) (quote macro)) (let ((er1622 (cadr b1621))) (let ((r-cache1623 (if (eq? er1622 er-cache1619) r-cache1620 (macros-only-env1255 er1622)))) (begin (set-cdr! b1621 (eval-local-transformer1302 (chi1295 (cddr b1621) r-cache1623 (quote (())) mod1595) mod1595)) (loop1617 (cdr bs1618) er1622 r-cache1623)))) (loop1617 (cdr bs1618) er-cache1619 r-cache1620))))) (set-cdr! r1577 (extend-env1253 labels1583 bindings1586 (cdr r1577))) (build-letrec1241 #f vars1584 (map (lambda (x1624) (chi1295 (cdr x1624) (car x1624) (quote (())) mod1595)) vals1585) (build-sequence1238 #f (map (lambda (x1625) (chi1295 (cdr x1625) (car x1625) (quote (())) mod1595)) (cons (cons er1589 (source-wrap1288 e1592 w1593 s1594 mod1595)) (cdr body1581)))))))))))))))))))))) (chi-macro1298 (lambda (p1626 e1627 r1628 w1629 rib1630 mod1631) (letrec ((rebuild-macro-output1632 (lambda (x1633 m1634) (cond ((pair? x1633) (cons (rebuild-macro-output1632 (car x1633) m1634) (rebuild-macro-output1632 (cdr x1633) m1634))) ((syntax-object?1243 x1633) (let ((w1635 (syntax-object-wrap1245 x1633))) (let ((ms1636 (wrap-marks1262 w1635)) (s1637 (wrap-subst1263 w1635))) (if (and (pair? ms1636) (eq? (car ms1636) #f)) (make-syntax-object1242 (syntax-object-expression1244 x1633) (make-wrap1261 (cdr ms1636) (if rib1630 (cons rib1630 (cdr s1637)) (cdr s1637))) (syntax-object-module1246 x1633)) (make-syntax-object1242 (syntax-object-expression1244 x1633) (make-wrap1261 (cons m1634 ms1636) (if rib1630 (cons rib1630 (cons (quote shift) s1637)) (cons (quote shift) s1637))) (let ((pmod1638 (procedure-module p1626))) (if pmod1638 (cons (quote hygiene) (module-name pmod1638)) (quote (hygiene guile))))))))) ((vector? x1633) (let ((n1639 (vector-length x1633))) (let ((v1640 (make-vector n1639))) (let doloop1641 ((i1642 0)) (if (fx=1226 i1642 n1639) v1640 (begin (vector-set! v1640 i1642 (rebuild-macro-output1632 (vector-ref x1633 i1642) m1634)) (doloop1641 (fx+1224 i1642 1)))))))) ((symbol? x1633) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1288 e1627 w1629 s mod1631) x1633)) (else x1633))))) (rebuild-macro-output1632 (p1626 (wrap1287 e1627 (anti-mark1274 w1629) mod1631)) (string #\m))))) (chi-application1297 (lambda (x1643 e1644 r1645 w1646 s1647 mod1648) ((lambda (tmp1649) ((lambda (tmp1650) (if tmp1650 (apply (lambda (e01651 e11652) (build-annotated1232 s1647 (cons x1643 (map (lambda (e1653) (chi1295 e1653 r1645 w1646 mod1648)) e11652)))) tmp1650) (syntax-violation #f "source expression failed to match any pattern" tmp1649))) ($sc-dispatch tmp1649 (quote (any . each-any))))) e1644))) (chi-expr1296 (lambda (type1655 value1656 e1657 r1658 w1659 s1660 mod1661) (let ((t1662 type1655)) (if (memv t1662 (quote (lexical))) (build-lexical-reference1233 (quote value) s1660 e1657 value1656) (if (memv t1662 (quote (core external-macro))) (value1656 e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote (module-ref))) (call-with-values (lambda () (value1656 e1657)) (lambda (id1663 mod1664) (build-global-reference1235 s1660 id1663 mod1664))) (if (memv t1662 (quote (lexical-call))) (chi-application1297 (build-lexical-reference1233 (quote fun) (source-annotation1250 (car e1657)) (car e1657) value1656) e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote (global-call))) (chi-application1297 (build-global-reference1235 (source-annotation1250 (car e1657)) value1656 (if (syntax-object?1243 (car e1657)) (syntax-object-module1246 (car e1657)) mod1661)) e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote (constant))) (build-data1237 s1660 (strip1306 (source-wrap1288 e1657 w1659 s1660 mod1661) (quote (())))) (if (memv t1662 (quote (global))) (build-global-reference1235 s1660 value1656 mod1661) (if (memv t1662 (quote (call))) (chi-application1297 (chi1295 (car e1657) r1658 w1659 mod1661) e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote (begin-form))) ((lambda (tmp1665) ((lambda (tmp1666) (if tmp1666 (apply (lambda (_1667 e11668 e21669) (chi-sequence1289 (cons e11668 e21669) r1658 w1659 s1660 mod1661)) tmp1666) (syntax-violation #f "source expression failed to match any pattern" tmp1665))) ($sc-dispatch tmp1665 (quote (any any . each-any))))) e1657) (if (memv t1662 (quote (local-syntax-form))) (chi-local-syntax1301 value1656 e1657 r1658 w1659 s1660 mod1661 chi-sequence1289) (if (memv t1662 (quote (eval-when-form))) ((lambda (tmp1671) ((lambda (tmp1672) (if tmp1672 (apply (lambda (_1673 x1674 e11675 e21676) (let ((when-list1677 (chi-when-list1292 e1657 x1674 w1659))) (if (memq (quote eval) when-list1677) (chi-sequence1289 (cons e11675 e21676) r1658 w1659 s1660 mod1661) (chi-void1303)))) tmp1672) (syntax-violation #f "source expression failed to match any pattern" tmp1671))) ($sc-dispatch tmp1671 (quote (any each-any any . each-any))))) e1657) (if (memv t1662 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1657 (wrap1287 value1656 w1659 mod1661)) (if (memv t1662 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1288 e1657 w1659 s1660 mod1661)) (if (memv t1662 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1288 e1657 w1659 s1660 mod1661)) (syntax-violation #f "unexpected syntax" (source-wrap1288 e1657 w1659 s1660 mod1661))))))))))))))))))) (chi1295 (lambda (e1680 r1681 w1682 mod1683) (call-with-values (lambda () (syntax-type1293 e1680 r1681 w1682 #f #f mod1683)) (lambda (type1684 value1685 e1686 w1687 s1688 mod1689) (chi-expr1296 type1684 value1685 e1686 r1681 w1687 s1688 mod1689))))) (chi-top1294 (lambda (e1690 r1691 w1692 m1693 esew1694 mod1695) (call-with-values (lambda () (syntax-type1293 e1690 r1691 w1692 #f #f mod1695)) (lambda (type1703 value1704 e1705 w1706 s1707 mod1708) (let ((t1709 type1703)) (if (memv t1709 (quote (begin-form))) ((lambda (tmp1710) ((lambda (tmp1711) (if tmp1711 (apply (lambda (_1712) (chi-void1303)) tmp1711) ((lambda (tmp1713) (if tmp1713 (apply (lambda (_1714 e11715 e21716) (chi-top-sequence1290 (cons e11715 e21716) r1691 w1706 s1707 m1693 esew1694 mod1708)) tmp1713) (syntax-violation #f "source expression failed to match any pattern" tmp1710))) ($sc-dispatch tmp1710 (quote (any any . each-any)))))) ($sc-dispatch tmp1710 (quote (any))))) e1705) (if (memv t1709 (quote (local-syntax-form))) (chi-local-syntax1301 value1704 e1705 r1691 w1706 s1707 mod1708 (lambda (body1718 r1719 w1720 s1721 mod1722) (chi-top-sequence1290 body1718 r1719 w1720 s1721 m1693 esew1694 mod1722))) (if (memv t1709 (quote (eval-when-form))) ((lambda (tmp1723) ((lambda (tmp1724) (if tmp1724 (apply (lambda (_1725 x1726 e11727 e21728) (let ((when-list1729 (chi-when-list1292 e1705 x1726 w1706)) (body1730 (cons e11727 e21728))) (cond ((eq? m1693 (quote e)) (if (memq (quote eval) when-list1729) (chi-top-sequence1290 body1730 r1691 w1706 s1707 (quote e) (quote (eval)) mod1708) (chi-void1303))) ((memq (quote load) when-list1729) (if (or (memq (quote compile) when-list1729) (and (eq? m1693 (quote c&e)) (memq (quote eval) when-list1729))) (chi-top-sequence1290 body1730 r1691 w1706 s1707 (quote c&e) (quote (compile load)) mod1708) (if (memq m1693 (quote (c c&e))) (chi-top-sequence1290 body1730 r1691 w1706 s1707 (quote c) (quote (load)) mod1708) (chi-void1303)))) ((or (memq (quote compile) when-list1729) (and (eq? m1693 (quote c&e)) (memq (quote eval) when-list1729))) (top-level-eval-hook1228 (chi-top-sequence1290 body1730 r1691 w1706 s1707 (quote e) (quote (eval)) mod1708) mod1708) (chi-void1303)) (else (chi-void1303))))) tmp1724) (syntax-violation #f "source expression failed to match any pattern" tmp1723))) ($sc-dispatch tmp1723 (quote (any each-any any . each-any))))) e1705) (if (memv t1709 (quote (define-syntax-form))) (let ((n1733 (id-var-name1281 value1704 w1706)) (r1734 (macros-only-env1255 r1691))) (let ((t1735 m1693)) (if (memv t1735 (quote (c))) (if (memq (quote compile) esew1694) (let ((e1736 (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)))) (begin (top-level-eval-hook1228 e1736 mod1708) (if (memq (quote load) esew1694) e1736 (chi-void1303)))) (if (memq (quote load) esew1694) (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)) (chi-void1303))) (if (memv t1735 (quote (c&e))) (let ((e1737 (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)))) (begin (top-level-eval-hook1228 e1737 mod1708) e1737)) (begin (if (memq (quote eval) esew1694) (top-level-eval-hook1228 (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)) mod1708)) (chi-void1303)))))) (if (memv t1709 (quote (define-form))) (let ((n1738 (id-var-name1281 value1704 w1706))) (let ((type1739 (binding-type1251 (lookup1256 n1738 r1691 mod1708)))) (let ((t1740 type1739)) (if (memv t1740 (quote (global core macro module-ref))) (let ((x1741 (build-annotated1232 s1707 (list (quote define) n1738 (chi1295 e1705 r1691 w1706 mod1708))))) (begin (if (eq? m1693 (quote c&e)) (top-level-eval-hook1228 x1741 mod1708)) x1741)) (if (memv t1740 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1705 (wrap1287 value1704 w1706 mod1708)) (syntax-violation #f "cannot define keyword at top level" e1705 (wrap1287 value1704 w1706 mod1708))))))) (let ((x1742 (chi-expr1296 type1703 value1704 e1705 r1691 w1706 s1707 mod1708))) (begin (if (eq? m1693 (quote c&e)) (top-level-eval-hook1228 x1742 mod1708)) x1742)))))))))))) (syntax-type1293 (lambda (e1743 r1744 w1745 s1746 rib1747 mod1748) (cond ((symbol? e1743) (let ((n1749 (id-var-name1281 e1743 w1745))) (let ((b1750 (lookup1256 n1749 r1744 mod1748))) (let ((type1751 (binding-type1251 b1750))) (let ((t1752 type1751)) (if (memv t1752 (quote (lexical))) (values type1751 (binding-value1252 b1750) e1743 w1745 s1746 mod1748) (if (memv t1752 (quote (global))) (values type1751 n1749 e1743 w1745 s1746 mod1748) (if (memv t1752 (quote (macro))) (syntax-type1293 (chi-macro1298 (binding-value1252 b1750) e1743 r1744 w1745 rib1747 mod1748) r1744 (quote (())) s1746 rib1747 mod1748) (values type1751 (binding-value1252 b1750) e1743 w1745 s1746 mod1748))))))))) ((pair? e1743) (let ((first1753 (car e1743))) (if (id?1259 first1753) (let ((n1754 (id-var-name1281 first1753 w1745))) (let ((b1755 (lookup1256 n1754 r1744 (or (and (syntax-object?1243 first1753) (syntax-object-module1246 first1753)) mod1748)))) (let ((type1756 (binding-type1251 b1755))) (let ((t1757 type1756)) (if (memv t1757 (quote (lexical))) (values (quote lexical-call) (binding-value1252 b1755) e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (global))) (values (quote global-call) n1754 e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (macro))) (syntax-type1293 (chi-macro1298 (binding-value1252 b1755) e1743 r1744 w1745 rib1747 mod1748) r1744 (quote (())) s1746 rib1747 mod1748) (if (memv t1757 (quote (core external-macro module-ref))) (values type1756 (binding-value1252 b1755) e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1252 b1755) e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (begin))) (values (quote begin-form) #f e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (eval-when))) (values (quote eval-when-form) #f e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (define))) ((lambda (tmp1758) ((lambda (tmp1759) (if (if tmp1759 (apply (lambda (_1760 name1761 val1762) (id?1259 name1761)) tmp1759) #f) (apply (lambda (_1763 name1764 val1765) (values (quote define-form) name1764 val1765 w1745 s1746 mod1748)) tmp1759) ((lambda (tmp1766) (if (if tmp1766 (apply (lambda (_1767 name1768 args1769 e11770 e21771) (and (id?1259 name1768) (valid-bound-ids?1284 (lambda-var-list1308 args1769)))) tmp1766) #f) (apply (lambda (_1772 name1773 args1774 e11775 e21776) (values (quote define-form) (wrap1287 name1773 w1745 mod1748) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap1287 (cons args1774 (cons e11775 e21776)) w1745 mod1748)) (quote (())) s1746 mod1748)) tmp1766) ((lambda (tmp1778) (if (if tmp1778 (apply (lambda (_1779 name1780) (id?1259 name1780)) tmp1778) #f) (apply (lambda (_1781 name1782) (values (quote define-form) (wrap1287 name1782 w1745 mod1748) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s1746 mod1748)) tmp1778) (syntax-violation #f "source expression failed to match any pattern" tmp1758))) ($sc-dispatch tmp1758 (quote (any any)))))) ($sc-dispatch tmp1758 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1758 (quote (any any any))))) e1743) (if (memv t1757 (quote (define-syntax))) ((lambda (tmp1783) ((lambda (tmp1784) (if (if tmp1784 (apply (lambda (_1785 name1786 val1787) (id?1259 name1786)) tmp1784) #f) (apply (lambda (_1788 name1789 val1790) (values (quote define-syntax-form) name1789 val1790 w1745 s1746 mod1748)) tmp1784) (syntax-violation #f "source expression failed to match any pattern" tmp1783))) ($sc-dispatch tmp1783 (quote (any any any))))) e1743) (values (quote call) #f e1743 w1745 s1746 mod1748)))))))))))))) (values (quote call) #f e1743 w1745 s1746 mod1748)))) ((syntax-object?1243 e1743) (syntax-type1293 (syntax-object-expression1244 e1743) r1744 (join-wraps1278 w1745 (syntax-object-wrap1245 e1743)) #f rib1747 (or (syntax-object-module1246 e1743) mod1748))) ((annotation? e1743) (syntax-type1293 (annotation-expression e1743) r1744 w1745 (annotation-source e1743) rib1747 mod1748)) ((self-evaluating? e1743) (values (quote constant) #f e1743 w1745 s1746 mod1748)) (else (values (quote other) #f e1743 w1745 s1746 mod1748))))) (chi-when-list1292 (lambda (e1791 when-list1792 w1793) (let f1794 ((when-list1795 when-list1792) (situations1796 (quote ()))) (if (null? when-list1795) situations1796 (f1794 (cdr when-list1795) (cons (let ((x1797 (car when-list1795))) (cond ((free-id=?1282 x1797 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile)) ((free-id=?1282 x1797 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load)) ((free-id=?1282 x1797 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1791 (wrap1287 x1797 w1793 #f))))) situations1796)))))) (chi-install-global1291 (lambda (name1798 e1799) (build-annotated1232 #f (list (build-annotated1232 #f (quote define)) name1798 (if (let ((v1800 (module-variable (current-module) name1798))) (and v1800 (variable-bound? v1800) (macro? (variable-ref v1800)) (not (eq? (macro-type (variable-ref v1800)) (quote syncase-macro))))) (build-annotated1232 #f (list (build-annotated1232 #f (quote make-extended-syncase-macro)) (build-annotated1232 #f (list (build-annotated1232 #f (quote module-ref)) (build-annotated1232 #f (quote (current-module))) (build-data1237 #f name1798))) (build-data1237 #f (quote macro)) e1799)) (build-annotated1232 #f (list (build-annotated1232 #f (quote make-syncase-macro)) (build-data1237 #f (quote macro)) e1799))))))) (chi-top-sequence1290 (lambda (body1801 r1802 w1803 s1804 m1805 esew1806 mod1807) (build-sequence1238 s1804 (let dobody1808 ((body1809 body1801) (r1810 r1802) (w1811 w1803) (m1812 m1805) (esew1813 esew1806) (mod1814 mod1807)) (if (null? body1809) (quote ()) (let ((first1815 (chi-top1294 (car body1809) r1810 w1811 m1812 esew1813 mod1814))) (cons first1815 (dobody1808 (cdr body1809) r1810 w1811 m1812 esew1813 mod1814)))))))) (chi-sequence1289 (lambda (body1816 r1817 w1818 s1819 mod1820) (build-sequence1238 s1819 (let dobody1821 ((body1822 body1816) (r1823 r1817) (w1824 w1818) (mod1825 mod1820)) (if (null? body1822) (quote ()) (let ((first1826 (chi1295 (car body1822) r1823 w1824 mod1825))) (cons first1826 (dobody1821 (cdr body1822) r1823 w1824 mod1825)))))))) (source-wrap1288 (lambda (x1827 w1828 s1829 defmod1830) (wrap1287 (if s1829 (make-annotation x1827 s1829 #f) x1827) w1828 defmod1830))) (wrap1287 (lambda (x1831 w1832 defmod1833) (cond ((and (null? (wrap-marks1262 w1832)) (null? (wrap-subst1263 w1832))) x1831) ((syntax-object?1243 x1831) (make-syntax-object1242 (syntax-object-expression1244 x1831) (join-wraps1278 w1832 (syntax-object-wrap1245 x1831)) (syntax-object-module1246 x1831))) ((null? x1831) x1831) (else (make-syntax-object1242 x1831 w1832 defmod1833))))) (bound-id-member?1286 (lambda (x1834 list1835) (and (not (null? list1835)) (or (bound-id=?1283 x1834 (car list1835)) (bound-id-member?1286 x1834 (cdr list1835)))))) (distinct-bound-ids?1285 (lambda (ids1836) (let distinct?1837 ((ids1838 ids1836)) (or (null? ids1838) (and (not (bound-id-member?1286 (car ids1838) (cdr ids1838))) (distinct?1837 (cdr ids1838))))))) (valid-bound-ids?1284 (lambda (ids1839) (and (let all-ids?1840 ((ids1841 ids1839)) (or (null? ids1841) (and (id?1259 (car ids1841)) (all-ids?1840 (cdr ids1841))))) (distinct-bound-ids?1285 ids1839)))) (bound-id=?1283 (lambda (i1842 j1843) (if (and (syntax-object?1243 i1842) (syntax-object?1243 j1843)) (and (eq? (let ((e1844 (syntax-object-expression1244 i1842))) (if (annotation? e1844) (annotation-expression e1844) e1844)) (let ((e1845 (syntax-object-expression1244 j1843))) (if (annotation? e1845) (annotation-expression e1845) e1845))) (same-marks?1280 (wrap-marks1262 (syntax-object-wrap1245 i1842)) (wrap-marks1262 (syntax-object-wrap1245 j1843)))) (eq? (let ((e1846 i1842)) (if (annotation? e1846) (annotation-expression e1846) e1846)) (let ((e1847 j1843)) (if (annotation? e1847) (annotation-expression e1847) e1847)))))) (free-id=?1282 (lambda (i1848 j1849) (and (eq? (let ((x1850 i1848)) (let ((e1851 (if (syntax-object?1243 x1850) (syntax-object-expression1244 x1850) x1850))) (if (annotation? e1851) (annotation-expression e1851) e1851))) (let ((x1852 j1849)) (let ((e1853 (if (syntax-object?1243 x1852) (syntax-object-expression1244 x1852) x1852))) (if (annotation? e1853) (annotation-expression e1853) e1853)))) (eq? (id-var-name1281 i1848 (quote (()))) (id-var-name1281 j1849 (quote (()))))))) (id-var-name1281 (lambda (id1854 w1855) (letrec ((search-vector-rib1858 (lambda (sym1864 subst1865 marks1866 symnames1867 ribcage1868) (let ((n1869 (vector-length symnames1867))) (let f1870 ((i1871 0)) (cond ((fx=1226 i1871 n1869) (search1856 sym1864 (cdr subst1865) marks1866)) ((and (eq? (vector-ref symnames1867 i1871) sym1864) (same-marks?1280 marks1866 (vector-ref (ribcage-marks1269 ribcage1868) i1871))) (values (vector-ref (ribcage-labels1270 ribcage1868) i1871) marks1866)) (else (f1870 (fx+1224 i1871 1)))))))) (search-list-rib1857 (lambda (sym1872 subst1873 marks1874 symnames1875 ribcage1876) (let f1877 ((symnames1878 symnames1875) (i1879 0)) (cond ((null? symnames1878) (search1856 sym1872 (cdr subst1873) marks1874)) ((and (eq? (car symnames1878) sym1872) (same-marks?1280 marks1874 (list-ref (ribcage-marks1269 ribcage1876) i1879))) (values (list-ref (ribcage-labels1270 ribcage1876) i1879) marks1874)) (else (f1877 (cdr symnames1878) (fx+1224 i1879 1))))))) (search1856 (lambda (sym1880 subst1881 marks1882) (if (null? subst1881) (values #f marks1882) (let ((fst1883 (car subst1881))) (if (eq? fst1883 (quote shift)) (search1856 sym1880 (cdr subst1881) (cdr marks1882)) (let ((symnames1884 (ribcage-symnames1268 fst1883))) (if (vector? symnames1884) (search-vector-rib1858 sym1880 subst1881 marks1882 symnames1884 fst1883) (search-list-rib1857 sym1880 subst1881 marks1882 symnames1884 fst1883))))))))) (cond ((symbol? id1854) (or (call-with-values (lambda () (search1856 id1854 (wrap-subst1263 w1855) (wrap-marks1262 w1855))) (lambda (x1886 . ignore1885) x1886)) id1854)) ((syntax-object?1243 id1854) (let ((id1887 (let ((e1889 (syntax-object-expression1244 id1854))) (if (annotation? e1889) (annotation-expression e1889) e1889))) (w11888 (syntax-object-wrap1245 id1854))) (let ((marks1890 (join-marks1279 (wrap-marks1262 w1855) (wrap-marks1262 w11888)))) (call-with-values (lambda () (search1856 id1887 (wrap-subst1263 w1855) marks1890)) (lambda (new-id1891 marks1892) (or new-id1891 (call-with-values (lambda () (search1856 id1887 (wrap-subst1263 w11888) marks1892)) (lambda (x1894 . ignore1893) x1894)) id1887)))))) ((annotation? id1854) (let ((id1895 (let ((e1896 id1854)) (if (annotation? e1896) (annotation-expression e1896) e1896)))) (or (call-with-values (lambda () (search1856 id1895 (wrap-subst1263 w1855) (wrap-marks1262 w1855))) (lambda (x1898 . ignore1897) x1898)) id1895))) (else (syntax-violation (quote id-var-name) "invalid id" id1854)))))) (same-marks?1280 (lambda (x1899 y1900) (or (eq? x1899 y1900) (and (not (null? x1899)) (not (null? y1900)) (eq? (car x1899) (car y1900)) (same-marks?1280 (cdr x1899) (cdr y1900)))))) (join-marks1279 (lambda (m11901 m21902) (smart-append1277 m11901 m21902))) (join-wraps1278 (lambda (w11903 w21904) (let ((m11905 (wrap-marks1262 w11903)) (s11906 (wrap-subst1263 w11903))) (if (null? m11905) (if (null? s11906) w21904 (make-wrap1261 (wrap-marks1262 w21904) (smart-append1277 s11906 (wrap-subst1263 w21904)))) (make-wrap1261 (smart-append1277 m11905 (wrap-marks1262 w21904)) (smart-append1277 s11906 (wrap-subst1263 w21904))))))) (smart-append1277 (lambda (m11907 m21908) (if (null? m21908) m11907 (append m11907 m21908)))) (make-binding-wrap1276 (lambda (ids1909 labels1910 w1911) (if (null? ids1909) w1911 (make-wrap1261 (wrap-marks1262 w1911) (cons (let ((labelvec1912 (list->vector labels1910))) (let ((n1913 (vector-length labelvec1912))) (let ((symnamevec1914 (make-vector n1913)) (marksvec1915 (make-vector n1913))) (begin (let f1916 ((ids1917 ids1909) (i1918 0)) (if (not (null? ids1917)) (call-with-values (lambda () (id-sym-name&marks1260 (car ids1917) w1911)) (lambda (symname1919 marks1920) (begin (vector-set! symnamevec1914 i1918 symname1919) (vector-set! marksvec1915 i1918 marks1920) (f1916 (cdr ids1917) (fx+1224 i1918 1))))))) (make-ribcage1266 symnamevec1914 marksvec1915 labelvec1912))))) (wrap-subst1263 w1911)))))) (extend-ribcage!1275 (lambda (ribcage1921 id1922 label1923) (begin (set-ribcage-symnames!1271 ribcage1921 (cons (let ((e1924 (syntax-object-expression1244 id1922))) (if (annotation? e1924) (annotation-expression e1924) e1924)) (ribcage-symnames1268 ribcage1921))) (set-ribcage-marks!1272 ribcage1921 (cons (wrap-marks1262 (syntax-object-wrap1245 id1922)) (ribcage-marks1269 ribcage1921))) (set-ribcage-labels!1273 ribcage1921 (cons label1923 (ribcage-labels1270 ribcage1921)))))) (anti-mark1274 (lambda (w1925) (make-wrap1261 (cons #f (wrap-marks1262 w1925)) (cons (quote shift) (wrap-subst1263 w1925))))) (set-ribcage-labels!1273 (lambda (x1926 update1927) (vector-set! x1926 3 update1927))) (set-ribcage-marks!1272 (lambda (x1928 update1929) (vector-set! x1928 2 update1929))) (set-ribcage-symnames!1271 (lambda (x1930 update1931) (vector-set! x1930 1 update1931))) (ribcage-labels1270 (lambda (x1932) (vector-ref x1932 3))) (ribcage-marks1269 (lambda (x1933) (vector-ref x1933 2))) (ribcage-symnames1268 (lambda (x1934) (vector-ref x1934 1))) (ribcage?1267 (lambda (x1935) (and (vector? x1935) (= (vector-length x1935) 4) (eq? (vector-ref x1935 0) (quote ribcage))))) (make-ribcage1266 (lambda (symnames1936 marks1937 labels1938) (vector (quote ribcage) symnames1936 marks1937 labels1938))) (gen-labels1265 (lambda (ls1939) (if (null? ls1939) (quote ()) (cons (gen-label1264) (gen-labels1265 (cdr ls1939)))))) (gen-label1264 (lambda () (string #\i))) (wrap-subst1263 cdr) (wrap-marks1262 car) (make-wrap1261 cons) (id-sym-name&marks1260 (lambda (x1940 w1941) (if (syntax-object?1243 x1940) (values (let ((e1942 (syntax-object-expression1244 x1940))) (if (annotation? e1942) (annotation-expression e1942) e1942)) (join-marks1279 (wrap-marks1262 w1941) (wrap-marks1262 (syntax-object-wrap1245 x1940)))) (values (let ((e1943 x1940)) (if (annotation? e1943) (annotation-expression e1943) e1943)) (wrap-marks1262 w1941))))) (id?1259 (lambda (x1944) (cond ((symbol? x1944) #t) ((syntax-object?1243 x1944) (symbol? (let ((e1945 (syntax-object-expression1244 x1944))) (if (annotation? e1945) (annotation-expression e1945) e1945)))) ((annotation? x1944) (symbol? (annotation-expression x1944))) (else #f)))) (nonsymbol-id?1258 (lambda (x1946) (and (syntax-object?1243 x1946) (symbol? (let ((e1947 (syntax-object-expression1244 x1946))) (if (annotation? e1947) (annotation-expression e1947) e1947)))))) (global-extend1257 (lambda (type1948 sym1949 val1950) (put-global-definition-hook1230 sym1949 type1948 val1950))) (lookup1256 (lambda (x1951 r1952 mod1953) (cond ((assq x1951 r1952) => cdr) ((symbol? x1951) (or (get-global-definition-hook1231 x1951 mod1953) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1255 (lambda (r1954) (if (null? r1954) (quote ()) (let ((a1955 (car r1954))) (if (eq? (cadr a1955) (quote macro)) (cons a1955 (macros-only-env1255 (cdr r1954))) (macros-only-env1255 (cdr r1954))))))) (extend-var-env1254 (lambda (labels1956 vars1957 r1958) (if (null? labels1956) r1958 (extend-var-env1254 (cdr labels1956) (cdr vars1957) (cons (cons (car labels1956) (cons (quote lexical) (car vars1957))) r1958))))) (extend-env1253 (lambda (labels1959 bindings1960 r1961) (if (null? labels1959) r1961 (extend-env1253 (cdr labels1959) (cdr bindings1960) (cons (cons (car labels1959) (car bindings1960)) r1961))))) (binding-value1252 cdr) (binding-type1251 car) (source-annotation1250 (lambda (x1962) (cond ((annotation? x1962) (annotation-source x1962)) ((syntax-object?1243 x1962) (source-annotation1250 (syntax-object-expression1244 x1962))) (else #f)))) (set-syntax-object-module!1249 (lambda (x1963 update1964) (vector-set! x1963 3 update1964))) (set-syntax-object-wrap!1248 (lambda (x1965 update1966) (vector-set! x1965 2 update1966))) (set-syntax-object-expression!1247 (lambda (x1967 update1968) (vector-set! x1967 1 update1968))) (syntax-object-module1246 (lambda (x1969) (vector-ref x1969 3))) (syntax-object-wrap1245 (lambda (x1970) (vector-ref x1970 2))) (syntax-object-expression1244 (lambda (x1971) (vector-ref x1971 1))) (syntax-object?1243 (lambda (x1972) (and (vector? x1972) (= (vector-length x1972) 4) (eq? (vector-ref x1972 0) (quote syntax-object))))) (make-syntax-object1242 (lambda (expression1973 wrap1974 module1975) (vector (quote syntax-object) expression1973 wrap1974 module1975))) (build-letrec1241 (lambda (src1976 vars1977 val-exps1978 body-exp1979) (if (null? vars1977) (build-annotated1232 src1976 body-exp1979) (build-annotated1232 src1976 (list (quote letrec) (map list vars1977 val-exps1978) body-exp1979))))) (build-named-let1240 (lambda (src1980 vars1981 val-exps1982 body-exp1983) (if (null? vars1981) (build-annotated1232 src1980 body-exp1983) (build-annotated1232 src1980 (list (quote let) (car vars1981) (map list (cdr vars1981) val-exps1982) body-exp1983))))) (build-let1239 (lambda (src1984 vars1985 val-exps1986 body-exp1987) (if (null? vars1985) (build-annotated1232 src1984 body-exp1987) (build-annotated1232 src1984 (list (quote let) (map list vars1985 val-exps1986) body-exp1987))))) (build-sequence1238 (lambda (src1988 exps1989) (if (null? (cdr exps1989)) (build-annotated1232 src1988 (car exps1989)) (build-annotated1232 src1988 (cons (quote begin) exps1989))))) (build-data1237 (lambda (src1990 exp1991) (if (and (self-evaluating? exp1991) (not (vector? exp1991))) (build-annotated1232 src1990 exp1991) (build-annotated1232 src1990 (list (quote quote) exp1991))))) (build-global-assignment1236 (lambda (source1992 var1993 exp1994 mod1995) (let ((ref1996 (build-global-reference1235 source1992 var1993 mod1995))) (build-annotated1232 source1992 (list (quote set!) ref1996 exp1994))))) (build-global-reference1235 (lambda (source1997 var1998 mod1999) (build-annotated1232 source1997 (if (not mod1999) var1998 (let ((make-module-ref2000 (let ((t2003 (fluid-ref *mode*1223))) (if (memv t2003 (quote (c))) (@ (ice-9 expand-support) make-module-ref) (lambda (mod2004 var2005 public?2006) (list (if public?2006 (quote @) (quote @@)) mod2004 var2005))))) (kind2001 (car mod1999)) (mod2002 (cdr mod1999))) (let ((t2007 kind2001)) (if (memv t2007 (quote (public))) (make-module-ref2000 mod2002 var1998 #t) (if (memv t2007 (quote (private))) (if (not (equal? mod2002 (module-name (current-module)))) (make-module-ref2000 mod2002 var1998 #f) var1998) (if (memv t2007 (quote (bare))) var1998 (if (memv t2007 (quote (hygiene))) (if (and (not (equal? mod2002 (module-name (current-module)))) (module-variable (resolve-module mod2002) var1998)) (make-module-ref2000 mod2002 var1998 #f) var1998) (syntax-violation #f "bad module kind" var1998 mod2002))))))))))) (build-lexical-assignment1234 (lambda (source2008 name2009 var2010 exp2011) (build-annotated1232 source2008 (list (quote set!) (build-lexical-reference1233 (quote set) #f name2009 var2010) exp2011)))) (build-lexical-reference1233 (lambda (type2012 source2013 name2014 var2015) (build-annotated1232 source2013 (let ((t2016 (fluid-ref *mode*1223))) (if (memv t2016 (quote (c))) ((@ (ice-9 expand-support) make-lexical) name2014 var2015) var2015))))) (build-annotated1232 (lambda (src2017 exp2018) (if (and src2017 (not (annotation? exp2018))) (make-annotation exp2018 src2017 #t) exp2018))) (get-global-definition-hook1231 (lambda (symbol2019 module2020) (begin (if (and (not module2020) (current-module)) (warn "module system is booted, we should have a module" symbol2019)) (let ((v2021 (module-variable (if module2020 (resolve-module (cdr module2020)) (current-module)) symbol2019))) (and v2021 (variable-bound? v2021) (let ((val2022 (variable-ref v2021))) (and (macro? val2022) (syncase-macro-type val2022) (cons (syncase-macro-type val2022) (syncase-macro-binding val2022))))))))) (put-global-definition-hook1230 (lambda (symbol2023 type2024 val2025) (let ((existing2026 (let ((v2027 (module-variable (current-module) symbol2023))) (and v2027 (variable-bound? v2027) (let ((val2028 (variable-ref v2027))) (and (macro? val2028) (not (syncase-macro-type val2028)) val2028)))))) (module-define! (current-module) symbol2023 (if existing2026 (make-extended-syncase-macro existing2026 type2024 val2025) (make-syncase-macro type2024 val2025)))))) (local-eval-hook1229 (lambda (x2029 mod2030) (primitive-eval (list noexpand1222 (let ((t2031 (fluid-ref *mode*1223))) (if (memv t2031 (quote (c))) ((@ (ice-9 expand-support) strip-expansion-structures) x2029) x2029)))))) (top-level-eval-hook1228 (lambda (x2032 mod2033) (primitive-eval (list noexpand1222 (let ((t2034 (fluid-ref *mode*1223))) (if (memv t2034 (quote (c))) ((@ (ice-9 expand-support) strip-expansion-structures) x2032) x2032)))))) (fx<1227 <) (fx=1226 =) (fx-1225 -) (fx+1224 +) (*mode*1223 (make-fluid)) (noexpand1222 "noexpand")) (begin (global-extend1257 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1257 (quote local-syntax) (quote let-syntax) #f) (global-extend1257 (quote core) (quote fluid-let-syntax) (lambda (e2035 r2036 w2037 s2038 mod2039) ((lambda (tmp2040) ((lambda (tmp2041) (if (if tmp2041 (apply (lambda (_2042 var2043 val2044 e12045 e22046) (valid-bound-ids?1284 var2043)) tmp2041) #f) (apply (lambda (_2048 var2049 val2050 e12051 e22052) (let ((names2053 (map (lambda (x2054) (id-var-name1281 x2054 w2037)) var2049))) (begin (for-each (lambda (id2056 n2057) (let ((t2058 (binding-type1251 (lookup1256 n2057 r2036 mod2039)))) (if (memv t2058 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e2035 (source-wrap1288 id2056 w2037 s2038 mod2039))))) var2049 names2053) (chi-body1299 (cons e12051 e22052) (source-wrap1288 e2035 w2037 s2038 mod2039) (extend-env1253 names2053 (let ((trans-r2061 (macros-only-env1255 r2036))) (map (lambda (x2062) (cons (quote macro) (eval-local-transformer1302 (chi1295 x2062 trans-r2061 w2037 mod2039) mod2039))) val2050)) r2036) w2037 mod2039)))) tmp2041) ((lambda (_2064) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1288 e2035 w2037 s2038 mod2039))) tmp2040))) ($sc-dispatch tmp2040 (quote (any #(each (any any)) any . each-any))))) e2035))) (global-extend1257 (quote core) (quote quote) (lambda (e2065 r2066 w2067 s2068 mod2069) ((lambda (tmp2070) ((lambda (tmp2071) (if tmp2071 (apply (lambda (_2072 e2073) (build-data1237 s2068 (strip1306 e2073 w2067))) tmp2071) ((lambda (_2074) (syntax-violation (quote quote) "bad syntax" (source-wrap1288 e2065 w2067 s2068 mod2069))) tmp2070))) ($sc-dispatch tmp2070 (quote (any any))))) e2065))) (global-extend1257 (quote core) (quote syntax) (letrec ((regen2082 (lambda (x2083) (let ((t2084 (car x2083))) (if (memv t2084 (quote (ref))) (build-lexical-reference1233 (quote value) #f (cadr x2083) (cadr x2083)) (if (memv t2084 (quote (primitive))) (build-annotated1232 #f (cadr x2083)) (if (memv t2084 (quote (quote))) (build-data1237 #f (cadr x2083)) (if (memv t2084 (quote (lambda))) (build-annotated1232 #f (list (quote lambda) (cadr x2083) (regen2082 (caddr x2083)))) (if (memv t2084 (quote (map))) (let ((ls2085 (map regen2082 (cdr x2083)))) (build-annotated1232 #f (cons (if (fx=1226 (length ls2085) 2) (build-annotated1232 #f (quote map)) (build-annotated1232 #f (quote map))) ls2085))) (build-annotated1232 #f (cons (build-annotated1232 #f (car x2083)) (map regen2082 (cdr x2083)))))))))))) (gen-vector2081 (lambda (x2086) (cond ((eq? (car x2086) (quote list)) (cons (quote vector) (cdr x2086))) ((eq? (car x2086) (quote quote)) (list (quote quote) (list->vector (cadr x2086)))) (else (list (quote list->vector) x2086))))) (gen-append2080 (lambda (x2087 y2088) (if (equal? y2088 (quote (quote ()))) x2087 (list (quote append) x2087 y2088)))) (gen-cons2079 (lambda (x2089 y2090) (let ((t2091 (car y2090))) (if (memv t2091 (quote (quote))) (if (eq? (car x2089) (quote quote)) (list (quote quote) (cons (cadr x2089) (cadr y2090))) (if (eq? (cadr y2090) (quote ())) (list (quote list) x2089) (list (quote cons) x2089 y2090))) (if (memv t2091 (quote (list))) (cons (quote list) (cons x2089 (cdr y2090))) (list (quote cons) x2089 y2090)))))) (gen-map2078 (lambda (e2092 map-env2093) (let ((formals2094 (map cdr map-env2093)) (actuals2095 (map (lambda (x2096) (list (quote ref) (car x2096))) map-env2093))) (cond ((eq? (car e2092) (quote ref)) (car actuals2095)) ((and-map (lambda (x2097) (and (eq? (car x2097) (quote ref)) (memq (cadr x2097) formals2094))) (cdr e2092)) (cons (quote map) (cons (list (quote primitive) (car e2092)) (map (let ((r2098 (map cons formals2094 actuals2095))) (lambda (x2099) (cdr (assq (cadr x2099) r2098)))) (cdr e2092))))) (else (cons (quote map) (cons (list (quote lambda) formals2094 e2092) actuals2095))))))) (gen-mappend2077 (lambda (e2100 map-env2101) (list (quote apply) (quote (primitive append)) (gen-map2078 e2100 map-env2101)))) (gen-ref2076 (lambda (src2102 var2103 level2104 maps2105) (if (fx=1226 level2104 0) (values var2103 maps2105) (if (null? maps2105) (syntax-violation (quote syntax) "missing ellipsis" src2102) (call-with-values (lambda () (gen-ref2076 src2102 var2103 (fx-1225 level2104 1) (cdr maps2105))) (lambda (outer-var2106 outer-maps2107) (let ((b2108 (assq outer-var2106 (car maps2105)))) (if b2108 (values (cdr b2108) maps2105) (let ((inner-var2109 (gen-var1307 (quote tmp)))) (values inner-var2109 (cons (cons (cons outer-var2106 inner-var2109) (car maps2105)) outer-maps2107))))))))))) (gen-syntax2075 (lambda (src2110 e2111 r2112 maps2113 ellipsis?2114 mod2115) (if (id?1259 e2111) (let ((label2116 (id-var-name1281 e2111 (quote (()))))) (let ((b2117 (lookup1256 label2116 r2112 mod2115))) (if (eq? (binding-type1251 b2117) (quote syntax)) (call-with-values (lambda () (let ((var.lev2118 (binding-value1252 b2117))) (gen-ref2076 src2110 (car var.lev2118) (cdr var.lev2118) maps2113))) (lambda (var2119 maps2120) (values (list (quote ref) var2119) maps2120))) (if (ellipsis?2114 e2111) (syntax-violation (quote syntax) "misplaced ellipsis" src2110) (values (list (quote quote) e2111) maps2113))))) ((lambda (tmp2121) ((lambda (tmp2122) (if (if tmp2122 (apply (lambda (dots2123 e2124) (ellipsis?2114 dots2123)) tmp2122) #f) (apply (lambda (dots2125 e2126) (gen-syntax2075 src2110 e2126 r2112 maps2113 (lambda (x2127) #f) mod2115)) tmp2122) ((lambda (tmp2128) (if (if tmp2128 (apply (lambda (x2129 dots2130 y2131) (ellipsis?2114 dots2130)) tmp2128) #f) (apply (lambda (x2132 dots2133 y2134) (let f2135 ((y2136 y2134) (k2137 (lambda (maps2138) (call-with-values (lambda () (gen-syntax2075 src2110 x2132 r2112 (cons (quote ()) maps2138) ellipsis?2114 mod2115)) (lambda (x2139 maps2140) (if (null? (car maps2140)) (syntax-violation (quote syntax) "extra ellipsis" src2110) (values (gen-map2078 x2139 (car maps2140)) (cdr maps2140)))))))) ((lambda (tmp2141) ((lambda (tmp2142) (if (if tmp2142 (apply (lambda (dots2143 y2144) (ellipsis?2114 dots2143)) tmp2142) #f) (apply (lambda (dots2145 y2146) (f2135 y2146 (lambda (maps2147) (call-with-values (lambda () (k2137 (cons (quote ()) maps2147))) (lambda (x2148 maps2149) (if (null? (car maps2149)) (syntax-violation (quote syntax) "extra ellipsis" src2110) (values (gen-mappend2077 x2148 (car maps2149)) (cdr maps2149)))))))) tmp2142) ((lambda (_2150) (call-with-values (lambda () (gen-syntax2075 src2110 y2136 r2112 maps2113 ellipsis?2114 mod2115)) (lambda (y2151 maps2152) (call-with-values (lambda () (k2137 maps2152)) (lambda (x2153 maps2154) (values (gen-append2080 x2153 y2151) maps2154)))))) tmp2141))) ($sc-dispatch tmp2141 (quote (any . any))))) y2136))) tmp2128) ((lambda (tmp2155) (if tmp2155 (apply (lambda (x2156 y2157) (call-with-values (lambda () (gen-syntax2075 src2110 x2156 r2112 maps2113 ellipsis?2114 mod2115)) (lambda (x2158 maps2159) (call-with-values (lambda () (gen-syntax2075 src2110 y2157 r2112 maps2159 ellipsis?2114 mod2115)) (lambda (y2160 maps2161) (values (gen-cons2079 x2158 y2160) maps2161)))))) tmp2155) ((lambda (tmp2162) (if tmp2162 (apply (lambda (e12163 e22164) (call-with-values (lambda () (gen-syntax2075 src2110 (cons e12163 e22164) r2112 maps2113 ellipsis?2114 mod2115)) (lambda (e2166 maps2167) (values (gen-vector2081 e2166) maps2167)))) tmp2162) ((lambda (_2168) (values (list (quote quote) e2111) maps2113)) tmp2121))) ($sc-dispatch tmp2121 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2121 (quote (any . any)))))) ($sc-dispatch tmp2121 (quote (any any . any)))))) ($sc-dispatch tmp2121 (quote (any any))))) e2111))))) (lambda (e2169 r2170 w2171 s2172 mod2173) (let ((e2174 (source-wrap1288 e2169 w2171 s2172 mod2173))) ((lambda (tmp2175) ((lambda (tmp2176) (if tmp2176 (apply (lambda (_2177 x2178) (call-with-values (lambda () (gen-syntax2075 e2174 x2178 r2170 (quote ()) ellipsis?1304 mod2173)) (lambda (e2179 maps2180) (regen2082 e2179)))) tmp2176) ((lambda (_2181) (syntax-violation (quote syntax) "bad `syntax' form" e2174)) tmp2175))) ($sc-dispatch tmp2175 (quote (any any))))) e2174))))) (global-extend1257 (quote core) (quote lambda) (lambda (e2182 r2183 w2184 s2185 mod2186) ((lambda (tmp2187) ((lambda (tmp2188) (if tmp2188 (apply (lambda (_2189 c2190) (chi-lambda-clause1300 (source-wrap1288 e2182 w2184 s2185 mod2186) #f c2190 r2183 w2184 mod2186 (lambda (vars2191 docstring2192 body2193) (build-annotated1232 s2185 (cons (quote lambda) (cons vars2191 (append (if docstring2192 (list docstring2192) (quote ())) (list body2193)))))))) tmp2188) (syntax-violation #f "source expression failed to match any pattern" tmp2187))) ($sc-dispatch tmp2187 (quote (any . any))))) e2182))) (global-extend1257 (quote core) (quote let) (letrec ((chi-let2194 (lambda (e2195 r2196 w2197 s2198 mod2199 constructor2200 ids2201 vals2202 exps2203) (if (not (valid-bound-ids?1284 ids2201)) (syntax-violation (quote let) "duplicate bound variable" e2195) (let ((labels2204 (gen-labels1265 ids2201)) (new-vars2205 (map gen-var1307 ids2201))) (let ((nw2206 (make-binding-wrap1276 ids2201 labels2204 w2197)) (nr2207 (extend-var-env1254 labels2204 new-vars2205 r2196))) (constructor2200 s2198 new-vars2205 (map (lambda (x2208) (chi1295 x2208 r2196 w2197 mod2199)) vals2202) (chi-body1299 exps2203 (source-wrap1288 e2195 nw2206 s2198 mod2199) nr2207 nw2206 mod2199)))))))) (lambda (e2209 r2210 w2211 s2212 mod2213) ((lambda (tmp2214) ((lambda (tmp2215) (if tmp2215 (apply (lambda (_2216 id2217 val2218 e12219 e22220) (chi-let2194 e2209 r2210 w2211 s2212 mod2213 build-let1239 id2217 val2218 (cons e12219 e22220))) tmp2215) ((lambda (tmp2224) (if (if tmp2224 (apply (lambda (_2225 f2226 id2227 val2228 e12229 e22230) (id?1259 f2226)) tmp2224) #f) (apply (lambda (_2231 f2232 id2233 val2234 e12235 e22236) (chi-let2194 e2209 r2210 w2211 s2212 mod2213 build-named-let1240 (cons f2232 id2233) val2234 (cons e12235 e22236))) tmp2224) ((lambda (_2240) (syntax-violation (quote let) "bad let" (source-wrap1288 e2209 w2211 s2212 mod2213))) tmp2214))) ($sc-dispatch tmp2214 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2214 (quote (any #(each (any any)) any . each-any))))) e2209)))) (global-extend1257 (quote core) (quote letrec) (lambda (e2241 r2242 w2243 s2244 mod2245) ((lambda (tmp2246) ((lambda (tmp2247) (if tmp2247 (apply (lambda (_2248 id2249 val2250 e12251 e22252) (let ((ids2253 id2249)) (if (not (valid-bound-ids?1284 ids2253)) (syntax-violation (quote letrec) "duplicate bound variable" e2241) (let ((labels2255 (gen-labels1265 ids2253)) (new-vars2256 (map gen-var1307 ids2253))) (let ((w2257 (make-binding-wrap1276 ids2253 labels2255 w2243)) (r2258 (extend-var-env1254 labels2255 new-vars2256 r2242))) (build-letrec1241 s2244 new-vars2256 (map (lambda (x2259) (chi1295 x2259 r2258 w2257 mod2245)) val2250) (chi-body1299 (cons e12251 e22252) (source-wrap1288 e2241 w2257 s2244 mod2245) r2258 w2257 mod2245))))))) tmp2247) ((lambda (_2262) (syntax-violation (quote letrec) "bad letrec" (source-wrap1288 e2241 w2243 s2244 mod2245))) tmp2246))) ($sc-dispatch tmp2246 (quote (any #(each (any any)) any . each-any))))) e2241))) (global-extend1257 (quote core) (quote set!) (lambda (e2263 r2264 w2265 s2266 mod2267) ((lambda (tmp2268) ((lambda (tmp2269) (if (if tmp2269 (apply (lambda (_2270 id2271 val2272) (id?1259 id2271)) tmp2269) #f) (apply (lambda (_2273 id2274 val2275) (let ((val2276 (chi1295 val2275 r2264 w2265 mod2267)) (n2277 (id-var-name1281 id2274 w2265))) (let ((b2278 (lookup1256 n2277 r2264 mod2267))) (let ((t2279 (binding-type1251 b2278))) (if (memv t2279 (quote (lexical))) (build-lexical-assignment1234 s2266 (syntax->datum id2274) (binding-value1252 b2278) val2276) (if (memv t2279 (quote (global))) (build-global-assignment1236 s2266 n2277 val2276 mod2267) (if (memv t2279 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1287 id2274 w2265 mod2267)) (syntax-violation (quote set!) "bad set!" (source-wrap1288 e2263 w2265 s2266 mod2267))))))))) tmp2269) ((lambda (tmp2280) (if tmp2280 (apply (lambda (_2281 head2282 tail2283 val2284) (call-with-values (lambda () (syntax-type1293 head2282 r2264 (quote (())) #f #f mod2267)) (lambda (type2285 value2286 ee2287 ww2288 ss2289 modmod2290) (let ((t2291 type2285)) (if (memv t2291 (quote (module-ref))) (let ((val2292 (chi1295 val2284 r2264 w2265 mod2267))) (call-with-values (lambda () (value2286 (cons head2282 tail2283))) (lambda (id2294 mod2295) (build-global-assignment1236 s2266 id2294 val2292 mod2295)))) (build-annotated1232 s2266 (cons (chi1295 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head2282) r2264 w2265 mod2267) (map (lambda (e2296) (chi1295 e2296 r2264 w2265 mod2267)) (append tail2283 (list val2284)))))))))) tmp2280) ((lambda (_2298) (syntax-violation (quote set!) "bad set!" (source-wrap1288 e2263 w2265 s2266 mod2267))) tmp2268))) ($sc-dispatch tmp2268 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2268 (quote (any any any))))) e2263))) (global-extend1257 (quote module-ref) (quote @) (lambda (e2299) ((lambda (tmp2300) ((lambda (tmp2301) (if (if tmp2301 (apply (lambda (_2302 mod2303 id2304) (and (and-map id?1259 mod2303) (id?1259 id2304))) tmp2301) #f) (apply (lambda (_2306 mod2307 id2308) (values (syntax->datum id2308) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2307)))) tmp2301) (syntax-violation #f "source expression failed to match any pattern" tmp2300))) ($sc-dispatch tmp2300 (quote (any each-any any))))) e2299))) (global-extend1257 (quote module-ref) (quote @@) (lambda (e2310) ((lambda (tmp2311) ((lambda (tmp2312) (if (if tmp2312 (apply (lambda (_2313 mod2314 id2315) (and (and-map id?1259 mod2314) (id?1259 id2315))) tmp2312) #f) (apply (lambda (_2317 mod2318 id2319) (values (syntax->datum id2319) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2318)))) tmp2312) (syntax-violation #f "source expression failed to match any pattern" tmp2311))) ($sc-dispatch tmp2311 (quote (any each-any any))))) e2310))) (global-extend1257 (quote begin) (quote begin) (quote ())) (global-extend1257 (quote define) (quote define) (quote ())) (global-extend1257 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1257 (quote eval-when) (quote eval-when) (quote ())) (global-extend1257 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2324 (lambda (x2325 keys2326 clauses2327 r2328 mod2329) (if (null? clauses2327) (build-annotated1232 #f (list (build-annotated1232 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2325)) ((lambda (tmp2330) ((lambda (tmp2331) (if tmp2331 (apply (lambda (pat2332 exp2333) (if (and (id?1259 pat2332) (and-map (lambda (x2334) (not (free-id=?1282 pat2332 x2334))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys2326))) (let ((labels2335 (list (gen-label1264))) (var2336 (gen-var1307 pat2332))) (build-annotated1232 #f (list (build-annotated1232 #f (list (quote lambda) (list var2336) (chi1295 exp2333 (extend-env1253 labels2335 (list (cons (quote syntax) (cons var2336 0))) r2328) (make-binding-wrap1276 (list pat2332) labels2335 (quote (()))) mod2329))) x2325))) (gen-clause2323 x2325 keys2326 (cdr clauses2327) r2328 pat2332 #t exp2333 mod2329))) tmp2331) ((lambda (tmp2337) (if tmp2337 (apply (lambda (pat2338 fender2339 exp2340) (gen-clause2323 x2325 keys2326 (cdr clauses2327) r2328 pat2338 fender2339 exp2340 mod2329)) tmp2337) ((lambda (_2341) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2327))) tmp2330))) ($sc-dispatch tmp2330 (quote (any any any)))))) ($sc-dispatch tmp2330 (quote (any any))))) (car clauses2327))))) (gen-clause2323 (lambda (x2342 keys2343 clauses2344 r2345 pat2346 fender2347 exp2348 mod2349) (call-with-values (lambda () (convert-pattern2321 pat2346 keys2343)) (lambda (p2350 pvars2351) (cond ((not (distinct-bound-ids?1285 (map car pvars2351))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2346)) ((not (and-map (lambda (x2352) (not (ellipsis?1304 (car x2352)))) pvars2351)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2346)) (else (let ((y2353 (gen-var1307 (quote tmp)))) (build-annotated1232 #f (list (build-annotated1232 #f (list (quote lambda) (list y2353) (let ((y2354 (build-lexical-reference1233 (quote value) #f (quote tmp) y2353))) (build-annotated1232 #f (list (quote if) ((lambda (tmp2355) ((lambda (tmp2356) (if tmp2356 (apply (lambda () y2354) tmp2356) ((lambda (_2357) (build-annotated1232 #f (list (quote if) y2354 (build-dispatch-call2322 pvars2351 fender2347 y2354 r2345 mod2349) (build-data1237 #f #f)))) tmp2355))) ($sc-dispatch tmp2355 (quote #(atom #t))))) fender2347) (build-dispatch-call2322 pvars2351 exp2348 y2354 r2345 mod2349) (gen-syntax-case2324 x2342 keys2343 clauses2344 r2345 mod2349)))))) (if (eq? p2350 (quote any)) (build-annotated1232 #f (list (build-annotated1232 #f (quote list)) x2342)) (build-annotated1232 #f (list (build-annotated1232 #f (quote $sc-dispatch)) x2342 (build-data1237 #f p2350))))))))))))) (build-dispatch-call2322 (lambda (pvars2358 exp2359 y2360 r2361 mod2362) (let ((ids2363 (map car pvars2358)) (levels2364 (map cdr pvars2358))) (let ((labels2365 (gen-labels1265 ids2363)) (new-vars2366 (map gen-var1307 ids2363))) (build-annotated1232 #f (list (build-annotated1232 #f (quote apply)) (build-annotated1232 #f (list (quote lambda) new-vars2366 (chi1295 exp2359 (extend-env1253 labels2365 (map (lambda (var2367 level2368) (cons (quote syntax) (cons var2367 level2368))) new-vars2366 (map cdr pvars2358)) r2361) (make-binding-wrap1276 ids2363 labels2365 (quote (()))) mod2362))) y2360)))))) (convert-pattern2321 (lambda (pattern2369 keys2370) (let cvt2371 ((p2372 pattern2369) (n2373 0) (ids2374 (quote ()))) (if (id?1259 p2372) (if (bound-id-member?1286 p2372 keys2370) (values (vector (quote free-id) p2372) ids2374) (values (quote any) (cons (cons p2372 n2373) ids2374))) ((lambda (tmp2375) ((lambda (tmp2376) (if (if tmp2376 (apply (lambda (x2377 dots2378) (ellipsis?1304 dots2378)) tmp2376) #f) (apply (lambda (x2379 dots2380) (call-with-values (lambda () (cvt2371 x2379 (fx+1224 n2373 1) ids2374)) (lambda (p2381 ids2382) (values (if (eq? p2381 (quote any)) (quote each-any) (vector (quote each) p2381)) ids2382)))) tmp2376) ((lambda (tmp2383) (if tmp2383 (apply (lambda (x2384 y2385) (call-with-values (lambda () (cvt2371 y2385 n2373 ids2374)) (lambda (y2386 ids2387) (call-with-values (lambda () (cvt2371 x2384 n2373 ids2387)) (lambda (x2388 ids2389) (values (cons x2388 y2386) ids2389)))))) tmp2383) ((lambda (tmp2390) (if tmp2390 (apply (lambda () (values (quote ()) ids2374)) tmp2390) ((lambda (tmp2391) (if tmp2391 (apply (lambda (x2392) (call-with-values (lambda () (cvt2371 x2392 n2373 ids2374)) (lambda (p2394 ids2395) (values (vector (quote vector) p2394) ids2395)))) tmp2391) ((lambda (x2396) (values (vector (quote atom) (strip1306 p2372 (quote (())))) ids2374)) tmp2375))) ($sc-dispatch tmp2375 (quote #(vector each-any)))))) ($sc-dispatch tmp2375 (quote ()))))) ($sc-dispatch tmp2375 (quote (any . any)))))) ($sc-dispatch tmp2375 (quote (any any))))) p2372)))))) (lambda (e2397 r2398 w2399 s2400 mod2401) (let ((e2402 (source-wrap1288 e2397 w2399 s2400 mod2401))) ((lambda (tmp2403) ((lambda (tmp2404) (if tmp2404 (apply (lambda (_2405 val2406 key2407 m2408) (if (and-map (lambda (x2409) (and (id?1259 x2409) (not (ellipsis?1304 x2409)))) key2407) (let ((x2411 (gen-var1307 (quote tmp)))) (build-annotated1232 s2400 (list (build-annotated1232 #f (list (quote lambda) (list x2411) (gen-syntax-case2324 (build-lexical-reference1233 (quote value) #f (quote tmp) x2411) key2407 m2408 r2398 mod2401))) (chi1295 val2406 r2398 (quote (())) mod2401)))) (syntax-violation (quote syntax-case) "invalid literals list" e2402))) tmp2404) (syntax-violation #f "source expression failed to match any pattern" tmp2403))) ($sc-dispatch tmp2403 (quote (any any each-any . each-any))))) e2402))))) (set! sc-expand (lambda (x2415 . rest2414) (if (and (pair? x2415) (equal? (car x2415) noexpand1222)) (cadr x2415) (let ((m2416 (if (null? rest2414) (quote e) (car rest2414))) (esew2417 (if (or (null? rest2414) (null? (cdr rest2414))) (quote (eval)) (cadr rest2414)))) (with-fluid* *mode*1223 m2416 (lambda () (chi-top1294 x2415 (quote ()) (quote ((top))) m2416 esew2417 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x2418) (nonsymbol-id?1258 x2418))) (set! datum->syntax (lambda (id2419 datum2420) (make-syntax-object1242 datum2420 (syntax-object-wrap1245 id2419) #f))) (set! syntax->datum (lambda (x2421) (strip1306 x2421 (quote (()))))) (set! generate-temporaries (lambda (ls2422) (begin (let ((x2423 ls2422)) (if (not (list? x2423)) (syntax-violation (quote generate-temporaries) "invalid argument" x2423))) (map (lambda (x2424) (wrap1287 (gensym) (quote ((top))) #f)) ls2422)))) (set! free-identifier=? (lambda (x2425 y2426) (begin (let ((x2427 x2425)) (if (not (nonsymbol-id?1258 x2427)) (syntax-violation (quote free-identifier=?) "invalid argument" x2427))) (let ((x2428 y2426)) (if (not (nonsymbol-id?1258 x2428)) (syntax-violation (quote free-identifier=?) "invalid argument" x2428))) (free-id=?1282 x2425 y2426)))) (set! bound-identifier=? (lambda (x2429 y2430) (begin (let ((x2431 x2429)) (if (not (nonsymbol-id?1258 x2431)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2431))) (let ((x2432 y2430)) (if (not (nonsymbol-id?1258 x2432)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2432))) (bound-id=?1283 x2429 y2430)))) (set! syntax-violation (lambda (who2436 message2435 form2434 . subform2433) (begin (let ((x2437 who2436)) (if (not ((lambda (x2438) (or (not x2438) (string? x2438) (symbol? x2438))) x2437)) (syntax-violation (quote syntax-violation) "invalid argument" x2437))) (let ((x2439 message2435)) (if (not (string? x2439)) (syntax-violation (quote syntax-violation) "invalid argument" x2439))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2436 "~a: " "") "~a " (if (null? subform2433) "in ~a" "in subform `~s' of `~s'")) (let ((tail2440 (cons message2435 (map (lambda (x2441) (strip1306 x2441 (quote (())))) (append subform2433 (list form2434)))))) (if who2436 (cons who2436 tail2440) tail2440)) #f)))) (letrec ((match2446 (lambda (e2447 p2448 w2449 r2450 mod2451) (cond ((not r2450) #f) ((eq? p2448 (quote any)) (cons (wrap1287 e2447 w2449 mod2451) r2450)) ((syntax-object?1243 e2447) (match*2445 (let ((e2452 (syntax-object-expression1244 e2447))) (if (annotation? e2452) (annotation-expression e2452) e2452)) p2448 (join-wraps1278 w2449 (syntax-object-wrap1245 e2447)) r2450 (syntax-object-module1246 e2447))) (else (match*2445 (let ((e2453 e2447)) (if (annotation? e2453) (annotation-expression e2453) e2453)) p2448 w2449 r2450 mod2451))))) (match*2445 (lambda (e2454 p2455 w2456 r2457 mod2458) (cond ((null? p2455) (and (null? e2454) r2457)) ((pair? p2455) (and (pair? e2454) (match2446 (car e2454) (car p2455) w2456 (match2446 (cdr e2454) (cdr p2455) w2456 r2457 mod2458) mod2458))) ((eq? p2455 (quote each-any)) (let ((l2459 (match-each-any2443 e2454 w2456 mod2458))) (and l2459 (cons l2459 r2457)))) (else (let ((t2460 (vector-ref p2455 0))) (if (memv t2460 (quote (each))) (if (null? e2454) (match-empty2444 (vector-ref p2455 1) r2457) (let ((l2461 (match-each2442 e2454 (vector-ref p2455 1) w2456 mod2458))) (and l2461 (let collect2462 ((l2463 l2461)) (if (null? (car l2463)) r2457 (cons (map car l2463) (collect2462 (map cdr l2463)))))))) (if (memv t2460 (quote (free-id))) (and (id?1259 e2454) (free-id=?1282 (wrap1287 e2454 w2456 mod2458) (vector-ref p2455 1)) r2457) (if (memv t2460 (quote (atom))) (and (equal? (vector-ref p2455 1) (strip1306 e2454 w2456)) r2457) (if (memv t2460 (quote (vector))) (and (vector? e2454) (match2446 (vector->list e2454) (vector-ref p2455 1) w2456 r2457 mod2458))))))))))) (match-empty2444 (lambda (p2464 r2465) (cond ((null? p2464) r2465) ((eq? p2464 (quote any)) (cons (quote ()) r2465)) ((pair? p2464) (match-empty2444 (car p2464) (match-empty2444 (cdr p2464) r2465))) ((eq? p2464 (quote each-any)) (cons (quote ()) r2465)) (else (let ((t2466 (vector-ref p2464 0))) (if (memv t2466 (quote (each))) (match-empty2444 (vector-ref p2464 1) r2465) (if (memv t2466 (quote (free-id atom))) r2465 (if (memv t2466 (quote (vector))) (match-empty2444 (vector-ref p2464 1) r2465))))))))) (match-each-any2443 (lambda (e2467 w2468 mod2469) (cond ((annotation? e2467) (match-each-any2443 (annotation-expression e2467) w2468 mod2469)) ((pair? e2467) (let ((l2470 (match-each-any2443 (cdr e2467) w2468 mod2469))) (and l2470 (cons (wrap1287 (car e2467) w2468 mod2469) l2470)))) ((null? e2467) (quote ())) ((syntax-object?1243 e2467) (match-each-any2443 (syntax-object-expression1244 e2467) (join-wraps1278 w2468 (syntax-object-wrap1245 e2467)) mod2469)) (else #f)))) (match-each2442 (lambda (e2471 p2472 w2473 mod2474) (cond ((annotation? e2471) (match-each2442 (annotation-expression e2471) p2472 w2473 mod2474)) ((pair? e2471) (let ((first2475 (match2446 (car e2471) p2472 w2473 (quote ()) mod2474))) (and first2475 (let ((rest2476 (match-each2442 (cdr e2471) p2472 w2473 mod2474))) (and rest2476 (cons first2475 rest2476)))))) ((null? e2471) (quote ())) ((syntax-object?1243 e2471) (match-each2442 (syntax-object-expression1244 e2471) p2472 (join-wraps1278 w2473 (syntax-object-wrap1245 e2471)) (syntax-object-module1246 e2471))) (else #f))))) (set! $sc-dispatch (lambda (e2477 p2478) (cond ((eq? p2478 (quote any)) (list e2477)) ((syntax-object?1243 e2477) (match*2445 (let ((e2479 (syntax-object-expression1244 e2477))) (if (annotation? e2479) (annotation-expression e2479) e2479)) p2478 (syntax-object-wrap1245 e2477) (quote ()) (syntax-object-module1246 e2477))) (else (match*2445 (let ((e2480 e2477)) (if (annotation? e2480) (annotation-expression e2480) e2480)) p2478 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x2481) ((lambda (tmp2482) ((lambda (tmp2483) (if tmp2483 (apply (lambda (_2484 e12485 e22486) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12485 e22486))) tmp2483) ((lambda (tmp2488) (if tmp2488 (apply (lambda (_2489 out2490 in2491 e12492 e22493) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2491 (quote ()) (list out2490 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12492 e22493))))) tmp2488) ((lambda (tmp2495) (if tmp2495 (apply (lambda (_2496 out2497 in2498 e12499 e22500) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2498) (quote ()) (list out2497 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12499 e22500))))) tmp2495) (syntax-violation #f "source expression failed to match any pattern" tmp2482))) ($sc-dispatch tmp2482 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2482 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2482 (quote (any () any . each-any))))) x2481))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2504) ((lambda (tmp2505) ((lambda (tmp2506) (if tmp2506 (apply (lambda (_2507 k2508 keyword2509 pattern2510 template2511) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k2508 (map (lambda (tmp2514 tmp2513) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2513) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2514))) template2511 pattern2510)))))) tmp2506) (syntax-violation #f "source expression failed to match any pattern" tmp2505))) ($sc-dispatch tmp2505 (quote (any each-any . #(each ((any . any) any))))))) x2504))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2515) ((lambda (tmp2516) ((lambda (tmp2517) (if (if tmp2517 (apply (lambda (let*2518 x2519 v2520 e12521 e22522) (and-map identifier? x2519)) tmp2517) #f) (apply (lambda (let*2524 x2525 v2526 e12527 e22528) (let f2529 ((bindings2530 (map list x2525 v2526))) (if (null? bindings2530) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e12527 e22528))) ((lambda (tmp2534) ((lambda (tmp2535) (if tmp2535 (apply (lambda (body2536 binding2537) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding2537) body2536)) tmp2535) (syntax-violation #f "source expression failed to match any pattern" tmp2534))) ($sc-dispatch tmp2534 (quote (any any))))) (list (f2529 (cdr bindings2530)) (car bindings2530)))))) tmp2517) (syntax-violation #f "source expression failed to match any pattern" tmp2516))) ($sc-dispatch tmp2516 (quote (any #(each (any any)) any . each-any))))) x2515))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2538) ((lambda (tmp2539) ((lambda (tmp2540) (if tmp2540 (apply (lambda (_2541 var2542 init2543 step2544 e02545 e12546 c2547) ((lambda (tmp2548) ((lambda (tmp2549) (if tmp2549 (apply (lambda (step2550) ((lambda (tmp2551) ((lambda (tmp2552) (if tmp2552 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2542 init2543) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02545) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2550))))))) tmp2552) ((lambda (tmp2557) (if tmp2557 (apply (lambda (e12558 e22559) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2542 init2543) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02545 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e12558 e22559)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2550))))))) tmp2557) (syntax-violation #f "source expression failed to match any pattern" tmp2551))) ($sc-dispatch tmp2551 (quote (any . each-any)))))) ($sc-dispatch tmp2551 (quote ())))) e12546)) tmp2549) (syntax-violation #f "source expression failed to match any pattern" tmp2548))) ($sc-dispatch tmp2548 (quote each-any)))) (map (lambda (v2566 s2567) ((lambda (tmp2568) ((lambda (tmp2569) (if tmp2569 (apply (lambda () v2566) tmp2569) ((lambda (tmp2570) (if tmp2570 (apply (lambda (e2571) e2571) tmp2570) ((lambda (_2572) (syntax-violation (quote do) "bad step expression" orig-x2538 s2567)) tmp2568))) ($sc-dispatch tmp2568 (quote (any)))))) ($sc-dispatch tmp2568 (quote ())))) s2567)) var2542 step2544))) tmp2540) (syntax-violation #f "source expression failed to match any pattern" tmp2539))) ($sc-dispatch tmp2539 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2538))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2575 (lambda (x2579 y2580) ((lambda (tmp2581) ((lambda (tmp2582) (if tmp2582 (apply (lambda (x2583 y2584) ((lambda (tmp2585) ((lambda (tmp2586) (if tmp2586 (apply (lambda (dy2587) ((lambda (tmp2588) ((lambda (tmp2589) (if tmp2589 (apply (lambda (dx2590) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx2590 dy2587))) tmp2589) ((lambda (_2591) (if (null? dy2587) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2583) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2583 y2584))) tmp2588))) ($sc-dispatch tmp2588 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x2583)) tmp2586) ((lambda (tmp2592) (if tmp2592 (apply (lambda (stuff2593) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x2583 stuff2593))) tmp2592) ((lambda (else2594) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2583 y2584)) tmp2585))) ($sc-dispatch tmp2585 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp2585 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y2584)) tmp2582) (syntax-violation #f "source expression failed to match any pattern" tmp2581))) ($sc-dispatch tmp2581 (quote (any any))))) (list x2579 y2580)))) (quasiappend2576 (lambda (x2595 y2596) ((lambda (tmp2597) ((lambda (tmp2598) (if tmp2598 (apply (lambda (x2599 y2600) ((lambda (tmp2601) ((lambda (tmp2602) (if tmp2602 (apply (lambda () x2599) tmp2602) ((lambda (_2603) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2599 y2600)) tmp2601))) ($sc-dispatch tmp2601 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y2600)) tmp2598) (syntax-violation #f "source expression failed to match any pattern" tmp2597))) ($sc-dispatch tmp2597 (quote (any any))))) (list x2595 y2596)))) (quasivector2577 (lambda (x2604) ((lambda (tmp2605) ((lambda (x2606) ((lambda (tmp2607) ((lambda (tmp2608) (if tmp2608 (apply (lambda (x2609) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x2609))) tmp2608) ((lambda (tmp2611) (if tmp2611 (apply (lambda (x2612) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2612)) tmp2611) ((lambda (_2614) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2606)) tmp2607))) ($sc-dispatch tmp2607 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp2607 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x2606)) tmp2605)) x2604))) (quasi2578 (lambda (p2615 lev2616) ((lambda (tmp2617) ((lambda (tmp2618) (if tmp2618 (apply (lambda (p2619) (if (= lev2616 0) p2619 (quasicons2575 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2578 (list p2619) (- lev2616 1))))) tmp2618) ((lambda (tmp2620) (if tmp2620 (apply (lambda (p2621 q2622) (if (= lev2616 0) (quasiappend2576 p2621 (quasi2578 q2622 lev2616)) (quasicons2575 (quasicons2575 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2578 (list p2621) (- lev2616 1))) (quasi2578 q2622 lev2616)))) tmp2620) ((lambda (tmp2623) (if tmp2623 (apply (lambda (p2624) (quasicons2575 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2578 (list p2624) (+ lev2616 1)))) tmp2623) ((lambda (tmp2625) (if tmp2625 (apply (lambda (p2626 q2627) (quasicons2575 (quasi2578 p2626 lev2616) (quasi2578 q2627 lev2616))) tmp2625) ((lambda (tmp2628) (if tmp2628 (apply (lambda (x2629) (quasivector2577 (quasi2578 x2629 lev2616))) tmp2628) ((lambda (p2631) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p2631)) tmp2617))) ($sc-dispatch tmp2617 (quote #(vector each-any)))))) ($sc-dispatch tmp2617 (quote (any . any)))))) ($sc-dispatch tmp2617 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp2617 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp2617 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p2615)))) (lambda (x2632) ((lambda (tmp2633) ((lambda (tmp2634) (if tmp2634 (apply (lambda (_2635 e2636) (quasi2578 e2636 0)) tmp2634) (syntax-violation #f "source expression failed to match any pattern" tmp2633))) ($sc-dispatch tmp2633 (quote (any any))))) x2632)))))
+(define include (make-syncase-macro (quote macro) (lambda (x2637) (letrec ((read-file2638 (lambda (fn2639 k2640) (let ((p2641 (open-input-file fn2639))) (let f2642 ((x2643 (read p2641))) (if (eof-object? x2643) (begin (close-input-port p2641) (quote ())) (cons (datum->syntax k2640 x2643) (f2642 (read p2641))))))))) ((lambda (tmp2644) ((lambda (tmp2645) (if tmp2645 (apply (lambda (k2646 filename2647) (let ((fn2648 (syntax->datum filename2647))) ((lambda (tmp2649) ((lambda (tmp2650) (if tmp2650 (apply (lambda (exp2651) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp2651)) tmp2650) (syntax-violation #f "source expression failed to match any pattern" tmp2649))) ($sc-dispatch tmp2649 (quote each-any)))) (read-file2638 fn2648 k2646)))) tmp2645) (syntax-violation #f "source expression failed to match any pattern" tmp2644))) ($sc-dispatch tmp2644 (quote (any any))))) x2637)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x2653) ((lambda (tmp2654) ((lambda (tmp2655) (if tmp2655 (apply (lambda (_2656 e2657) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x2653)) tmp2655) (syntax-violation #f "source expression failed to match any pattern" tmp2654))) ($sc-dispatch tmp2654 (quote (any any))))) x2653))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2658) ((lambda (tmp2659) ((lambda (tmp2660) (if tmp2660 (apply (lambda (_2661 e2662) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x2658)) tmp2660) (syntax-violation #f "source expression failed to match any pattern" tmp2659))) ($sc-dispatch tmp2659 (quote (any any))))) x2658))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2663) ((lambda (tmp2664) ((lambda (tmp2665) (if tmp2665 (apply (lambda (_2666 e2667 m12668 m22669) ((lambda (tmp2670) ((lambda (body2671) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2667)) body2671)) tmp2670)) (let f2672 ((clause2673 m12668) (clauses2674 m22669)) (if (null? clauses2674) ((lambda (tmp2676) ((lambda (tmp2677) (if tmp2677 (apply (lambda (e12678 e22679) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12678 e22679))) tmp2677) ((lambda (tmp2681) (if tmp2681 (apply (lambda (k2682 e12683 e22684) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2682)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12683 e22684)))) tmp2681) ((lambda (_2687) (syntax-violation (quote case) "bad clause" x2663 clause2673)) tmp2676))) ($sc-dispatch tmp2676 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2676 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause2673) ((lambda (tmp2688) ((lambda (rest2689) ((lambda (tmp2690) ((lambda (tmp2691) (if tmp2691 (apply (lambda (k2692 e12693 e22694) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2692)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12693 e22694)) rest2689)) tmp2691) ((lambda (_2697) (syntax-violation (quote case) "bad clause" x2663 clause2673)) tmp2690))) ($sc-dispatch tmp2690 (quote (each-any any . each-any))))) clause2673)) tmp2688)) (f2672 (car clauses2674) (cdr clauses2674))))))) tmp2665) (syntax-violation #f "source expression failed to match any pattern" tmp2664))) ($sc-dispatch tmp2664 (quote (any any any . each-any))))) x2663))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2698) ((lambda (tmp2699) ((lambda (tmp2700) (if tmp2700 (apply (lambda (_2701 e2702) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2702)) (list (cons _2701 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e2702 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp2700) (syntax-violation #f "source expression failed to match any pattern" tmp2699))) ($sc-dispatch tmp2699 (quote (any any))))) x2698))))
HCoop / bpt / guile.git / blobdiff