-(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
-(void)
-(letrec ((lambda-var-list1132 (lambda (vars1337) (let lvl1338 ((vars1339 vars1337) (ls1340 (quote ())) (w1341 (quote (())))) (cond ((pair? vars1339) (lvl1338 (cdr vars1339) (cons (wrap1111 (car vars1339) w1341 #f) ls1340) w1341)) ((id?1083 vars1339) (cons (wrap1111 vars1339 w1341 #f) ls1340)) ((null? vars1339) ls1340) ((syntax-object?1067 vars1339) (lvl1338 (syntax-object-expression1068 vars1339) ls1340 (join-wraps1102 w1341 (syntax-object-wrap1069 vars1339)))) ((annotation? vars1339) (lvl1338 (annotation-expression vars1339) ls1340 w1341)) (else (cons vars1339 ls1340)))))) (gen-var1131 (lambda (id1342) (let ((id1343 (if (syntax-object?1067 id1342) (syntax-object-expression1068 id1342) id1342))) (if (annotation? id1343) (build-annotated1060 (annotation-source id1343) (gensym (symbol->string (annotation-expression id1343)))) (build-annotated1060 #f (gensym (symbol->string id1343))))))) (strip1130 (lambda (x1344 w1345) (if (memq (quote top) (wrap-marks1086 w1345)) (if (or (annotation? x1344) (and (pair? x1344) (annotation? (car x1344)))) (strip-annotation1129 x1344 #f) x1344) (let f1346 ((x1347 x1344)) (cond ((syntax-object?1067 x1347) (strip1130 (syntax-object-expression1068 x1347) (syntax-object-wrap1069 x1347))) ((pair? x1347) (let ((a1348 (f1346 (car x1347))) (d1349 (f1346 (cdr x1347)))) (if (and (eq? a1348 (car x1347)) (eq? d1349 (cdr x1347))) x1347 (cons a1348 d1349)))) ((vector? x1347) (let ((old1350 (vector->list x1347))) (let ((new1351 (map f1346 old1350))) (if (andmap eq? old1350 new1351) x1347 (list->vector new1351))))) (else x1347)))))) (strip-annotation1129 (lambda (x1352 parent1353) (cond ((pair? x1352) (let ((new1354 (cons #f #f))) (begin (if parent1353 (set-annotation-stripped! parent1353 new1354)) (set-car! new1354 (strip-annotation1129 (car x1352) #f)) (set-cdr! new1354 (strip-annotation1129 (cdr x1352) #f)) new1354))) ((annotation? x1352) (or (annotation-stripped x1352) (strip-annotation1129 (annotation-expression x1352) x1352))) ((vector? x1352) (let ((new1355 (make-vector (vector-length x1352)))) (begin (if parent1353 (set-annotation-stripped! parent1353 new1355)) (let loop1356 ((i1357 (- (vector-length x1352) 1))) (unless (fx<1053 i1357 0) (vector-set! new1355 i1357 (strip-annotation1129 (vector-ref x1352 i1357) #f)) (loop1356 (fx-1051 i1357 1)))) new1355))) (else x1352)))) (ellipsis?1128 (lambda (x1358) (and (nonsymbol-id?1082 x1358) (free-id=?1106 x1358 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1127 (lambda () (build-annotated1060 #f (list (build-annotated1060 #f (quote void)))))) (eval-local-transformer1126 (lambda (expanded1359 mod1360) (let ((p1361 (local-eval-hook1055 expanded1359 mod1360))) (if (procedure? p1361) p1361 (syntax-error p1361 "nonprocedure transformer"))))) (chi-local-syntax1125 (lambda (rec?1362 e1363 r1364 w1365 s1366 mod1367 k1368) ((lambda (tmp1369) ((lambda (tmp1370) (if tmp1370 (apply (lambda (_1371 id1372 val1373 e11374 e21375) (let ((ids1376 id1372)) (if (not (valid-bound-ids?1108 ids1376)) (syntax-error e1363 "duplicate bound keyword in") (let ((labels1378 (gen-labels1089 ids1376))) (let ((new-w1379 (make-binding-wrap1100 ids1376 labels1378 w1365))) (k1368 (cons e11374 e21375) (extend-env1077 labels1378 (let ((w1381 (if rec?1362 new-w1379 w1365)) (trans-r1382 (macros-only-env1079 r1364))) (map (lambda (x1383) (cons (quote macro) (eval-local-transformer1126 (chi1119 x1383 trans-r1382 w1381 mod1367) mod1367))) val1373)) r1364) new-w1379 s1366 mod1367)))))) tmp1370) ((lambda (_1385) (syntax-error (source-wrap1112 e1363 w1365 s1366 mod1367))) tmp1369))) (syntax-dispatch tmp1369 (quote (any #(each (any any)) any . each-any))))) e1363))) (chi-lambda-clause1124 (lambda (e1386 docstring1387 c1388 r1389 w1390 mod1391 k1392) ((lambda (tmp1393) ((lambda (tmp1394) (if (if tmp1394 (apply (lambda (args1395 doc1396 e11397 e21398) (and (string? (syntax-object->datum doc1396)) (not docstring1387))) tmp1394) #f) (apply (lambda (args1399 doc1400 e11401 e21402) (chi-lambda-clause1124 e1386 doc1400 (cons args1399 (cons e11401 e21402)) r1389 w1390 mod1391 k1392)) tmp1394) ((lambda (tmp1404) (if tmp1404 (apply (lambda (id1405 e11406 e21407) (let ((ids1408 id1405)) (if (not (valid-bound-ids?1108 ids1408)) (syntax-error e1386 "invalid parameter list in") (let ((labels1410 (gen-labels1089 ids1408)) (new-vars1411 (map gen-var1131 ids1408))) (k1392 new-vars1411 docstring1387 (chi-body1123 (cons e11406 e21407) e1386 (extend-var-env1078 labels1410 new-vars1411 r1389) (make-binding-wrap1100 ids1408 labels1410 w1390) mod1391)))))) tmp1404) ((lambda (tmp1413) (if tmp1413 (apply (lambda (ids1414 e11415 e21416) (let ((old-ids1417 (lambda-var-list1132 ids1414))) (if (not (valid-bound-ids?1108 old-ids1417)) (syntax-error e1386 "invalid parameter list in") (let ((labels1418 (gen-labels1089 old-ids1417)) (new-vars1419 (map gen-var1131 old-ids1417))) (k1392 (let f1420 ((ls11421 (cdr new-vars1419)) (ls21422 (car new-vars1419))) (if (null? ls11421) ls21422 (f1420 (cdr ls11421) (cons (car ls11421) ls21422)))) docstring1387 (chi-body1123 (cons e11415 e21416) e1386 (extend-var-env1078 labels1418 new-vars1419 r1389) (make-binding-wrap1100 old-ids1417 labels1418 w1390) mod1391)))))) tmp1413) ((lambda (_1424) (syntax-error e1386)) tmp1393))) (syntax-dispatch tmp1393 (quote (any any . each-any)))))) (syntax-dispatch tmp1393 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1393 (quote (any any any . each-any))))) c1388))) (chi-body1123 (lambda (body1425 outer-form1426 r1427 w1428 mod1429) (let ((r1430 (cons (quote ("placeholder" placeholder)) r1427))) (let ((ribcage1431 (make-ribcage1090 (quote ()) (quote ()) (quote ())))) (let ((w1432 (make-wrap1085 (wrap-marks1086 w1428) (cons ribcage1431 (wrap-subst1087 w1428))))) (let parse1433 ((body1434 (map (lambda (x1440) (cons r1430 (wrap1111 x1440 w1432 mod1429))) body1425)) (ids1435 (quote ())) (labels1436 (quote ())) (vars1437 (quote ())) (vals1438 (quote ())) (bindings1439 (quote ()))) (if (null? body1434) (syntax-error outer-form1426 "no expressions in body") (let ((e1441 (cdar body1434)) (er1442 (caar body1434))) (call-with-values (lambda () (syntax-type1117 e1441 er1442 (quote (())) #f ribcage1431 mod1429)) (lambda (type1443 value1444 e1445 w1446 s1447 mod1448) (let ((t1449 type1443)) (if (memv t1449 (quote (define-form))) (let ((id1450 (wrap1111 value1444 w1446 mod1448)) (label1451 (gen-label1088))) (let ((var1452 (gen-var1131 id1450))) (begin (extend-ribcage!1099 ribcage1431 id1450 label1451) (parse1433 (cdr body1434) (cons id1450 ids1435) (cons label1451 labels1436) (cons var1452 vars1437) (cons (cons er1442 (wrap1111 e1445 w1446 mod1448)) vals1438) (cons (cons (quote lexical) var1452) bindings1439))))) (if (memv t1449 (quote (define-syntax-form))) (let ((id1453 (wrap1111 value1444 w1446 mod1448)) (label1454 (gen-label1088))) (begin (extend-ribcage!1099 ribcage1431 id1453 label1454) (parse1433 (cdr body1434) (cons id1453 ids1435) (cons label1454 labels1436) vars1437 vals1438 (cons (cons (quote macro) (cons er1442 (wrap1111 e1445 w1446 mod1448))) bindings1439)))) (if (memv t1449 (quote (begin-form))) ((lambda (tmp1455) ((lambda (tmp1456) (if tmp1456 (apply (lambda (_1457 e11458) (parse1433 (let f1459 ((forms1460 e11458)) (if (null? forms1460) (cdr body1434) (cons (cons er1442 (wrap1111 (car forms1460) w1446 mod1448)) (f1459 (cdr forms1460))))) ids1435 labels1436 vars1437 vals1438 bindings1439)) tmp1456) (syntax-error tmp1455))) (syntax-dispatch tmp1455 (quote (any . each-any))))) e1445) (if (memv t1449 (quote (local-syntax-form))) (chi-local-syntax1125 value1444 e1445 er1442 w1446 s1447 mod1448 (lambda (forms1462 er1463 w1464 s1465 mod1466) (parse1433 (let f1467 ((forms1468 forms1462)) (if (null? forms1468) (cdr body1434) (cons (cons er1463 (wrap1111 (car forms1468) w1464 mod1466)) (f1467 (cdr forms1468))))) ids1435 labels1436 vars1437 vals1438 bindings1439))) (if (null? ids1435) (build-sequence1062 #f (map (lambda (x1469) (chi1119 (cdr x1469) (car x1469) (quote (())) mod1448)) (cons (cons er1442 (source-wrap1112 e1445 w1446 s1447 mod1448)) (cdr body1434)))) (begin (if (not (valid-bound-ids?1108 ids1435)) (syntax-error outer-form1426 "invalid or duplicate identifier in definition")) (let loop1470 ((bs1471 bindings1439) (er-cache1472 #f) (r-cache1473 #f)) (if (not (null? bs1471)) (let ((b1474 (car bs1471))) (if (eq? (car b1474) (quote macro)) (let ((er1475 (cadr b1474))) (let ((r-cache1476 (if (eq? er1475 er-cache1472) r-cache1473 (macros-only-env1079 er1475)))) (begin (set-cdr! b1474 (eval-local-transformer1126 (chi1119 (cddr b1474) r-cache1476 (quote (())) mod1448) mod1448)) (loop1470 (cdr bs1471) er1475 r-cache1476)))) (loop1470 (cdr bs1471) er-cache1472 r-cache1473))))) (set-cdr! r1430 (extend-env1077 labels1436 bindings1439 (cdr r1430))) (build-letrec1065 #f vars1437 (map (lambda (x1477) (chi1119 (cdr x1477) (car x1477) (quote (())) mod1448)) vals1438) (build-sequence1062 #f (map (lambda (x1478) (chi1119 (cdr x1478) (car x1478) (quote (())) mod1448)) (cons (cons er1442 (source-wrap1112 e1445 w1446 s1447 mod1448)) (cdr body1434)))))))))))))))))))))) (chi-macro1122 (lambda (p1479 e1480 r1481 w1482 rib1483 mod1484) (letrec ((rebuild-macro-output1485 (lambda (x1486 m1487) (cond ((pair? x1486) (cons (rebuild-macro-output1485 (car x1486) m1487) (rebuild-macro-output1485 (cdr x1486) m1487))) ((syntax-object?1067 x1486) (let ((w1488 (syntax-object-wrap1069 x1486))) (let ((ms1489 (wrap-marks1086 w1488)) (s1490 (wrap-subst1087 w1488))) (if (and (pair? ms1489) (eq? (car ms1489) #f)) (make-syntax-object1066 (syntax-object-expression1068 x1486) (make-wrap1085 (cdr ms1489) (if rib1483 (cons rib1483 (cdr s1490)) (cdr s1490))) (syntax-object-module1070 x1486)) (make-syntax-object1066 (syntax-object-expression1068 x1486) (make-wrap1085 (cons m1487 ms1489) (if rib1483 (cons rib1483 (cons (quote shift) s1490)) (cons (quote shift) s1490))) (let ((pmod1491 (procedure-module p1479))) (if pmod1491 (cons (quote hygiene) (module-name pmod1491)) (quote (hygiene guile))))))))) ((vector? x1486) (let ((n1492 (vector-length x1486))) (let ((v1493 (make-vector n1492))) (let doloop1494 ((i1495 0)) (if (fx=1052 i1495 n1492) v1493 (begin (vector-set! v1493 i1495 (rebuild-macro-output1485 (vector-ref x1486 i1495) m1487)) (doloop1494 (fx+1050 i1495 1)))))))) ((symbol? x1486) (syntax-error x1486 "encountered raw symbol in macro output")) (else x1486))))) (rebuild-macro-output1485 (p1479 (wrap1111 e1480 (anti-mark1098 w1482) mod1484)) (string #\m))))) (chi-application1121 (lambda (x1496 e1497 r1498 w1499 s1500 mod1501) ((lambda (tmp1502) ((lambda (tmp1503) (if tmp1503 (apply (lambda (e01504 e11505) (build-annotated1060 s1500 (cons x1496 (map (lambda (e1506) (chi1119 e1506 r1498 w1499 mod1501)) e11505)))) tmp1503) (syntax-error tmp1502))) (syntax-dispatch tmp1502 (quote (any . each-any))))) e1497))) (chi-expr1120 (lambda (type1508 value1509 e1510 r1511 w1512 s1513 mod1514) (let ((t1515 type1508)) (if (memv t1515 (quote (lexical))) (build-annotated1060 s1513 value1509) (if (memv t1515 (quote (core external-macro))) (value1509 e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (module-ref))) (call-with-values (lambda () (value1509 e1510)) (lambda (id1516 mod1517) (build-annotated1060 s1513 (if mod1517 (make-module-ref (cdr mod1517) id1516 (car mod1517)) (make-module-ref mod1517 id1516 (quote bare)))))) (if (memv t1515 (quote (lexical-call))) (chi-application1121 (build-annotated1060 (source-annotation1074 (car e1510)) value1509) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (global-call))) (chi-application1121 (build-annotated1060 (source-annotation1074 (car e1510)) (if (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514) (make-module-ref (cdr (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514)) value1509 (car (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514))) (make-module-ref (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514) value1509 (quote bare)))) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (constant))) (build-data1061 s1513 (strip1130 (source-wrap1112 e1510 w1512 s1513 mod1514) (quote (())))) (if (memv t1515 (quote (global))) (build-annotated1060 s1513 (if mod1514 (make-module-ref (cdr mod1514) value1509 (car mod1514)) (make-module-ref mod1514 value1509 (quote bare)))) (if (memv t1515 (quote (call))) (chi-application1121 (chi1119 (car e1510) r1511 w1512 mod1514) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (begin-form))) ((lambda (tmp1518) ((lambda (tmp1519) (if tmp1519 (apply (lambda (_1520 e11521 e21522) (chi-sequence1113 (cons e11521 e21522) r1511 w1512 s1513 mod1514)) tmp1519) (syntax-error tmp1518))) (syntax-dispatch tmp1518 (quote (any any . each-any))))) e1510) (if (memv t1515 (quote (local-syntax-form))) (chi-local-syntax1125 value1509 e1510 r1511 w1512 s1513 mod1514 chi-sequence1113) (if (memv t1515 (quote (eval-when-form))) ((lambda (tmp1524) ((lambda (tmp1525) (if tmp1525 (apply (lambda (_1526 x1527 e11528 e21529) (let ((when-list1530 (chi-when-list1116 e1510 x1527 w1512))) (if (memq (quote eval) when-list1530) (chi-sequence1113 (cons e11528 e21529) r1511 w1512 s1513 mod1514) (chi-void1127)))) tmp1525) (syntax-error tmp1524))) (syntax-dispatch tmp1524 (quote (any each-any any . each-any))))) e1510) (if (memv t1515 (quote (define-form define-syntax-form))) (syntax-error (wrap1111 value1509 w1512 mod1514) "invalid context for definition of") (if (memv t1515 (quote (syntax))) (syntax-error (source-wrap1112 e1510 w1512 s1513 mod1514) "reference to pattern variable outside syntax form") (if (memv t1515 (quote (displaced-lexical))) (syntax-error (source-wrap1112 e1510 w1512 s1513 mod1514) "reference to identifier outside its scope") (syntax-error (source-wrap1112 e1510 w1512 s1513 mod1514))))))))))))))))))) (chi1119 (lambda (e1533 r1534 w1535 mod1536) (call-with-values (lambda () (syntax-type1117 e1533 r1534 w1535 #f #f mod1536)) (lambda (type1537 value1538 e1539 w1540 s1541 mod1542) (chi-expr1120 type1537 value1538 e1539 r1534 w1540 s1541 mod1542))))) (chi-top1118 (lambda (e1543 r1544 w1545 m1546 esew1547 mod1548) (call-with-values (lambda () (syntax-type1117 e1543 r1544 w1545 #f #f mod1548)) (lambda (type1556 value1557 e1558 w1559 s1560 mod1561) (let ((t1562 type1556)) (if (memv t1562 (quote (begin-form))) ((lambda (tmp1563) ((lambda (tmp1564) (if tmp1564 (apply (lambda (_1565) (chi-void1127)) tmp1564) ((lambda (tmp1566) (if tmp1566 (apply (lambda (_1567 e11568 e21569) (chi-top-sequence1114 (cons e11568 e21569) r1544 w1559 s1560 m1546 esew1547 mod1561)) tmp1566) (syntax-error tmp1563))) (syntax-dispatch tmp1563 (quote (any any . each-any)))))) (syntax-dispatch tmp1563 (quote (any))))) e1558) (if (memv t1562 (quote (local-syntax-form))) (chi-local-syntax1125 value1557 e1558 r1544 w1559 s1560 mod1561 (lambda (body1571 r1572 w1573 s1574 mod1575) (chi-top-sequence1114 body1571 r1572 w1573 s1574 m1546 esew1547 mod1575))) (if (memv t1562 (quote (eval-when-form))) ((lambda (tmp1576) ((lambda (tmp1577) (if tmp1577 (apply (lambda (_1578 x1579 e11580 e21581) (let ((when-list1582 (chi-when-list1116 e1558 x1579 w1559)) (body1583 (cons e11580 e21581))) (cond ((eq? m1546 (quote e)) (if (memq (quote eval) when-list1582) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote e) (quote (eval)) mod1561) (chi-void1127))) ((memq (quote load) when-list1582) (if (or (memq (quote compile) when-list1582) (and (eq? m1546 (quote c&e)) (memq (quote eval) when-list1582))) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote c&e) (quote (compile load)) mod1561) (if (memq m1546 (quote (c c&e))) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote c) (quote (load)) mod1561) (chi-void1127)))) ((or (memq (quote compile) when-list1582) (and (eq? m1546 (quote c&e)) (memq (quote eval) when-list1582))) (top-level-eval-hook1054 (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote e) (quote (eval)) mod1561) mod1561) (chi-void1127)) (else (chi-void1127))))) tmp1577) (syntax-error tmp1576))) (syntax-dispatch tmp1576 (quote (any each-any any . each-any))))) e1558) (if (memv t1562 (quote (define-syntax-form))) (let ((n1586 (id-var-name1105 value1557 w1559)) (r1587 (macros-only-env1079 r1544))) (let ((t1588 m1546)) (if (memv t1588 (quote (c))) (if (memq (quote compile) esew1547) (let ((e1589 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)))) (begin (top-level-eval-hook1054 e1589 mod1561) (if (memq (quote load) esew1547) e1589 (chi-void1127)))) (if (memq (quote load) esew1547) (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)) (chi-void1127))) (if (memv t1588 (quote (c&e))) (let ((e1590 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)))) (begin (top-level-eval-hook1054 e1590 mod1561) e1590)) (begin (if (memq (quote eval) esew1547) (top-level-eval-hook1054 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)) mod1561)) (chi-void1127)))))) (if (memv t1562 (quote (define-form))) (let ((n1591 (id-var-name1105 value1557 w1559))) (let ((type1592 (binding-type1075 (lookup1080 n1591 r1544 mod1561)))) (let ((t1593 type1592)) (if (memv t1593 (quote (global))) (let ((x1594 (build-annotated1060 s1560 (list (quote define) n1591 (chi1119 e1558 r1544 w1559 mod1561))))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1594 mod1561)) x1594)) (if (memv t1593 (quote (displaced-lexical))) (syntax-error (wrap1111 value1557 w1559 mod1561) "identifier out of context") (if (memv t1593 (quote (core macro module-ref))) (begin (remove-global-definition-hook1058 n1591) (let ((x1595 (build-annotated1060 s1560 (list (quote define) n1591 (chi1119 e1558 r1544 w1559 mod1561))))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1595 mod1561)) x1595))) (syntax-error (wrap1111 value1557 w1559 mod1561) "cannot define keyword at top level"))))))) (let ((x1596 (chi-expr1120 type1556 value1557 e1558 r1544 w1559 s1560 mod1561))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1596 mod1561)) x1596)))))))))))) (syntax-type1117 (lambda (e1597 r1598 w1599 s1600 rib1601 mod1602) (cond ((symbol? e1597) (let ((n1603 (id-var-name1105 e1597 w1599))) (let ((b1604 (lookup1080 n1603 r1598 mod1602))) (let ((type1605 (binding-type1075 b1604))) (let ((t1606 type1605)) (if (memv t1606 (quote (lexical))) (values type1605 (binding-value1076 b1604) e1597 w1599 s1600 mod1602) (if (memv t1606 (quote (global))) (values type1605 n1603 e1597 w1599 s1600 mod1602) (if (memv t1606 (quote (macro))) (syntax-type1117 (chi-macro1122 (binding-value1076 b1604) e1597 r1598 w1599 rib1601 mod1602) r1598 (quote (())) s1600 rib1601 mod1602) (values type1605 (binding-value1076 b1604) e1597 w1599 s1600 mod1602))))))))) ((pair? e1597) (let ((first1607 (car e1597))) (if (id?1083 first1607) (let ((n1608 (id-var-name1105 first1607 w1599))) (let ((b1609 (lookup1080 n1608 r1598 (or (and (syntax-object?1067 first1607) (syntax-object-module1070 first1607)) mod1602)))) (let ((type1610 (binding-type1075 b1609))) (let ((t1611 type1610)) (if (memv t1611 (quote (lexical))) (values (quote lexical-call) (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (global))) (values (quote global-call) n1608 e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (macro))) (syntax-type1117 (chi-macro1122 (binding-value1076 b1609) e1597 r1598 w1599 rib1601 mod1602) r1598 (quote (())) s1600 rib1601 mod1602) (if (memv t1611 (quote (core external-macro module-ref))) (values type1610 (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (begin))) (values (quote begin-form) #f e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (eval-when))) (values (quote eval-when-form) #f e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (define))) ((lambda (tmp1612) ((lambda (tmp1613) (if (if tmp1613 (apply (lambda (_1614 name1615 val1616) (id?1083 name1615)) tmp1613) #f) (apply (lambda (_1617 name1618 val1619) (values (quote define-form) name1618 val1619 w1599 s1600 mod1602)) tmp1613) ((lambda (tmp1620) (if (if tmp1620 (apply (lambda (_1621 name1622 args1623 e11624 e21625) (and (id?1083 name1622) (valid-bound-ids?1108 (lambda-var-list1132 args1623)))) tmp1620) #f) (apply (lambda (_1626 name1627 args1628 e11629 e21630) (values (quote define-form) (wrap1111 name1627 w1599 mod1602) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1111 (cons args1628 (cons e11629 e21630)) w1599 mod1602)) (quote (())) s1600 mod1602)) tmp1620) ((lambda (tmp1632) (if (if tmp1632 (apply (lambda (_1633 name1634) (id?1083 name1634)) tmp1632) #f) (apply (lambda (_1635 name1636) (values (quote define-form) (wrap1111 name1636 w1599 mod1602) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1600 mod1602)) tmp1632) (syntax-error tmp1612))) (syntax-dispatch tmp1612 (quote (any any)))))) (syntax-dispatch tmp1612 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1612 (quote (any any any))))) e1597) (if (memv t1611 (quote (define-syntax))) ((lambda (tmp1637) ((lambda (tmp1638) (if (if tmp1638 (apply (lambda (_1639 name1640 val1641) (id?1083 name1640)) tmp1638) #f) (apply (lambda (_1642 name1643 val1644) (values (quote define-syntax-form) name1643 val1644 w1599 s1600 mod1602)) tmp1638) (syntax-error tmp1637))) (syntax-dispatch tmp1637 (quote (any any any))))) e1597) (values (quote call) #f e1597 w1599 s1600 mod1602)))))))))))))) (values (quote call) #f e1597 w1599 s1600 mod1602)))) ((syntax-object?1067 e1597) (syntax-type1117 (syntax-object-expression1068 e1597) r1598 (join-wraps1102 w1599 (syntax-object-wrap1069 e1597)) #f rib1601 (or (syntax-object-module1070 e1597) mod1602))) ((annotation? e1597) (syntax-type1117 (annotation-expression e1597) r1598 w1599 (annotation-source e1597) rib1601 mod1602)) ((self-evaluating? e1597) (values (quote constant) #f e1597 w1599 s1600 mod1602)) (else (values (quote other) #f e1597 w1599 s1600 mod1602))))) (chi-when-list1116 (lambda (e1645 when-list1646 w1647) (let f1648 ((when-list1649 when-list1646) (situations1650 (quote ()))) (if (null? when-list1649) situations1650 (f1648 (cdr when-list1649) (cons (let ((x1651 (car when-list1649))) (cond ((free-id=?1106 x1651 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1106 x1651 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1106 x1651 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-error (wrap1111 x1651 w1647 #f) "invalid eval-when situation")))) situations1650)))))) (chi-install-global1115 (lambda (name1652 e1653) (build-annotated1060 #f (list (build-annotated1060 #f (quote install-global-transformer)) (build-data1061 #f name1652) e1653)))) (chi-top-sequence1114 (lambda (body1654 r1655 w1656 s1657 m1658 esew1659 mod1660) (build-sequence1062 s1657 (let dobody1661 ((body1662 body1654) (r1663 r1655) (w1664 w1656) (m1665 m1658) (esew1666 esew1659) (mod1667 mod1660)) (if (null? body1662) (quote ()) (let ((first1668 (chi-top1118 (car body1662) r1663 w1664 m1665 esew1666 mod1667))) (cons first1668 (dobody1661 (cdr body1662) r1663 w1664 m1665 esew1666 mod1667)))))))) (chi-sequence1113 (lambda (body1669 r1670 w1671 s1672 mod1673) (build-sequence1062 s1672 (let dobody1674 ((body1675 body1669) (r1676 r1670) (w1677 w1671) (mod1678 mod1673)) (if (null? body1675) (quote ()) (let ((first1679 (chi1119 (car body1675) r1676 w1677 mod1678))) (cons first1679 (dobody1674 (cdr body1675) r1676 w1677 mod1678)))))))) (source-wrap1112 (lambda (x1680 w1681 s1682 defmod1683) (wrap1111 (if s1682 (make-annotation x1680 s1682 #f) x1680) w1681 defmod1683))) (wrap1111 (lambda (x1684 w1685 defmod1686) (cond ((and (null? (wrap-marks1086 w1685)) (null? (wrap-subst1087 w1685))) x1684) ((syntax-object?1067 x1684) (make-syntax-object1066 (syntax-object-expression1068 x1684) (join-wraps1102 w1685 (syntax-object-wrap1069 x1684)) (syntax-object-module1070 x1684))) ((null? x1684) x1684) (else (make-syntax-object1066 x1684 w1685 defmod1686))))) (bound-id-member?1110 (lambda (x1687 list1688) (and (not (null? list1688)) (or (bound-id=?1107 x1687 (car list1688)) (bound-id-member?1110 x1687 (cdr list1688)))))) (distinct-bound-ids?1109 (lambda (ids1689) (let distinct?1690 ((ids1691 ids1689)) (or (null? ids1691) (and (not (bound-id-member?1110 (car ids1691) (cdr ids1691))) (distinct?1690 (cdr ids1691))))))) (valid-bound-ids?1108 (lambda (ids1692) (and (let all-ids?1693 ((ids1694 ids1692)) (or (null? ids1694) (and (id?1083 (car ids1694)) (all-ids?1693 (cdr ids1694))))) (distinct-bound-ids?1109 ids1692)))) (bound-id=?1107 (lambda (i1695 j1696) (if (and (syntax-object?1067 i1695) (syntax-object?1067 j1696)) (and (eq? (let ((e1697 (syntax-object-expression1068 i1695))) (if (annotation? e1697) (annotation-expression e1697) e1697)) (let ((e1698 (syntax-object-expression1068 j1696))) (if (annotation? e1698) (annotation-expression e1698) e1698))) (same-marks?1104 (wrap-marks1086 (syntax-object-wrap1069 i1695)) (wrap-marks1086 (syntax-object-wrap1069 j1696)))) (eq? (let ((e1699 i1695)) (if (annotation? e1699) (annotation-expression e1699) e1699)) (let ((e1700 j1696)) (if (annotation? e1700) (annotation-expression e1700) e1700)))))) (free-id=?1106 (lambda (i1701 j1702) (and (eq? (let ((x1703 i1701)) (let ((e1704 (if (syntax-object?1067 x1703) (syntax-object-expression1068 x1703) x1703))) (if (annotation? e1704) (annotation-expression e1704) e1704))) (let ((x1705 j1702)) (let ((e1706 (if (syntax-object?1067 x1705) (syntax-object-expression1068 x1705) x1705))) (if (annotation? e1706) (annotation-expression e1706) e1706)))) (eq? (id-var-name1105 i1701 (quote (()))) (id-var-name1105 j1702 (quote (()))))))) (id-var-name1105 (lambda (id1707 w1708) (letrec ((search-vector-rib1711 (lambda (sym1717 subst1718 marks1719 symnames1720 ribcage1721) (let ((n1722 (vector-length symnames1720))) (let f1723 ((i1724 0)) (cond ((fx=1052 i1724 n1722) (search1709 sym1717 (cdr subst1718) marks1719)) ((and (eq? (vector-ref symnames1720 i1724) sym1717) (same-marks?1104 marks1719 (vector-ref (ribcage-marks1093 ribcage1721) i1724))) (values (vector-ref (ribcage-labels1094 ribcage1721) i1724) marks1719)) (else (f1723 (fx+1050 i1724 1)))))))) (search-list-rib1710 (lambda (sym1725 subst1726 marks1727 symnames1728 ribcage1729) (let f1730 ((symnames1731 symnames1728) (i1732 0)) (cond ((null? symnames1731) (search1709 sym1725 (cdr subst1726) marks1727)) ((and (eq? (car symnames1731) sym1725) (same-marks?1104 marks1727 (list-ref (ribcage-marks1093 ribcage1729) i1732))) (values (list-ref (ribcage-labels1094 ribcage1729) i1732) marks1727)) (else (f1730 (cdr symnames1731) (fx+1050 i1732 1))))))) (search1709 (lambda (sym1733 subst1734 marks1735) (if (null? subst1734) (values #f marks1735) (let ((fst1736 (car subst1734))) (if (eq? fst1736 (quote shift)) (search1709 sym1733 (cdr subst1734) (cdr marks1735)) (let ((symnames1737 (ribcage-symnames1092 fst1736))) (if (vector? symnames1737) (search-vector-rib1711 sym1733 subst1734 marks1735 symnames1737 fst1736) (search-list-rib1710 sym1733 subst1734 marks1735 symnames1737 fst1736))))))))) (cond ((symbol? id1707) (or (call-with-values (lambda () (search1709 id1707 (wrap-subst1087 w1708) (wrap-marks1086 w1708))) (lambda (x1739 . ignore1738) x1739)) id1707)) ((syntax-object?1067 id1707) (let ((id1740 (let ((e1742 (syntax-object-expression1068 id1707))) (if (annotation? e1742) (annotation-expression e1742) e1742))) (w11741 (syntax-object-wrap1069 id1707))) (let ((marks1743 (join-marks1103 (wrap-marks1086 w1708) (wrap-marks1086 w11741)))) (call-with-values (lambda () (search1709 id1740 (wrap-subst1087 w1708) marks1743)) (lambda (new-id1744 marks1745) (or new-id1744 (call-with-values (lambda () (search1709 id1740 (wrap-subst1087 w11741) marks1745)) (lambda (x1747 . ignore1746) x1747)) id1740)))))) ((annotation? id1707) (let ((id1748 (let ((e1749 id1707)) (if (annotation? e1749) (annotation-expression e1749) e1749)))) (or (call-with-values (lambda () (search1709 id1748 (wrap-subst1087 w1708) (wrap-marks1086 w1708))) (lambda (x1751 . ignore1750) x1751)) id1748))) (else (error-hook1056 (quote id-var-name) "invalid id" id1707)))))) (same-marks?1104 (lambda (x1752 y1753) (or (eq? x1752 y1753) (and (not (null? x1752)) (not (null? y1753)) (eq? (car x1752) (car y1753)) (same-marks?1104 (cdr x1752) (cdr y1753)))))) (join-marks1103 (lambda (m11754 m21755) (smart-append1101 m11754 m21755))) (join-wraps1102 (lambda (w11756 w21757) (let ((m11758 (wrap-marks1086 w11756)) (s11759 (wrap-subst1087 w11756))) (if (null? m11758) (if (null? s11759) w21757 (make-wrap1085 (wrap-marks1086 w21757) (smart-append1101 s11759 (wrap-subst1087 w21757)))) (make-wrap1085 (smart-append1101 m11758 (wrap-marks1086 w21757)) (smart-append1101 s11759 (wrap-subst1087 w21757))))))) (smart-append1101 (lambda (m11760 m21761) (if (null? m21761) m11760 (append m11760 m21761)))) (make-binding-wrap1100 (lambda (ids1762 labels1763 w1764) (if (null? ids1762) w1764 (make-wrap1085 (wrap-marks1086 w1764) (cons (let ((labelvec1765 (list->vector labels1763))) (let ((n1766 (vector-length labelvec1765))) (let ((symnamevec1767 (make-vector n1766)) (marksvec1768 (make-vector n1766))) (begin (let f1769 ((ids1770 ids1762) (i1771 0)) (if (not (null? ids1770)) (call-with-values (lambda () (id-sym-name&marks1084 (car ids1770) w1764)) (lambda (symname1772 marks1773) (begin (vector-set! symnamevec1767 i1771 symname1772) (vector-set! marksvec1768 i1771 marks1773) (f1769 (cdr ids1770) (fx+1050 i1771 1))))))) (make-ribcage1090 symnamevec1767 marksvec1768 labelvec1765))))) (wrap-subst1087 w1764)))))) (extend-ribcage!1099 (lambda (ribcage1774 id1775 label1776) (begin (set-ribcage-symnames!1095 ribcage1774 (cons (let ((e1777 (syntax-object-expression1068 id1775))) (if (annotation? e1777) (annotation-expression e1777) e1777)) (ribcage-symnames1092 ribcage1774))) (set-ribcage-marks!1096 ribcage1774 (cons (wrap-marks1086 (syntax-object-wrap1069 id1775)) (ribcage-marks1093 ribcage1774))) (set-ribcage-labels!1097 ribcage1774 (cons label1776 (ribcage-labels1094 ribcage1774)))))) (anti-mark1098 (lambda (w1778) (make-wrap1085 (cons #f (wrap-marks1086 w1778)) (cons (quote shift) (wrap-subst1087 w1778))))) (set-ribcage-labels!1097 (lambda (x1779 update1780) (vector-set! x1779 3 update1780))) (set-ribcage-marks!1096 (lambda (x1781 update1782) (vector-set! x1781 2 update1782))) (set-ribcage-symnames!1095 (lambda (x1783 update1784) (vector-set! x1783 1 update1784))) (ribcage-labels1094 (lambda (x1785) (vector-ref x1785 3))) (ribcage-marks1093 (lambda (x1786) (vector-ref x1786 2))) (ribcage-symnames1092 (lambda (x1787) (vector-ref x1787 1))) (ribcage?1091 (lambda (x1788) (and (vector? x1788) (= (vector-length x1788) 4) (eq? (vector-ref x1788 0) (quote ribcage))))) (make-ribcage1090 (lambda (symnames1789 marks1790 labels1791) (vector (quote ribcage) symnames1789 marks1790 labels1791))) (gen-labels1089 (lambda (ls1792) (if (null? ls1792) (quote ()) (cons (gen-label1088) (gen-labels1089 (cdr ls1792)))))) (gen-label1088 (lambda () (string #\i))) (wrap-subst1087 cdr) (wrap-marks1086 car) (make-wrap1085 cons) (id-sym-name&marks1084 (lambda (x1793 w1794) (if (syntax-object?1067 x1793) (values (let ((e1795 (syntax-object-expression1068 x1793))) (if (annotation? e1795) (annotation-expression e1795) e1795)) (join-marks1103 (wrap-marks1086 w1794) (wrap-marks1086 (syntax-object-wrap1069 x1793)))) (values (let ((e1796 x1793)) (if (annotation? e1796) (annotation-expression e1796) e1796)) (wrap-marks1086 w1794))))) (id?1083 (lambda (x1797) (cond ((symbol? x1797) #t) ((syntax-object?1067 x1797) (symbol? (let ((e1798 (syntax-object-expression1068 x1797))) (if (annotation? e1798) (annotation-expression e1798) e1798)))) ((annotation? x1797) (symbol? (annotation-expression x1797))) (else #f)))) (nonsymbol-id?1082 (lambda (x1799) (and (syntax-object?1067 x1799) (symbol? (let ((e1800 (syntax-object-expression1068 x1799))) (if (annotation? e1800) (annotation-expression e1800) e1800)))))) (global-extend1081 (lambda (type1801 sym1802 val1803) (put-global-definition-hook1057 sym1802 type1801 val1803))) (lookup1080 (lambda (x1804 r1805 mod1806) (cond ((assq x1804 r1805) => cdr) ((symbol? x1804) (or (get-global-definition-hook1059 x1804 mod1806) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1079 (lambda (r1807) (if (null? r1807) (quote ()) (let ((a1808 (car r1807))) (if (eq? (cadr a1808) (quote macro)) (cons a1808 (macros-only-env1079 (cdr r1807))) (macros-only-env1079 (cdr r1807))))))) (extend-var-env1078 (lambda (labels1809 vars1810 r1811) (if (null? labels1809) r1811 (extend-var-env1078 (cdr labels1809) (cdr vars1810) (cons (cons (car labels1809) (cons (quote lexical) (car vars1810))) r1811))))) (extend-env1077 (lambda (labels1812 bindings1813 r1814) (if (null? labels1812) r1814 (extend-env1077 (cdr labels1812) (cdr bindings1813) (cons (cons (car labels1812) (car bindings1813)) r1814))))) (binding-value1076 cdr) (binding-type1075 car) (source-annotation1074 (lambda (x1815) (cond ((annotation? x1815) (annotation-source x1815)) ((syntax-object?1067 x1815) (source-annotation1074 (syntax-object-expression1068 x1815))) (else #f)))) (set-syntax-object-module!1073 (lambda (x1816 update1817) (vector-set! x1816 3 update1817))) (set-syntax-object-wrap!1072 (lambda (x1818 update1819) (vector-set! x1818 2 update1819))) (set-syntax-object-expression!1071 (lambda (x1820 update1821) (vector-set! x1820 1 update1821))) (syntax-object-module1070 (lambda (x1822) (vector-ref x1822 3))) (syntax-object-wrap1069 (lambda (x1823) (vector-ref x1823 2))) (syntax-object-expression1068 (lambda (x1824) (vector-ref x1824 1))) (syntax-object?1067 (lambda (x1825) (and (vector? x1825) (= (vector-length x1825) 4) (eq? (vector-ref x1825 0) (quote syntax-object))))) (make-syntax-object1066 (lambda (expression1826 wrap1827 module1828) (vector (quote syntax-object) expression1826 wrap1827 module1828))) (build-letrec1065 (lambda (src1829 vars1830 val-exps1831 body-exp1832) (if (null? vars1830) (build-annotated1060 src1829 body-exp1832) (build-annotated1060 src1829 (list (quote letrec) (map list vars1830 val-exps1831) body-exp1832))))) (build-named-let1064 (lambda (src1833 vars1834 val-exps1835 body-exp1836) (if (null? vars1834) (build-annotated1060 src1833 body-exp1836) (build-annotated1060 src1833 (list (quote let) (car vars1834) (map list (cdr vars1834) val-exps1835) body-exp1836))))) (build-let1063 (lambda (src1837 vars1838 val-exps1839 body-exp1840) (if (null? vars1838) (build-annotated1060 src1837 body-exp1840) (build-annotated1060 src1837 (list (quote let) (map list vars1838 val-exps1839) body-exp1840))))) (build-sequence1062 (lambda (src1841 exps1842) (if (null? (cdr exps1842)) (build-annotated1060 src1841 (car exps1842)) (build-annotated1060 src1841 (cons (quote begin) exps1842))))) (build-data1061 (lambda (src1843 exp1844) (if (and (self-evaluating? exp1844) (not (vector? exp1844))) (build-annotated1060 src1843 exp1844) (build-annotated1060 src1843 (list (quote quote) exp1844))))) (build-annotated1060 (lambda (src1845 exp1846) (if (and src1845 (not (annotation? exp1846))) (make-annotation exp1846 src1845 #t) exp1846))) (get-global-definition-hook1059 (lambda (symbol1847 module1848) (begin (if (and (not module1848) (current-module)) (warn "module system is booted, we should have a module" symbol1847)) (module-lookup-keyword (if module1848 (resolve-module (cdr module1848)) (current-module)) symbol1847)))) (remove-global-definition-hook1058 (lambda (symbol1849) (module-undefine-keyword! (current-module) symbol1849))) (put-global-definition-hook1057 (lambda (symbol1850 type1851 val1852) (module-define-keyword! (current-module) symbol1850 type1851 val1852))) (error-hook1056 (lambda (who1853 why1854 what1855) (error who1853 "~a ~s" why1854 what1855))) (local-eval-hook1055 (lambda (x1856 mod1857) (primitive-eval (list noexpand1049 x1856)))) (top-level-eval-hook1054 (lambda (x1858 mod1859) (primitive-eval (list noexpand1049 x1858)))) (fx<1053 <) (fx=1052 =) (fx-1051 -) (fx+1050 +) (noexpand1049 "noexpand")) (begin (global-extend1081 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1081 (quote local-syntax) (quote let-syntax) #f) (global-extend1081 (quote core) (quote fluid-let-syntax) (lambda (e1860 r1861 w1862 s1863 mod1864) ((lambda (tmp1865) ((lambda (tmp1866) (if (if tmp1866 (apply (lambda (_1867 var1868 val1869 e11870 e21871) (valid-bound-ids?1108 var1868)) tmp1866) #f) (apply (lambda (_1873 var1874 val1875 e11876 e21877) (let ((names1878 (map (lambda (x1879) (id-var-name1105 x1879 w1862)) var1874))) (begin (for-each (lambda (id1881 n1882) (let ((t1883 (binding-type1075 (lookup1080 n1882 r1861 mod1864)))) (if (memv t1883 (quote (displaced-lexical))) (syntax-error (source-wrap1112 id1881 w1862 s1863 mod1864) "identifier out of context")))) var1874 names1878) (chi-body1123 (cons e11876 e21877) (source-wrap1112 e1860 w1862 s1863 mod1864) (extend-env1077 names1878 (let ((trans-r1886 (macros-only-env1079 r1861))) (map (lambda (x1887) (cons (quote macro) (eval-local-transformer1126 (chi1119 x1887 trans-r1886 w1862 mod1864) mod1864))) val1875)) r1861) w1862 mod1864)))) tmp1866) ((lambda (_1889) (syntax-error (source-wrap1112 e1860 w1862 s1863 mod1864))) tmp1865))) (syntax-dispatch tmp1865 (quote (any #(each (any any)) any . each-any))))) e1860))) (global-extend1081 (quote core) (quote quote) (lambda (e1890 r1891 w1892 s1893 mod1894) ((lambda (tmp1895) ((lambda (tmp1896) (if tmp1896 (apply (lambda (_1897 e1898) (build-data1061 s1893 (strip1130 e1898 w1892))) tmp1896) ((lambda (_1899) (syntax-error (source-wrap1112 e1890 w1892 s1893 mod1894))) tmp1895))) (syntax-dispatch tmp1895 (quote (any any))))) e1890))) (global-extend1081 (quote core) (quote syntax) (letrec ((regen1907 (lambda (x1908) (let ((t1909 (car x1908))) (if (memv t1909 (quote (ref))) (build-annotated1060 #f (cadr x1908)) (if (memv t1909 (quote (primitive))) (build-annotated1060 #f (cadr x1908)) (if (memv t1909 (quote (quote))) (build-data1061 #f (cadr x1908)) (if (memv t1909 (quote (lambda))) (build-annotated1060 #f (list (quote lambda) (cadr x1908) (regen1907 (caddr x1908)))) (if (memv t1909 (quote (map))) (let ((ls1910 (map regen1907 (cdr x1908)))) (build-annotated1060 #f (cons (if (fx=1052 (length ls1910) 2) (build-annotated1060 #f (quote map)) (build-annotated1060 #f (quote map))) ls1910))) (build-annotated1060 #f (cons (build-annotated1060 #f (car x1908)) (map regen1907 (cdr x1908)))))))))))) (gen-vector1906 (lambda (x1911) (cond ((eq? (car x1911) (quote list)) (cons (quote vector) (cdr x1911))) ((eq? (car x1911) (quote quote)) (list (quote quote) (list->vector (cadr x1911)))) (else (list (quote list->vector) x1911))))) (gen-append1905 (lambda (x1912 y1913) (if (equal? y1913 (quote (quote ()))) x1912 (list (quote append) x1912 y1913)))) (gen-cons1904 (lambda (x1914 y1915) (let ((t1916 (car y1915))) (if (memv t1916 (quote (quote))) (if (eq? (car x1914) (quote quote)) (list (quote quote) (cons (cadr x1914) (cadr y1915))) (if (eq? (cadr y1915) (quote ())) (list (quote list) x1914) (list (quote cons) x1914 y1915))) (if (memv t1916 (quote (list))) (cons (quote list) (cons x1914 (cdr y1915))) (list (quote cons) x1914 y1915)))))) (gen-map1903 (lambda (e1917 map-env1918) (let ((formals1919 (map cdr map-env1918)) (actuals1920 (map (lambda (x1921) (list (quote ref) (car x1921))) map-env1918))) (cond ((eq? (car e1917) (quote ref)) (car actuals1920)) ((andmap (lambda (x1922) (and (eq? (car x1922) (quote ref)) (memq (cadr x1922) formals1919))) (cdr e1917)) (cons (quote map) (cons (list (quote primitive) (car e1917)) (map (let ((r1923 (map cons formals1919 actuals1920))) (lambda (x1924) (cdr (assq (cadr x1924) r1923)))) (cdr e1917))))) (else (cons (quote map) (cons (list (quote lambda) formals1919 e1917) actuals1920))))))) (gen-mappend1902 (lambda (e1925 map-env1926) (list (quote apply) (quote (primitive append)) (gen-map1903 e1925 map-env1926)))) (gen-ref1901 (lambda (src1927 var1928 level1929 maps1930) (if (fx=1052 level1929 0) (values var1928 maps1930) (if (null? maps1930) (syntax-error src1927 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1901 src1927 var1928 (fx-1051 level1929 1) (cdr maps1930))) (lambda (outer-var1931 outer-maps1932) (let ((b1933 (assq outer-var1931 (car maps1930)))) (if b1933 (values (cdr b1933) maps1930) (let ((inner-var1934 (gen-var1131 (quote tmp)))) (values inner-var1934 (cons (cons (cons outer-var1931 inner-var1934) (car maps1930)) outer-maps1932))))))))))) (gen-syntax1900 (lambda (src1935 e1936 r1937 maps1938 ellipsis?1939 mod1940) (if (id?1083 e1936) (let ((label1941 (id-var-name1105 e1936 (quote (()))))) (let ((b1942 (lookup1080 label1941 r1937 mod1940))) (if (eq? (binding-type1075 b1942) (quote syntax)) (call-with-values (lambda () (let ((var.lev1943 (binding-value1076 b1942))) (gen-ref1901 src1935 (car var.lev1943) (cdr var.lev1943) maps1938))) (lambda (var1944 maps1945) (values (list (quote ref) var1944) maps1945))) (if (ellipsis?1939 e1936) (syntax-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-wrap1112 e1994 w1996 s1997 mod1998))) ((lambda (tmp2000) ((lambda (tmp2001) (if tmp2001 (apply (lambda (_2002 x2003) (call-with-values (lambda () (gen-syntax1900 e1999 x2003 r1995 (quote ()) ellipsis?1128 mod1998)) (lambda (e2004 maps2005) (regen1907 e2004)))) tmp2001) ((lambda (_2006) (syntax-error e1999)) tmp2000))) (syntax-dispatch tmp2000 (quote (any any))))) e1999))))) (global-extend1081 (quote core) (quote lambda) (lambda (e2007 r2008 w2009 s2010 mod2011) ((lambda (tmp2012) ((lambda (tmp2013) (if tmp2013 (apply (lambda (_2014 c2015) (chi-lambda-clause1124 (source-wrap1112 e2007 w2009 s2010 mod2011) #f c2015 r2008 w2009 mod2011 (lambda (vars2016 docstring2017 body2018) (build-annotated1060 s2010 (cons (quote lambda) (cons vars2016 (append (if docstring2017 (list docstring2017) (quote ())) (list body2018)))))))) tmp2013) (syntax-error tmp2012))) (syntax-dispatch tmp2012 (quote (any . any))))) e2007))) (global-extend1081 (quote core) (quote let) (letrec ((chi-let2019 (lambda (e2020 r2021 w2022 s2023 mod2024 constructor2025 ids2026 vals2027 exps2028) (if (not (valid-bound-ids?1108 ids2026)) (syntax-error e2020 "duplicate bound variable in") (let ((labels2029 (gen-labels1089 ids2026)) (new-vars2030 (map gen-var1131 ids2026))) (let ((nw2031 (make-binding-wrap1100 ids2026 labels2029 w2022)) (nr2032 (extend-var-env1078 labels2029 new-vars2030 r2021))) (constructor2025 s2023 new-vars2030 (map (lambda (x2033) (chi1119 x2033 r2021 w2022 mod2024)) vals2027) (chi-body1123 exps2028 (source-wrap1112 e2020 nw2031 s2023 mod2024) nr2032 nw2031 mod2024)))))))) (lambda (e2034 r2035 w2036 s2037 mod2038) ((lambda (tmp2039) ((lambda (tmp2040) (if tmp2040 (apply (lambda (_2041 id2042 val2043 e12044 e22045) (chi-let2019 e2034 r2035 w2036 s2037 mod2038 build-let1063 id2042 val2043 (cons e12044 e22045))) tmp2040) ((lambda (tmp2049) (if (if tmp2049 (apply (lambda (_2050 f2051 id2052 val2053 e12054 e22055) (id?1083 f2051)) tmp2049) #f) (apply (lambda (_2056 f2057 id2058 val2059 e12060 e22061) (chi-let2019 e2034 r2035 w2036 s2037 mod2038 build-named-let1064 (cons f2057 id2058) val2059 (cons e12060 e22061))) tmp2049) ((lambda (_2065) (syntax-error (source-wrap1112 e2034 w2036 s2037 mod2038))) tmp2039))) (syntax-dispatch tmp2039 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2039 (quote (any #(each (any any)) any . each-any))))) e2034)))) (global-extend1081 (quote core) (quote letrec) (lambda (e2066 r2067 w2068 s2069 mod2070) ((lambda (tmp2071) ((lambda (tmp2072) (if tmp2072 (apply (lambda (_2073 id2074 val2075 e12076 e22077) (let ((ids2078 id2074)) (if (not (valid-bound-ids?1108 ids2078)) (syntax-error e2066 "duplicate bound variable in") (let ((labels2080 (gen-labels1089 ids2078)) (new-vars2081 (map gen-var1131 ids2078))) (let ((w2082 (make-binding-wrap1100 ids2078 labels2080 w2068)) (r2083 (extend-var-env1078 labels2080 new-vars2081 r2067))) (build-letrec1065 s2069 new-vars2081 (map (lambda (x2084) (chi1119 x2084 r2083 w2082 mod2070)) val2075) (chi-body1123 (cons e12076 e22077) (source-wrap1112 e2066 w2082 s2069 mod2070) r2083 w2082 mod2070))))))) tmp2072) ((lambda (_2087) (syntax-error (source-wrap1112 e2066 w2068 s2069 mod2070))) tmp2071))) (syntax-dispatch tmp2071 (quote (any #(each (any any)) any . each-any))))) e2066))) (global-extend1081 (quote core) (quote set!) (lambda (e2088 r2089 w2090 s2091 mod2092) ((lambda (tmp2093) ((lambda (tmp2094) (if (if tmp2094 (apply (lambda (_2095 id2096 val2097) (id?1083 id2096)) tmp2094) #f) (apply (lambda (_2098 id2099 val2100) (let ((val2101 (chi1119 val2100 r2089 w2090 mod2092)) (n2102 (id-var-name1105 id2099 w2090))) (let ((b2103 (lookup1080 n2102 r2089 mod2092))) (let ((t2104 (binding-type1075 b2103))) (if (memv t2104 (quote (lexical))) (build-annotated1060 s2091 (list (quote set!) (binding-value1076 b2103) val2101)) (if (memv t2104 (quote (global))) (build-annotated1060 s2091 (list (quote set!) (if mod2092 (make-module-ref (cdr mod2092) n2102 (car mod2092)) (make-module-ref mod2092 n2102 (quote bare))) val2101)) (if (memv t2104 (quote (displaced-lexical))) (syntax-error (wrap1111 id2099 w2090 mod2092) "identifier out of context") (syntax-error (source-wrap1112 e2088 w2090 s2091 mod2092))))))))) tmp2094) ((lambda (tmp2105) (if tmp2105 (apply (lambda (_2106 head2107 tail2108 val2109) (call-with-values (lambda () (syntax-type1117 head2107 r2089 (quote (())) #f #f mod2092)) (lambda (type2110 value2111 ee2112 ww2113 ss2114 modmod2115) (let ((t2116 type2110)) (if (memv t2116 (quote (module-ref))) (let ((val2117 (chi1119 val2109 r2089 w2090 mod2092))) (call-with-values (lambda () (value2111 (cons head2107 tail2108))) (lambda (id2119 mod2120) (build-annotated1060 s2091 (list (quote set!) (if mod2120 (make-module-ref (cdr mod2120) id2119 (car mod2120)) (make-module-ref mod2120 id2119 (quote bare))) val2117))))) (build-annotated1060 s2091 (cons (chi1119 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2107) r2089 w2090 mod2092) (map (lambda (e2121) (chi1119 e2121 r2089 w2090 mod2092)) (append tail2108 (list val2109)))))))))) tmp2105) ((lambda (_2123) (syntax-error (source-wrap1112 e2088 w2090 s2091 mod2092))) tmp2093))) (syntax-dispatch tmp2093 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2093 (quote (any any any))))) e2088))) (global-extend1081 (quote module-ref) (quote @) (lambda (e2124) ((lambda (tmp2125) ((lambda (tmp2126) (if (if tmp2126 (apply (lambda (_2127 mod2128 id2129) (and (andmap id?1083 mod2128) (id?1083 id2129))) tmp2126) #f) (apply (lambda (_2131 mod2132 id2133) (values (syntax-object->datum id2133) (syntax-object->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2132)))) tmp2126) (syntax-error tmp2125))) (syntax-dispatch tmp2125 (quote (any each-any any))))) e2124))) (global-extend1081 (quote module-ref) (quote @@) (lambda (e2135) ((lambda (tmp2136) ((lambda (tmp2137) (if (if tmp2137 (apply (lambda (_2138 mod2139 id2140) (and (andmap id?1083 mod2139) (id?1083 id2140))) tmp2137) #f) (apply (lambda (_2142 mod2143 id2144) (values (syntax-object->datum id2144) (syntax-object->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2143)))) tmp2137) (syntax-error tmp2136))) (syntax-dispatch tmp2136 (quote (any each-any any))))) e2135))) (global-extend1081 (quote begin) (quote begin) (quote ())) (global-extend1081 (quote define) (quote define) (quote ())) (global-extend1081 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1081 (quote eval-when) (quote eval-when) (quote ())) (global-extend1081 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2149 (lambda (x2150 keys2151 clauses2152 r2153 mod2154) (if (null? clauses2152) (build-annotated1060 #f (list (build-annotated1060 #f (quote syntax-error)) x2150)) ((lambda (tmp2155) ((lambda (tmp2156) (if tmp2156 (apply (lambda (pat2157 exp2158) (if (and (id?1083 pat2157) (andmap (lambda (x2159) (not (free-id=?1106 pat2157 x2159))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2151))) (let ((labels2160 (list (gen-label1088))) (var2161 (gen-var1131 pat2157))) (build-annotated1060 #f (list (build-annotated1060 #f (list (quote lambda) (list var2161) (chi1119 exp2158 (extend-env1077 labels2160 (list (cons (quote syntax) (cons var2161 0))) r2153) (make-binding-wrap1100 (list pat2157) labels2160 (quote (()))) mod2154))) x2150))) (gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2157 #t exp2158 mod2154))) tmp2156) ((lambda (tmp2162) (if tmp2162 (apply (lambda (pat2163 fender2164 exp2165) (gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2163 fender2164 exp2165 mod2154)) tmp2162) ((lambda (_2166) (syntax-error (car clauses2152) "invalid syntax-case clause")) tmp2155))) (syntax-dispatch tmp2155 (quote (any any any)))))) (syntax-dispatch tmp2155 (quote (any any))))) (car clauses2152))))) (gen-clause2148 (lambda (x2167 keys2168 clauses2169 r2170 pat2171 fender2172 exp2173 mod2174) (call-with-values (lambda () (convert-pattern2146 pat2171 keys2168)) (lambda (p2175 pvars2176) (cond ((not (distinct-bound-ids?1109 (map car pvars2176))) (syntax-error pat2171 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2177) (not (ellipsis?1128 (car x2177)))) pvars2176)) (syntax-error pat2171 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2178 (gen-var1131 (quote tmp)))) (build-annotated1060 #f (list (build-annotated1060 #f (list (quote lambda) (list y2178) (let ((y2179 (build-annotated1060 #f y2178))) (build-annotated1060 #f (list (quote if) ((lambda (tmp2180) ((lambda (tmp2181) (if tmp2181 (apply (lambda () y2179) tmp2181) ((lambda (_2182) (build-annotated1060 #f (list (quote if) y2179 (build-dispatch-call2147 pvars2176 fender2172 y2179 r2170 mod2174) (build-data1061 #f #f)))) tmp2180))) (syntax-dispatch tmp2180 (quote #(atom #t))))) fender2172) (build-dispatch-call2147 pvars2176 exp2173 y2179 r2170 mod2174) (gen-syntax-case2149 x2167 keys2168 clauses2169 r2170 mod2174)))))) (if (eq? p2175 (quote any)) (build-annotated1060 #f (list (build-annotated1060 #f (quote list)) x2167)) (build-annotated1060 #f (list (build-annotated1060 #f (quote syntax-dispatch)) x2167 (build-data1061 #f p2175))))))))))))) (build-dispatch-call2147 (lambda (pvars2183 exp2184 y2185 r2186 mod2187) (let ((ids2188 (map car pvars2183)) (levels2189 (map cdr pvars2183))) (let ((labels2190 (gen-labels1089 ids2188)) (new-vars2191 (map gen-var1131 ids2188))) (build-annotated1060 #f (list (build-annotated1060 #f (quote apply)) (build-annotated1060 #f (list (quote lambda) new-vars2191 (chi1119 exp2184 (extend-env1077 labels2190 (map (lambda (var2192 level2193) (cons (quote syntax) (cons var2192 level2193))) new-vars2191 (map cdr pvars2183)) r2186) (make-binding-wrap1100 ids2188 labels2190 (quote (()))) mod2187))) y2185)))))) (convert-pattern2146 (lambda (pattern2194 keys2195) (let cvt2196 ((p2197 pattern2194) (n2198 0) (ids2199 (quote ()))) (if (id?1083 p2197) (if (bound-id-member?1110 p2197 keys2195) (values (vector (quote free-id) p2197) ids2199) (values (quote any) (cons (cons p2197 n2198) ids2199))) ((lambda (tmp2200) ((lambda (tmp2201) (if (if tmp2201 (apply (lambda (x2202 dots2203) (ellipsis?1128 dots2203)) tmp2201) #f) (apply (lambda (x2204 dots2205) (call-with-values (lambda () (cvt2196 x2204 (fx+1050 n2198 1) ids2199)) (lambda (p2206 ids2207) (values (if (eq? p2206 (quote any)) (quote each-any) (vector (quote each) p2206)) ids2207)))) tmp2201) ((lambda (tmp2208) (if tmp2208 (apply (lambda (x2209 y2210) (call-with-values (lambda () (cvt2196 y2210 n2198 ids2199)) (lambda (y2211 ids2212) (call-with-values (lambda () (cvt2196 x2209 n2198 ids2212)) (lambda (x2213 ids2214) (values (cons x2213 y2211) ids2214)))))) tmp2208) ((lambda (tmp2215) (if tmp2215 (apply (lambda () (values (quote ()) ids2199)) tmp2215) ((lambda (tmp2216) (if tmp2216 (apply (lambda (x2217) (call-with-values (lambda () (cvt2196 x2217 n2198 ids2199)) (lambda (p2219 ids2220) (values (vector (quote vector) p2219) ids2220)))) tmp2216) ((lambda (x2221) (values (vector (quote atom) (strip1130 p2197 (quote (())))) ids2199)) tmp2200))) (syntax-dispatch tmp2200 (quote #(vector each-any)))))) (syntax-dispatch tmp2200 (quote ()))))) (syntax-dispatch tmp2200 (quote (any . any)))))) (syntax-dispatch tmp2200 (quote (any any))))) p2197)))))) (lambda (e2222 r2223 w2224 s2225 mod2226) (let ((e2227 (source-wrap1112 e2222 w2224 s2225 mod2226))) ((lambda (tmp2228) ((lambda (tmp2229) (if tmp2229 (apply (lambda (_2230 val2231 key2232 m2233) (if (andmap (lambda (x2234) (and (id?1083 x2234) (not (ellipsis?1128 x2234)))) key2232) (let ((x2236 (gen-var1131 (quote tmp)))) (build-annotated1060 s2225 (list (build-annotated1060 #f (list (quote lambda) (list x2236) (gen-syntax-case2149 (build-annotated1060 #f x2236) key2232 m2233 r2223 mod2226))) (chi1119 val2231 r2223 (quote (())) mod2226)))) (syntax-error e2227 "invalid literals list in"))) tmp2229) (syntax-error tmp2228))) (syntax-dispatch tmp2228 (quote (any any each-any . each-any))))) e2227))))) (set! sc-expand (let ((m2239 (quote e)) (esew2240 (quote (eval)))) (lambda (x2241) (if (and (pair? x2241) (equal? (car x2241) noexpand1049)) (cadr x2241) (chi-top1118 x2241 (quote ()) (quote ((top))) m2239 esew2240 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2242 (quote e)) (esew2243 (quote (eval)))) (lambda (x2245 . rest2244) (if (and (pair? x2245) (equal? (car x2245) noexpand1049)) (cadr x2245) (chi-top1118 x2245 (quote ()) (quote ((top))) (if (null? rest2244) m2242 (car rest2244)) (if (or (null? rest2244) (null? (cdr rest2244))) esew2243 (cadr rest2244)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2246) (nonsymbol-id?1082 x2246))) (set! datum->syntax-object (lambda (id2247 datum2248) (make-syntax-object1066 datum2248 (syntax-object-wrap1069 id2247) #f))) (set! syntax-object->datum (lambda (x2249) (strip1130 x2249 (quote (()))))) (set! generate-temporaries (lambda (ls2250) (begin (let ((x2251 ls2250)) (if (not (list? x2251)) (error-hook1056 (quote generate-temporaries) "invalid argument" x2251))) (map (lambda (x2252) (wrap1111 (gensym) (quote ((top))) #f)) ls2250)))) (set! free-identifier=? (lambda (x2253 y2254) (begin (let ((x2255 x2253)) (if (not (nonsymbol-id?1082 x2255)) (error-hook1056 (quote free-identifier=?) "invalid argument" x2255))) (let ((x2256 y2254)) (if (not (nonsymbol-id?1082 x2256)) (error-hook1056 (quote free-identifier=?) "invalid argument" x2256))) (free-id=?1106 x2253 y2254)))) (set! bound-identifier=? (lambda (x2257 y2258) (begin (let ((x2259 x2257)) (if (not (nonsymbol-id?1082 x2259)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2259))) (let ((x2260 y2258)) (if (not (nonsymbol-id?1082 x2260)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2260))) (bound-id=?1107 x2257 y2258)))) (set! syntax-error (lambda (object2262 . messages2261) (begin (for-each (lambda (x2263) (let ((x2264 x2263)) (if (not (string? x2264)) (error-hook1056 (quote syntax-error) "invalid argument" x2264)))) messages2261) (let ((message2265 (if (null? messages2261) "invalid syntax" (apply string-append messages2261)))) (error-hook1056 #f message2265 (strip1130 object2262 (quote (())))))))) (set! install-global-transformer (lambda (sym2266 v2267) (begin (let ((x2268 sym2266)) (if (not (symbol? x2268)) (error-hook1056 (quote define-syntax) "invalid argument" x2268))) (let ((x2269 v2267)) (if (not (procedure? x2269)) (error-hook1056 (quote define-syntax) "invalid argument" x2269))) (global-extend1081 (quote macro) sym2266 v2267)))) (letrec ((match2274 (lambda (e2275 p2276 w2277 r2278 mod2279) (cond ((not r2278) #f) ((eq? p2276 (quote any)) (cons (wrap1111 e2275 w2277 mod2279) r2278)) ((syntax-object?1067 e2275) (match*2273 (let ((e2280 (syntax-object-expression1068 e2275))) (if (annotation? e2280) (annotation-expression e2280) e2280)) p2276 (join-wraps1102 w2277 (syntax-object-wrap1069 e2275)) r2278 (syntax-object-module1070 e2275))) (else (match*2273 (let ((e2281 e2275)) (if (annotation? e2281) (annotation-expression e2281) e2281)) p2276 w2277 r2278 mod2279))))) (match*2273 (lambda (e2282 p2283 w2284 r2285 mod2286) (cond ((null? p2283) (and (null? e2282) r2285)) ((pair? p2283) (and (pair? e2282) (match2274 (car e2282) (car p2283) w2284 (match2274 (cdr e2282) (cdr p2283) w2284 r2285 mod2286) mod2286))) ((eq? p2283 (quote each-any)) (let ((l2287 (match-each-any2271 e2282 w2284 mod2286))) (and l2287 (cons l2287 r2285)))) (else (let ((t2288 (vector-ref p2283 0))) (if (memv t2288 (quote (each))) (if (null? e2282) (match-empty2272 (vector-ref p2283 1) r2285) (let ((l2289 (match-each2270 e2282 (vector-ref p2283 1) w2284 mod2286))) (and l2289 (let collect2290 ((l2291 l2289)) (if (null? (car l2291)) r2285 (cons (map car l2291) (collect2290 (map cdr l2291)))))))) (if (memv t2288 (quote (free-id))) (and (id?1083 e2282) (free-id=?1106 (wrap1111 e2282 w2284 mod2286) (vector-ref p2283 1)) r2285) (if (memv t2288 (quote (atom))) (and (equal? (vector-ref p2283 1) (strip1130 e2282 w2284)) r2285) (if (memv t2288 (quote (vector))) (and (vector? e2282) (match2274 (vector->list e2282) (vector-ref p2283 1) w2284 r2285 mod2286))))))))))) (match-empty2272 (lambda (p2292 r2293) (cond ((null? p2292) r2293) ((eq? p2292 (quote any)) (cons (quote ()) r2293)) ((pair? p2292) (match-empty2272 (car p2292) (match-empty2272 (cdr p2292) r2293))) ((eq? p2292 (quote each-any)) (cons (quote ()) r2293)) (else (let ((t2294 (vector-ref p2292 0))) (if (memv t2294 (quote (each))) (match-empty2272 (vector-ref p2292 1) r2293) (if (memv t2294 (quote (free-id atom))) r2293 (if (memv t2294 (quote (vector))) (match-empty2272 (vector-ref p2292 1) r2293))))))))) (match-each-any2271 (lambda (e2295 w2296 mod2297) (cond ((annotation? e2295) (match-each-any2271 (annotation-expression e2295) w2296 mod2297)) ((pair? e2295) (let ((l2298 (match-each-any2271 (cdr e2295) w2296 mod2297))) (and l2298 (cons (wrap1111 (car e2295) w2296 mod2297) l2298)))) ((null? e2295) (quote ())) ((syntax-object?1067 e2295) (match-each-any2271 (syntax-object-expression1068 e2295) (join-wraps1102 w2296 (syntax-object-wrap1069 e2295)) mod2297)) (else #f)))) (match-each2270 (lambda (e2299 p2300 w2301 mod2302) (cond ((annotation? e2299) (match-each2270 (annotation-expression e2299) p2300 w2301 mod2302)) ((pair? e2299) (let ((first2303 (match2274 (car e2299) p2300 w2301 (quote ()) mod2302))) (and first2303 (let ((rest2304 (match-each2270 (cdr e2299) p2300 w2301 mod2302))) (and rest2304 (cons first2303 rest2304)))))) ((null? e2299) (quote ())) ((syntax-object?1067 e2299) (match-each2270 (syntax-object-expression1068 e2299) p2300 (join-wraps1102 w2301 (syntax-object-wrap1069 e2299)) (syntax-object-module1070 e2299))) (else #f))))) (set! syntax-dispatch (lambda (e2305 p2306) (cond ((eq? p2306 (quote any)) (list e2305)) ((syntax-object?1067 e2305) (match*2273 (let ((e2307 (syntax-object-expression1068 e2305))) (if (annotation? e2307) (annotation-expression e2307) e2307)) p2306 (syntax-object-wrap1069 e2305) (quote ()) (syntax-object-module1070 e2305))) (else (match*2273 (let ((e2308 e2305)) (if (annotation? e2308) (annotation-expression e2308) e2308)) p2306 (quote (())) (quote ()) #f))))))))
-(install-global-transformer (quote with-syntax) (lambda (x2309) ((lambda (tmp2310) ((lambda (tmp2311) (if tmp2311 (apply (lambda (_2312 e12313 e22314) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12313 e22314))) tmp2311) ((lambda (tmp2316) (if tmp2316 (apply (lambda (_2317 out2318 in2319 e12320 e22321) (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))) in2319 (quote ()) (list out2318 (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 e12320 e22321))))) tmp2316) ((lambda (tmp2323) (if tmp2323 (apply (lambda (_2324 out2325 in2326 e12327 e22328) (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))) in2326) (quote ()) (list out2325 (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 e12327 e22328))))) tmp2323) (syntax-error tmp2310))) (syntax-dispatch tmp2310 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2310 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2310 (quote (any () any . each-any))))) x2309)))
-(install-global-transformer (quote syntax-rules) (lambda (x2332) ((lambda (tmp2333) ((lambda (tmp2334) (if tmp2334 (apply (lambda (_2335 k2336 keyword2337 pattern2338 template2339) (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 k2336 (map (lambda (tmp2342 tmp2341) (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))) tmp2341) (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))) tmp2342))) template2339 pattern2338)))))) tmp2334) (syntax-error tmp2333))) (syntax-dispatch tmp2333 (quote (any each-any . #(each ((any . any) any))))))) x2332)))
-(install-global-transformer (quote let*) (lambda (x2343) ((lambda (tmp2344) ((lambda (tmp2345) (if (if tmp2345 (apply (lambda (let*2346 x2347 v2348 e12349 e22350) (andmap identifier? x2347)) tmp2345) #f) (apply (lambda (let*2352 x2353 v2354 e12355 e22356) (let f2357 ((bindings2358 (map list x2353 v2354))) (if (null? bindings2358) (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 e12355 e22356))) ((lambda (tmp2362) ((lambda (tmp2363) (if tmp2363 (apply (lambda (body2364 binding2365) (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 binding2365) body2364)) tmp2363) (syntax-error tmp2362))) (syntax-dispatch tmp2362 (quote (any any))))) (list (f2357 (cdr bindings2358)) (car bindings2358)))))) tmp2345) (syntax-error tmp2344))) (syntax-dispatch tmp2344 (quote (any #(each (any any)) any . each-any))))) x2343)))
-(install-global-transformer (quote do) (lambda (orig-x2366) ((lambda (tmp2367) ((lambda (tmp2368) (if tmp2368 (apply (lambda (_2369 var2370 init2371 step2372 e02373 e12374 c2375) ((lambda (tmp2376) ((lambda (tmp2377) (if tmp2377 (apply (lambda (step2378) ((lambda (tmp2379) ((lambda (tmp2380) (if tmp2380 (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 var2370 init2371) (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))) e02373) (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 c2375 (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))) step2378))))))) tmp2380) ((lambda (tmp2385) (if tmp2385 (apply (lambda (e12386 e22387) (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 var2370 init2371) (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))) e02373 (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 e12386 e22387)) (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 c2375 (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))) step2378))))))) tmp2385) (syntax-error tmp2379))) (syntax-dispatch tmp2379 (quote (any . each-any)))))) (syntax-dispatch tmp2379 (quote ())))) e12374)) tmp2377) (syntax-error tmp2376))) (syntax-dispatch tmp2376 (quote each-any)))) (map (lambda (v2394 s2395) ((lambda (tmp2396) ((lambda (tmp2397) (if tmp2397 (apply (lambda () v2394) tmp2397) ((lambda (tmp2398) (if tmp2398 (apply (lambda (e2399) e2399) tmp2398) ((lambda (_2400) (syntax-error orig-x2366)) tmp2396))) (syntax-dispatch tmp2396 (quote (any)))))) (syntax-dispatch tmp2396 (quote ())))) s2395)) var2370 step2372))) tmp2368) (syntax-error tmp2367))) (syntax-dispatch tmp2367 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2366)))
-(install-global-transformer (quote quasiquote) (letrec ((quasicons2403 (lambda (x2407 y2408) ((lambda (tmp2409) ((lambda (tmp2410) (if tmp2410 (apply (lambda (x2411 y2412) ((lambda (tmp2413) ((lambda (tmp2414) (if tmp2414 (apply (lambda (dy2415) ((lambda (tmp2416) ((lambda (tmp2417) (if tmp2417 (apply (lambda (dx2418) (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 dx2418 dy2415))) tmp2417) ((lambda (_2419) (if (null? dy2415) (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))) x2411) (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))) x2411 y2412))) tmp2416))) (syntax-dispatch tmp2416 (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))))) x2411)) tmp2414) ((lambda (tmp2420) (if tmp2420 (apply (lambda (stuff2421) (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 x2411 stuff2421))) tmp2420) ((lambda (else2422) (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))) x2411 y2412)) tmp2413))) (syntax-dispatch tmp2413 (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)))))) (syntax-dispatch tmp2413 (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))))) y2412)) tmp2410) (syntax-error tmp2409))) (syntax-dispatch tmp2409 (quote (any any))))) (list x2407 y2408)))) (quasiappend2404 (lambda (x2423 y2424) ((lambda (tmp2425) ((lambda (tmp2426) (if tmp2426 (apply (lambda (x2427 y2428) ((lambda (tmp2429) ((lambda (tmp2430) (if tmp2430 (apply (lambda () x2427) tmp2430) ((lambda (_2431) (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))) x2427 y2428)) tmp2429))) (syntax-dispatch tmp2429 (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))) ()))))) y2428)) tmp2426) (syntax-error tmp2425))) (syntax-dispatch tmp2425 (quote (any any))))) (list x2423 y2424)))) (quasivector2405 (lambda (x2432) ((lambda (tmp2433) ((lambda (x2434) ((lambda (tmp2435) ((lambda (tmp2436) (if tmp2436 (apply (lambda (x2437) (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 x2437))) tmp2436) ((lambda (tmp2439) (if tmp2439 (apply (lambda (x2440) (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))) x2440)) tmp2439) ((lambda (_2442) (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))) x2434)) tmp2435))) (syntax-dispatch tmp2435 (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)))))) (syntax-dispatch tmp2435 (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))))) x2434)) tmp2433)) x2432))) (quasi2406 (lambda (p2443 lev2444) ((lambda (tmp2445) ((lambda (tmp2446) (if tmp2446 (apply (lambda (p2447) (if (= lev2444 0) p2447 (quasicons2403 (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)))) (quasi2406 (list p2447) (- lev2444 1))))) tmp2446) ((lambda (tmp2448) (if tmp2448 (apply (lambda (p2449 q2450) (if (= lev2444 0) (quasiappend2404 p2449 (quasi2406 q2450 lev2444)) (quasicons2403 (quasicons2403 (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)))) (quasi2406 (list p2449) (- lev2444 1))) (quasi2406 q2450 lev2444)))) tmp2448) ((lambda (tmp2451) (if tmp2451 (apply (lambda (p2452) (quasicons2403 (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)))) (quasi2406 (list p2452) (+ lev2444 1)))) tmp2451) ((lambda (tmp2453) (if tmp2453 (apply (lambda (p2454 q2455) (quasicons2403 (quasi2406 p2454 lev2444) (quasi2406 q2455 lev2444))) tmp2453) ((lambda (tmp2456) (if tmp2456 (apply (lambda (x2457) (quasivector2405 (quasi2406 x2457 lev2444))) tmp2456) ((lambda (p2459) (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))) p2459)) tmp2445))) (syntax-dispatch tmp2445 (quote #(vector each-any)))))) (syntax-dispatch tmp2445 (quote (any . any)))))) (syntax-dispatch tmp2445 (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)))))) (syntax-dispatch tmp2445 (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)))))) (syntax-dispatch tmp2445 (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))))) p2443)))) (lambda (x2460) ((lambda (tmp2461) ((lambda (tmp2462) (if tmp2462 (apply (lambda (_2463 e2464) (quasi2406 e2464 0)) tmp2462) (syntax-error tmp2461))) (syntax-dispatch tmp2461 (quote (any any))))) x2460))))
-(install-global-transformer (quote include) (lambda (x2465) (letrec ((read-file2466 (lambda (fn2467 k2468) (let ((p2469 (open-input-file fn2467))) (let f2470 ((x2471 (read p2469))) (if (eof-object? x2471) (begin (close-input-port p2469) (quote ())) (cons (datum->syntax-object k2468 x2471) (f2470 (read p2469))))))))) ((lambda (tmp2472) ((lambda (tmp2473) (if tmp2473 (apply (lambda (k2474 filename2475) (let ((fn2476 (syntax-object->datum filename2475))) ((lambda (tmp2477) ((lambda (tmp2478) (if tmp2478 (apply (lambda (exp2479) (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))) exp2479)) tmp2478) (syntax-error tmp2477))) (syntax-dispatch tmp2477 (quote each-any)))) (read-file2466 fn2476 k2474)))) tmp2473) (syntax-error tmp2472))) (syntax-dispatch tmp2472 (quote (any any))))) x2465))))
-(install-global-transformer (quote unquote) (lambda (x2481) ((lambda (tmp2482) ((lambda (tmp2483) (if tmp2483 (apply (lambda (_2484 e2485) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2485))) tmp2483) (syntax-error tmp2482))) (syntax-dispatch tmp2482 (quote (any any))))) x2481)))
-(install-global-transformer (quote unquote-splicing) (lambda (x2486) ((lambda (tmp2487) ((lambda (tmp2488) (if tmp2488 (apply (lambda (_2489 e2490) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2490))) tmp2488) (syntax-error tmp2487))) (syntax-dispatch tmp2487 (quote (any any))))) x2486)))
-(install-global-transformer (quote case) (lambda (x2491) ((lambda (tmp2492) ((lambda (tmp2493) (if tmp2493 (apply (lambda (_2494 e2495 m12496 m22497) ((lambda (tmp2498) ((lambda (body2499) (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))) e2495)) body2499)) tmp2498)) (let f2500 ((clause2501 m12496) (clauses2502 m22497)) (if (null? clauses2502) ((lambda (tmp2504) ((lambda (tmp2505) (if tmp2505 (apply (lambda (e12506 e22507) (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 e12506 e22507))) tmp2505) ((lambda (tmp2509) (if tmp2509 (apply (lambda (k2510 e12511 e22512) (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))) k2510)) (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 e12511 e22512)))) tmp2509) ((lambda (_2515) (syntax-error x2491)) tmp2504))) (syntax-dispatch tmp2504 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2504 (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))))) clause2501) ((lambda (tmp2516) ((lambda (rest2517) ((lambda (tmp2518) ((lambda (tmp2519) (if tmp2519 (apply (lambda (k2520 e12521 e22522) (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))) k2520)) (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 e12521 e22522)) rest2517)) tmp2519) ((lambda (_2525) (syntax-error x2491)) tmp2518))) (syntax-dispatch tmp2518 (quote (each-any any . each-any))))) clause2501)) tmp2516)) (f2500 (car clauses2502) (cdr clauses2502))))))) tmp2493) (syntax-error tmp2492))) (syntax-dispatch tmp2492 (quote (any any any . each-any))))) x2491)))
-(install-global-transformer (quote identifier-syntax) (lambda (x2526) ((lambda (tmp2527) ((lambda (tmp2528) (if tmp2528 (apply (lambda (_2529 e2530) (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))) e2530)) (list (cons _2529 (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 e2530 (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)))))))))) tmp2528) (syntax-error tmp2527))) (syntax-dispatch tmp2527 (quote (any any))))) x2526)))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(void)
+(letrec ((lambda-var-list1261 (lambda (vars1466) (let lvl1467 ((vars1468 vars1466) (ls1469 (quote ())) (w1470 (quote (())))) (cond ((pair? vars1468) (lvl1467 (cdr vars1468) (cons (wrap1240 (car vars1468) w1470 #f) ls1469) w1470)) ((id?1212 vars1468) (cons (wrap1240 vars1468 w1470 #f) ls1469)) ((null? vars1468) ls1469) ((syntax-object?1196 vars1468) (lvl1467 (syntax-object-expression1197 vars1468) ls1469 (join-wraps1231 w1470 (syntax-object-wrap1198 vars1468)))) ((annotation? vars1468) (lvl1467 (annotation-expression vars1468) ls1469 w1470)) (else (cons vars1468 ls1469)))))) (gen-var1260 (lambda (id1471) (let ((id1472 (if (syntax-object?1196 id1471) (syntax-object-expression1197 id1471) id1471))) (if (annotation? id1472) (build-annotated1189 (annotation-source id1472) (gensym (symbol->string (annotation-expression id1472)))) (build-annotated1189 #f (gensym (symbol->string id1472))))))) (strip1259 (lambda (x1473 w1474) (if (memq (quote top) (wrap-marks1215 w1474)) (if (or (annotation? x1473) (and (pair? x1473) (annotation? (car x1473)))) (strip-annotation1258 x1473 #f) x1473) (let f1475 ((x1476 x1473)) (cond ((syntax-object?1196 x1476) (strip1259 (syntax-object-expression1197 x1476) (syntax-object-wrap1198 x1476))) ((pair? x1476) (let ((a1477 (f1475 (car x1476))) (d1478 (f1475 (cdr x1476)))) (if (and (eq? a1477 (car x1476)) (eq? d1478 (cdr x1476))) x1476 (cons a1477 d1478)))) ((vector? x1476) (let ((old1479 (vector->list x1476))) (let ((new1480 (map f1475 old1479))) (if (andmap eq? old1479 new1480) x1476 (list->vector new1480))))) (else x1476)))))) (strip-annotation1258 (lambda (x1481 parent1482) (cond ((pair? x1481) (let ((new1483 (cons #f #f))) (begin (if parent1482 (set-annotation-stripped! parent1482 new1483)) (set-car! new1483 (strip-annotation1258 (car x1481) #f)) (set-cdr! new1483 (strip-annotation1258 (cdr x1481) #f)) new1483))) ((annotation? x1481) (or (annotation-stripped x1481) (strip-annotation1258 (annotation-expression x1481) x1481))) ((vector? x1481) (let ((new1484 (make-vector (vector-length x1481)))) (begin (if parent1482 (set-annotation-stripped! parent1482 new1484)) (let loop1485 ((i1486 (- (vector-length x1481) 1))) (unless (fx<1183 i1486 0) (vector-set! new1484 i1486 (strip-annotation1258 (vector-ref x1481 i1486) #f)) (loop1485 (fx-1181 i1486 1)))) new1484))) (else x1481)))) (ellipsis?1257 (lambda (x1487) (and (nonsymbol-id?1211 x1487) (free-id=?1235 x1487 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1256 (lambda () (build-annotated1189 #f (list (build-annotated1189 #f (quote void)))))) (eval-local-transformer1255 (lambda (expanded1488 mod1489) (let ((p1490 (local-eval-hook1185 expanded1488 mod1489))) (if (procedure? p1490) p1490 (syntax-violation #f "nonprocedure transformer" p1490))))) (chi-local-syntax1254 (lambda (rec?1491 e1492 r1493 w1494 s1495 mod1496 k1497) ((lambda (tmp1498) ((lambda (tmp1499) (if tmp1499 (apply (lambda (_1500 id1501 val1502 e11503 e21504) (let ((ids1505 id1501)) (if (not (valid-bound-ids?1237 ids1505)) (syntax-violation #f "duplicate bound keyword" e1492) (let ((labels1507 (gen-labels1218 ids1505))) (let ((new-w1508 (make-binding-wrap1229 ids1505 labels1507 w1494))) (k1497 (cons e11503 e21504) (extend-env1206 labels1507 (let ((w1510 (if rec?1491 new-w1508 w1494)) (trans-r1511 (macros-only-env1208 r1493))) (map (lambda (x1512) (cons (quote macro) (eval-local-transformer1255 (chi1248 x1512 trans-r1511 w1510 mod1496) mod1496))) val1502)) r1493) new-w1508 s1495 mod1496)))))) tmp1499) ((lambda (_1514) (syntax-violation #f "bad local syntax definition" (source-wrap1241 e1492 w1494 s1495 mod1496))) tmp1498))) ($sc-dispatch tmp1498 (quote (any #(each (any any)) any . each-any))))) e1492))) (chi-lambda-clause1253 (lambda (e1515 docstring1516 c1517 r1518 w1519 mod1520 k1521) ((lambda (tmp1522) ((lambda (tmp1523) (if (if tmp1523 (apply (lambda (args1524 doc1525 e11526 e21527) (and (string? (syntax->datum doc1525)) (not docstring1516))) tmp1523) #f) (apply (lambda (args1528 doc1529 e11530 e21531) (chi-lambda-clause1253 e1515 doc1529 (cons args1528 (cons e11530 e21531)) r1518 w1519 mod1520 k1521)) tmp1523) ((lambda (tmp1533) (if tmp1533 (apply (lambda (id1534 e11535 e21536) (let ((ids1537 id1534)) (if (not (valid-bound-ids?1237 ids1537)) (syntax-violation (quote lambda) "invalid parameter list" e1515) (let ((labels1539 (gen-labels1218 ids1537)) (new-vars1540 (map gen-var1260 ids1537))) (k1521 new-vars1540 docstring1516 (chi-body1252 (cons e11535 e21536) e1515 (extend-var-env1207 labels1539 new-vars1540 r1518) (make-binding-wrap1229 ids1537 labels1539 w1519) mod1520)))))) tmp1533) ((lambda (tmp1542) (if tmp1542 (apply (lambda (ids1543 e11544 e21545) (let ((old-ids1546 (lambda-var-list1261 ids1543))) (if (not (valid-bound-ids?1237 old-ids1546)) (syntax-violation (quote lambda) "invalid parameter list" e1515) (let ((labels1547 (gen-labels1218 old-ids1546)) (new-vars1548 (map gen-var1260 old-ids1546))) (k1521 (let f1549 ((ls11550 (cdr new-vars1548)) (ls21551 (car new-vars1548))) (if (null? ls11550) ls21551 (f1549 (cdr ls11550) (cons (car ls11550) ls21551)))) docstring1516 (chi-body1252 (cons e11544 e21545) e1515 (extend-var-env1207 labels1547 new-vars1548 r1518) (make-binding-wrap1229 old-ids1546 labels1547 w1519) mod1520)))))) tmp1542) ((lambda (_1553) (syntax-violation (quote lambda) "bad lambda" e1515)) tmp1522))) ($sc-dispatch tmp1522 (quote (any any . each-any)))))) ($sc-dispatch tmp1522 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1522 (quote (any any any . each-any))))) c1517))) (chi-body1252 (lambda (body1554 outer-form1555 r1556 w1557 mod1558) (let ((r1559 (cons (quote ("placeholder" placeholder)) r1556))) (let ((ribcage1560 (make-ribcage1219 (quote ()) (quote ()) (quote ())))) (let ((w1561 (make-wrap1214 (wrap-marks1215 w1557) (cons ribcage1560 (wrap-subst1216 w1557))))) (let parse1562 ((body1563 (map (lambda (x1569) (cons r1559 (wrap1240 x1569 w1561 mod1558))) body1554)) (ids1564 (quote ())) (labels1565 (quote ())) (vars1566 (quote ())) (vals1567 (quote ())) (bindings1568 (quote ()))) (if (null? body1563) (syntax-violation #f "no expressions in body" outer-form1555) (let ((e1570 (cdar body1563)) (er1571 (caar body1563))) (call-with-values (lambda () (syntax-type1246 e1570 er1571 (quote (())) #f ribcage1560 mod1558)) (lambda (type1572 value1573 e1574 w1575 s1576 mod1577) (let ((t1578 type1572)) (if (memv t1578 (quote (define-form))) (let ((id1579 (wrap1240 value1573 w1575 mod1577)) (label1580 (gen-label1217))) (let ((var1581 (gen-var1260 id1579))) (begin (extend-ribcage!1228 ribcage1560 id1579 label1580) (parse1562 (cdr body1563) (cons id1579 ids1564) (cons label1580 labels1565) (cons var1581 vars1566) (cons (cons er1571 (wrap1240 e1574 w1575 mod1577)) vals1567) (cons (cons (quote lexical) var1581) bindings1568))))) (if (memv t1578 (quote (define-syntax-form))) (let ((id1582 (wrap1240 value1573 w1575 mod1577)) (label1583 (gen-label1217))) (begin (extend-ribcage!1228 ribcage1560 id1582 label1583) (parse1562 (cdr body1563) (cons id1582 ids1564) (cons label1583 labels1565) vars1566 vals1567 (cons (cons (quote macro) (cons er1571 (wrap1240 e1574 w1575 mod1577))) bindings1568)))) (if (memv t1578 (quote (begin-form))) ((lambda (tmp1584) ((lambda (tmp1585) (if tmp1585 (apply (lambda (_1586 e11587) (parse1562 (let f1588 ((forms1589 e11587)) (if (null? forms1589) (cdr body1563) (cons (cons er1571 (wrap1240 (car forms1589) w1575 mod1577)) (f1588 (cdr forms1589))))) ids1564 labels1565 vars1566 vals1567 bindings1568)) tmp1585) (syntax-violation #f "source expression failed to match any pattern" tmp1584))) ($sc-dispatch tmp1584 (quote (any . each-any))))) e1574) (if (memv t1578 (quote (local-syntax-form))) (chi-local-syntax1254 value1573 e1574 er1571 w1575 s1576 mod1577 (lambda (forms1591 er1592 w1593 s1594 mod1595) (parse1562 (let f1596 ((forms1597 forms1591)) (if (null? forms1597) (cdr body1563) (cons (cons er1592 (wrap1240 (car forms1597) w1593 mod1595)) (f1596 (cdr forms1597))))) ids1564 labels1565 vars1566 vals1567 bindings1568))) (if (null? ids1564) (build-sequence1191 #f (map (lambda (x1598) (chi1248 (cdr x1598) (car x1598) (quote (())) mod1577)) (cons (cons er1571 (source-wrap1241 e1574 w1575 s1576 mod1577)) (cdr body1563)))) (begin (if (not (valid-bound-ids?1237 ids1564)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1555)) (let loop1599 ((bs1600 bindings1568) (er-cache1601 #f) (r-cache1602 #f)) (if (not (null? bs1600)) (let ((b1603 (car bs1600))) (if (eq? (car b1603) (quote macro)) (let ((er1604 (cadr b1603))) (let ((r-cache1605 (if (eq? er1604 er-cache1601) r-cache1602 (macros-only-env1208 er1604)))) (begin (set-cdr! b1603 (eval-local-transformer1255 (chi1248 (cddr b1603) r-cache1605 (quote (())) mod1577) mod1577)) (loop1599 (cdr bs1600) er1604 r-cache1605)))) (loop1599 (cdr bs1600) er-cache1601 r-cache1602))))) (set-cdr! r1559 (extend-env1206 labels1565 bindings1568 (cdr r1559))) (build-letrec1194 #f vars1566 (map (lambda (x1606) (chi1248 (cdr x1606) (car x1606) (quote (())) mod1577)) vals1567) (build-sequence1191 #f (map (lambda (x1607) (chi1248 (cdr x1607) (car x1607) (quote (())) mod1577)) (cons (cons er1571 (source-wrap1241 e1574 w1575 s1576 mod1577)) (cdr body1563)))))))))))))))))))))) (chi-macro1251 (lambda (p1608 e1609 r1610 w1611 rib1612 mod1613) (letrec ((rebuild-macro-output1614 (lambda (x1615 m1616) (cond ((pair? x1615) (cons (rebuild-macro-output1614 (car x1615) m1616) (rebuild-macro-output1614 (cdr x1615) m1616))) ((syntax-object?1196 x1615) (let ((w1617 (syntax-object-wrap1198 x1615))) (let ((ms1618 (wrap-marks1215 w1617)) (s1619 (wrap-subst1216 w1617))) (if (and (pair? ms1618) (eq? (car ms1618) #f)) (make-syntax-object1195 (syntax-object-expression1197 x1615) (make-wrap1214 (cdr ms1618) (if rib1612 (cons rib1612 (cdr s1619)) (cdr s1619))) (syntax-object-module1199 x1615)) (make-syntax-object1195 (syntax-object-expression1197 x1615) (make-wrap1214 (cons m1616 ms1618) (if rib1612 (cons rib1612 (cons (quote shift) s1619)) (cons (quote shift) s1619))) (let ((pmod1620 (procedure-module p1608))) (if pmod1620 (cons (quote hygiene) (module-name pmod1620)) (quote (hygiene guile))))))))) ((vector? x1615) (let ((n1621 (vector-length x1615))) (let ((v1622 (make-vector n1621))) (let doloop1623 ((i1624 0)) (if (fx=1182 i1624 n1621) v1622 (begin (vector-set! v1622 i1624 (rebuild-macro-output1614 (vector-ref x1615 i1624) m1616)) (doloop1623 (fx+1180 i1624 1)))))))) ((symbol? x1615) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1241 e1609 w1611 s mod1613) x1615)) (else x1615))))) (rebuild-macro-output1614 (p1608 (wrap1240 e1609 (anti-mark1227 w1611) mod1613)) (string #\m))))) (chi-application1250 (lambda (x1625 e1626 r1627 w1628 s1629 mod1630) ((lambda (tmp1631) ((lambda (tmp1632) (if tmp1632 (apply (lambda (e01633 e11634) (build-annotated1189 s1629 (cons x1625 (map (lambda (e1635) (chi1248 e1635 r1627 w1628 mod1630)) e11634)))) tmp1632) (syntax-violation #f "source expression failed to match any pattern" tmp1631))) ($sc-dispatch tmp1631 (quote (any . each-any))))) e1626))) (chi-expr1249 (lambda (type1637 value1638 e1639 r1640 w1641 s1642 mod1643) (let ((t1644 type1637)) (if (memv t1644 (quote (lexical))) (build-annotated1189 s1642 value1638) (if (memv t1644 (quote (core external-macro))) (value1638 e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (module-ref))) (call-with-values (lambda () (value1638 e1639)) (lambda (id1645 mod1646) (build-annotated1189 s1642 (if mod1646 (make-module-ref (cdr mod1646) id1645 (car mod1646)) (make-module-ref mod1646 id1645 (quote bare)))))) (if (memv t1644 (quote (lexical-call))) (chi-application1250 (build-annotated1189 (source-annotation1203 (car e1639)) value1638) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (global-call))) (chi-application1250 (build-annotated1189 (source-annotation1203 (car e1639)) (if (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643) (make-module-ref (cdr (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643)) value1638 (car (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643))) (make-module-ref (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643) value1638 (quote bare)))) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (constant))) (build-data1190 s1642 (strip1259 (source-wrap1241 e1639 w1641 s1642 mod1643) (quote (())))) (if (memv t1644 (quote (global))) (build-annotated1189 s1642 (if mod1643 (make-module-ref (cdr mod1643) value1638 (car mod1643)) (make-module-ref mod1643 value1638 (quote bare)))) (if (memv t1644 (quote (call))) (chi-application1250 (chi1248 (car e1639) r1640 w1641 mod1643) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (begin-form))) ((lambda (tmp1647) ((lambda (tmp1648) (if tmp1648 (apply (lambda (_1649 e11650 e21651) (chi-sequence1242 (cons e11650 e21651) r1640 w1641 s1642 mod1643)) tmp1648) (syntax-violation #f "source expression failed to match any pattern" tmp1647))) ($sc-dispatch tmp1647 (quote (any any . each-any))))) e1639) (if (memv t1644 (quote (local-syntax-form))) (chi-local-syntax1254 value1638 e1639 r1640 w1641 s1642 mod1643 chi-sequence1242) (if (memv t1644 (quote (eval-when-form))) ((lambda (tmp1653) ((lambda (tmp1654) (if tmp1654 (apply (lambda (_1655 x1656 e11657 e21658) (let ((when-list1659 (chi-when-list1245 e1639 x1656 w1641))) (if (memq (quote eval) when-list1659) (chi-sequence1242 (cons e11657 e21658) r1640 w1641 s1642 mod1643) (chi-void1256)))) tmp1654) (syntax-violation #f "source expression failed to match any pattern" tmp1653))) ($sc-dispatch tmp1653 (quote (any each-any any . each-any))))) e1639) (if (memv t1644 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1639 (wrap1240 value1638 w1641 mod1643)) (if (memv t1644 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1241 e1639 w1641 s1642 mod1643)) (if (memv t1644 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1241 e1639 w1641 s1642 mod1643)) (syntax-violation #f "unexpected syntax" (source-wrap1241 e1639 w1641 s1642 mod1643))))))))))))))))))) (chi1248 (lambda (e1662 r1663 w1664 mod1665) (call-with-values (lambda () (syntax-type1246 e1662 r1663 w1664 #f #f mod1665)) (lambda (type1666 value1667 e1668 w1669 s1670 mod1671) (chi-expr1249 type1666 value1667 e1668 r1663 w1669 s1670 mod1671))))) (chi-top1247 (lambda (e1672 r1673 w1674 m1675 esew1676 mod1677) (call-with-values (lambda () (syntax-type1246 e1672 r1673 w1674 #f #f mod1677)) (lambda (type1685 value1686 e1687 w1688 s1689 mod1690) (let ((t1691 type1685)) (if (memv t1691 (quote (begin-form))) ((lambda (tmp1692) ((lambda (tmp1693) (if tmp1693 (apply (lambda (_1694) (chi-void1256)) tmp1693) ((lambda (tmp1695) (if tmp1695 (apply (lambda (_1696 e11697 e21698) (chi-top-sequence1243 (cons e11697 e21698) r1673 w1688 s1689 m1675 esew1676 mod1690)) tmp1695) (syntax-violation #f "source expression failed to match any pattern" tmp1692))) ($sc-dispatch tmp1692 (quote (any any . each-any)))))) ($sc-dispatch tmp1692 (quote (any))))) e1687) (if (memv t1691 (quote (local-syntax-form))) (chi-local-syntax1254 value1686 e1687 r1673 w1688 s1689 mod1690 (lambda (body1700 r1701 w1702 s1703 mod1704) (chi-top-sequence1243 body1700 r1701 w1702 s1703 m1675 esew1676 mod1704))) (if (memv t1691 (quote (eval-when-form))) ((lambda (tmp1705) ((lambda (tmp1706) (if tmp1706 (apply (lambda (_1707 x1708 e11709 e21710) (let ((when-list1711 (chi-when-list1245 e1687 x1708 w1688)) (body1712 (cons e11709 e21710))) (cond ((eq? m1675 (quote e)) (if (memq (quote eval) when-list1711) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote e) (quote (eval)) mod1690) (chi-void1256))) ((memq (quote load) when-list1711) (if (or (memq (quote compile) when-list1711) (and (eq? m1675 (quote c&e)) (memq (quote eval) when-list1711))) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote c&e) (quote (compile load)) mod1690) (if (memq m1675 (quote (c c&e))) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote c) (quote (load)) mod1690) (chi-void1256)))) ((or (memq (quote compile) when-list1711) (and (eq? m1675 (quote c&e)) (memq (quote eval) when-list1711))) (top-level-eval-hook1184 (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote e) (quote (eval)) mod1690) mod1690) (chi-void1256)) (else (chi-void1256))))) tmp1706) (syntax-violation #f "source expression failed to match any pattern" tmp1705))) ($sc-dispatch tmp1705 (quote (any each-any any . each-any))))) e1687) (if (memv t1691 (quote (define-syntax-form))) (let ((n1715 (id-var-name1234 value1686 w1688)) (r1716 (macros-only-env1208 r1673))) (let ((t1717 m1675)) (if (memv t1717 (quote (c))) (if (memq (quote compile) esew1676) (let ((e1718 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)))) (begin (top-level-eval-hook1184 e1718 mod1690) (if (memq (quote load) esew1676) e1718 (chi-void1256)))) (if (memq (quote load) esew1676) (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)) (chi-void1256))) (if (memv t1717 (quote (c&e))) (let ((e1719 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)))) (begin (top-level-eval-hook1184 e1719 mod1690) e1719)) (begin (if (memq (quote eval) esew1676) (top-level-eval-hook1184 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)) mod1690)) (chi-void1256)))))) (if (memv t1691 (quote (define-form))) (let ((n1720 (id-var-name1234 value1686 w1688))) (let ((type1721 (binding-type1204 (lookup1209 n1720 r1673 mod1690)))) (let ((t1722 type1721)) (if (memv t1722 (quote (global core macro module-ref))) (let ((x1723 (build-annotated1189 s1689 (list (quote define) n1720 (chi1248 e1687 r1673 w1688 mod1690))))) (begin (if (eq? m1675 (quote c&e)) (top-level-eval-hook1184 x1723 mod1690)) x1723)) (if (memv t1722 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1687 (wrap1240 value1686 w1688 mod1690)) (syntax-violation #f "cannot define keyword at top level" e1687 (wrap1240 value1686 w1688 mod1690))))))) (let ((x1724 (chi-expr1249 type1685 value1686 e1687 r1673 w1688 s1689 mod1690))) (begin (if (eq? m1675 (quote c&e)) (top-level-eval-hook1184 x1724 mod1690)) x1724)))))))))))) (syntax-type1246 (lambda (e1725 r1726 w1727 s1728 rib1729 mod1730) (cond ((symbol? e1725) (let ((n1731 (id-var-name1234 e1725 w1727))) (let ((b1732 (lookup1209 n1731 r1726 mod1730))) (let ((type1733 (binding-type1204 b1732))) (let ((t1734 type1733)) (if (memv t1734 (quote (lexical))) (values type1733 (binding-value1205 b1732) e1725 w1727 s1728 mod1730) (if (memv t1734 (quote (global))) (values type1733 n1731 e1725 w1727 s1728 mod1730) (if (memv t1734 (quote (macro))) (syntax-type1246 (chi-macro1251 (binding-value1205 b1732) e1725 r1726 w1727 rib1729 mod1730) r1726 (quote (())) s1728 rib1729 mod1730) (values type1733 (binding-value1205 b1732) e1725 w1727 s1728 mod1730))))))))) ((pair? e1725) (let ((first1735 (car e1725))) (if (id?1212 first1735) (let ((n1736 (id-var-name1234 first1735 w1727))) (let ((b1737 (lookup1209 n1736 r1726 (or (and (syntax-object?1196 first1735) (syntax-object-module1199 first1735)) mod1730)))) (let ((type1738 (binding-type1204 b1737))) (let ((t1739 type1738)) (if (memv t1739 (quote (lexical))) (values (quote lexical-call) (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (global))) (values (quote global-call) n1736 e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (macro))) (syntax-type1246 (chi-macro1251 (binding-value1205 b1737) e1725 r1726 w1727 rib1729 mod1730) r1726 (quote (())) s1728 rib1729 mod1730) (if (memv t1739 (quote (core external-macro module-ref))) (values type1738 (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (begin))) (values (quote begin-form) #f e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (eval-when))) (values (quote eval-when-form) #f e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (define))) ((lambda (tmp1740) ((lambda (tmp1741) (if (if tmp1741 (apply (lambda (_1742 name1743 val1744) (id?1212 name1743)) tmp1741) #f) (apply (lambda (_1745 name1746 val1747) (values (quote define-form) name1746 val1747 w1727 s1728 mod1730)) tmp1741) ((lambda (tmp1748) (if (if tmp1748 (apply (lambda (_1749 name1750 args1751 e11752 e21753) (and (id?1212 name1750) (valid-bound-ids?1237 (lambda-var-list1261 args1751)))) tmp1748) #f) (apply (lambda (_1754 name1755 args1756 e11757 e21758) (values (quote define-form) (wrap1240 name1755 w1727 mod1730) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1240 (cons args1756 (cons e11757 e21758)) w1727 mod1730)) (quote (())) s1728 mod1730)) tmp1748) ((lambda (tmp1760) (if (if tmp1760 (apply (lambda (_1761 name1762) (id?1212 name1762)) tmp1760) #f) (apply (lambda (_1763 name1764) (values (quote define-form) (wrap1240 name1764 w1727 mod1730) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1728 mod1730)) tmp1760) (syntax-violation #f "source expression failed to match any pattern" tmp1740))) ($sc-dispatch tmp1740 (quote (any any)))))) ($sc-dispatch tmp1740 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1740 (quote (any any any))))) e1725) (if (memv t1739 (quote (define-syntax))) ((lambda (tmp1765) ((lambda (tmp1766) (if (if tmp1766 (apply (lambda (_1767 name1768 val1769) (id?1212 name1768)) tmp1766) #f) (apply (lambda (_1770 name1771 val1772) (values (quote define-syntax-form) name1771 val1772 w1727 s1728 mod1730)) tmp1766) (syntax-violation #f "source expression failed to match any pattern" tmp1765))) ($sc-dispatch tmp1765 (quote (any any any))))) e1725) (values (quote call) #f e1725 w1727 s1728 mod1730)))))))))))))) (values (quote call) #f e1725 w1727 s1728 mod1730)))) ((syntax-object?1196 e1725) (syntax-type1246 (syntax-object-expression1197 e1725) r1726 (join-wraps1231 w1727 (syntax-object-wrap1198 e1725)) #f rib1729 (or (syntax-object-module1199 e1725) mod1730))) ((annotation? e1725) (syntax-type1246 (annotation-expression e1725) r1726 w1727 (annotation-source e1725) rib1729 mod1730)) ((self-evaluating? e1725) (values (quote constant) #f e1725 w1727 s1728 mod1730)) (else (values (quote other) #f e1725 w1727 s1728 mod1730))))) (chi-when-list1245 (lambda (e1773 when-list1774 w1775) (let f1776 ((when-list1777 when-list1774) (situations1778 (quote ()))) (if (null? when-list1777) situations1778 (f1776 (cdr when-list1777) (cons (let ((x1779 (car when-list1777))) (cond ((free-id=?1235 x1779 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1235 x1779 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1235 x1779 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1773 (wrap1240 x1779 w1775 #f))))) situations1778)))))) (chi-install-global1244 (lambda (name1780 e1781) (build-annotated1189 #f (list (build-annotated1189 #f (quote define)) name1780 (if (let ((v1782 (module-variable (current-module) name1780))) (and v1782 (variable-bound? v1782) (macro? (variable-ref v1782)) (not (eq? (macro-type (variable-ref v1782)) (quote syncase-macro))))) (build-annotated1189 #f (list (build-annotated1189 #f (quote make-extended-syncase-macro)) (build-annotated1189 #f (list (build-annotated1189 #f (quote module-ref)) (build-annotated1189 #f (quote (current-module))) (build-data1190 #f name1780))) (build-data1190 #f (quote macro)) e1781)) (build-annotated1189 #f (list (build-annotated1189 #f (quote make-syncase-macro)) (build-data1190 #f (quote macro)) e1781))))))) (chi-top-sequence1243 (lambda (body1783 r1784 w1785 s1786 m1787 esew1788 mod1789) (build-sequence1191 s1786 (let dobody1790 ((body1791 body1783) (r1792 r1784) (w1793 w1785) (m1794 m1787) (esew1795 esew1788) (mod1796 mod1789)) (if (null? body1791) (quote ()) (let ((first1797 (chi-top1247 (car body1791) r1792 w1793 m1794 esew1795 mod1796))) (cons first1797 (dobody1790 (cdr body1791) r1792 w1793 m1794 esew1795 mod1796)))))))) (chi-sequence1242 (lambda (body1798 r1799 w1800 s1801 mod1802) (build-sequence1191 s1801 (let dobody1803 ((body1804 body1798) (r1805 r1799) (w1806 w1800) (mod1807 mod1802)) (if (null? body1804) (quote ()) (let ((first1808 (chi1248 (car body1804) r1805 w1806 mod1807))) (cons first1808 (dobody1803 (cdr body1804) r1805 w1806 mod1807)))))))) (source-wrap1241 (lambda (x1809 w1810 s1811 defmod1812) (wrap1240 (if s1811 (make-annotation x1809 s1811 #f) x1809) w1810 defmod1812))) (wrap1240 (lambda (x1813 w1814 defmod1815) (cond ((and (null? (wrap-marks1215 w1814)) (null? (wrap-subst1216 w1814))) x1813) ((syntax-object?1196 x1813) (make-syntax-object1195 (syntax-object-expression1197 x1813) (join-wraps1231 w1814 (syntax-object-wrap1198 x1813)) (syntax-object-module1199 x1813))) ((null? x1813) x1813) (else (make-syntax-object1195 x1813 w1814 defmod1815))))) (bound-id-member?1239 (lambda (x1816 list1817) (and (not (null? list1817)) (or (bound-id=?1236 x1816 (car list1817)) (bound-id-member?1239 x1816 (cdr list1817)))))) (distinct-bound-ids?1238 (lambda (ids1818) (let distinct?1819 ((ids1820 ids1818)) (or (null? ids1820) (and (not (bound-id-member?1239 (car ids1820) (cdr ids1820))) (distinct?1819 (cdr ids1820))))))) (valid-bound-ids?1237 (lambda (ids1821) (and (let all-ids?1822 ((ids1823 ids1821)) (or (null? ids1823) (and (id?1212 (car ids1823)) (all-ids?1822 (cdr ids1823))))) (distinct-bound-ids?1238 ids1821)))) (bound-id=?1236 (lambda (i1824 j1825) (if (and (syntax-object?1196 i1824) (syntax-object?1196 j1825)) (and (eq? (let ((e1826 (syntax-object-expression1197 i1824))) (if (annotation? e1826) (annotation-expression e1826) e1826)) (let ((e1827 (syntax-object-expression1197 j1825))) (if (annotation? e1827) (annotation-expression e1827) e1827))) (same-marks?1233 (wrap-marks1215 (syntax-object-wrap1198 i1824)) (wrap-marks1215 (syntax-object-wrap1198 j1825)))) (eq? (let ((e1828 i1824)) (if (annotation? e1828) (annotation-expression e1828) e1828)) (let ((e1829 j1825)) (if (annotation? e1829) (annotation-expression e1829) e1829)))))) (free-id=?1235 (lambda (i1830 j1831) (and (eq? (let ((x1832 i1830)) (let ((e1833 (if (syntax-object?1196 x1832) (syntax-object-expression1197 x1832) x1832))) (if (annotation? e1833) (annotation-expression e1833) e1833))) (let ((x1834 j1831)) (let ((e1835 (if (syntax-object?1196 x1834) (syntax-object-expression1197 x1834) x1834))) (if (annotation? e1835) (annotation-expression e1835) e1835)))) (eq? (id-var-name1234 i1830 (quote (()))) (id-var-name1234 j1831 (quote (()))))))) (id-var-name1234 (lambda (id1836 w1837) (letrec ((search-vector-rib1840 (lambda (sym1846 subst1847 marks1848 symnames1849 ribcage1850) (let ((n1851 (vector-length symnames1849))) (let f1852 ((i1853 0)) (cond ((fx=1182 i1853 n1851) (search1838 sym1846 (cdr subst1847) marks1848)) ((and (eq? (vector-ref symnames1849 i1853) sym1846) (same-marks?1233 marks1848 (vector-ref (ribcage-marks1222 ribcage1850) i1853))) (values (vector-ref (ribcage-labels1223 ribcage1850) i1853) marks1848)) (else (f1852 (fx+1180 i1853 1)))))))) (search-list-rib1839 (lambda (sym1854 subst1855 marks1856 symnames1857 ribcage1858) (let f1859 ((symnames1860 symnames1857) (i1861 0)) (cond ((null? symnames1860) (search1838 sym1854 (cdr subst1855) marks1856)) ((and (eq? (car symnames1860) sym1854) (same-marks?1233 marks1856 (list-ref (ribcage-marks1222 ribcage1858) i1861))) (values (list-ref (ribcage-labels1223 ribcage1858) i1861) marks1856)) (else (f1859 (cdr symnames1860) (fx+1180 i1861 1))))))) (search1838 (lambda (sym1862 subst1863 marks1864) (if (null? subst1863) (values #f marks1864) (let ((fst1865 (car subst1863))) (if (eq? fst1865 (quote shift)) (search1838 sym1862 (cdr subst1863) (cdr marks1864)) (let ((symnames1866 (ribcage-symnames1221 fst1865))) (if (vector? symnames1866) (search-vector-rib1840 sym1862 subst1863 marks1864 symnames1866 fst1865) (search-list-rib1839 sym1862 subst1863 marks1864 symnames1866 fst1865))))))))) (cond ((symbol? id1836) (or (call-with-values (lambda () (search1838 id1836 (wrap-subst1216 w1837) (wrap-marks1215 w1837))) (lambda (x1868 . ignore1867) x1868)) id1836)) ((syntax-object?1196 id1836) (let ((id1869 (let ((e1871 (syntax-object-expression1197 id1836))) (if (annotation? e1871) (annotation-expression e1871) e1871))) (w11870 (syntax-object-wrap1198 id1836))) (let ((marks1872 (join-marks1232 (wrap-marks1215 w1837) (wrap-marks1215 w11870)))) (call-with-values (lambda () (search1838 id1869 (wrap-subst1216 w1837) marks1872)) (lambda (new-id1873 marks1874) (or new-id1873 (call-with-values (lambda () (search1838 id1869 (wrap-subst1216 w11870) marks1874)) (lambda (x1876 . ignore1875) x1876)) id1869)))))) ((annotation? id1836) (let ((id1877 (let ((e1878 id1836)) (if (annotation? e1878) (annotation-expression e1878) e1878)))) (or (call-with-values (lambda () (search1838 id1877 (wrap-subst1216 w1837) (wrap-marks1215 w1837))) (lambda (x1880 . ignore1879) x1880)) id1877))) (else (error-hook1186 (quote id-var-name) "invalid id" id1836)))))) (same-marks?1233 (lambda (x1881 y1882) (or (eq? x1881 y1882) (and (not (null? x1881)) (not (null? y1882)) (eq? (car x1881) (car y1882)) (same-marks?1233 (cdr x1881) (cdr y1882)))))) (join-marks1232 (lambda (m11883 m21884) (smart-append1230 m11883 m21884))) (join-wraps1231 (lambda (w11885 w21886) (let ((m11887 (wrap-marks1215 w11885)) (s11888 (wrap-subst1216 w11885))) (if (null? m11887) (if (null? s11888) w21886 (make-wrap1214 (wrap-marks1215 w21886) (smart-append1230 s11888 (wrap-subst1216 w21886)))) (make-wrap1214 (smart-append1230 m11887 (wrap-marks1215 w21886)) (smart-append1230 s11888 (wrap-subst1216 w21886))))))) (smart-append1230 (lambda (m11889 m21890) (if (null? m21890) m11889 (append m11889 m21890)))) (make-binding-wrap1229 (lambda (ids1891 labels1892 w1893) (if (null? ids1891) w1893 (make-wrap1214 (wrap-marks1215 w1893) (cons (let ((labelvec1894 (list->vector labels1892))) (let ((n1895 (vector-length labelvec1894))) (let ((symnamevec1896 (make-vector n1895)) (marksvec1897 (make-vector n1895))) (begin (let f1898 ((ids1899 ids1891) (i1900 0)) (if (not (null? ids1899)) (call-with-values (lambda () (id-sym-name&marks1213 (car ids1899) w1893)) (lambda (symname1901 marks1902) (begin (vector-set! symnamevec1896 i1900 symname1901) (vector-set! marksvec1897 i1900 marks1902) (f1898 (cdr ids1899) (fx+1180 i1900 1))))))) (make-ribcage1219 symnamevec1896 marksvec1897 labelvec1894))))) (wrap-subst1216 w1893)))))) (extend-ribcage!1228 (lambda (ribcage1903 id1904 label1905) (begin (set-ribcage-symnames!1224 ribcage1903 (cons (let ((e1906 (syntax-object-expression1197 id1904))) (if (annotation? e1906) (annotation-expression e1906) e1906)) (ribcage-symnames1221 ribcage1903))) (set-ribcage-marks!1225 ribcage1903 (cons (wrap-marks1215 (syntax-object-wrap1198 id1904)) (ribcage-marks1222 ribcage1903))) (set-ribcage-labels!1226 ribcage1903 (cons label1905 (ribcage-labels1223 ribcage1903)))))) (anti-mark1227 (lambda (w1907) (make-wrap1214 (cons #f (wrap-marks1215 w1907)) (cons (quote shift) (wrap-subst1216 w1907))))) (set-ribcage-labels!1226 (lambda (x1908 update1909) (vector-set! x1908 3 update1909))) (set-ribcage-marks!1225 (lambda (x1910 update1911) (vector-set! x1910 2 update1911))) (set-ribcage-symnames!1224 (lambda (x1912 update1913) (vector-set! x1912 1 update1913))) (ribcage-labels1223 (lambda (x1914) (vector-ref x1914 3))) (ribcage-marks1222 (lambda (x1915) (vector-ref x1915 2))) (ribcage-symnames1221 (lambda (x1916) (vector-ref x1916 1))) (ribcage?1220 (lambda (x1917) (and (vector? x1917) (= (vector-length x1917) 4) (eq? (vector-ref x1917 0) (quote ribcage))))) (make-ribcage1219 (lambda (symnames1918 marks1919 labels1920) (vector (quote ribcage) symnames1918 marks1919 labels1920))) (gen-labels1218 (lambda (ls1921) (if (null? ls1921) (quote ()) (cons (gen-label1217) (gen-labels1218 (cdr ls1921)))))) (gen-label1217 (lambda () (string #\i))) (wrap-subst1216 cdr) (wrap-marks1215 car) (make-wrap1214 cons) (id-sym-name&marks1213 (lambda (x1922 w1923) (if (syntax-object?1196 x1922) (values (let ((e1924 (syntax-object-expression1197 x1922))) (if (annotation? e1924) (annotation-expression e1924) e1924)) (join-marks1232 (wrap-marks1215 w1923) (wrap-marks1215 (syntax-object-wrap1198 x1922)))) (values (let ((e1925 x1922)) (if (annotation? e1925) (annotation-expression e1925) e1925)) (wrap-marks1215 w1923))))) (id?1212 (lambda (x1926) (cond ((symbol? x1926) #t) ((syntax-object?1196 x1926) (symbol? (let ((e1927 (syntax-object-expression1197 x1926))) (if (annotation? e1927) (annotation-expression e1927) e1927)))) ((annotation? x1926) (symbol? (annotation-expression x1926))) (else #f)))) (nonsymbol-id?1211 (lambda (x1928) (and (syntax-object?1196 x1928) (symbol? (let ((e1929 (syntax-object-expression1197 x1928))) (if (annotation? e1929) (annotation-expression e1929) e1929)))))) (global-extend1210 (lambda (type1930 sym1931 val1932) (put-global-definition-hook1187 sym1931 type1930 val1932))) (lookup1209 (lambda (x1933 r1934 mod1935) (cond ((assq x1933 r1934) => cdr) ((symbol? x1933) (or (get-global-definition-hook1188 x1933 mod1935) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1208 (lambda (r1936) (if (null? r1936) (quote ()) (let ((a1937 (car r1936))) (if (eq? (cadr a1937) (quote macro)) (cons a1937 (macros-only-env1208 (cdr r1936))) (macros-only-env1208 (cdr r1936))))))) (extend-var-env1207 (lambda (labels1938 vars1939 r1940) (if (null? labels1938) r1940 (extend-var-env1207 (cdr labels1938) (cdr vars1939) (cons (cons (car labels1938) (cons (quote lexical) (car vars1939))) r1940))))) (extend-env1206 (lambda (labels1941 bindings1942 r1943) (if (null? labels1941) r1943 (extend-env1206 (cdr labels1941) (cdr bindings1942) (cons (cons (car labels1941) (car bindings1942)) r1943))))) (binding-value1205 cdr) (binding-type1204 car) (source-annotation1203 (lambda (x1944) (cond ((annotation? x1944) (annotation-source x1944)) ((syntax-object?1196 x1944) (source-annotation1203 (syntax-object-expression1197 x1944))) (else #f)))) (set-syntax-object-module!1202 (lambda (x1945 update1946) (vector-set! x1945 3 update1946))) (set-syntax-object-wrap!1201 (lambda (x1947 update1948) (vector-set! x1947 2 update1948))) (set-syntax-object-expression!1200 (lambda (x1949 update1950) (vector-set! x1949 1 update1950))) (syntax-object-module1199 (lambda (x1951) (vector-ref x1951 3))) (syntax-object-wrap1198 (lambda (x1952) (vector-ref x1952 2))) (syntax-object-expression1197 (lambda (x1953) (vector-ref x1953 1))) (syntax-object?1196 (lambda (x1954) (and (vector? x1954) (= (vector-length x1954) 4) (eq? (vector-ref x1954 0) (quote syntax-object))))) (make-syntax-object1195 (lambda (expression1955 wrap1956 module1957) (vector (quote syntax-object) expression1955 wrap1956 module1957))) (build-letrec1194 (lambda (src1958 vars1959 val-exps1960 body-exp1961) (if (null? vars1959) (build-annotated1189 src1958 body-exp1961) (build-annotated1189 src1958 (list (quote letrec) (map list vars1959 val-exps1960) body-exp1961))))) (build-named-let1193 (lambda (src1962 vars1963 val-exps1964 body-exp1965) (if (null? vars1963) (build-annotated1189 src1962 body-exp1965) (build-annotated1189 src1962 (list (quote let) (car vars1963) (map list (cdr vars1963) val-exps1964) body-exp1965))))) (build-let1192 (lambda (src1966 vars1967 val-exps1968 body-exp1969) (if (null? vars1967) (build-annotated1189 src1966 body-exp1969) (build-annotated1189 src1966 (list (quote let) (map list vars1967 val-exps1968) body-exp1969))))) (build-sequence1191 (lambda (src1970 exps1971) (if (null? (cdr exps1971)) (build-annotated1189 src1970 (car exps1971)) (build-annotated1189 src1970 (cons (quote begin) exps1971))))) (build-data1190 (lambda (src1972 exp1973) (if (and (self-evaluating? exp1973) (not (vector? exp1973))) (build-annotated1189 src1972 exp1973) (build-annotated1189 src1972 (list (quote quote) exp1973))))) (build-annotated1189 (lambda (src1974 exp1975) (if (and src1974 (not (annotation? exp1975))) (make-annotation exp1975 src1974 #t) exp1975))) (get-global-definition-hook1188 (lambda (symbol1976 module1977) (begin (if (and (not module1977) (current-module)) (warn "module system is booted, we should have a module" symbol1976)) (let ((v1978 (module-variable (if module1977 (resolve-module (cdr module1977)) (current-module)) symbol1976))) (and v1978 (variable-bound? v1978) (let ((val1979 (variable-ref v1978))) (and (macro? val1979) (syncase-macro-type val1979) (cons (syncase-macro-type val1979) (syncase-macro-binding val1979))))))))) (put-global-definition-hook1187 (lambda (symbol1980 type1981 val1982) (let ((existing1983 (let ((v1984 (module-variable (current-module) symbol1980))) (and v1984 (variable-bound? v1984) (let ((val1985 (variable-ref v1984))) (and (macro? val1985) (not (syncase-macro-type val1985)) val1985)))))) (module-define! (current-module) symbol1980 (if existing1983 (make-extended-syncase-macro existing1983 type1981 val1982) (make-syncase-macro type1981 val1982)))))) (error-hook1186 (lambda (who1986 why1987 what1988) (error who1986 "~a ~s" why1987 what1988))) (local-eval-hook1185 (lambda (x1989 mod1990) (primitive-eval (list noexpand1179 x1989)))) (top-level-eval-hook1184 (lambda (x1991 mod1992) (primitive-eval (list noexpand1179 x1991)))) (fx<1183 <) (fx=1182 =) (fx-1181 -) (fx+1180 +) (noexpand1179 "noexpand")) (begin (global-extend1210 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1210 (quote local-syntax) (quote let-syntax) #f) (global-extend1210 (quote core) (quote fluid-let-syntax) (lambda (e1993 r1994 w1995 s1996 mod1997) ((lambda (tmp1998) ((lambda (tmp1999) (if (if tmp1999 (apply (lambda (_2000 var2001 val2002 e12003 e22004) (valid-bound-ids?1237 var2001)) tmp1999) #f) (apply (lambda (_2006 var2007 val2008 e12009 e22010) (let ((names2011 (map (lambda (x2012) (id-var-name1234 x2012 w1995)) var2007))) (begin (for-each (lambda (id2014 n2015) (let ((t2016 (binding-type1204 (lookup1209 n2015 r1994 mod1997)))) (if (memv t2016 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1993 (source-wrap1241 id2014 w1995 s1996 mod1997))))) var2007 names2011) (chi-body1252 (cons e12009 e22010) (source-wrap1241 e1993 w1995 s1996 mod1997) (extend-env1206 names2011 (let ((trans-r2019 (macros-only-env1208 r1994))) (map (lambda (x2020) (cons (quote macro) (eval-local-transformer1255 (chi1248 x2020 trans-r2019 w1995 mod1997) mod1997))) val2008)) r1994) w1995 mod1997)))) tmp1999) ((lambda (_2022) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1241 e1993 w1995 s1996 mod1997))) tmp1998))) ($sc-dispatch tmp1998 (quote (any #(each (any any)) any . each-any))))) e1993))) (global-extend1210 (quote core) (quote quote) (lambda (e2023 r2024 w2025 s2026 mod2027) ((lambda (tmp2028) ((lambda (tmp2029) (if tmp2029 (apply (lambda (_2030 e2031) (build-data1190 s2026 (strip1259 e2031 w2025))) tmp2029) ((lambda (_2032) (syntax-violation (quote quote) "bad syntax" (source-wrap1241 e2023 w2025 s2026 mod2027))) tmp2028))) ($sc-dispatch tmp2028 (quote (any any))))) e2023))) (global-extend1210 (quote core) (quote syntax) (letrec ((regen2040 (lambda (x2041) (let ((t2042 (car x2041))) (if (memv t2042 (quote (ref))) (build-annotated1189 #f (cadr x2041)) (if (memv t2042 (quote (primitive))) (build-annotated1189 #f (cadr x2041)) (if (memv t2042 (quote (quote))) (build-data1190 #f (cadr x2041)) (if (memv t2042 (quote (lambda))) (build-annotated1189 #f (list (quote lambda) (cadr x2041) (regen2040 (caddr x2041)))) (if (memv t2042 (quote (map))) (let ((ls2043 (map regen2040 (cdr x2041)))) (build-annotated1189 #f (cons (if (fx=1182 (length ls2043) 2) (build-annotated1189 #f (quote map)) (build-annotated1189 #f (quote map))) ls2043))) (build-annotated1189 #f (cons (build-annotated1189 #f (car x2041)) (map regen2040 (cdr x2041)))))))))))) (gen-vector2039 (lambda (x2044) (cond ((eq? (car x2044) (quote list)) (cons (quote vector) (cdr x2044))) ((eq? (car x2044) (quote quote)) (list (quote quote) (list->vector (cadr x2044)))) (else (list (quote list->vector) x2044))))) (gen-append2038 (lambda (x2045 y2046) (if (equal? y2046 (quote (quote ()))) x2045 (list (quote append) x2045 y2046)))) (gen-cons2037 (lambda (x2047 y2048) (let ((t2049 (car y2048))) (if (memv t2049 (quote (quote))) (if (eq? (car x2047) (quote quote)) (list (quote quote) (cons (cadr x2047) (cadr y2048))) (if (eq? (cadr y2048) (quote ())) (list (quote list) x2047) (list (quote cons) x2047 y2048))) (if (memv t2049 (quote (list))) (cons (quote list) (cons x2047 (cdr y2048))) (list (quote cons) x2047 y2048)))))) (gen-map2036 (lambda (e2050 map-env2051) (let ((formals2052 (map cdr map-env2051)) (actuals2053 (map (lambda (x2054) (list (quote ref) (car x2054))) map-env2051))) (cond ((eq? (car e2050) (quote ref)) (car actuals2053)) ((andmap (lambda (x2055) (and (eq? (car x2055) (quote ref)) (memq (cadr x2055) formals2052))) (cdr e2050)) (cons (quote map) (cons (list (quote primitive) (car e2050)) (map (let ((r2056 (map cons formals2052 actuals2053))) (lambda (x2057) (cdr (assq (cadr x2057) r2056)))) (cdr e2050))))) (else (cons (quote map) (cons (list (quote lambda) formals2052 e2050) actuals2053))))))) (gen-mappend2035 (lambda (e2058 map-env2059) (list (quote apply) (quote (primitive append)) (gen-map2036 e2058 map-env2059)))) (gen-ref2034 (lambda (src2060 var2061 level2062 maps2063) (if (fx=1182 level2062 0) (values var2061 maps2063) (if (null? maps2063) (syntax-violation (quote syntax) "missing ellipsis" src2060) (call-with-values (lambda () (gen-ref2034 src2060 var2061 (fx-1181 level2062 1) (cdr maps2063))) (lambda (outer-var2064 outer-maps2065) (let ((b2066 (assq outer-var2064 (car maps2063)))) (if b2066 (values (cdr b2066) maps2063) (let ((inner-var2067 (gen-var1260 (quote tmp)))) (values inner-var2067 (cons (cons (cons outer-var2064 inner-var2067) (car maps2063)) outer-maps2065))))))))))) (gen-syntax2033 (lambda (src2068 e2069 r2070 maps2071 ellipsis?2072 mod2073) (if (id?1212 e2069) (let ((label2074 (id-var-name1234 e2069 (quote (()))))) (let ((b2075 (lookup1209 label2074 r2070 mod2073))) (if (eq? (binding-type1204 b2075) (quote syntax)) (call-with-values (lambda () (let ((var.lev2076 (binding-value1205 b2075))) (gen-ref2034 src2068 (car var.lev2076) (cdr var.lev2076) maps2071))) (lambda (var2077 maps2078) (values (list (quote ref) var2077) maps2078))) (if (ellipsis?2072 e2069) (syntax-violation (quote syntax) "misplaced ellipsis" src2068) (values (list (quote quote) e2069) maps2071))))) ((lambda (tmp2079) ((lambda (tmp2080) (if (if tmp2080 (apply (lambda (dots2081 e2082) (ellipsis?2072 dots2081)) tmp2080) #f) (apply (lambda (dots2083 e2084) (gen-syntax2033 src2068 e2084 r2070 maps2071 (lambda (x2085) #f) mod2073)) tmp2080) ((lambda (tmp2086) (if (if tmp2086 (apply (lambda (x2087 dots2088 y2089) (ellipsis?2072 dots2088)) tmp2086) #f) (apply (lambda (x2090 dots2091 y2092) (let f2093 ((y2094 y2092) (k2095 (lambda (maps2096) (call-with-values (lambda () (gen-syntax2033 src2068 x2090 r2070 (cons (quote ()) maps2096) ellipsis?2072 mod2073)) (lambda (x2097 maps2098) (if (null? (car maps2098)) (syntax-violation (quote syntax) "extra ellipsis" src2068) (values (gen-map2036 x2097 (car maps2098)) (cdr maps2098)))))))) ((lambda (tmp2099) ((lambda (tmp2100) (if (if tmp2100 (apply (lambda (dots2101 y2102) (ellipsis?2072 dots2101)) tmp2100) #f) (apply (lambda (dots2103 y2104) (f2093 y2104 (lambda (maps2105) (call-with-values (lambda () (k2095 (cons (quote ()) maps2105))) (lambda (x2106 maps2107) (if (null? (car maps2107)) (syntax-violation (quote syntax) "extra ellipsis" src2068) (values (gen-mappend2035 x2106 (car maps2107)) (cdr maps2107)))))))) tmp2100) ((lambda (_2108) (call-with-values (lambda () (gen-syntax2033 src2068 y2094 r2070 maps2071 ellipsis?2072 mod2073)) (lambda (y2109 maps2110) (call-with-values (lambda () (k2095 maps2110)) (lambda (x2111 maps2112) (values (gen-append2038 x2111 y2109) maps2112)))))) tmp2099))) ($sc-dispatch tmp2099 (quote (any . any))))) y2094))) tmp2086) ((lambda (tmp2113) (if tmp2113 (apply (lambda (x2114 y2115) (call-with-values (lambda () (gen-syntax2033 src2068 x2114 r2070 maps2071 ellipsis?2072 mod2073)) (lambda (x2116 maps2117) (call-with-values (lambda () (gen-syntax2033 src2068 y2115 r2070 maps2117 ellipsis?2072 mod2073)) (lambda (y2118 maps2119) (values (gen-cons2037 x2116 y2118) maps2119)))))) tmp2113) ((lambda (tmp2120) (if tmp2120 (apply (lambda (e12121 e22122) (call-with-values (lambda () (gen-syntax2033 src2068 (cons e12121 e22122) r2070 maps2071 ellipsis?2072 mod2073)) (lambda (e2124 maps2125) (values (gen-vector2039 e2124) maps2125)))) tmp2120) ((lambda (_2126) (values (list (quote quote) e2069) maps2071)) tmp2079))) ($sc-dispatch tmp2079 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2079 (quote (any . any)))))) ($sc-dispatch tmp2079 (quote (any any . any)))))) ($sc-dispatch tmp2079 (quote (any any))))) e2069))))) (lambda (e2127 r2128 w2129 s2130 mod2131) (let ((e2132 (source-wrap1241 e2127 w2129 s2130 mod2131))) ((lambda (tmp2133) ((lambda (tmp2134) (if tmp2134 (apply (lambda (_2135 x2136) (call-with-values (lambda () (gen-syntax2033 e2132 x2136 r2128 (quote ()) ellipsis?1257 mod2131)) (lambda (e2137 maps2138) (regen2040 e2137)))) tmp2134) ((lambda (_2139) (syntax-violation (quote syntax) "bad `syntax' form" e2132)) tmp2133))) ($sc-dispatch tmp2133 (quote (any any))))) e2132))))) (global-extend1210 (quote core) (quote lambda) (lambda (e2140 r2141 w2142 s2143 mod2144) ((lambda (tmp2145) ((lambda (tmp2146) (if tmp2146 (apply (lambda (_2147 c2148) (chi-lambda-clause1253 (source-wrap1241 e2140 w2142 s2143 mod2144) #f c2148 r2141 w2142 mod2144 (lambda (vars2149 docstring2150 body2151) (build-annotated1189 s2143 (cons (quote lambda) (cons vars2149 (append (if docstring2150 (list docstring2150) (quote ())) (list body2151)))))))) tmp2146) (syntax-violation #f "source expression failed to match any pattern" tmp2145))) ($sc-dispatch tmp2145 (quote (any . any))))) e2140))) (global-extend1210 (quote core) (quote let) (letrec ((chi-let2152 (lambda (e2153 r2154 w2155 s2156 mod2157 constructor2158 ids2159 vals2160 exps2161) (if (not (valid-bound-ids?1237 ids2159)) (syntax-violation (quote let) "duplicate bound variable" e2153) (let ((labels2162 (gen-labels1218 ids2159)) (new-vars2163 (map gen-var1260 ids2159))) (let ((nw2164 (make-binding-wrap1229 ids2159 labels2162 w2155)) (nr2165 (extend-var-env1207 labels2162 new-vars2163 r2154))) (constructor2158 s2156 new-vars2163 (map (lambda (x2166) (chi1248 x2166 r2154 w2155 mod2157)) vals2160) (chi-body1252 exps2161 (source-wrap1241 e2153 nw2164 s2156 mod2157) nr2165 nw2164 mod2157)))))))) (lambda (e2167 r2168 w2169 s2170 mod2171) ((lambda (tmp2172) ((lambda (tmp2173) (if tmp2173 (apply (lambda (_2174 id2175 val2176 e12177 e22178) (chi-let2152 e2167 r2168 w2169 s2170 mod2171 build-let1192 id2175 val2176 (cons e12177 e22178))) tmp2173) ((lambda (tmp2182) (if (if tmp2182 (apply (lambda (_2183 f2184 id2185 val2186 e12187 e22188) (id?1212 f2184)) tmp2182) #f) (apply (lambda (_2189 f2190 id2191 val2192 e12193 e22194) (chi-let2152 e2167 r2168 w2169 s2170 mod2171 build-named-let1193 (cons f2190 id2191) val2192 (cons e12193 e22194))) tmp2182) ((lambda (_2198) (syntax-violation (quote let) "bad let" (source-wrap1241 e2167 w2169 s2170 mod2171))) tmp2172))) ($sc-dispatch tmp2172 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2172 (quote (any #(each (any any)) any . each-any))))) e2167)))) (global-extend1210 (quote core) (quote letrec) (lambda (e2199 r2200 w2201 s2202 mod2203) ((lambda (tmp2204) ((lambda (tmp2205) (if tmp2205 (apply (lambda (_2206 id2207 val2208 e12209 e22210) (let ((ids2211 id2207)) (if (not (valid-bound-ids?1237 ids2211)) (syntax-violation (quote letrec) "duplicate bound variable" e2199) (let ((labels2213 (gen-labels1218 ids2211)) (new-vars2214 (map gen-var1260 ids2211))) (let ((w2215 (make-binding-wrap1229 ids2211 labels2213 w2201)) (r2216 (extend-var-env1207 labels2213 new-vars2214 r2200))) (build-letrec1194 s2202 new-vars2214 (map (lambda (x2217) (chi1248 x2217 r2216 w2215 mod2203)) val2208) (chi-body1252 (cons e12209 e22210) (source-wrap1241 e2199 w2215 s2202 mod2203) r2216 w2215 mod2203))))))) tmp2205) ((lambda (_2220) (syntax-violation (quote letrec) "bad letrec" (source-wrap1241 e2199 w2201 s2202 mod2203))) tmp2204))) ($sc-dispatch tmp2204 (quote (any #(each (any any)) any . each-any))))) e2199))) (global-extend1210 (quote core) (quote set!) (lambda (e2221 r2222 w2223 s2224 mod2225) ((lambda (tmp2226) ((lambda (tmp2227) (if (if tmp2227 (apply (lambda (_2228 id2229 val2230) (id?1212 id2229)) tmp2227) #f) (apply (lambda (_2231 id2232 val2233) (let ((val2234 (chi1248 val2233 r2222 w2223 mod2225)) (n2235 (id-var-name1234 id2232 w2223))) (let ((b2236 (lookup1209 n2235 r2222 mod2225))) (let ((t2237 (binding-type1204 b2236))) (if (memv t2237 (quote (lexical))) (build-annotated1189 s2224 (list (quote set!) (binding-value1205 b2236) val2234)) (if (memv t2237 (quote (global))) (build-annotated1189 s2224 (list (quote set!) (if mod2225 (make-module-ref (cdr mod2225) n2235 (car mod2225)) (make-module-ref mod2225 n2235 (quote bare))) val2234)) (if (memv t2237 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1240 id2232 w2223 mod2225)) (syntax-violation (quote set!) "bad set!" (source-wrap1241 e2221 w2223 s2224 mod2225))))))))) tmp2227) ((lambda (tmp2238) (if tmp2238 (apply (lambda (_2239 head2240 tail2241 val2242) (call-with-values (lambda () (syntax-type1246 head2240 r2222 (quote (())) #f #f mod2225)) (lambda (type2243 value2244 ee2245 ww2246 ss2247 modmod2248) (let ((t2249 type2243)) (if (memv t2249 (quote (module-ref))) (let ((val2250 (chi1248 val2242 r2222 w2223 mod2225))) (call-with-values (lambda () (value2244 (cons head2240 tail2241))) (lambda (id2252 mod2253) (build-annotated1189 s2224 (list (quote set!) (if mod2253 (make-module-ref (cdr mod2253) id2252 (car mod2253)) (make-module-ref mod2253 id2252 (quote bare))) val2250))))) (build-annotated1189 s2224 (cons (chi1248 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2240) r2222 w2223 mod2225) (map (lambda (e2254) (chi1248 e2254 r2222 w2223 mod2225)) (append tail2241 (list val2242)))))))))) tmp2238) ((lambda (_2256) (syntax-violation (quote set!) "bad set!" (source-wrap1241 e2221 w2223 s2224 mod2225))) tmp2226))) ($sc-dispatch tmp2226 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2226 (quote (any any any))))) e2221))) (global-extend1210 (quote module-ref) (quote @) (lambda (e2257) ((lambda (tmp2258) ((lambda (tmp2259) (if (if tmp2259 (apply (lambda (_2260 mod2261 id2262) (and (andmap id?1212 mod2261) (id?1212 id2262))) tmp2259) #f) (apply (lambda (_2264 mod2265 id2266) (values (syntax->datum id2266) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2265)))) tmp2259) (syntax-violation #f "source expression failed to match any pattern" tmp2258))) ($sc-dispatch tmp2258 (quote (any each-any any))))) e2257))) (global-extend1210 (quote module-ref) (quote @@) (lambda (e2268) ((lambda (tmp2269) ((lambda (tmp2270) (if (if tmp2270 (apply (lambda (_2271 mod2272 id2273) (and (andmap id?1212 mod2272) (id?1212 id2273))) tmp2270) #f) (apply (lambda (_2275 mod2276 id2277) (values (syntax->datum id2277) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2276)))) tmp2270) (syntax-violation #f "source expression failed to match any pattern" tmp2269))) ($sc-dispatch tmp2269 (quote (any each-any any))))) e2268))) (global-extend1210 (quote begin) (quote begin) (quote ())) (global-extend1210 (quote define) (quote define) (quote ())) (global-extend1210 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1210 (quote eval-when) (quote eval-when) (quote ())) (global-extend1210 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2282 (lambda (x2283 keys2284 clauses2285 r2286 mod2287) (if (null? clauses2285) (build-annotated1189 #f (list (build-annotated1189 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2283)) ((lambda (tmp2288) ((lambda (tmp2289) (if tmp2289 (apply (lambda (pat2290 exp2291) (if (and (id?1212 pat2290) (andmap (lambda (x2292) (not (free-id=?1235 pat2290 x2292))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2284))) (let ((labels2293 (list (gen-label1217))) (var2294 (gen-var1260 pat2290))) (build-annotated1189 #f (list (build-annotated1189 #f (list (quote lambda) (list var2294) (chi1248 exp2291 (extend-env1206 labels2293 (list (cons (quote syntax) (cons var2294 0))) r2286) (make-binding-wrap1229 (list pat2290) labels2293 (quote (()))) mod2287))) x2283))) (gen-clause2281 x2283 keys2284 (cdr clauses2285) r2286 pat2290 #t exp2291 mod2287))) tmp2289) ((lambda (tmp2295) (if tmp2295 (apply (lambda (pat2296 fender2297 exp2298) (gen-clause2281 x2283 keys2284 (cdr clauses2285) r2286 pat2296 fender2297 exp2298 mod2287)) tmp2295) ((lambda (_2299) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2285))) tmp2288))) ($sc-dispatch tmp2288 (quote (any any any)))))) ($sc-dispatch tmp2288 (quote (any any))))) (car clauses2285))))) (gen-clause2281 (lambda (x2300 keys2301 clauses2302 r2303 pat2304 fender2305 exp2306 mod2307) (call-with-values (lambda () (convert-pattern2279 pat2304 keys2301)) (lambda (p2308 pvars2309) (cond ((not (distinct-bound-ids?1238 (map car pvars2309))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2304)) ((not (andmap (lambda (x2310) (not (ellipsis?1257 (car x2310)))) pvars2309)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2304)) (else (let ((y2311 (gen-var1260 (quote tmp)))) (build-annotated1189 #f (list (build-annotated1189 #f (list (quote lambda) (list y2311) (let ((y2312 (build-annotated1189 #f y2311))) (build-annotated1189 #f (list (quote if) ((lambda (tmp2313) ((lambda (tmp2314) (if tmp2314 (apply (lambda () y2312) tmp2314) ((lambda (_2315) (build-annotated1189 #f (list (quote if) y2312 (build-dispatch-call2280 pvars2309 fender2305 y2312 r2303 mod2307) (build-data1190 #f #f)))) tmp2313))) ($sc-dispatch tmp2313 (quote #(atom #t))))) fender2305) (build-dispatch-call2280 pvars2309 exp2306 y2312 r2303 mod2307) (gen-syntax-case2282 x2300 keys2301 clauses2302 r2303 mod2307)))))) (if (eq? p2308 (quote any)) (build-annotated1189 #f (list (build-annotated1189 #f (quote list)) x2300)) (build-annotated1189 #f (list (build-annotated1189 #f (quote $sc-dispatch)) x2300 (build-data1190 #f p2308))))))))))))) (build-dispatch-call2280 (lambda (pvars2316 exp2317 y2318 r2319 mod2320) (let ((ids2321 (map car pvars2316)) (levels2322 (map cdr pvars2316))) (let ((labels2323 (gen-labels1218 ids2321)) (new-vars2324 (map gen-var1260 ids2321))) (build-annotated1189 #f (list (build-annotated1189 #f (quote apply)) (build-annotated1189 #f (list (quote lambda) new-vars2324 (chi1248 exp2317 (extend-env1206 labels2323 (map (lambda (var2325 level2326) (cons (quote syntax) (cons var2325 level2326))) new-vars2324 (map cdr pvars2316)) r2319) (make-binding-wrap1229 ids2321 labels2323 (quote (()))) mod2320))) y2318)))))) (convert-pattern2279 (lambda (pattern2327 keys2328) (let cvt2329 ((p2330 pattern2327) (n2331 0) (ids2332 (quote ()))) (if (id?1212 p2330) (if (bound-id-member?1239 p2330 keys2328) (values (vector (quote free-id) p2330) ids2332) (values (quote any) (cons (cons p2330 n2331) ids2332))) ((lambda (tmp2333) ((lambda (tmp2334) (if (if tmp2334 (apply (lambda (x2335 dots2336) (ellipsis?1257 dots2336)) tmp2334) #f) (apply (lambda (x2337 dots2338) (call-with-values (lambda () (cvt2329 x2337 (fx+1180 n2331 1) ids2332)) (lambda (p2339 ids2340) (values (if (eq? p2339 (quote any)) (quote each-any) (vector (quote each) p2339)) ids2340)))) tmp2334) ((lambda (tmp2341) (if tmp2341 (apply (lambda (x2342 y2343) (call-with-values (lambda () (cvt2329 y2343 n2331 ids2332)) (lambda (y2344 ids2345) (call-with-values (lambda () (cvt2329 x2342 n2331 ids2345)) (lambda (x2346 ids2347) (values (cons x2346 y2344) ids2347)))))) tmp2341) ((lambda (tmp2348) (if tmp2348 (apply (lambda () (values (quote ()) ids2332)) tmp2348) ((lambda (tmp2349) (if tmp2349 (apply (lambda (x2350) (call-with-values (lambda () (cvt2329 x2350 n2331 ids2332)) (lambda (p2352 ids2353) (values (vector (quote vector) p2352) ids2353)))) tmp2349) ((lambda (x2354) (values (vector (quote atom) (strip1259 p2330 (quote (())))) ids2332)) tmp2333))) ($sc-dispatch tmp2333 (quote #(vector each-any)))))) ($sc-dispatch tmp2333 (quote ()))))) ($sc-dispatch tmp2333 (quote (any . any)))))) ($sc-dispatch tmp2333 (quote (any any))))) p2330)))))) (lambda (e2355 r2356 w2357 s2358 mod2359) (let ((e2360 (source-wrap1241 e2355 w2357 s2358 mod2359))) ((lambda (tmp2361) ((lambda (tmp2362) (if tmp2362 (apply (lambda (_2363 val2364 key2365 m2366) (if (andmap (lambda (x2367) (and (id?1212 x2367) (not (ellipsis?1257 x2367)))) key2365) (let ((x2369 (gen-var1260 (quote tmp)))) (build-annotated1189 s2358 (list (build-annotated1189 #f (list (quote lambda) (list x2369) (gen-syntax-case2282 (build-annotated1189 #f x2369) key2365 m2366 r2356 mod2359))) (chi1248 val2364 r2356 (quote (())) mod2359)))) (syntax-violation (quote syntax-case) "invalid literals list" e2360))) tmp2362) (syntax-violation #f "source expression failed to match any pattern" tmp2361))) ($sc-dispatch tmp2361 (quote (any any each-any . each-any))))) e2360))))) (set! sc-expand (let ((m2372 (quote e)) (esew2373 (quote (eval)))) (lambda (x2374) (if (and (pair? x2374) (equal? (car x2374) noexpand1179)) (cadr x2374) (chi-top1247 x2374 (quote ()) (quote ((top))) m2372 esew2373 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2375 (quote e)) (esew2376 (quote (eval)))) (lambda (x2378 . rest2377) (if (and (pair? x2378) (equal? (car x2378) noexpand1179)) (cadr x2378) (chi-top1247 x2378 (quote ()) (quote ((top))) (if (null? rest2377) m2375 (car rest2377)) (if (or (null? rest2377) (null? (cdr rest2377))) esew2376 (cadr rest2377)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2379) (nonsymbol-id?1211 x2379))) (set! datum->syntax (lambda (id2380 datum2381) (make-syntax-object1195 datum2381 (syntax-object-wrap1198 id2380) #f))) (set! syntax->datum (lambda (x2382) (strip1259 x2382 (quote (()))))) (set! generate-temporaries (lambda (ls2383) (begin (let ((x2384 ls2383)) (if (not (list? x2384)) (error-hook1186 (quote generate-temporaries) "invalid argument" x2384))) (map (lambda (x2385) (wrap1240 (gensym) (quote ((top))) #f)) ls2383)))) (set! free-identifier=? (lambda (x2386 y2387) (begin (let ((x2388 x2386)) (if (not (nonsymbol-id?1211 x2388)) (error-hook1186 (quote free-identifier=?) "invalid argument" x2388))) (let ((x2389 y2387)) (if (not (nonsymbol-id?1211 x2389)) (error-hook1186 (quote free-identifier=?) "invalid argument" x2389))) (free-id=?1235 x2386 y2387)))) (set! bound-identifier=? (lambda (x2390 y2391) (begin (let ((x2392 x2390)) (if (not (nonsymbol-id?1211 x2392)) (error-hook1186 (quote bound-identifier=?) "invalid argument" x2392))) (let ((x2393 y2391)) (if (not (nonsymbol-id?1211 x2393)) (error-hook1186 (quote bound-identifier=?) "invalid argument" x2393))) (bound-id=?1236 x2390 y2391)))) (set! syntax-violation (lambda (who2397 message2396 form2395 . subform2394) (begin (let ((x2398 who2397)) (if (not ((lambda (x2399) (or (not x2399) (string? x2399) (symbol? x2399))) x2398)) (error-hook1186 (quote syntax-violation) "invalid argument" x2398))) (let ((x2400 message2396)) (if (not (string? x2400)) (error-hook1186 (quote syntax-violation) "invalid argument" x2400))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2397 "~a: " "") "~a " (if (null? subform2394) "in ~a" "in subform `~s' of `~s'")) (let ((tail2401 (cons message2396 (map (lambda (x2402) (strip1259 x2402 (quote (())))) (append subform2394 (list form2395)))))) (if who2397 (cons who2397 tail2401) tail2401)) #f)))) (letrec ((match2407 (lambda (e2408 p2409 w2410 r2411 mod2412) (cond ((not r2411) #f) ((eq? p2409 (quote any)) (cons (wrap1240 e2408 w2410 mod2412) r2411)) ((syntax-object?1196 e2408) (match*2406 (let ((e2413 (syntax-object-expression1197 e2408))) (if (annotation? e2413) (annotation-expression e2413) e2413)) p2409 (join-wraps1231 w2410 (syntax-object-wrap1198 e2408)) r2411 (syntax-object-module1199 e2408))) (else (match*2406 (let ((e2414 e2408)) (if (annotation? e2414) (annotation-expression e2414) e2414)) p2409 w2410 r2411 mod2412))))) (match*2406 (lambda (e2415 p2416 w2417 r2418 mod2419) (cond ((null? p2416) (and (null? e2415) r2418)) ((pair? p2416) (and (pair? e2415) (match2407 (car e2415) (car p2416) w2417 (match2407 (cdr e2415) (cdr p2416) w2417 r2418 mod2419) mod2419))) ((eq? p2416 (quote each-any)) (let ((l2420 (match-each-any2404 e2415 w2417 mod2419))) (and l2420 (cons l2420 r2418)))) (else (let ((t2421 (vector-ref p2416 0))) (if (memv t2421 (quote (each))) (if (null? e2415) (match-empty2405 (vector-ref p2416 1) r2418) (let ((l2422 (match-each2403 e2415 (vector-ref p2416 1) w2417 mod2419))) (and l2422 (let collect2423 ((l2424 l2422)) (if (null? (car l2424)) r2418 (cons (map car l2424) (collect2423 (map cdr l2424)))))))) (if (memv t2421 (quote (free-id))) (and (id?1212 e2415) (free-id=?1235 (wrap1240 e2415 w2417 mod2419) (vector-ref p2416 1)) r2418) (if (memv t2421 (quote (atom))) (and (equal? (vector-ref p2416 1) (strip1259 e2415 w2417)) r2418) (if (memv t2421 (quote (vector))) (and (vector? e2415) (match2407 (vector->list e2415) (vector-ref p2416 1) w2417 r2418 mod2419))))))))))) (match-empty2405 (lambda (p2425 r2426) (cond ((null? p2425) r2426) ((eq? p2425 (quote any)) (cons (quote ()) r2426)) ((pair? p2425) (match-empty2405 (car p2425) (match-empty2405 (cdr p2425) r2426))) ((eq? p2425 (quote each-any)) (cons (quote ()) r2426)) (else (let ((t2427 (vector-ref p2425 0))) (if (memv t2427 (quote (each))) (match-empty2405 (vector-ref p2425 1) r2426) (if (memv t2427 (quote (free-id atom))) r2426 (if (memv t2427 (quote (vector))) (match-empty2405 (vector-ref p2425 1) r2426))))))))) (match-each-any2404 (lambda (e2428 w2429 mod2430) (cond ((annotation? e2428) (match-each-any2404 (annotation-expression e2428) w2429 mod2430)) ((pair? e2428) (let ((l2431 (match-each-any2404 (cdr e2428) w2429 mod2430))) (and l2431 (cons (wrap1240 (car e2428) w2429 mod2430) l2431)))) ((null? e2428) (quote ())) ((syntax-object?1196 e2428) (match-each-any2404 (syntax-object-expression1197 e2428) (join-wraps1231 w2429 (syntax-object-wrap1198 e2428)) mod2430)) (else #f)))) (match-each2403 (lambda (e2432 p2433 w2434 mod2435) (cond ((annotation? e2432) (match-each2403 (annotation-expression e2432) p2433 w2434 mod2435)) ((pair? e2432) (let ((first2436 (match2407 (car e2432) p2433 w2434 (quote ()) mod2435))) (and first2436 (let ((rest2437 (match-each2403 (cdr e2432) p2433 w2434 mod2435))) (and rest2437 (cons first2436 rest2437)))))) ((null? e2432) (quote ())) ((syntax-object?1196 e2432) (match-each2403 (syntax-object-expression1197 e2432) p2433 (join-wraps1231 w2434 (syntax-object-wrap1198 e2432)) (syntax-object-module1199 e2432))) (else #f))))) (set! $sc-dispatch (lambda (e2438 p2439) (cond ((eq? p2439 (quote any)) (list e2438)) ((syntax-object?1196 e2438) (match*2406 (let ((e2440 (syntax-object-expression1197 e2438))) (if (annotation? e2440) (annotation-expression e2440) e2440)) p2439 (syntax-object-wrap1198 e2438) (quote ()) (syntax-object-module1199 e2438))) (else (match*2406 (let ((e2441 e2438)) (if (annotation? e2441) (annotation-expression e2441) e2441)) p2439 (quote (())) (quote ()) #f))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (_2445 e12446 e22447) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12446 e22447))) tmp2444) ((lambda (tmp2449) (if tmp2449 (apply (lambda (_2450 out2451 in2452 e12453 e22454) (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))) in2452 (quote ()) (list out2451 (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 e12453 e22454))))) tmp2449) ((lambda (tmp2456) (if tmp2456 (apply (lambda (_2457 out2458 in2459 e12460 e22461) (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))) in2459) (quote ()) (list out2458 (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 e12460 e22461))))) tmp2456) (syntax-violation #f "source expression failed to match any pattern" tmp2443))) ($sc-dispatch tmp2443 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2443 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2443 (quote (any () any . each-any))))) x2442))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2465) ((lambda (tmp2466) ((lambda (tmp2467) (if tmp2467 (apply (lambda (_2468 k2469 keyword2470 pattern2471 template2472) (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 k2469 (map (lambda (tmp2475 tmp2474) (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))) tmp2474) (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))) tmp2475))) template2472 pattern2471)))))) tmp2467) (syntax-violation #f "source expression failed to match any pattern" tmp2466))) ($sc-dispatch tmp2466 (quote (any each-any . #(each ((any . any) any))))))) x2465))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2476) ((lambda (tmp2477) ((lambda (tmp2478) (if (if tmp2478 (apply (lambda (let*2479 x2480 v2481 e12482 e22483) (andmap identifier? x2480)) tmp2478) #f) (apply (lambda (let*2485 x2486 v2487 e12488 e22489) (let f2490 ((bindings2491 (map list x2486 v2487))) (if (null? bindings2491) (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 e12488 e22489))) ((lambda (tmp2495) ((lambda (tmp2496) (if tmp2496 (apply (lambda (body2497 binding2498) (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 binding2498) body2497)) tmp2496) (syntax-violation #f "source expression failed to match any pattern" tmp2495))) ($sc-dispatch tmp2495 (quote (any any))))) (list (f2490 (cdr bindings2491)) (car bindings2491)))))) tmp2478) (syntax-violation #f "source expression failed to match any pattern" tmp2477))) ($sc-dispatch tmp2477 (quote (any #(each (any any)) any . each-any))))) x2476))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2499) ((lambda (tmp2500) ((lambda (tmp2501) (if tmp2501 (apply (lambda (_2502 var2503 init2504 step2505 e02506 e12507 c2508) ((lambda (tmp2509) ((lambda (tmp2510) (if tmp2510 (apply (lambda (step2511) ((lambda (tmp2512) ((lambda (tmp2513) (if tmp2513 (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 var2503 init2504) (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))) e02506) (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 c2508 (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))) step2511))))))) tmp2513) ((lambda (tmp2518) (if tmp2518 (apply (lambda (e12519 e22520) (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 var2503 init2504) (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))) e02506 (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 e12519 e22520)) (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 c2508 (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))) step2511))))))) tmp2518) (syntax-violation #f "source expression failed to match any pattern" tmp2512))) ($sc-dispatch tmp2512 (quote (any . each-any)))))) ($sc-dispatch tmp2512 (quote ())))) e12507)) tmp2510) (syntax-violation #f "source expression failed to match any pattern" tmp2509))) ($sc-dispatch tmp2509 (quote each-any)))) (map (lambda (v2527 s2528) ((lambda (tmp2529) ((lambda (tmp2530) (if tmp2530 (apply (lambda () v2527) tmp2530) ((lambda (tmp2531) (if tmp2531 (apply (lambda (e2532) e2532) tmp2531) ((lambda (_2533) (syntax-violation (quote do) "bad step expression" orig-x2499 s2528)) tmp2529))) ($sc-dispatch tmp2529 (quote (any)))))) ($sc-dispatch tmp2529 (quote ())))) s2528)) var2503 step2505))) tmp2501) (syntax-violation #f "source expression failed to match any pattern" tmp2500))) ($sc-dispatch tmp2500 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2499))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2536 (lambda (x2540 y2541) ((lambda (tmp2542) ((lambda (tmp2543) (if tmp2543 (apply (lambda (x2544 y2545) ((lambda (tmp2546) ((lambda (tmp2547) (if tmp2547 (apply (lambda (dy2548) ((lambda (tmp2549) ((lambda (tmp2550) (if tmp2550 (apply (lambda (dx2551) (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 dx2551 dy2548))) tmp2550) ((lambda (_2552) (if (null? dy2548) (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))) x2544) (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))) x2544 y2545))) tmp2549))) ($sc-dispatch tmp2549 (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))))) x2544)) tmp2547) ((lambda (tmp2553) (if tmp2553 (apply (lambda (stuff2554) (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 x2544 stuff2554))) tmp2553) ((lambda (else2555) (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))) x2544 y2545)) tmp2546))) ($sc-dispatch tmp2546 (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 tmp2546 (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))))) y2545)) tmp2543) (syntax-violation #f "source expression failed to match any pattern" tmp2542))) ($sc-dispatch tmp2542 (quote (any any))))) (list x2540 y2541)))) (quasiappend2537 (lambda (x2556 y2557) ((lambda (tmp2558) ((lambda (tmp2559) (if tmp2559 (apply (lambda (x2560 y2561) ((lambda (tmp2562) ((lambda (tmp2563) (if tmp2563 (apply (lambda () x2560) tmp2563) ((lambda (_2564) (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))) x2560 y2561)) tmp2562))) ($sc-dispatch tmp2562 (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))) ()))))) y2561)) tmp2559) (syntax-violation #f "source expression failed to match any pattern" tmp2558))) ($sc-dispatch tmp2558 (quote (any any))))) (list x2556 y2557)))) (quasivector2538 (lambda (x2565) ((lambda (tmp2566) ((lambda (x2567) ((lambda (tmp2568) ((lambda (tmp2569) (if tmp2569 (apply (lambda (x2570) (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 x2570))) tmp2569) ((lambda (tmp2572) (if tmp2572 (apply (lambda (x2573) (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))) x2573)) tmp2572) ((lambda (_2575) (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))) x2567)) tmp2568))) ($sc-dispatch tmp2568 (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 tmp2568 (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))))) x2567)) tmp2566)) x2565))) (quasi2539 (lambda (p2576 lev2577) ((lambda (tmp2578) ((lambda (tmp2579) (if tmp2579 (apply (lambda (p2580) (if (= lev2577 0) p2580 (quasicons2536 (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)))) (quasi2539 (list p2580) (- lev2577 1))))) tmp2579) ((lambda (tmp2581) (if tmp2581 (apply (lambda (p2582 q2583) (if (= lev2577 0) (quasiappend2537 p2582 (quasi2539 q2583 lev2577)) (quasicons2536 (quasicons2536 (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)))) (quasi2539 (list p2582) (- lev2577 1))) (quasi2539 q2583 lev2577)))) tmp2581) ((lambda (tmp2584) (if tmp2584 (apply (lambda (p2585) (quasicons2536 (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)))) (quasi2539 (list p2585) (+ lev2577 1)))) tmp2584) ((lambda (tmp2586) (if tmp2586 (apply (lambda (p2587 q2588) (quasicons2536 (quasi2539 p2587 lev2577) (quasi2539 q2588 lev2577))) tmp2586) ((lambda (tmp2589) (if tmp2589 (apply (lambda (x2590) (quasivector2538 (quasi2539 x2590 lev2577))) tmp2589) ((lambda (p2592) (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))) p2592)) tmp2578))) ($sc-dispatch tmp2578 (quote #(vector each-any)))))) ($sc-dispatch tmp2578 (quote (any . any)))))) ($sc-dispatch tmp2578 (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 tmp2578 (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 tmp2578 (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))))) p2576)))) (lambda (x2593) ((lambda (tmp2594) ((lambda (tmp2595) (if tmp2595 (apply (lambda (_2596 e2597) (quasi2539 e2597 0)) tmp2595) (syntax-violation #f "source expression failed to match any pattern" tmp2594))) ($sc-dispatch tmp2594 (quote (any any))))) x2593)))))
+(define include (make-syncase-macro (quote macro) (lambda (x2598) (letrec ((read-file2599 (lambda (fn2600 k2601) (let ((p2602 (open-input-file fn2600))) (let f2603 ((x2604 (read p2602))) (if (eof-object? x2604) (begin (close-input-port p2602) (quote ())) (cons (datum->syntax k2601 x2604) (f2603 (read p2602))))))))) ((lambda (tmp2605) ((lambda (tmp2606) (if tmp2606 (apply (lambda (k2607 filename2608) (let ((fn2609 (syntax->datum filename2608))) ((lambda (tmp2610) ((lambda (tmp2611) (if tmp2611 (apply (lambda (exp2612) (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))) exp2612)) tmp2611) (syntax-violation #f "source expression failed to match any pattern" tmp2610))) ($sc-dispatch tmp2610 (quote each-any)))) (read-file2599 fn2609 k2607)))) tmp2606) (syntax-violation #f "source expression failed to match any pattern" tmp2605))) ($sc-dispatch tmp2605 (quote (any any))))) x2598)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x2614) ((lambda (tmp2615) ((lambda (tmp2616) (if tmp2616 (apply (lambda (_2617 e2618) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2618))) tmp2616) (syntax-violation #f "source expression failed to match any pattern" tmp2615))) ($sc-dispatch tmp2615 (quote (any any))))) x2614))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2619) ((lambda (tmp2620) ((lambda (tmp2621) (if tmp2621 (apply (lambda (_2622 e2623) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2623))) tmp2621) (syntax-violation #f "source expression failed to match any pattern" tmp2620))) ($sc-dispatch tmp2620 (quote (any any))))) x2619))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2624) ((lambda (tmp2625) ((lambda (tmp2626) (if tmp2626 (apply (lambda (_2627 e2628 m12629 m22630) ((lambda (tmp2631) ((lambda (body2632) (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))) e2628)) body2632)) tmp2631)) (let f2633 ((clause2634 m12629) (clauses2635 m22630)) (if (null? clauses2635) ((lambda (tmp2637) ((lambda (tmp2638) (if tmp2638 (apply (lambda (e12639 e22640) (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 e12639 e22640))) tmp2638) ((lambda (tmp2642) (if tmp2642 (apply (lambda (k2643 e12644 e22645) (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))) k2643)) (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 e12644 e22645)))) tmp2642) ((lambda (_2648) (syntax-violation (quote case) "bad clause" x2624 clause2634)) tmp2637))) ($sc-dispatch tmp2637 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2637 (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))))) clause2634) ((lambda (tmp2649) ((lambda (rest2650) ((lambda (tmp2651) ((lambda (tmp2652) (if tmp2652 (apply (lambda (k2653 e12654 e22655) (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))) k2653)) (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 e12654 e22655)) rest2650)) tmp2652) ((lambda (_2658) (syntax-violation (quote case) "bad clause" x2624 clause2634)) tmp2651))) ($sc-dispatch tmp2651 (quote (each-any any . each-any))))) clause2634)) tmp2649)) (f2633 (car clauses2635) (cdr clauses2635))))))) tmp2626) (syntax-violation #f "source expression failed to match any pattern" tmp2625))) ($sc-dispatch tmp2625 (quote (any any any . each-any))))) x2624))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2659) ((lambda (tmp2660) ((lambda (tmp2661) (if tmp2661 (apply (lambda (_2662 e2663) (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))) e2663)) (list (cons _2662 (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 e2663 (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)))))))))) tmp2661) (syntax-violation #f "source expression failed to match any pattern" tmp2660))) ($sc-dispatch tmp2660 (quote (any any))))) x2659))))
HCoop / bpt / guile.git / blobdiff