\f
-;; Before the module system boots, there are no module names. But
-;; psyntax does want a module-name definition, so give it one.
+;; Define a minimal stub of the module API for psyntax, before modules
+;; have booted.
(define (module-name x)
'(guile))
-(define (module-add! module sym var)
- (hashq-set! (%get-pre-modules-obarray) sym var))
(define (module-define! module sym val)
(let ((v (hashq-ref (%get-pre-modules-obarray) sym)))
(if v
(define (module-ref module sym)
(let ((v (module-variable module sym)))
(if v (variable-ref v) (error "badness!" (pk module) (pk sym)))))
+(define (resolve-module . args)
+ #f)
(define (make-module-ref mod var kind)
(case kind
`(@@ ,mod ,var)
var))
(else (error "foo" mod var kind))))
-(define (resolve-module . args)
- #f)
;;; API provided by psyntax
(define syntax-violation #f)
(define $sc-dispatch #f)
;;; Useless crap I'd like to get rid of
-(define install-global-transformer #f)
(define (annotation? x) #f)
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(void)
-(letrec ((lambda-var-list1131 (lambda (vars1336) (let lvl1337 ((vars1338 vars1336) (ls1339 (quote ())) (w1340 (quote (())))) (cond ((pair? vars1338) (lvl1337 (cdr vars1338) (cons (wrap1110 (car vars1338) w1340 #f) ls1339) w1340)) ((id?1082 vars1338) (cons (wrap1110 vars1338 w1340 #f) ls1339)) ((null? vars1338) ls1339) ((syntax-object?1066 vars1338) (lvl1337 (syntax-object-expression1067 vars1338) ls1339 (join-wraps1101 w1340 (syntax-object-wrap1068 vars1338)))) ((annotation? vars1338) (lvl1337 (annotation-expression vars1338) ls1339 w1340)) (else (cons vars1338 ls1339)))))) (gen-var1130 (lambda (id1341) (let ((id1342 (if (syntax-object?1066 id1341) (syntax-object-expression1067 id1341) id1341))) (if (annotation? id1342) (build-annotated1059 (annotation-source id1342) (gensym (symbol->string (annotation-expression id1342)))) (build-annotated1059 #f (gensym (symbol->string id1342))))))) (strip1129 (lambda (x1343 w1344) (if (memq (quote top) (wrap-marks1085 w1344)) (if (or (annotation? x1343) (and (pair? x1343) (annotation? (car x1343)))) (strip-annotation1128 x1343 #f) x1343) (let f1345 ((x1346 x1343)) (cond ((syntax-object?1066 x1346) (strip1129 (syntax-object-expression1067 x1346) (syntax-object-wrap1068 x1346))) ((pair? x1346) (let ((a1347 (f1345 (car x1346))) (d1348 (f1345 (cdr x1346)))) (if (and (eq? a1347 (car x1346)) (eq? d1348 (cdr x1346))) x1346 (cons a1347 d1348)))) ((vector? x1346) (let ((old1349 (vector->list x1346))) (let ((new1350 (map f1345 old1349))) (if (andmap eq? old1349 new1350) x1346 (list->vector new1350))))) (else x1346)))))) (strip-annotation1128 (lambda (x1351 parent1352) (cond ((pair? x1351) (let ((new1353 (cons #f #f))) (begin (if parent1352 (set-annotation-stripped! parent1352 new1353)) (set-car! new1353 (strip-annotation1128 (car x1351) #f)) (set-cdr! new1353 (strip-annotation1128 (cdr x1351) #f)) new1353))) ((annotation? x1351) (or (annotation-stripped x1351) (strip-annotation1128 (annotation-expression x1351) x1351))) ((vector? x1351) (let ((new1354 (make-vector (vector-length x1351)))) (begin (if parent1352 (set-annotation-stripped! parent1352 new1354)) (let loop1355 ((i1356 (- (vector-length x1351) 1))) (unless (fx<1053 i1356 0) (vector-set! new1354 i1356 (strip-annotation1128 (vector-ref x1351 i1356) #f)) (loop1355 (fx-1051 i1356 1)))) new1354))) (else x1351)))) (ellipsis?1127 (lambda (x1357) (and (nonsymbol-id?1081 x1357) (free-id=?1105 x1357 (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-void1126 (lambda () (build-annotated1059 #f (list (build-annotated1059 #f (quote void)))))) (eval-local-transformer1125 (lambda (expanded1358 mod1359) (let ((p1360 (local-eval-hook1055 expanded1358 mod1359))) (if (procedure? p1360) p1360 (syntax-violation #f "nonprocedure transformer" p1360))))) (chi-local-syntax1124 (lambda (rec?1361 e1362 r1363 w1364 s1365 mod1366 k1367) ((lambda (tmp1368) ((lambda (tmp1369) (if tmp1369 (apply (lambda (_1370 id1371 val1372 e11373 e21374) (let ((ids1375 id1371)) (if (not (valid-bound-ids?1107 ids1375)) (syntax-violation #f "duplicate bound keyword" e1362) (let ((labels1377 (gen-labels1088 ids1375))) (let ((new-w1378 (make-binding-wrap1099 ids1375 labels1377 w1364))) (k1367 (cons e11373 e21374) (extend-env1076 labels1377 (let ((w1380 (if rec?1361 new-w1378 w1364)) (trans-r1381 (macros-only-env1078 r1363))) (map (lambda (x1382) (cons (quote macro) (eval-local-transformer1125 (chi1118 x1382 trans-r1381 w1380 mod1366) mod1366))) val1372)) r1363) new-w1378 s1365 mod1366)))))) tmp1369) ((lambda (_1384) (syntax-violation #f "bad local syntax definition" (source-wrap1111 e1362 w1364 s1365 mod1366))) tmp1368))) ($sc-dispatch tmp1368 (quote (any #(each (any any)) any . each-any))))) e1362))) (chi-lambda-clause1123 (lambda (e1385 docstring1386 c1387 r1388 w1389 mod1390 k1391) ((lambda (tmp1392) ((lambda (tmp1393) (if (if tmp1393 (apply (lambda (args1394 doc1395 e11396 e21397) (and (string? (syntax->datum doc1395)) (not docstring1386))) tmp1393) #f) (apply (lambda (args1398 doc1399 e11400 e21401) (chi-lambda-clause1123 e1385 doc1399 (cons args1398 (cons e11400 e21401)) r1388 w1389 mod1390 k1391)) tmp1393) ((lambda (tmp1403) (if tmp1403 (apply (lambda (id1404 e11405 e21406) (let ((ids1407 id1404)) (if (not (valid-bound-ids?1107 ids1407)) (syntax-violation (quote lambda) "invalid parameter list" e1385) (let ((labels1409 (gen-labels1088 ids1407)) (new-vars1410 (map gen-var1130 ids1407))) (k1391 new-vars1410 docstring1386 (chi-body1122 (cons e11405 e21406) e1385 (extend-var-env1077 labels1409 new-vars1410 r1388) (make-binding-wrap1099 ids1407 labels1409 w1389) mod1390)))))) tmp1403) ((lambda (tmp1412) (if tmp1412 (apply (lambda (ids1413 e11414 e21415) (let ((old-ids1416 (lambda-var-list1131 ids1413))) (if (not (valid-bound-ids?1107 old-ids1416)) (syntax-violation (quote lambda) "invalid parameter list" e1385) (let ((labels1417 (gen-labels1088 old-ids1416)) (new-vars1418 (map gen-var1130 old-ids1416))) (k1391 (let f1419 ((ls11420 (cdr new-vars1418)) (ls21421 (car new-vars1418))) (if (null? ls11420) ls21421 (f1419 (cdr ls11420) (cons (car ls11420) ls21421)))) docstring1386 (chi-body1122 (cons e11414 e21415) e1385 (extend-var-env1077 labels1417 new-vars1418 r1388) (make-binding-wrap1099 old-ids1416 labels1417 w1389) mod1390)))))) tmp1412) ((lambda (_1423) (syntax-violation (quote lambda) "bad lambda" e1385)) tmp1392))) ($sc-dispatch tmp1392 (quote (any any . each-any)))))) ($sc-dispatch tmp1392 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1392 (quote (any any any . each-any))))) c1387))) (chi-body1122 (lambda (body1424 outer-form1425 r1426 w1427 mod1428) (let ((r1429 (cons (quote ("placeholder" placeholder)) r1426))) (let ((ribcage1430 (make-ribcage1089 (quote ()) (quote ()) (quote ())))) (let ((w1431 (make-wrap1084 (wrap-marks1085 w1427) (cons ribcage1430 (wrap-subst1086 w1427))))) (let parse1432 ((body1433 (map (lambda (x1439) (cons r1429 (wrap1110 x1439 w1431 mod1428))) body1424)) (ids1434 (quote ())) (labels1435 (quote ())) (vars1436 (quote ())) (vals1437 (quote ())) (bindings1438 (quote ()))) (if (null? body1433) (syntax-violation #f "no expressions in body" outer-form1425) (let ((e1440 (cdar body1433)) (er1441 (caar body1433))) (call-with-values (lambda () (syntax-type1116 e1440 er1441 (quote (())) #f ribcage1430 mod1428)) (lambda (type1442 value1443 e1444 w1445 s1446 mod1447) (let ((t1448 type1442)) (if (memv t1448 (quote (define-form))) (let ((id1449 (wrap1110 value1443 w1445 mod1447)) (label1450 (gen-label1087))) (let ((var1451 (gen-var1130 id1449))) (begin (extend-ribcage!1098 ribcage1430 id1449 label1450) (parse1432 (cdr body1433) (cons id1449 ids1434) (cons label1450 labels1435) (cons var1451 vars1436) (cons (cons er1441 (wrap1110 e1444 w1445 mod1447)) vals1437) (cons (cons (quote lexical) var1451) bindings1438))))) (if (memv t1448 (quote (define-syntax-form))) (let ((id1452 (wrap1110 value1443 w1445 mod1447)) (label1453 (gen-label1087))) (begin (extend-ribcage!1098 ribcage1430 id1452 label1453) (parse1432 (cdr body1433) (cons id1452 ids1434) (cons label1453 labels1435) vars1436 vals1437 (cons (cons (quote macro) (cons er1441 (wrap1110 e1444 w1445 mod1447))) bindings1438)))) (if (memv t1448 (quote (begin-form))) ((lambda (tmp1454) ((lambda (tmp1455) (if tmp1455 (apply (lambda (_1456 e11457) (parse1432 (let f1458 ((forms1459 e11457)) (if (null? forms1459) (cdr body1433) (cons (cons er1441 (wrap1110 (car forms1459) w1445 mod1447)) (f1458 (cdr forms1459))))) ids1434 labels1435 vars1436 vals1437 bindings1438)) tmp1455) (syntax-violation #f "source expression failed to match any pattern" tmp1454))) ($sc-dispatch tmp1454 (quote (any . each-any))))) e1444) (if (memv t1448 (quote (local-syntax-form))) (chi-local-syntax1124 value1443 e1444 er1441 w1445 s1446 mod1447 (lambda (forms1461 er1462 w1463 s1464 mod1465) (parse1432 (let f1466 ((forms1467 forms1461)) (if (null? forms1467) (cdr body1433) (cons (cons er1462 (wrap1110 (car forms1467) w1463 mod1465)) (f1466 (cdr forms1467))))) ids1434 labels1435 vars1436 vals1437 bindings1438))) (if (null? ids1434) (build-sequence1061 #f (map (lambda (x1468) (chi1118 (cdr x1468) (car x1468) (quote (())) mod1447)) (cons (cons er1441 (source-wrap1111 e1444 w1445 s1446 mod1447)) (cdr body1433)))) (begin (if (not (valid-bound-ids?1107 ids1434)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1425)) (let loop1469 ((bs1470 bindings1438) (er-cache1471 #f) (r-cache1472 #f)) (if (not (null? bs1470)) (let ((b1473 (car bs1470))) (if (eq? (car b1473) (quote macro)) (let ((er1474 (cadr b1473))) (let ((r-cache1475 (if (eq? er1474 er-cache1471) r-cache1472 (macros-only-env1078 er1474)))) (begin (set-cdr! b1473 (eval-local-transformer1125 (chi1118 (cddr b1473) r-cache1475 (quote (())) mod1447) mod1447)) (loop1469 (cdr bs1470) er1474 r-cache1475)))) (loop1469 (cdr bs1470) er-cache1471 r-cache1472))))) (set-cdr! r1429 (extend-env1076 labels1435 bindings1438 (cdr r1429))) (build-letrec1064 #f vars1436 (map (lambda (x1476) (chi1118 (cdr x1476) (car x1476) (quote (())) mod1447)) vals1437) (build-sequence1061 #f (map (lambda (x1477) (chi1118 (cdr x1477) (car x1477) (quote (())) mod1447)) (cons (cons er1441 (source-wrap1111 e1444 w1445 s1446 mod1447)) (cdr body1433)))))))))))))))))))))) (chi-macro1121 (lambda (p1478 e1479 r1480 w1481 rib1482 mod1483) (letrec ((rebuild-macro-output1484 (lambda (x1485 m1486) (cond ((pair? x1485) (cons (rebuild-macro-output1484 (car x1485) m1486) (rebuild-macro-output1484 (cdr x1485) m1486))) ((syntax-object?1066 x1485) (let ((w1487 (syntax-object-wrap1068 x1485))) (let ((ms1488 (wrap-marks1085 w1487)) (s1489 (wrap-subst1086 w1487))) (if (and (pair? ms1488) (eq? (car ms1488) #f)) (make-syntax-object1065 (syntax-object-expression1067 x1485) (make-wrap1084 (cdr ms1488) (if rib1482 (cons rib1482 (cdr s1489)) (cdr s1489))) (syntax-object-module1069 x1485)) (make-syntax-object1065 (syntax-object-expression1067 x1485) (make-wrap1084 (cons m1486 ms1488) (if rib1482 (cons rib1482 (cons (quote shift) s1489)) (cons (quote shift) s1489))) (let ((pmod1490 (procedure-module p1478))) (if pmod1490 (cons (quote hygiene) (module-name pmod1490)) (quote (hygiene guile))))))))) ((vector? x1485) (let ((n1491 (vector-length x1485))) (let ((v1492 (make-vector n1491))) (let doloop1493 ((i1494 0)) (if (fx=1052 i1494 n1491) v1492 (begin (vector-set! v1492 i1494 (rebuild-macro-output1484 (vector-ref x1485 i1494) m1486)) (doloop1493 (fx+1050 i1494 1)))))))) ((symbol? x1485) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1111 e1479 w1481 s mod1483) x1485)) (else x1485))))) (rebuild-macro-output1484 (p1478 (wrap1110 e1479 (anti-mark1097 w1481) mod1483)) (string #\m))))) (chi-application1120 (lambda (x1495 e1496 r1497 w1498 s1499 mod1500) ((lambda (tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda (e01503 e11504) (build-annotated1059 s1499 (cons x1495 (map (lambda (e1505) (chi1118 e1505 r1497 w1498 mod1500)) e11504)))) tmp1502) (syntax-violation #f "source expression failed to match any pattern" tmp1501))) ($sc-dispatch tmp1501 (quote (any . each-any))))) e1496))) (chi-expr1119 (lambda (type1507 value1508 e1509 r1510 w1511 s1512 mod1513) (let ((t1514 type1507)) (if (memv t1514 (quote (lexical))) (build-annotated1059 s1512 value1508) (if (memv t1514 (quote (core external-macro))) (value1508 e1509 r1510 w1511 s1512 mod1513) (if (memv t1514 (quote (module-ref))) (call-with-values (lambda () (value1508 e1509)) (lambda (id1515 mod1516) (build-annotated1059 s1512 (if mod1516 (make-module-ref (cdr mod1516) id1515 (car mod1516)) (make-module-ref mod1516 id1515 (quote bare)))))) (if (memv t1514 (quote (lexical-call))) (chi-application1120 (build-annotated1059 (source-annotation1073 (car e1509)) value1508) e1509 r1510 w1511 s1512 mod1513) (if (memv t1514 (quote (global-call))) (chi-application1120 (build-annotated1059 (source-annotation1073 (car e1509)) (if (if (syntax-object?1066 (car e1509)) (syntax-object-module1069 (car e1509)) mod1513) (make-module-ref (cdr (if (syntax-object?1066 (car e1509)) (syntax-object-module1069 (car e1509)) mod1513)) value1508 (car (if (syntax-object?1066 (car e1509)) (syntax-object-module1069 (car e1509)) mod1513))) (make-module-ref (if (syntax-object?1066 (car e1509)) (syntax-object-module1069 (car e1509)) mod1513) value1508 (quote bare)))) e1509 r1510 w1511 s1512 mod1513) (if (memv t1514 (quote (constant))) (build-data1060 s1512 (strip1129 (source-wrap1111 e1509 w1511 s1512 mod1513) (quote (())))) (if (memv t1514 (quote (global))) (build-annotated1059 s1512 (if mod1513 (make-module-ref (cdr mod1513) value1508 (car mod1513)) (make-module-ref mod1513 value1508 (quote bare)))) (if (memv t1514 (quote (call))) (chi-application1120 (chi1118 (car e1509) r1510 w1511 mod1513) e1509 r1510 w1511 s1512 mod1513) (if (memv t1514 (quote (begin-form))) ((lambda (tmp1517) ((lambda (tmp1518) (if tmp1518 (apply (lambda (_1519 e11520 e21521) (chi-sequence1112 (cons e11520 e21521) r1510 w1511 s1512 mod1513)) tmp1518) (syntax-violation #f "source expression failed to match any pattern" tmp1517))) ($sc-dispatch tmp1517 (quote (any any . each-any))))) e1509) (if (memv t1514 (quote (local-syntax-form))) (chi-local-syntax1124 value1508 e1509 r1510 w1511 s1512 mod1513 chi-sequence1112) (if (memv t1514 (quote (eval-when-form))) ((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (_1525 x1526 e11527 e21528) (let ((when-list1529 (chi-when-list1115 e1509 x1526 w1511))) (if (memq (quote eval) when-list1529) (chi-sequence1112 (cons e11527 e21528) r1510 w1511 s1512 mod1513) (chi-void1126)))) tmp1524) (syntax-violation #f "source expression failed to match any pattern" tmp1523))) ($sc-dispatch tmp1523 (quote (any each-any any . each-any))))) e1509) (if (memv t1514 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1509 (wrap1110 value1508 w1511 mod1513)) (if (memv t1514 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1111 e1509 w1511 s1512 mod1513)) (if (memv t1514 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1111 e1509 w1511 s1512 mod1513)) (syntax-violation #f "unexpected syntax" (source-wrap1111 e1509 w1511 s1512 mod1513))))))))))))))))))) (chi1118 (lambda (e1532 r1533 w1534 mod1535) (call-with-values (lambda () (syntax-type1116 e1532 r1533 w1534 #f #f mod1535)) (lambda (type1536 value1537 e1538 w1539 s1540 mod1541) (chi-expr1119 type1536 value1537 e1538 r1533 w1539 s1540 mod1541))))) (chi-top1117 (lambda (e1542 r1543 w1544 m1545 esew1546 mod1547) (call-with-values (lambda () (syntax-type1116 e1542 r1543 w1544 #f #f mod1547)) (lambda (type1555 value1556 e1557 w1558 s1559 mod1560) (let ((t1561 type1555)) (if (memv t1561 (quote (begin-form))) ((lambda (tmp1562) ((lambda (tmp1563) (if tmp1563 (apply (lambda (_1564) (chi-void1126)) tmp1563) ((lambda (tmp1565) (if tmp1565 (apply (lambda (_1566 e11567 e21568) (chi-top-sequence1113 (cons e11567 e21568) r1543 w1558 s1559 m1545 esew1546 mod1560)) tmp1565) (syntax-violation #f "source expression failed to match any pattern" tmp1562))) ($sc-dispatch tmp1562 (quote (any any . each-any)))))) ($sc-dispatch tmp1562 (quote (any))))) e1557) (if (memv t1561 (quote (local-syntax-form))) (chi-local-syntax1124 value1556 e1557 r1543 w1558 s1559 mod1560 (lambda (body1570 r1571 w1572 s1573 mod1574) (chi-top-sequence1113 body1570 r1571 w1572 s1573 m1545 esew1546 mod1574))) (if (memv t1561 (quote (eval-when-form))) ((lambda (tmp1575) ((lambda (tmp1576) (if tmp1576 (apply (lambda (_1577 x1578 e11579 e21580) (let ((when-list1581 (chi-when-list1115 e1557 x1578 w1558)) (body1582 (cons e11579 e21580))) (cond ((eq? m1545 (quote e)) (if (memq (quote eval) when-list1581) (chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote e) (quote (eval)) mod1560) (chi-void1126))) ((memq (quote load) when-list1581) (if (or (memq (quote compile) when-list1581) (and (eq? m1545 (quote c&e)) (memq (quote eval) when-list1581))) (chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote c&e) (quote (compile load)) mod1560) (if (memq m1545 (quote (c c&e))) (chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote c) (quote (load)) mod1560) (chi-void1126)))) ((or (memq (quote compile) when-list1581) (and (eq? m1545 (quote c&e)) (memq (quote eval) when-list1581))) (top-level-eval-hook1054 (chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote e) (quote (eval)) mod1560) mod1560) (chi-void1126)) (else (chi-void1126))))) tmp1576) (syntax-violation #f "source expression failed to match any pattern" tmp1575))) ($sc-dispatch tmp1575 (quote (any each-any any . each-any))))) e1557) (if (memv t1561 (quote (define-syntax-form))) (let ((n1585 (id-var-name1104 value1556 w1558)) (r1586 (macros-only-env1078 r1543))) (let ((t1587 m1545)) (if (memv t1587 (quote (c))) (if (memq (quote compile) esew1546) (let ((e1588 (chi-install-global1114 n1585 (chi1118 e1557 r1586 w1558 mod1560)))) (begin (top-level-eval-hook1054 e1588 mod1560) (if (memq (quote load) esew1546) e1588 (chi-void1126)))) (if (memq (quote load) esew1546) (chi-install-global1114 n1585 (chi1118 e1557 r1586 w1558 mod1560)) (chi-void1126))) (if (memv t1587 (quote (c&e))) (let ((e1589 (chi-install-global1114 n1585 (chi1118 e1557 r1586 w1558 mod1560)))) (begin (top-level-eval-hook1054 e1589 mod1560) e1589)) (begin (if (memq (quote eval) esew1546) (top-level-eval-hook1054 (chi-install-global1114 n1585 (chi1118 e1557 r1586 w1558 mod1560)) mod1560)) (chi-void1126)))))) (if (memv t1561 (quote (define-form))) (let ((n1590 (id-var-name1104 value1556 w1558))) (let ((type1591 (binding-type1074 (lookup1079 n1590 r1543 mod1560)))) (let ((t1592 type1591)) (if (memv t1592 (quote (global core macro module-ref))) (let ((x1593 (build-annotated1059 s1559 (list (quote define) n1590 (chi1118 e1557 r1543 w1558 mod1560))))) (begin (if (eq? m1545 (quote c&e)) (top-level-eval-hook1054 x1593 mod1560)) x1593)) (if (memv t1592 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1557 (wrap1110 value1556 w1558 mod1560)) (syntax-violation #f "cannot define keyword at top level" e1557 (wrap1110 value1556 w1558 mod1560))))))) (let ((x1594 (chi-expr1119 type1555 value1556 e1557 r1543 w1558 s1559 mod1560))) (begin (if (eq? m1545 (quote c&e)) (top-level-eval-hook1054 x1594 mod1560)) x1594)))))))))))) (syntax-type1116 (lambda (e1595 r1596 w1597 s1598 rib1599 mod1600) (cond ((symbol? e1595) (let ((n1601 (id-var-name1104 e1595 w1597))) (let ((b1602 (lookup1079 n1601 r1596 mod1600))) (let ((type1603 (binding-type1074 b1602))) (let ((t1604 type1603)) (if (memv t1604 (quote (lexical))) (values type1603 (binding-value1075 b1602) e1595 w1597 s1598 mod1600) (if (memv t1604 (quote (global))) (values type1603 n1601 e1595 w1597 s1598 mod1600) (if (memv t1604 (quote (macro))) (syntax-type1116 (chi-macro1121 (binding-value1075 b1602) e1595 r1596 w1597 rib1599 mod1600) r1596 (quote (())) s1598 rib1599 mod1600) (values type1603 (binding-value1075 b1602) e1595 w1597 s1598 mod1600))))))))) ((pair? e1595) (let ((first1605 (car e1595))) (if (id?1082 first1605) (let ((n1606 (id-var-name1104 first1605 w1597))) (let ((b1607 (lookup1079 n1606 r1596 (or (and (syntax-object?1066 first1605) (syntax-object-module1069 first1605)) mod1600)))) (let ((type1608 (binding-type1074 b1607))) (let ((t1609 type1608)) (if (memv t1609 (quote (lexical))) (values (quote lexical-call) (binding-value1075 b1607) e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (global))) (values (quote global-call) n1606 e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (macro))) (syntax-type1116 (chi-macro1121 (binding-value1075 b1607) e1595 r1596 w1597 rib1599 mod1600) r1596 (quote (())) s1598 rib1599 mod1600) (if (memv t1609 (quote (core external-macro module-ref))) (values type1608 (binding-value1075 b1607) e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1075 b1607) e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (begin))) (values (quote begin-form) #f e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (eval-when))) (values (quote eval-when-form) #f e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (define))) ((lambda (tmp1610) ((lambda (tmp1611) (if (if tmp1611 (apply (lambda (_1612 name1613 val1614) (id?1082 name1613)) tmp1611) #f) (apply (lambda (_1615 name1616 val1617) (values (quote define-form) name1616 val1617 w1597 s1598 mod1600)) tmp1611) ((lambda (tmp1618) (if (if tmp1618 (apply (lambda (_1619 name1620 args1621 e11622 e21623) (and (id?1082 name1620) (valid-bound-ids?1107 (lambda-var-list1131 args1621)))) tmp1618) #f) (apply (lambda (_1624 name1625 args1626 e11627 e21628) (values (quote define-form) (wrap1110 name1625 w1597 mod1600) (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))) (wrap1110 (cons args1626 (cons e11627 e21628)) w1597 mod1600)) (quote (())) s1598 mod1600)) tmp1618) ((lambda (tmp1630) (if (if tmp1630 (apply (lambda (_1631 name1632) (id?1082 name1632)) tmp1630) #f) (apply (lambda (_1633 name1634) (values (quote define-form) (wrap1110 name1634 w1597 mod1600) (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 (())) s1598 mod1600)) tmp1630) (syntax-violation #f "source expression failed to match any pattern" tmp1610))) ($sc-dispatch tmp1610 (quote (any any)))))) ($sc-dispatch tmp1610 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1610 (quote (any any any))))) e1595) (if (memv t1609 (quote (define-syntax))) ((lambda (tmp1635) ((lambda (tmp1636) (if (if tmp1636 (apply (lambda (_1637 name1638 val1639) (id?1082 name1638)) tmp1636) #f) (apply (lambda (_1640 name1641 val1642) (values (quote define-syntax-form) name1641 val1642 w1597 s1598 mod1600)) tmp1636) (syntax-violation #f "source expression failed to match any pattern" tmp1635))) ($sc-dispatch tmp1635 (quote (any any any))))) e1595) (values (quote call) #f e1595 w1597 s1598 mod1600)))))))))))))) (values (quote call) #f e1595 w1597 s1598 mod1600)))) ((syntax-object?1066 e1595) (syntax-type1116 (syntax-object-expression1067 e1595) r1596 (join-wraps1101 w1597 (syntax-object-wrap1068 e1595)) #f rib1599 (or (syntax-object-module1069 e1595) mod1600))) ((annotation? e1595) (syntax-type1116 (annotation-expression e1595) r1596 w1597 (annotation-source e1595) rib1599 mod1600)) ((self-evaluating? e1595) (values (quote constant) #f e1595 w1597 s1598 mod1600)) (else (values (quote other) #f e1595 w1597 s1598 mod1600))))) (chi-when-list1115 (lambda (e1643 when-list1644 w1645) (let f1646 ((when-list1647 when-list1644) (situations1648 (quote ()))) (if (null? when-list1647) situations1648 (f1646 (cdr when-list1647) (cons (let ((x1649 (car when-list1647))) (cond ((free-id=?1105 x1649 (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=?1105 x1649 (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=?1105 x1649 (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" e1643 (wrap1110 x1649 w1645 #f))))) situations1648)))))) (chi-install-global1114 (lambda (name1650 e1651) (build-annotated1059 #f (list (build-annotated1059 #f (quote define)) name1650 (if (let ((v1652 (module-variable (current-module) name1650))) (and v1652 (variable-bound? v1652) (macro? (variable-ref v1652)) (not (eq? (macro-type (variable-ref v1652)) (quote syncase-macro))))) (build-annotated1059 #f (list (build-annotated1059 #f (quote make-extended-syncase-macro)) (build-annotated1059 #f (list (build-annotated1059 #f (quote module-ref)) (build-annotated1059 #f (quote (current-module))) (build-data1060 #f name1650))) (build-data1060 #f (quote macro)) e1651)) (build-annotated1059 #f (list (build-annotated1059 #f (quote make-syncase-macro)) (build-data1060 #f (quote macro)) e1651))))))) (chi-top-sequence1113 (lambda (body1653 r1654 w1655 s1656 m1657 esew1658 mod1659) (build-sequence1061 s1656 (let dobody1660 ((body1661 body1653) (r1662 r1654) (w1663 w1655) (m1664 m1657) (esew1665 esew1658) (mod1666 mod1659)) (if (null? body1661) (quote ()) (let ((first1667 (chi-top1117 (car body1661) r1662 w1663 m1664 esew1665 mod1666))) (cons first1667 (dobody1660 (cdr body1661) r1662 w1663 m1664 esew1665 mod1666)))))))) (chi-sequence1112 (lambda (body1668 r1669 w1670 s1671 mod1672) (build-sequence1061 s1671 (let dobody1673 ((body1674 body1668) (r1675 r1669) (w1676 w1670) (mod1677 mod1672)) (if (null? body1674) (quote ()) (let ((first1678 (chi1118 (car body1674) r1675 w1676 mod1677))) (cons first1678 (dobody1673 (cdr body1674) r1675 w1676 mod1677)))))))) (source-wrap1111 (lambda (x1679 w1680 s1681 defmod1682) (wrap1110 (if s1681 (make-annotation x1679 s1681 #f) x1679) w1680 defmod1682))) (wrap1110 (lambda (x1683 w1684 defmod1685) (cond ((and (null? (wrap-marks1085 w1684)) (null? (wrap-subst1086 w1684))) x1683) ((syntax-object?1066 x1683) (make-syntax-object1065 (syntax-object-expression1067 x1683) (join-wraps1101 w1684 (syntax-object-wrap1068 x1683)) (syntax-object-module1069 x1683))) ((null? x1683) x1683) (else (make-syntax-object1065 x1683 w1684 defmod1685))))) (bound-id-member?1109 (lambda (x1686 list1687) (and (not (null? list1687)) (or (bound-id=?1106 x1686 (car list1687)) (bound-id-member?1109 x1686 (cdr list1687)))))) (distinct-bound-ids?1108 (lambda (ids1688) (let distinct?1689 ((ids1690 ids1688)) (or (null? ids1690) (and (not (bound-id-member?1109 (car ids1690) (cdr ids1690))) (distinct?1689 (cdr ids1690))))))) (valid-bound-ids?1107 (lambda (ids1691) (and (let all-ids?1692 ((ids1693 ids1691)) (or (null? ids1693) (and (id?1082 (car ids1693)) (all-ids?1692 (cdr ids1693))))) (distinct-bound-ids?1108 ids1691)))) (bound-id=?1106 (lambda (i1694 j1695) (if (and (syntax-object?1066 i1694) (syntax-object?1066 j1695)) (and (eq? (let ((e1696 (syntax-object-expression1067 i1694))) (if (annotation? e1696) (annotation-expression e1696) e1696)) (let ((e1697 (syntax-object-expression1067 j1695))) (if (annotation? e1697) (annotation-expression e1697) e1697))) (same-marks?1103 (wrap-marks1085 (syntax-object-wrap1068 i1694)) (wrap-marks1085 (syntax-object-wrap1068 j1695)))) (eq? (let ((e1698 i1694)) (if (annotation? e1698) (annotation-expression e1698) e1698)) (let ((e1699 j1695)) (if (annotation? e1699) (annotation-expression e1699) e1699)))))) (free-id=?1105 (lambda (i1700 j1701) (and (eq? (let ((x1702 i1700)) (let ((e1703 (if (syntax-object?1066 x1702) (syntax-object-expression1067 x1702) x1702))) (if (annotation? e1703) (annotation-expression e1703) e1703))) (let ((x1704 j1701)) (let ((e1705 (if (syntax-object?1066 x1704) (syntax-object-expression1067 x1704) x1704))) (if (annotation? e1705) (annotation-expression e1705) e1705)))) (eq? (id-var-name1104 i1700 (quote (()))) (id-var-name1104 j1701 (quote (()))))))) (id-var-name1104 (lambda (id1706 w1707) (letrec ((search-vector-rib1710 (lambda (sym1716 subst1717 marks1718 symnames1719 ribcage1720) (let ((n1721 (vector-length symnames1719))) (let f1722 ((i1723 0)) (cond ((fx=1052 i1723 n1721) (search1708 sym1716 (cdr subst1717) marks1718)) ((and (eq? (vector-ref symnames1719 i1723) sym1716) (same-marks?1103 marks1718 (vector-ref (ribcage-marks1092 ribcage1720) i1723))) (values (vector-ref (ribcage-labels1093 ribcage1720) i1723) marks1718)) (else (f1722 (fx+1050 i1723 1)))))))) (search-list-rib1709 (lambda (sym1724 subst1725 marks1726 symnames1727 ribcage1728) (let f1729 ((symnames1730 symnames1727) (i1731 0)) (cond ((null? symnames1730) (search1708 sym1724 (cdr subst1725) marks1726)) ((and (eq? (car symnames1730) sym1724) (same-marks?1103 marks1726 (list-ref (ribcage-marks1092 ribcage1728) i1731))) (values (list-ref (ribcage-labels1093 ribcage1728) i1731) marks1726)) (else (f1729 (cdr symnames1730) (fx+1050 i1731 1))))))) (search1708 (lambda (sym1732 subst1733 marks1734) (if (null? subst1733) (values #f marks1734) (let ((fst1735 (car subst1733))) (if (eq? fst1735 (quote shift)) (search1708 sym1732 (cdr subst1733) (cdr marks1734)) (let ((symnames1736 (ribcage-symnames1091 fst1735))) (if (vector? symnames1736) (search-vector-rib1710 sym1732 subst1733 marks1734 symnames1736 fst1735) (search-list-rib1709 sym1732 subst1733 marks1734 symnames1736 fst1735))))))))) (cond ((symbol? id1706) (or (call-with-values (lambda () (search1708 id1706 (wrap-subst1086 w1707) (wrap-marks1085 w1707))) (lambda (x1738 . ignore1737) x1738)) id1706)) ((syntax-object?1066 id1706) (let ((id1739 (let ((e1741 (syntax-object-expression1067 id1706))) (if (annotation? e1741) (annotation-expression e1741) e1741))) (w11740 (syntax-object-wrap1068 id1706))) (let ((marks1742 (join-marks1102 (wrap-marks1085 w1707) (wrap-marks1085 w11740)))) (call-with-values (lambda () (search1708 id1739 (wrap-subst1086 w1707) marks1742)) (lambda (new-id1743 marks1744) (or new-id1743 (call-with-values (lambda () (search1708 id1739 (wrap-subst1086 w11740) marks1744)) (lambda (x1746 . ignore1745) x1746)) id1739)))))) ((annotation? id1706) (let ((id1747 (let ((e1748 id1706)) (if (annotation? e1748) (annotation-expression e1748) e1748)))) (or (call-with-values (lambda () (search1708 id1747 (wrap-subst1086 w1707) (wrap-marks1085 w1707))) (lambda (x1750 . ignore1749) x1750)) id1747))) (else (error-hook1056 (quote id-var-name) "invalid id" id1706)))))) (same-marks?1103 (lambda (x1751 y1752) (or (eq? x1751 y1752) (and (not (null? x1751)) (not (null? y1752)) (eq? (car x1751) (car y1752)) (same-marks?1103 (cdr x1751) (cdr y1752)))))) (join-marks1102 (lambda (m11753 m21754) (smart-append1100 m11753 m21754))) (join-wraps1101 (lambda (w11755 w21756) (let ((m11757 (wrap-marks1085 w11755)) (s11758 (wrap-subst1086 w11755))) (if (null? m11757) (if (null? s11758) w21756 (make-wrap1084 (wrap-marks1085 w21756) (smart-append1100 s11758 (wrap-subst1086 w21756)))) (make-wrap1084 (smart-append1100 m11757 (wrap-marks1085 w21756)) (smart-append1100 s11758 (wrap-subst1086 w21756))))))) (smart-append1100 (lambda (m11759 m21760) (if (null? m21760) m11759 (append m11759 m21760)))) (make-binding-wrap1099 (lambda (ids1761 labels1762 w1763) (if (null? ids1761) w1763 (make-wrap1084 (wrap-marks1085 w1763) (cons (let ((labelvec1764 (list->vector labels1762))) (let ((n1765 (vector-length labelvec1764))) (let ((symnamevec1766 (make-vector n1765)) (marksvec1767 (make-vector n1765))) (begin (let f1768 ((ids1769 ids1761) (i1770 0)) (if (not (null? ids1769)) (call-with-values (lambda () (id-sym-name&marks1083 (car ids1769) w1763)) (lambda (symname1771 marks1772) (begin (vector-set! symnamevec1766 i1770 symname1771) (vector-set! marksvec1767 i1770 marks1772) (f1768 (cdr ids1769) (fx+1050 i1770 1))))))) (make-ribcage1089 symnamevec1766 marksvec1767 labelvec1764))))) (wrap-subst1086 w1763)))))) (extend-ribcage!1098 (lambda (ribcage1773 id1774 label1775) (begin (set-ribcage-symnames!1094 ribcage1773 (cons (let ((e1776 (syntax-object-expression1067 id1774))) (if (annotation? e1776) (annotation-expression e1776) e1776)) (ribcage-symnames1091 ribcage1773))) (set-ribcage-marks!1095 ribcage1773 (cons (wrap-marks1085 (syntax-object-wrap1068 id1774)) (ribcage-marks1092 ribcage1773))) (set-ribcage-labels!1096 ribcage1773 (cons label1775 (ribcage-labels1093 ribcage1773)))))) (anti-mark1097 (lambda (w1777) (make-wrap1084 (cons #f (wrap-marks1085 w1777)) (cons (quote shift) (wrap-subst1086 w1777))))) (set-ribcage-labels!1096 (lambda (x1778 update1779) (vector-set! x1778 3 update1779))) (set-ribcage-marks!1095 (lambda (x1780 update1781) (vector-set! x1780 2 update1781))) (set-ribcage-symnames!1094 (lambda (x1782 update1783) (vector-set! x1782 1 update1783))) (ribcage-labels1093 (lambda (x1784) (vector-ref x1784 3))) (ribcage-marks1092 (lambda (x1785) (vector-ref x1785 2))) (ribcage-symnames1091 (lambda (x1786) (vector-ref x1786 1))) (ribcage?1090 (lambda (x1787) (and (vector? x1787) (= (vector-length x1787) 4) (eq? (vector-ref x1787 0) (quote ribcage))))) (make-ribcage1089 (lambda (symnames1788 marks1789 labels1790) (vector (quote ribcage) symnames1788 marks1789 labels1790))) (gen-labels1088 (lambda (ls1791) (if (null? ls1791) (quote ()) (cons (gen-label1087) (gen-labels1088 (cdr ls1791)))))) (gen-label1087 (lambda () (string #\i))) (wrap-subst1086 cdr) (wrap-marks1085 car) (make-wrap1084 cons) (id-sym-name&marks1083 (lambda (x1792 w1793) (if (syntax-object?1066 x1792) (values (let ((e1794 (syntax-object-expression1067 x1792))) (if (annotation? e1794) (annotation-expression e1794) e1794)) (join-marks1102 (wrap-marks1085 w1793) (wrap-marks1085 (syntax-object-wrap1068 x1792)))) (values (let ((e1795 x1792)) (if (annotation? e1795) (annotation-expression e1795) e1795)) (wrap-marks1085 w1793))))) (id?1082 (lambda (x1796) (cond ((symbol? x1796) #t) ((syntax-object?1066 x1796) (symbol? (let ((e1797 (syntax-object-expression1067 x1796))) (if (annotation? e1797) (annotation-expression e1797) e1797)))) ((annotation? x1796) (symbol? (annotation-expression x1796))) (else #f)))) (nonsymbol-id?1081 (lambda (x1798) (and (syntax-object?1066 x1798) (symbol? (let ((e1799 (syntax-object-expression1067 x1798))) (if (annotation? e1799) (annotation-expression e1799) e1799)))))) (global-extend1080 (lambda (type1800 sym1801 val1802) (put-global-definition-hook1057 sym1801 type1800 val1802))) (lookup1079 (lambda (x1803 r1804 mod1805) (cond ((assq x1803 r1804) => cdr) ((symbol? x1803) (or (get-global-definition-hook1058 x1803 mod1805) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1078 (lambda (r1806) (if (null? r1806) (quote ()) (let ((a1807 (car r1806))) (if (eq? (cadr a1807) (quote macro)) (cons a1807 (macros-only-env1078 (cdr r1806))) (macros-only-env1078 (cdr r1806))))))) (extend-var-env1077 (lambda (labels1808 vars1809 r1810) (if (null? labels1808) r1810 (extend-var-env1077 (cdr labels1808) (cdr vars1809) (cons (cons (car labels1808) (cons (quote lexical) (car vars1809))) r1810))))) (extend-env1076 (lambda (labels1811 bindings1812 r1813) (if (null? labels1811) r1813 (extend-env1076 (cdr labels1811) (cdr bindings1812) (cons (cons (car labels1811) (car bindings1812)) r1813))))) (binding-value1075 cdr) (binding-type1074 car) (source-annotation1073 (lambda (x1814) (cond ((annotation? x1814) (annotation-source x1814)) ((syntax-object?1066 x1814) (source-annotation1073 (syntax-object-expression1067 x1814))) (else #f)))) (set-syntax-object-module!1072 (lambda (x1815 update1816) (vector-set! x1815 3 update1816))) (set-syntax-object-wrap!1071 (lambda (x1817 update1818) (vector-set! x1817 2 update1818))) (set-syntax-object-expression!1070 (lambda (x1819 update1820) (vector-set! x1819 1 update1820))) (syntax-object-module1069 (lambda (x1821) (vector-ref x1821 3))) (syntax-object-wrap1068 (lambda (x1822) (vector-ref x1822 2))) (syntax-object-expression1067 (lambda (x1823) (vector-ref x1823 1))) (syntax-object?1066 (lambda (x1824) (and (vector? x1824) (= (vector-length x1824) 4) (eq? (vector-ref x1824 0) (quote syntax-object))))) (make-syntax-object1065 (lambda (expression1825 wrap1826 module1827) (vector (quote syntax-object) expression1825 wrap1826 module1827))) (build-letrec1064 (lambda (src1828 vars1829 val-exps1830 body-exp1831) (if (null? vars1829) (build-annotated1059 src1828 body-exp1831) (build-annotated1059 src1828 (list (quote letrec) (map list vars1829 val-exps1830) body-exp1831))))) (build-named-let1063 (lambda (src1832 vars1833 val-exps1834 body-exp1835) (if (null? vars1833) (build-annotated1059 src1832 body-exp1835) (build-annotated1059 src1832 (list (quote let) (car vars1833) (map list (cdr vars1833) val-exps1834) body-exp1835))))) (build-let1062 (lambda (src1836 vars1837 val-exps1838 body-exp1839) (if (null? vars1837) (build-annotated1059 src1836 body-exp1839) (build-annotated1059 src1836 (list (quote let) (map list vars1837 val-exps1838) body-exp1839))))) (build-sequence1061 (lambda (src1840 exps1841) (if (null? (cdr exps1841)) (build-annotated1059 src1840 (car exps1841)) (build-annotated1059 src1840 (cons (quote begin) exps1841))))) (build-data1060 (lambda (src1842 exp1843) (if (and (self-evaluating? exp1843) (not (vector? exp1843))) (build-annotated1059 src1842 exp1843) (build-annotated1059 src1842 (list (quote quote) exp1843))))) (build-annotated1059 (lambda (src1844 exp1845) (if (and src1844 (not (annotation? exp1845))) (make-annotation exp1845 src1844 #t) exp1845))) (get-global-definition-hook1058 (lambda (symbol1846 module1847) (begin (if (and (not module1847) (current-module)) (warn "module system is booted, we should have a module" symbol1846)) (let ((v1848 (module-variable (if module1847 (resolve-module (cdr module1847)) (current-module)) symbol1846))) (and v1848 (variable-bound? v1848) (let ((val1849 (variable-ref v1848))) (and (macro? val1849) (syncase-macro-type val1849) (cons (syncase-macro-type val1849) (syncase-macro-binding val1849))))))))) (put-global-definition-hook1057 (lambda (symbol1850 type1851 val1852) (let ((existing1853 (let ((v1854 (module-variable (current-module) symbol1850))) (and v1854 (variable-bound? v1854) (let ((val1855 (variable-ref v1854))) (and (macro? val1855) (not (syncase-macro-type val1855)) val1855)))))) (module-define! (current-module) symbol1850 (if existing1853 (make-extended-syncase-macro existing1853 type1851 val1852) (make-syncase-macro type1851 val1852)))))) (error-hook1056 (lambda (who1856 why1857 what1858) (error who1856 "~a ~s" why1857 what1858))) (local-eval-hook1055 (lambda (x1859 mod1860) (primitive-eval (list noexpand1049 x1859)))) (top-level-eval-hook1054 (lambda (x1861 mod1862) (primitive-eval (list noexpand1049 x1861)))) (fx<1053 <) (fx=1052 =) (fx-1051 -) (fx+1050 +) (noexpand1049 "noexpand")) (begin (global-extend1080 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1080 (quote local-syntax) (quote let-syntax) #f) (global-extend1080 (quote core) (quote fluid-let-syntax) (lambda (e1863 r1864 w1865 s1866 mod1867) ((lambda (tmp1868) ((lambda (tmp1869) (if (if tmp1869 (apply (lambda (_1870 var1871 val1872 e11873 e21874) (valid-bound-ids?1107 var1871)) tmp1869) #f) (apply (lambda (_1876 var1877 val1878 e11879 e21880) (let ((names1881 (map (lambda (x1882) (id-var-name1104 x1882 w1865)) var1877))) (begin (for-each (lambda (id1884 n1885) (let ((t1886 (binding-type1074 (lookup1079 n1885 r1864 mod1867)))) (if (memv t1886 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1863 (source-wrap1111 id1884 w1865 s1866 mod1867))))) var1877 names1881) (chi-body1122 (cons e11879 e21880) (source-wrap1111 e1863 w1865 s1866 mod1867) (extend-env1076 names1881 (let ((trans-r1889 (macros-only-env1078 r1864))) (map (lambda (x1890) (cons (quote macro) (eval-local-transformer1125 (chi1118 x1890 trans-r1889 w1865 mod1867) mod1867))) val1878)) r1864) w1865 mod1867)))) tmp1869) ((lambda (_1892) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1111 e1863 w1865 s1866 mod1867))) tmp1868))) ($sc-dispatch tmp1868 (quote (any #(each (any any)) any . each-any))))) e1863))) (global-extend1080 (quote core) (quote quote) (lambda (e1893 r1894 w1895 s1896 mod1897) ((lambda (tmp1898) ((lambda (tmp1899) (if tmp1899 (apply (lambda (_1900 e1901) (build-data1060 s1896 (strip1129 e1901 w1895))) tmp1899) ((lambda (_1902) (syntax-violation (quote quote) "bad syntax" (source-wrap1111 e1893 w1895 s1896 mod1897))) tmp1898))) ($sc-dispatch tmp1898 (quote (any any))))) e1893))) (global-extend1080 (quote core) (quote syntax) (letrec ((regen1910 (lambda (x1911) (let ((t1912 (car x1911))) (if (memv t1912 (quote (ref))) (build-annotated1059 #f (cadr x1911)) (if (memv t1912 (quote (primitive))) (build-annotated1059 #f (cadr x1911)) (if (memv t1912 (quote (quote))) (build-data1060 #f (cadr x1911)) (if (memv t1912 (quote (lambda))) (build-annotated1059 #f (list (quote lambda) (cadr x1911) (regen1910 (caddr x1911)))) (if (memv t1912 (quote (map))) (let ((ls1913 (map regen1910 (cdr x1911)))) (build-annotated1059 #f (cons (if (fx=1052 (length ls1913) 2) (build-annotated1059 #f (quote map)) (build-annotated1059 #f (quote map))) ls1913))) (build-annotated1059 #f (cons (build-annotated1059 #f (car x1911)) (map regen1910 (cdr x1911)))))))))))) (gen-vector1909 (lambda (x1914) (cond ((eq? (car x1914) (quote list)) (cons (quote vector) (cdr x1914))) ((eq? (car x1914) (quote quote)) (list (quote quote) (list->vector (cadr x1914)))) (else (list (quote list->vector) x1914))))) (gen-append1908 (lambda (x1915 y1916) (if (equal? y1916 (quote (quote ()))) x1915 (list (quote append) x1915 y1916)))) (gen-cons1907 (lambda (x1917 y1918) (let ((t1919 (car y1918))) (if (memv t1919 (quote (quote))) (if (eq? (car x1917) (quote quote)) (list (quote quote) (cons (cadr x1917) (cadr y1918))) (if (eq? (cadr y1918) (quote ())) (list (quote list) x1917) (list (quote cons) x1917 y1918))) (if (memv t1919 (quote (list))) (cons (quote list) (cons x1917 (cdr y1918))) (list (quote cons) x1917 y1918)))))) (gen-map1906 (lambda (e1920 map-env1921) (let ((formals1922 (map cdr map-env1921)) (actuals1923 (map (lambda (x1924) (list (quote ref) (car x1924))) map-env1921))) (cond ((eq? (car e1920) (quote ref)) (car actuals1923)) ((andmap (lambda (x1925) (and (eq? (car x1925) (quote ref)) (memq (cadr x1925) formals1922))) (cdr e1920)) (cons (quote map) (cons (list (quote primitive) (car e1920)) (map (let ((r1926 (map cons formals1922 actuals1923))) (lambda (x1927) (cdr (assq (cadr x1927) r1926)))) (cdr e1920))))) (else (cons (quote map) (cons (list (quote lambda) formals1922 e1920) actuals1923))))))) (gen-mappend1905 (lambda (e1928 map-env1929) (list (quote apply) (quote (primitive append)) (gen-map1906 e1928 map-env1929)))) (gen-ref1904 (lambda (src1930 var1931 level1932 maps1933) (if (fx=1052 level1932 0) (values var1931 maps1933) (if (null? maps1933) (syntax-violation (quote syntax) "missing ellipsis" src1930) (call-with-values (lambda () (gen-ref1904 src1930 var1931 (fx-1051 level1932 1) (cdr maps1933))) (lambda (outer-var1934 outer-maps1935) (let ((b1936 (assq outer-var1934 (car maps1933)))) (if b1936 (values (cdr b1936) maps1933) (let ((inner-var1937 (gen-var1130 (quote tmp)))) (values inner-var1937 (cons (cons (cons outer-var1934 inner-var1937) (car maps1933)) outer-maps1935))))))))))) (gen-syntax1903 (lambda (src1938 e1939 r1940 maps1941 ellipsis?1942 mod1943) (if (id?1082 e1939) (let ((label1944 (id-var-name1104 e1939 (quote (()))))) (let ((b1945 (lookup1079 label1944 r1940 mod1943))) (if (eq? (binding-type1074 b1945) (quote syntax)) (call-with-values (lambda () (let ((var.lev1946 (binding-value1075 b1945))) (gen-ref1904 src1938 (car var.lev1946) (cdr var.lev1946) maps1941))) (lambda (var1947 maps1948) (values (list (quote ref) var1947) maps1948))) (if (ellipsis?1942 e1939) (syntax-violation (quote syntax) "misplaced ellipsis" src1938) (values (list (quote quote) e1939) maps1941))))) ((lambda (tmp1949) ((lambda (tmp1950) (if (if tmp1950 (apply (lambda (dots1951 e1952) (ellipsis?1942 dots1951)) tmp1950) #f) (apply (lambda (dots1953 e1954) (gen-syntax1903 src1938 e1954 r1940 maps1941 (lambda (x1955) #f) mod1943)) tmp1950) ((lambda (tmp1956) (if (if tmp1956 (apply (lambda (x1957 dots1958 y1959) (ellipsis?1942 dots1958)) tmp1956) #f) (apply (lambda (x1960 dots1961 y1962) (let f1963 ((y1964 y1962) (k1965 (lambda (maps1966) (call-with-values (lambda () (gen-syntax1903 src1938 x1960 r1940 (cons (quote ()) maps1966) ellipsis?1942 mod1943)) (lambda (x1967 maps1968) (if (null? (car maps1968)) (syntax-violation (quote syntax) "extra ellipsis" src1938) (values (gen-map1906 x1967 (car maps1968)) (cdr maps1968)))))))) ((lambda (tmp1969) ((lambda (tmp1970) (if (if tmp1970 (apply (lambda (dots1971 y1972) (ellipsis?1942 dots1971)) tmp1970) #f) (apply (lambda (dots1973 y1974) (f1963 y1974 (lambda (maps1975) (call-with-values (lambda () (k1965 (cons (quote ()) maps1975))) (lambda (x1976 maps1977) (if (null? (car maps1977)) (syntax-violation (quote syntax) "extra ellipsis" src1938) (values (gen-mappend1905 x1976 (car maps1977)) (cdr maps1977)))))))) tmp1970) ((lambda (_1978) (call-with-values (lambda () (gen-syntax1903 src1938 y1964 r1940 maps1941 ellipsis?1942 mod1943)) (lambda (y1979 maps1980) (call-with-values (lambda () (k1965 maps1980)) (lambda (x1981 maps1982) (values (gen-append1908 x1981 y1979) maps1982)))))) tmp1969))) ($sc-dispatch tmp1969 (quote (any . any))))) y1964))) tmp1956) ((lambda (tmp1983) (if tmp1983 (apply (lambda (x1984 y1985) (call-with-values (lambda () (gen-syntax1903 src1938 x1984 r1940 maps1941 ellipsis?1942 mod1943)) (lambda (x1986 maps1987) (call-with-values (lambda () (gen-syntax1903 src1938 y1985 r1940 maps1987 ellipsis?1942 mod1943)) (lambda (y1988 maps1989) (values (gen-cons1907 x1986 y1988) maps1989)))))) tmp1983) ((lambda (tmp1990) (if tmp1990 (apply (lambda (e11991 e21992) (call-with-values (lambda () (gen-syntax1903 src1938 (cons e11991 e21992) r1940 maps1941 ellipsis?1942 mod1943)) (lambda (e1994 maps1995) (values (gen-vector1909 e1994) maps1995)))) tmp1990) ((lambda (_1996) (values (list (quote quote) e1939) maps1941)) tmp1949))) ($sc-dispatch tmp1949 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1949 (quote (any . any)))))) ($sc-dispatch tmp1949 (quote (any any . any)))))) ($sc-dispatch tmp1949 (quote (any any))))) e1939))))) (lambda (e1997 r1998 w1999 s2000 mod2001) (let ((e2002 (source-wrap1111 e1997 w1999 s2000 mod2001))) ((lambda (tmp2003) ((lambda (tmp2004) (if tmp2004 (apply (lambda (_2005 x2006) (call-with-values (lambda () (gen-syntax1903 e2002 x2006 r1998 (quote ()) ellipsis?1127 mod2001)) (lambda (e2007 maps2008) (regen1910 e2007)))) tmp2004) ((lambda (_2009) (syntax-violation (quote syntax) "bad `syntax' form" e2002)) tmp2003))) ($sc-dispatch tmp2003 (quote (any any))))) e2002))))) (global-extend1080 (quote core) (quote lambda) (lambda (e2010 r2011 w2012 s2013 mod2014) ((lambda (tmp2015) ((lambda (tmp2016) (if tmp2016 (apply (lambda (_2017 c2018) (chi-lambda-clause1123 (source-wrap1111 e2010 w2012 s2013 mod2014) #f c2018 r2011 w2012 mod2014 (lambda (vars2019 docstring2020 body2021) (build-annotated1059 s2013 (cons (quote lambda) (cons vars2019 (append (if docstring2020 (list docstring2020) (quote ())) (list body2021)))))))) tmp2016) (syntax-violation #f "source expression failed to match any pattern" tmp2015))) ($sc-dispatch tmp2015 (quote (any . any))))) e2010))) (global-extend1080 (quote core) (quote let) (letrec ((chi-let2022 (lambda (e2023 r2024 w2025 s2026 mod2027 constructor2028 ids2029 vals2030 exps2031) (if (not (valid-bound-ids?1107 ids2029)) (syntax-violation (quote let) "duplicate bound variable" e2023) (let ((labels2032 (gen-labels1088 ids2029)) (new-vars2033 (map gen-var1130 ids2029))) (let ((nw2034 (make-binding-wrap1099 ids2029 labels2032 w2025)) (nr2035 (extend-var-env1077 labels2032 new-vars2033 r2024))) (constructor2028 s2026 new-vars2033 (map (lambda (x2036) (chi1118 x2036 r2024 w2025 mod2027)) vals2030) (chi-body1122 exps2031 (source-wrap1111 e2023 nw2034 s2026 mod2027) nr2035 nw2034 mod2027)))))))) (lambda (e2037 r2038 w2039 s2040 mod2041) ((lambda (tmp2042) ((lambda (tmp2043) (if tmp2043 (apply (lambda (_2044 id2045 val2046 e12047 e22048) (chi-let2022 e2037 r2038 w2039 s2040 mod2041 build-let1062 id2045 val2046 (cons e12047 e22048))) tmp2043) ((lambda (tmp2052) (if (if tmp2052 (apply (lambda (_2053 f2054 id2055 val2056 e12057 e22058) (id?1082 f2054)) tmp2052) #f) (apply (lambda (_2059 f2060 id2061 val2062 e12063 e22064) (chi-let2022 e2037 r2038 w2039 s2040 mod2041 build-named-let1063 (cons f2060 id2061) val2062 (cons e12063 e22064))) tmp2052) ((lambda (_2068) (syntax-violation (quote let) "bad let" (source-wrap1111 e2037 w2039 s2040 mod2041))) tmp2042))) ($sc-dispatch tmp2042 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2042 (quote (any #(each (any any)) any . each-any))))) e2037)))) (global-extend1080 (quote core) (quote letrec) (lambda (e2069 r2070 w2071 s2072 mod2073) ((lambda (tmp2074) ((lambda (tmp2075) (if tmp2075 (apply (lambda (_2076 id2077 val2078 e12079 e22080) (let ((ids2081 id2077)) (if (not (valid-bound-ids?1107 ids2081)) (syntax-violation (quote letrec) "duplicate bound variable" e2069) (let ((labels2083 (gen-labels1088 ids2081)) (new-vars2084 (map gen-var1130 ids2081))) (let ((w2085 (make-binding-wrap1099 ids2081 labels2083 w2071)) (r2086 (extend-var-env1077 labels2083 new-vars2084 r2070))) (build-letrec1064 s2072 new-vars2084 (map (lambda (x2087) (chi1118 x2087 r2086 w2085 mod2073)) val2078) (chi-body1122 (cons e12079 e22080) (source-wrap1111 e2069 w2085 s2072 mod2073) r2086 w2085 mod2073))))))) tmp2075) ((lambda (_2090) (syntax-violation (quote letrec) "bad letrec" (source-wrap1111 e2069 w2071 s2072 mod2073))) tmp2074))) ($sc-dispatch tmp2074 (quote (any #(each (any any)) any . each-any))))) e2069))) (global-extend1080 (quote core) (quote set!) (lambda (e2091 r2092 w2093 s2094 mod2095) ((lambda (tmp2096) ((lambda (tmp2097) (if (if tmp2097 (apply (lambda (_2098 id2099 val2100) (id?1082 id2099)) tmp2097) #f) (apply (lambda (_2101 id2102 val2103) (let ((val2104 (chi1118 val2103 r2092 w2093 mod2095)) (n2105 (id-var-name1104 id2102 w2093))) (let ((b2106 (lookup1079 n2105 r2092 mod2095))) (let ((t2107 (binding-type1074 b2106))) (if (memv t2107 (quote (lexical))) (build-annotated1059 s2094 (list (quote set!) (binding-value1075 b2106) val2104)) (if (memv t2107 (quote (global))) (build-annotated1059 s2094 (list (quote set!) (if mod2095 (make-module-ref (cdr mod2095) n2105 (car mod2095)) (make-module-ref mod2095 n2105 (quote bare))) val2104)) (if (memv t2107 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1110 id2102 w2093 mod2095)) (syntax-violation (quote set!) "bad set!" (source-wrap1111 e2091 w2093 s2094 mod2095))))))))) tmp2097) ((lambda (tmp2108) (if tmp2108 (apply (lambda (_2109 head2110 tail2111 val2112) (call-with-values (lambda () (syntax-type1116 head2110 r2092 (quote (())) #f #f mod2095)) (lambda (type2113 value2114 ee2115 ww2116 ss2117 modmod2118) (let ((t2119 type2113)) (if (memv t2119 (quote (module-ref))) (let ((val2120 (chi1118 val2112 r2092 w2093 mod2095))) (call-with-values (lambda () (value2114 (cons head2110 tail2111))) (lambda (id2122 mod2123) (build-annotated1059 s2094 (list (quote set!) (if mod2123 (make-module-ref (cdr mod2123) id2122 (car mod2123)) (make-module-ref mod2123 id2122 (quote bare))) val2120))))) (build-annotated1059 s2094 (cons (chi1118 (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))) head2110) r2092 w2093 mod2095) (map (lambda (e2124) (chi1118 e2124 r2092 w2093 mod2095)) (append tail2111 (list val2112)))))))))) tmp2108) ((lambda (_2126) (syntax-violation (quote set!) "bad set!" (source-wrap1111 e2091 w2093 s2094 mod2095))) tmp2096))) ($sc-dispatch tmp2096 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2096 (quote (any any any))))) e2091))) (global-extend1080 (quote module-ref) (quote @) (lambda (e2127) ((lambda (tmp2128) ((lambda (tmp2129) (if (if tmp2129 (apply (lambda (_2130 mod2131 id2132) (and (andmap id?1082 mod2131) (id?1082 id2132))) tmp2129) #f) (apply (lambda (_2134 mod2135 id2136) (values (syntax->datum id2136) (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))) mod2135)))) tmp2129) (syntax-violation #f "source expression failed to match any pattern" tmp2128))) ($sc-dispatch tmp2128 (quote (any each-any any))))) e2127))) (global-extend1080 (quote module-ref) (quote @@) (lambda (e2138) ((lambda (tmp2139) ((lambda (tmp2140) (if (if tmp2140 (apply (lambda (_2141 mod2142 id2143) (and (andmap id?1082 mod2142) (id?1082 id2143))) tmp2140) #f) (apply (lambda (_2145 mod2146 id2147) (values (syntax->datum id2147) (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))) mod2146)))) tmp2140) (syntax-violation #f "source expression failed to match any pattern" tmp2139))) ($sc-dispatch tmp2139 (quote (any each-any any))))) e2138))) (global-extend1080 (quote begin) (quote begin) (quote ())) (global-extend1080 (quote define) (quote define) (quote ())) (global-extend1080 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1080 (quote eval-when) (quote eval-when) (quote ())) (global-extend1080 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2152 (lambda (x2153 keys2154 clauses2155 r2156 mod2157) (if (null? clauses2155) (build-annotated1059 #f (list (build-annotated1059 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2153)) ((lambda (tmp2158) ((lambda (tmp2159) (if tmp2159 (apply (lambda (pat2160 exp2161) (if (and (id?1082 pat2160) (andmap (lambda (x2162) (not (free-id=?1105 pat2160 x2162))) (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))) keys2154))) (let ((labels2163 (list (gen-label1087))) (var2164 (gen-var1130 pat2160))) (build-annotated1059 #f (list (build-annotated1059 #f (list (quote lambda) (list var2164) (chi1118 exp2161 (extend-env1076 labels2163 (list (cons (quote syntax) (cons var2164 0))) r2156) (make-binding-wrap1099 (list pat2160) labels2163 (quote (()))) mod2157))) x2153))) (gen-clause2151 x2153 keys2154 (cdr clauses2155) r2156 pat2160 #t exp2161 mod2157))) tmp2159) ((lambda (tmp2165) (if tmp2165 (apply (lambda (pat2166 fender2167 exp2168) (gen-clause2151 x2153 keys2154 (cdr clauses2155) r2156 pat2166 fender2167 exp2168 mod2157)) tmp2165) ((lambda (_2169) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2155))) tmp2158))) ($sc-dispatch tmp2158 (quote (any any any)))))) ($sc-dispatch tmp2158 (quote (any any))))) (car clauses2155))))) (gen-clause2151 (lambda (x2170 keys2171 clauses2172 r2173 pat2174 fender2175 exp2176 mod2177) (call-with-values (lambda () (convert-pattern2149 pat2174 keys2171)) (lambda (p2178 pvars2179) (cond ((not (distinct-bound-ids?1108 (map car pvars2179))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2174)) ((not (andmap (lambda (x2180) (not (ellipsis?1127 (car x2180)))) pvars2179)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2174)) (else (let ((y2181 (gen-var1130 (quote tmp)))) (build-annotated1059 #f (list (build-annotated1059 #f (list (quote lambda) (list y2181) (let ((y2182 (build-annotated1059 #f y2181))) (build-annotated1059 #f (list (quote if) ((lambda (tmp2183) ((lambda (tmp2184) (if tmp2184 (apply (lambda () y2182) tmp2184) ((lambda (_2185) (build-annotated1059 #f (list (quote if) y2182 (build-dispatch-call2150 pvars2179 fender2175 y2182 r2173 mod2177) (build-data1060 #f #f)))) tmp2183))) ($sc-dispatch tmp2183 (quote #(atom #t))))) fender2175) (build-dispatch-call2150 pvars2179 exp2176 y2182 r2173 mod2177) (gen-syntax-case2152 x2170 keys2171 clauses2172 r2173 mod2177)))))) (if (eq? p2178 (quote any)) (build-annotated1059 #f (list (build-annotated1059 #f (quote list)) x2170)) (build-annotated1059 #f (list (build-annotated1059 #f (quote $sc-dispatch)) x2170 (build-data1060 #f p2178))))))))))))) (build-dispatch-call2150 (lambda (pvars2186 exp2187 y2188 r2189 mod2190) (let ((ids2191 (map car pvars2186)) (levels2192 (map cdr pvars2186))) (let ((labels2193 (gen-labels1088 ids2191)) (new-vars2194 (map gen-var1130 ids2191))) (build-annotated1059 #f (list (build-annotated1059 #f (quote apply)) (build-annotated1059 #f (list (quote lambda) new-vars2194 (chi1118 exp2187 (extend-env1076 labels2193 (map (lambda (var2195 level2196) (cons (quote syntax) (cons var2195 level2196))) new-vars2194 (map cdr pvars2186)) r2189) (make-binding-wrap1099 ids2191 labels2193 (quote (()))) mod2190))) y2188)))))) (convert-pattern2149 (lambda (pattern2197 keys2198) (let cvt2199 ((p2200 pattern2197) (n2201 0) (ids2202 (quote ()))) (if (id?1082 p2200) (if (bound-id-member?1109 p2200 keys2198) (values (vector (quote free-id) p2200) ids2202) (values (quote any) (cons (cons p2200 n2201) ids2202))) ((lambda (tmp2203) ((lambda (tmp2204) (if (if tmp2204 (apply (lambda (x2205 dots2206) (ellipsis?1127 dots2206)) tmp2204) #f) (apply (lambda (x2207 dots2208) (call-with-values (lambda () (cvt2199 x2207 (fx+1050 n2201 1) ids2202)) (lambda (p2209 ids2210) (values (if (eq? p2209 (quote any)) (quote each-any) (vector (quote each) p2209)) ids2210)))) tmp2204) ((lambda (tmp2211) (if tmp2211 (apply (lambda (x2212 y2213) (call-with-values (lambda () (cvt2199 y2213 n2201 ids2202)) (lambda (y2214 ids2215) (call-with-values (lambda () (cvt2199 x2212 n2201 ids2215)) (lambda (x2216 ids2217) (values (cons x2216 y2214) ids2217)))))) tmp2211) ((lambda (tmp2218) (if tmp2218 (apply (lambda () (values (quote ()) ids2202)) tmp2218) ((lambda (tmp2219) (if tmp2219 (apply (lambda (x2220) (call-with-values (lambda () (cvt2199 x2220 n2201 ids2202)) (lambda (p2222 ids2223) (values (vector (quote vector) p2222) ids2223)))) tmp2219) ((lambda (x2224) (values (vector (quote atom) (strip1129 p2200 (quote (())))) ids2202)) tmp2203))) ($sc-dispatch tmp2203 (quote #(vector each-any)))))) ($sc-dispatch tmp2203 (quote ()))))) ($sc-dispatch tmp2203 (quote (any . any)))))) ($sc-dispatch tmp2203 (quote (any any))))) p2200)))))) (lambda (e2225 r2226 w2227 s2228 mod2229) (let ((e2230 (source-wrap1111 e2225 w2227 s2228 mod2229))) ((lambda (tmp2231) ((lambda (tmp2232) (if tmp2232 (apply (lambda (_2233 val2234 key2235 m2236) (if (andmap (lambda (x2237) (and (id?1082 x2237) (not (ellipsis?1127 x2237)))) key2235) (let ((x2239 (gen-var1130 (quote tmp)))) (build-annotated1059 s2228 (list (build-annotated1059 #f (list (quote lambda) (list x2239) (gen-syntax-case2152 (build-annotated1059 #f x2239) key2235 m2236 r2226 mod2229))) (chi1118 val2234 r2226 (quote (())) mod2229)))) (syntax-violation (quote syntax-case) "invalid literals list" e2230))) tmp2232) (syntax-violation #f "source expression failed to match any pattern" tmp2231))) ($sc-dispatch tmp2231 (quote (any any each-any . each-any))))) e2230))))) (set! sc-expand (let ((m2242 (quote e)) (esew2243 (quote (eval)))) (lambda (x2244) (if (and (pair? x2244) (equal? (car x2244) noexpand1049)) (cadr x2244) (chi-top1117 x2244 (quote ()) (quote ((top))) m2242 esew2243 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2245 (quote e)) (esew2246 (quote (eval)))) (lambda (x2248 . rest2247) (if (and (pair? x2248) (equal? (car x2248) noexpand1049)) (cadr x2248) (chi-top1117 x2248 (quote ()) (quote ((top))) (if (null? rest2247) m2245 (car rest2247)) (if (or (null? rest2247) (null? (cdr rest2247))) esew2246 (cadr rest2247)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2249) (nonsymbol-id?1081 x2249))) (set! datum->syntax (lambda (id2250 datum2251) (make-syntax-object1065 datum2251 (syntax-object-wrap1068 id2250) #f))) (set! syntax->datum (lambda (x2252) (strip1129 x2252 (quote (()))))) (set! generate-temporaries (lambda (ls2253) (begin (let ((x2254 ls2253)) (if (not (list? x2254)) (error-hook1056 (quote generate-temporaries) "invalid argument" x2254))) (map (lambda (x2255) (wrap1110 (gensym) (quote ((top))) #f)) ls2253)))) (set! free-identifier=? (lambda (x2256 y2257) (begin (let ((x2258 x2256)) (if (not (nonsymbol-id?1081 x2258)) (error-hook1056 (quote free-identifier=?) "invalid argument" x2258))) (let ((x2259 y2257)) (if (not (nonsymbol-id?1081 x2259)) (error-hook1056 (quote free-identifier=?) "invalid argument" x2259))) (free-id=?1105 x2256 y2257)))) (set! bound-identifier=? (lambda (x2260 y2261) (begin (let ((x2262 x2260)) (if (not (nonsymbol-id?1081 x2262)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2262))) (let ((x2263 y2261)) (if (not (nonsymbol-id?1081 x2263)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2263))) (bound-id=?1106 x2260 y2261)))) (set! syntax-violation (lambda (who2267 message2266 form2265 . subform2264) (begin (let ((x2268 who2267)) (if (not ((lambda (x2269) (or (not x2269) (string? x2269) (symbol? x2269))) x2268)) (error-hook1056 (quote syntax-violation) "invalid argument" x2268))) (let ((x2270 message2266)) (if (not (string? x2270)) (error-hook1056 (quote syntax-violation) "invalid argument" x2270))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2267 "~a: " "") "~a " (if (null? subform2264) "in ~a" "in subform `~s' of `~s'")) (let ((tail2271 (cons message2266 (map (lambda (x2272) (strip1129 x2272 (quote (())))) (append subform2264 (list form2265)))))) (if who2267 (cons who2267 tail2271) tail2271)) #f)))) (set! install-global-transformer (lambda (sym2273 v2274) (begin (let ((x2275 sym2273)) (if (not (symbol? x2275)) (error-hook1056 (quote define-syntax) "invalid argument" x2275))) (let ((x2276 v2274)) (if (not (procedure? x2276)) (error-hook1056 (quote define-syntax) "invalid argument" x2276))) (global-extend1080 (quote macro) sym2273 v2274)))) (letrec ((match2281 (lambda (e2282 p2283 w2284 r2285 mod2286) (cond ((not r2285) #f) ((eq? p2283 (quote any)) (cons (wrap1110 e2282 w2284 mod2286) r2285)) ((syntax-object?1066 e2282) (match*2280 (let ((e2287 (syntax-object-expression1067 e2282))) (if (annotation? e2287) (annotation-expression e2287) e2287)) p2283 (join-wraps1101 w2284 (syntax-object-wrap1068 e2282)) r2285 (syntax-object-module1069 e2282))) (else (match*2280 (let ((e2288 e2282)) (if (annotation? e2288) (annotation-expression e2288) e2288)) p2283 w2284 r2285 mod2286))))) (match*2280 (lambda (e2289 p2290 w2291 r2292 mod2293) (cond ((null? p2290) (and (null? e2289) r2292)) ((pair? p2290) (and (pair? e2289) (match2281 (car e2289) (car p2290) w2291 (match2281 (cdr e2289) (cdr p2290) w2291 r2292 mod2293) mod2293))) ((eq? p2290 (quote each-any)) (let ((l2294 (match-each-any2278 e2289 w2291 mod2293))) (and l2294 (cons l2294 r2292)))) (else (let ((t2295 (vector-ref p2290 0))) (if (memv t2295 (quote (each))) (if (null? e2289) (match-empty2279 (vector-ref p2290 1) r2292) (let ((l2296 (match-each2277 e2289 (vector-ref p2290 1) w2291 mod2293))) (and l2296 (let collect2297 ((l2298 l2296)) (if (null? (car l2298)) r2292 (cons (map car l2298) (collect2297 (map cdr l2298)))))))) (if (memv t2295 (quote (free-id))) (and (id?1082 e2289) (free-id=?1105 (wrap1110 e2289 w2291 mod2293) (vector-ref p2290 1)) r2292) (if (memv t2295 (quote (atom))) (and (equal? (vector-ref p2290 1) (strip1129 e2289 w2291)) r2292) (if (memv t2295 (quote (vector))) (and (vector? e2289) (match2281 (vector->list e2289) (vector-ref p2290 1) w2291 r2292 mod2293))))))))))) (match-empty2279 (lambda (p2299 r2300) (cond ((null? p2299) r2300) ((eq? p2299 (quote any)) (cons (quote ()) r2300)) ((pair? p2299) (match-empty2279 (car p2299) (match-empty2279 (cdr p2299) r2300))) ((eq? p2299 (quote each-any)) (cons (quote ()) r2300)) (else (let ((t2301 (vector-ref p2299 0))) (if (memv t2301 (quote (each))) (match-empty2279 (vector-ref p2299 1) r2300) (if (memv t2301 (quote (free-id atom))) r2300 (if (memv t2301 (quote (vector))) (match-empty2279 (vector-ref p2299 1) r2300))))))))) (match-each-any2278 (lambda (e2302 w2303 mod2304) (cond ((annotation? e2302) (match-each-any2278 (annotation-expression e2302) w2303 mod2304)) ((pair? e2302) (let ((l2305 (match-each-any2278 (cdr e2302) w2303 mod2304))) (and l2305 (cons (wrap1110 (car e2302) w2303 mod2304) l2305)))) ((null? e2302) (quote ())) ((syntax-object?1066 e2302) (match-each-any2278 (syntax-object-expression1067 e2302) (join-wraps1101 w2303 (syntax-object-wrap1068 e2302)) mod2304)) (else #f)))) (match-each2277 (lambda (e2306 p2307 w2308 mod2309) (cond ((annotation? e2306) (match-each2277 (annotation-expression e2306) p2307 w2308 mod2309)) ((pair? e2306) (let ((first2310 (match2281 (car e2306) p2307 w2308 (quote ()) mod2309))) (and first2310 (let ((rest2311 (match-each2277 (cdr e2306) p2307 w2308 mod2309))) (and rest2311 (cons first2310 rest2311)))))) ((null? e2306) (quote ())) ((syntax-object?1066 e2306) (match-each2277 (syntax-object-expression1067 e2306) p2307 (join-wraps1101 w2308 (syntax-object-wrap1068 e2306)) (syntax-object-module1069 e2306))) (else #f))))) (set! $sc-dispatch (lambda (e2312 p2313) (cond ((eq? p2313 (quote any)) (list e2312)) ((syntax-object?1066 e2312) (match*2280 (let ((e2314 (syntax-object-expression1067 e2312))) (if (annotation? e2314) (annotation-expression e2314) e2314)) p2313 (syntax-object-wrap1068 e2312) (quote ()) (syntax-object-module1069 e2312))) (else (match*2280 (let ((e2315 e2312)) (if (annotation? e2315) (annotation-expression e2315) e2315)) p2313 (quote (())) (quote ()) #f))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x2316) ((lambda (tmp2317) ((lambda (tmp2318) (if tmp2318 (apply (lambda (_2319 e12320 e22321) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12320 e22321))) tmp2318) ((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))) 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) ((lambda (tmp2330) (if tmp2330 (apply (lambda (_2331 out2332 in2333 e12334 e22335) (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))) in2333) (quote ()) (list out2332 (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 e12334 e22335))))) tmp2330) (syntax-violation #f "source expression failed to match any pattern" tmp2317))) ($sc-dispatch tmp2317 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2317 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2317 (quote (any () any . each-any))))) x2316))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2339) ((lambda (tmp2340) ((lambda (tmp2341) (if tmp2341 (apply (lambda (_2342 k2343 keyword2344 pattern2345 template2346) (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 k2343 (map (lambda (tmp2349 tmp2348) (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))) tmp2348) (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))) tmp2349))) template2346 pattern2345)))))) tmp2341) (syntax-violation #f "source expression failed to match any pattern" tmp2340))) ($sc-dispatch tmp2340 (quote (any each-any . #(each ((any . any) any))))))) x2339))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2350) ((lambda (tmp2351) ((lambda (tmp2352) (if (if tmp2352 (apply (lambda (let*2353 x2354 v2355 e12356 e22357) (andmap identifier? x2354)) tmp2352) #f) (apply (lambda (let*2359 x2360 v2361 e12362 e22363) (let f2364 ((bindings2365 (map list x2360 v2361))) (if (null? bindings2365) (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 e12362 e22363))) ((lambda (tmp2369) ((lambda (tmp2370) (if tmp2370 (apply (lambda (body2371 binding2372) (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 binding2372) body2371)) tmp2370) (syntax-violation #f "source expression failed to match any pattern" tmp2369))) ($sc-dispatch tmp2369 (quote (any any))))) (list (f2364 (cdr bindings2365)) (car bindings2365)))))) tmp2352) (syntax-violation #f "source expression failed to match any pattern" tmp2351))) ($sc-dispatch tmp2351 (quote (any #(each (any any)) any . each-any))))) x2350))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2373) ((lambda (tmp2374) ((lambda (tmp2375) (if tmp2375 (apply (lambda (_2376 var2377 init2378 step2379 e02380 e12381 c2382) ((lambda (tmp2383) ((lambda (tmp2384) (if tmp2384 (apply (lambda (step2385) ((lambda (tmp2386) ((lambda (tmp2387) (if tmp2387 (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 var2377 init2378) (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))) e02380) (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 c2382 (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))) step2385))))))) tmp2387) ((lambda (tmp2392) (if tmp2392 (apply (lambda (e12393 e22394) (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 var2377 init2378) (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))) e02380 (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 e12393 e22394)) (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 c2382 (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))) step2385))))))) tmp2392) (syntax-violation #f "source expression failed to match any pattern" tmp2386))) ($sc-dispatch tmp2386 (quote (any . each-any)))))) ($sc-dispatch tmp2386 (quote ())))) e12381)) tmp2384) (syntax-violation #f "source expression failed to match any pattern" tmp2383))) ($sc-dispatch tmp2383 (quote each-any)))) (map (lambda (v2401 s2402) ((lambda (tmp2403) ((lambda (tmp2404) (if tmp2404 (apply (lambda () v2401) tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda (e2406) e2406) tmp2405) ((lambda (_2407) (syntax-violation (quote do) "bad step expression" orig-x2373 s2402)) tmp2403))) ($sc-dispatch tmp2403 (quote (any)))))) ($sc-dispatch tmp2403 (quote ())))) s2402)) var2377 step2379))) tmp2375) (syntax-violation #f "source expression failed to match any pattern" tmp2374))) ($sc-dispatch tmp2374 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2373))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2410 (lambda (x2414 y2415) ((lambda (tmp2416) ((lambda (tmp2417) (if tmp2417 (apply (lambda (x2418 y2419) ((lambda (tmp2420) ((lambda (tmp2421) (if tmp2421 (apply (lambda (dy2422) ((lambda (tmp2423) ((lambda (tmp2424) (if tmp2424 (apply (lambda (dx2425) (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 dx2425 dy2422))) tmp2424) ((lambda (_2426) (if (null? dy2422) (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))) x2418) (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))) x2418 y2419))) tmp2423))) ($sc-dispatch tmp2423 (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))))) x2418)) tmp2421) ((lambda (tmp2427) (if tmp2427 (apply (lambda (stuff2428) (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 x2418 stuff2428))) tmp2427) ((lambda (else2429) (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))) x2418 y2419)) tmp2420))) ($sc-dispatch tmp2420 (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 tmp2420 (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))))) y2419)) tmp2417) (syntax-violation #f "source expression failed to match any pattern" tmp2416))) ($sc-dispatch tmp2416 (quote (any any))))) (list x2414 y2415)))) (quasiappend2411 (lambda (x2430 y2431) ((lambda (tmp2432) ((lambda (tmp2433) (if tmp2433 (apply (lambda (x2434 y2435) ((lambda (tmp2436) ((lambda (tmp2437) (if tmp2437 (apply (lambda () x2434) tmp2437) ((lambda (_2438) (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))) x2434 y2435)) tmp2436))) ($sc-dispatch tmp2436 (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))) ()))))) y2435)) tmp2433) (syntax-violation #f "source expression failed to match any pattern" tmp2432))) ($sc-dispatch tmp2432 (quote (any any))))) (list x2430 y2431)))) (quasivector2412 (lambda (x2439) ((lambda (tmp2440) ((lambda (x2441) ((lambda (tmp2442) ((lambda (tmp2443) (if tmp2443 (apply (lambda (x2444) (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 x2444))) tmp2443) ((lambda (tmp2446) (if tmp2446 (apply (lambda (x2447) (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))) x2447)) tmp2446) ((lambda (_2449) (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))) x2441)) tmp2442))) ($sc-dispatch tmp2442 (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 tmp2442 (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))))) x2441)) tmp2440)) x2439))) (quasi2413 (lambda (p2450 lev2451) ((lambda (tmp2452) ((lambda (tmp2453) (if tmp2453 (apply (lambda (p2454) (if (= lev2451 0) p2454 (quasicons2410 (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)))) (quasi2413 (list p2454) (- lev2451 1))))) tmp2453) ((lambda (tmp2455) (if tmp2455 (apply (lambda (p2456 q2457) (if (= lev2451 0) (quasiappend2411 p2456 (quasi2413 q2457 lev2451)) (quasicons2410 (quasicons2410 (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)))) (quasi2413 (list p2456) (- lev2451 1))) (quasi2413 q2457 lev2451)))) tmp2455) ((lambda (tmp2458) (if tmp2458 (apply (lambda (p2459) (quasicons2410 (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)))) (quasi2413 (list p2459) (+ lev2451 1)))) tmp2458) ((lambda (tmp2460) (if tmp2460 (apply (lambda (p2461 q2462) (quasicons2410 (quasi2413 p2461 lev2451) (quasi2413 q2462 lev2451))) tmp2460) ((lambda (tmp2463) (if tmp2463 (apply (lambda (x2464) (quasivector2412 (quasi2413 x2464 lev2451))) tmp2463) ((lambda (p2466) (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))) p2466)) tmp2452))) ($sc-dispatch tmp2452 (quote #(vector each-any)))))) ($sc-dispatch tmp2452 (quote (any . any)))))) ($sc-dispatch tmp2452 (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 tmp2452 (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 tmp2452 (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))))) p2450)))) (lambda (x2467) ((lambda (tmp2468) ((lambda (tmp2469) (if tmp2469 (apply (lambda (_2470 e2471) (quasi2413 e2471 0)) tmp2469) (syntax-violation #f "source expression failed to match any pattern" tmp2468))) ($sc-dispatch tmp2468 (quote (any any))))) x2467)))))
-(define include (make-syncase-macro (quote macro) (lambda (x2472) (letrec ((read-file2473 (lambda (fn2474 k2475) (let ((p2476 (open-input-file fn2474))) (let f2477 ((x2478 (read p2476))) (if (eof-object? x2478) (begin (close-input-port p2476) (quote ())) (cons (datum->syntax k2475 x2478) (f2477 (read p2476))))))))) ((lambda (tmp2479) ((lambda (tmp2480) (if tmp2480 (apply (lambda (k2481 filename2482) (let ((fn2483 (syntax->datum filename2482))) ((lambda (tmp2484) ((lambda (tmp2485) (if tmp2485 (apply (lambda (exp2486) (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))) exp2486)) tmp2485) (syntax-violation #f "source expression failed to match any pattern" tmp2484))) ($sc-dispatch tmp2484 (quote each-any)))) (read-file2473 fn2483 k2481)))) tmp2480) (syntax-violation #f "source expression failed to match any pattern" tmp2479))) ($sc-dispatch tmp2479 (quote (any any))))) x2472)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x2488) ((lambda (tmp2489) ((lambda (tmp2490) (if tmp2490 (apply (lambda (_2491 e2492) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2492))) tmp2490) (syntax-violation #f "source expression failed to match any pattern" tmp2489))) ($sc-dispatch tmp2489 (quote (any any))))) x2488))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2493) ((lambda (tmp2494) ((lambda (tmp2495) (if tmp2495 (apply (lambda (_2496 e2497) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2497))) tmp2495) (syntax-violation #f "source expression failed to match any pattern" tmp2494))) ($sc-dispatch tmp2494 (quote (any any))))) x2493))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2498) ((lambda (tmp2499) ((lambda (tmp2500) (if tmp2500 (apply (lambda (_2501 e2502 m12503 m22504) ((lambda (tmp2505) ((lambda (body2506) (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))) e2502)) body2506)) tmp2505)) (let f2507 ((clause2508 m12503) (clauses2509 m22504)) (if (null? clauses2509) ((lambda (tmp2511) ((lambda (tmp2512) (if tmp2512 (apply (lambda (e12513 e22514) (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 e12513 e22514))) tmp2512) ((lambda (tmp2516) (if tmp2516 (apply (lambda (k2517 e12518 e22519) (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))) k2517)) (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 e12518 e22519)))) tmp2516) ((lambda (_2522) (syntax-violation (quote case) "bad clause" x2498 clause2508)) tmp2511))) ($sc-dispatch tmp2511 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2511 (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))))) clause2508) ((lambda (tmp2523) ((lambda (rest2524) ((lambda (tmp2525) ((lambda (tmp2526) (if tmp2526 (apply (lambda (k2527 e12528 e22529) (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))) k2527)) (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 e12528 e22529)) rest2524)) tmp2526) ((lambda (_2532) (syntax-violation (quote case) "bad clause" x2498 clause2508)) tmp2525))) ($sc-dispatch tmp2525 (quote (each-any any . each-any))))) clause2508)) tmp2523)) (f2507 (car clauses2509) (cdr clauses2509))))))) tmp2500) (syntax-violation #f "source expression failed to match any pattern" tmp2499))) ($sc-dispatch tmp2499 (quote (any any any . each-any))))) x2498))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2533) ((lambda (tmp2534) ((lambda (tmp2535) (if tmp2535 (apply (lambda (_2536 e2537) (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))) e2537)) (list (cons _2536 (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 e2537 (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)))))))))) tmp2535) (syntax-violation #f "source expression failed to match any pattern" tmp2534))) ($sc-dispatch tmp2534 (quote (any any))))) x2533))))
+(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))))
;;; Revision 3, for a complete description)
;;; (syntax-violation who message form [subform])
;;; used to report errors found during expansion
-;;; (install-global-transformer symbol value)
-;;; used by expanded code to install top-level syntactic abstractions
;;; ($sc-dispatch e p)
;;; used by expanded code to handle syntax-case matching
(if who (cons who tail) tail))
#f)))
-(set! install-global-transformer
- (lambda (sym v)
- (arg-check symbol? sym 'define-syntax)
- (arg-check procedure? v 'define-syntax)
- (global-extend 'macro sym v)))
-
;;; $sc-dispatch expects an expression and a pattern. If the expression
;;; matches the pattern a list of the matching expressions for each
;;; "any" is returned. Otherwise, #f is returned. (This use of #f will
HCoop / bpt / guile.git / commitdiff