diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index e4c3cb2f8..ac1ffd66a 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -187,7 +187,7 @@ ;; Until the module system is booted, this will be the current expander. (primitive-load-path "ice-9/psyntax-pp") -(define %pre-modules-transformer (lambda args (pk 'in args 'out (apply sc-expand args)))) +(define %pre-modules-transformer sc-expand) @@ -1860,7 +1860,6 @@ already) (autoload ;; Try to autoload the module, and recurse. - (pk name) (try-load-module name) (resolve-module name #f)) (else @@ -1894,9 +1893,7 @@ ;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module))) (define (try-load-module name) - (or (begin-deprecated (try-module-linked name)) - (try-module-autoload name) - (begin-deprecated (try-module-dynamic-link name)))) + (try-module-autoload name)) (define (purify-module! module) "Removes bindings in MODULE which are inherited from the (guile) module." @@ -2182,7 +2179,6 @@ module '(ice-9 q) '(make-q q-length))}." (and (not (autoload-done-or-in-progress? dir-hint name)) (let ((didit #f)) (define (load-file proc file) - (pk 'loading proc file) (save-module-excursion (lambda () (proc file))) (set! didit #t)) (dynamic-wind diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 9496275cb..befef849c 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -1,11 +1,11 @@ -(letrec ((lambda-var-list1141 (lambda (vars1340) (let lvl1341 ((vars1342 vars1340) (ls1343 (quote ())) (w1344 (quote (())))) (cond ((pair? vars1342) (lvl1341 (cdr vars1342) (cons (wrap1120 (car vars1342) w1344 #f) ls1343) w1344)) ((id?1092 vars1342) (cons (wrap1120 vars1342 w1344 #f) ls1343)) ((null? vars1342) ls1343) ((syntax-object?1076 vars1342) (lvl1341 (syntax-object-expression1077 vars1342) ls1343 (join-wraps1111 w1344 (syntax-object-wrap1078 vars1342)))) ((annotation? vars1342) (lvl1341 (annotation-expression vars1342) ls1343 w1344)) (else (cons vars1342 ls1343)))))) (gen-var1140 (lambda (id1345) (let ((id1346 (if (syntax-object?1076 id1345) (syntax-object-expression1077 id1345) id1345))) (if (annotation? id1346) (build-annotated1069 (annotation-source id1346) (gensym (symbol->string (annotation-expression id1346)))) (build-annotated1069 #f (gensym (symbol->string id1346))))))) (strip1139 (lambda (x1347 w1348) (if (memq (quote top) (wrap-marks1095 w1348)) (if (or (annotation? x1347) (and (pair? x1347) (annotation? (car x1347)))) (strip-annotation1138 x1347 #f) x1347) (let f1349 ((x1350 x1347)) (cond ((syntax-object?1076 x1350) (strip1139 (syntax-object-expression1077 x1350) (syntax-object-wrap1078 x1350))) ((pair? x1350) (let ((a1351 (f1349 (car x1350))) (d1352 (f1349 (cdr x1350)))) (if (and (eq? a1351 (car x1350)) (eq? d1352 (cdr x1350))) x1350 (cons a1351 d1352)))) ((vector? x1350) (let ((old1353 (vector->list x1350))) (let ((new1354 (map f1349 old1353))) (if (andmap eq? old1353 new1354) x1350 (list->vector new1354))))) (else x1350)))))) (strip-annotation1138 (lambda (x1355 parent1356) (cond ((pair? x1355) (let ((new1357 (cons #f #f))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1357)) (set-car! new1357 (strip-annotation1138 (car x1355) #f)) (set-cdr! new1357 (strip-annotation1138 (cdr x1355) #f)) new1357))) ((annotation? x1355) (or (annotation-stripped x1355) (strip-annotation1138 (annotation-expression x1355) x1355))) ((vector? x1355) (let ((new1358 (make-vector (vector-length x1355)))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1358)) (let loop1359 ((i1360 (- (vector-length x1355) 1))) (unless (fx<1062 i1360 0) (vector-set! new1358 i1360 (strip-annotation1138 (vector-ref x1355 i1360) #f)) (loop1359 (fx-1060 i1360 1)))) new1358))) (else x1355)))) (ellipsis?1137 (lambda (x1361) (and (nonsymbol-id?1091 x1361) (free-id=?1115 x1361 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))))))) (chi-void1136 (lambda () (build-annotated1069 #f (list (build-annotated1069 #f (quote void)))))) (eval-local-transformer1135 (lambda (expanded1362 mod1363) (let ((p1364 (local-eval-hook1064 expanded1362 mod1363))) (if (procedure? p1364) p1364 (syntax-error p1364 "nonprocedure transformer"))))) (chi-local-syntax1134 (lambda (rec?1365 e1366 r1367 w1368 s1369 mod1370 k1371) ((lambda (tmp1372) ((lambda (tmp1373) (if tmp1373 (apply (lambda (_1374 id1375 val1376 e11377 e21378) (let ((ids1379 id1375)) (if (not (valid-bound-ids?1117 ids1379)) (syntax-error e1366 "duplicate bound keyword in") (let ((labels1381 (gen-labels1098 ids1379))) (let ((new-w1382 (make-binding-wrap1109 ids1379 labels1381 w1368))) (k1371 (cons e11377 e21378) (extend-env1086 labels1381 (let ((w1384 (if rec?1365 new-w1382 w1368)) (trans-r1385 (macros-only-env1088 r1367))) (map (lambda (x1386) (cons (quote macro) (eval-local-transformer1135 (chi1128 x1386 trans-r1385 w1384 mod1370) mod1370))) val1376)) r1367) new-w1382 s1369 mod1370)))))) tmp1373) ((lambda (_1388) (syntax-error (source-wrap1121 e1366 w1368 s1369 mod1370))) tmp1372))) (syntax-dispatch tmp1372 (quote (any #(each (any any)) any . each-any))))) e1366))) (chi-lambda-clause1133 (lambda (e1389 c1390 r1391 w1392 mod1393 k1394) ((lambda (tmp1395) ((lambda (tmp1396) (if tmp1396 (apply (lambda (id1397 e11398 e21399) (let ((ids1400 id1397)) (if (not (valid-bound-ids?1117 ids1400)) (syntax-error e1389 "invalid parameter list in") (let ((labels1402 (gen-labels1098 ids1400)) (new-vars1403 (map gen-var1140 ids1400))) (k1394 new-vars1403 (chi-body1132 (cons e11398 e21399) e1389 (extend-var-env1087 labels1402 new-vars1403 r1391) (make-binding-wrap1109 ids1400 labels1402 w1392) mod1393)))))) tmp1396) ((lambda (tmp1405) (if tmp1405 (apply (lambda (ids1406 e11407 e21408) (let ((old-ids1409 (lambda-var-list1141 ids1406))) (if (not (valid-bound-ids?1117 old-ids1409)) (syntax-error e1389 "invalid parameter list in") (let ((labels1410 (gen-labels1098 old-ids1409)) (new-vars1411 (map gen-var1140 old-ids1409))) (k1394 (let f1412 ((ls11413 (cdr new-vars1411)) (ls21414 (car new-vars1411))) (if (null? ls11413) ls21414 (f1412 (cdr ls11413) (cons (car ls11413) ls21414)))) (chi-body1132 (cons e11407 e21408) e1389 (extend-var-env1087 labels1410 new-vars1411 r1391) (make-binding-wrap1109 old-ids1409 labels1410 w1392) mod1393)))))) tmp1405) ((lambda (_1416) (syntax-error e1389)) tmp1395))) (syntax-dispatch tmp1395 (quote (any any . each-any)))))) (syntax-dispatch tmp1395 (quote (each-any any . each-any))))) c1390))) (chi-body1132 (lambda (body1417 outer-form1418 r1419 w1420 mod1421) (let ((r1422 (cons (quote ("placeholder" placeholder)) r1419))) (let ((ribcage1423 (make-ribcage1099 (quote ()) (quote ()) (quote ())))) (let ((w1424 (make-wrap1094 (wrap-marks1095 w1420) (cons ribcage1423 (wrap-subst1096 w1420))))) (let parse1425 ((body1426 (map (lambda (x1432) (cons r1422 (wrap1120 x1432 w1424 mod1421))) body1417)) (ids1427 (quote ())) (labels1428 (quote ())) (vars1429 (quote ())) (vals1430 (quote ())) (bindings1431 (quote ()))) (if (null? body1426) (syntax-error outer-form1418 "no expressions in body") (let ((e1433 (cdar body1426)) (er1434 (caar body1426))) (call-with-values (lambda () (syntax-type1126 e1433 er1434 (quote (())) #f ribcage1423 mod1421)) (lambda (type1435 value1436 e1437 w1438 s1439 mod1440) (let ((t1441 type1435)) (if (memv t1441 (quote (define-form))) (let ((id1442 (wrap1120 value1436 w1438 mod1440)) (label1443 (gen-label1097))) (let ((var1444 (gen-var1140 id1442))) (begin (extend-ribcage!1108 ribcage1423 id1442 label1443) (parse1425 (cdr body1426) (cons id1442 ids1427) (cons label1443 labels1428) (cons var1444 vars1429) (cons (cons er1434 (wrap1120 e1437 w1438 mod1440)) vals1430) (cons (cons (quote lexical) var1444) bindings1431))))) (if (memv t1441 (quote (define-syntax-form))) (let ((id1445 (wrap1120 value1436 w1438 mod1440)) (label1446 (gen-label1097))) (begin (extend-ribcage!1108 ribcage1423 id1445 label1446) (parse1425 (cdr body1426) (cons id1445 ids1427) (cons label1446 labels1428) vars1429 vals1430 (cons (cons (quote macro) (cons er1434 (wrap1120 e1437 w1438 mod1440))) bindings1431)))) (if (memv t1441 (quote (begin-form))) ((lambda (tmp1447) ((lambda (tmp1448) (if tmp1448 (apply (lambda (_1449 e11450) (parse1425 (let f1451 ((forms1452 e11450)) (if (null? forms1452) (cdr body1426) (cons (cons er1434 (wrap1120 (car forms1452) w1438 mod1440)) (f1451 (cdr forms1452))))) ids1427 labels1428 vars1429 vals1430 bindings1431)) tmp1448) (syntax-error tmp1447))) (syntax-dispatch tmp1447 (quote (any . each-any))))) e1437) (if (memv t1441 (quote (local-syntax-form))) (chi-local-syntax1134 value1436 e1437 er1434 w1438 s1439 mod1440 (lambda (forms1454 er1455 w1456 s1457 mod1458) (parse1425 (let f1459 ((forms1460 forms1454)) (if (null? forms1460) (cdr body1426) (cons (cons er1455 (wrap1120 (car forms1460) w1456 mod1458)) (f1459 (cdr forms1460))))) ids1427 labels1428 vars1429 vals1430 bindings1431))) (if (null? ids1427) (build-sequence1071 #f (map (lambda (x1461) (chi1128 (cdr x1461) (car x1461) (quote (())) mod1440)) (cons (cons er1434 (source-wrap1121 e1437 w1438 s1439 mod1440)) (cdr body1426)))) (begin (if (not (valid-bound-ids?1117 ids1427)) (syntax-error outer-form1418 "invalid or duplicate identifier in definition")) (let loop1462 ((bs1463 bindings1431) (er-cache1464 #f) (r-cache1465 #f)) (if (not (null? bs1463)) (let ((b1466 (car bs1463))) (if (eq? (car b1466) (quote macro)) (let ((er1467 (cadr b1466))) (let ((r-cache1468 (if (eq? er1467 er-cache1464) r-cache1465 (macros-only-env1088 er1467)))) (begin (set-cdr! b1466 (eval-local-transformer1135 (chi1128 (cddr b1466) r-cache1468 (quote (())) mod1440) mod1440)) (loop1462 (cdr bs1463) er1467 r-cache1468)))) (loop1462 (cdr bs1463) er-cache1464 r-cache1465))))) (set-cdr! r1422 (extend-env1086 labels1428 bindings1431 (cdr r1422))) (build-letrec1074 #f vars1429 (map (lambda (x1469) (chi1128 (cdr x1469) (car x1469) (quote (())) mod1440)) vals1430) (build-sequence1071 #f (map (lambda (x1470) (chi1128 (cdr x1470) (car x1470) (quote (())) mod1440)) (cons (cons er1434 (source-wrap1121 e1437 w1438 s1439 mod1440)) (cdr body1426)))))))))))))))))))))) (chi-macro1131 (lambda (p1471 e1472 r1473 w1474 rib1475 mod1476) (letrec ((rebuild-macro-output1477 (lambda (x1478 m1479) (cond ((pair? x1478) (cons (rebuild-macro-output1477 (car x1478) m1479) (rebuild-macro-output1477 (cdr x1478) m1479))) ((syntax-object?1076 x1478) (let ((w1480 (syntax-object-wrap1078 x1478))) (let ((ms1481 (wrap-marks1095 w1480)) (s1482 (wrap-subst1096 w1480))) (if (and (pair? ms1481) (eq? (car ms1481) #f)) (make-syntax-object1075 (syntax-object-expression1077 x1478) (make-wrap1094 (cdr ms1481) (if rib1475 (cons rib1475 (cdr s1482)) (cdr s1482))) (syntax-object-module1079 x1478)) (make-syntax-object1075 (syntax-object-expression1077 x1478) (make-wrap1094 (cons m1479 ms1481) (if rib1475 (cons rib1475 (cons (quote shift) s1482)) (cons (quote shift) s1482))) (module-name (procedure-module p1471))))))) ((vector? x1478) (let ((n1483 (vector-length x1478))) (let ((v1484 (make-vector n1483))) (let doloop1485 ((i1486 0)) (if (fx=1061 i1486 n1483) v1484 (begin (vector-set! v1484 i1486 (rebuild-macro-output1477 (vector-ref x1478 i1486) m1479)) (doloop1485 (fx+1059 i1486 1)))))))) ((symbol? x1478) (syntax-error x1478 "encountered raw symbol in macro output")) (else x1478))))) (rebuild-macro-output1477 (p1471 (wrap1120 e1472 (anti-mark1107 w1474) mod1476)) (string #\m))))) (chi-application1130 (lambda (x1487 e1488 r1489 w1490 s1491 mod1492) ((lambda (tmp1493) ((lambda (tmp1494) (if tmp1494 (apply (lambda (e01495 e11496) (build-annotated1069 s1491 (cons x1487 (map (lambda (e1497) (chi1128 e1497 r1489 w1490 mod1492)) e11496)))) tmp1494) (syntax-error tmp1493))) (syntax-dispatch tmp1493 (quote (any . each-any))))) e1488))) (chi-expr1129 (lambda (type1499 value1500 e1501 r1502 w1503 s1504 mod1505) (let ((t1506 type1499)) (if (memv t1506 (quote (lexical))) (build-annotated1069 s1504 value1500) (if (memv t1506 (quote (core external-macro))) (value1500 e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (module-ref))) (call-with-values (lambda () (value1500 e1501)) (lambda (id1507 mod1508) (build-annotated1069 s1504 (make-module-ref mod1508 id1507 #f)))) (if (memv t1506 (quote (lexical-call))) (chi-application1130 (build-annotated1069 (source-annotation1083 (car e1501)) value1500) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (global-call))) (chi-application1130 (build-annotated1069 (source-annotation1083 (car e1501)) (make-module-ref (if (syntax-object?1076 (car e1501)) (syntax-object-module1079 (car e1501)) mod1505) value1500 #f)) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (constant))) (build-data1070 s1504 (strip1139 (source-wrap1121 e1501 w1503 s1504 mod1505) (quote (())))) (if (memv t1506 (quote (global))) (build-annotated1069 s1504 (make-module-ref mod1505 value1500 #f)) (if (memv t1506 (quote (call))) (chi-application1130 (chi1128 (car e1501) r1502 w1503 mod1505) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (begin-form))) ((lambda (tmp1509) ((lambda (tmp1510) (if tmp1510 (apply (lambda (_1511 e11512 e21513) (chi-sequence1122 (cons e11512 e21513) r1502 w1503 s1504 mod1505)) tmp1510) (syntax-error tmp1509))) (syntax-dispatch tmp1509 (quote (any any . each-any))))) e1501) (if (memv t1506 (quote (local-syntax-form))) (chi-local-syntax1134 value1500 e1501 r1502 w1503 s1504 mod1505 chi-sequence1122) (if (memv t1506 (quote (eval-when-form))) ((lambda (tmp1515) ((lambda (tmp1516) (if tmp1516 (apply (lambda (_1517 x1518 e11519 e21520) (let ((when-list1521 (chi-when-list1125 e1501 x1518 w1503))) (if (memq (quote eval) when-list1521) (chi-sequence1122 (cons e11519 e21520) r1502 w1503 s1504 mod1505) (chi-void1136)))) tmp1516) (syntax-error tmp1515))) (syntax-dispatch tmp1515 (quote (any each-any any . each-any))))) e1501) (if (memv t1506 (quote (define-form define-syntax-form))) (syntax-error (wrap1120 value1500 w1503 mod1505) "invalid context for definition of") (if (memv t1506 (quote (syntax))) (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505) "reference to pattern variable outside syntax form") (if (memv t1506 (quote (displaced-lexical))) (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505) "reference to identifier outside its scope") (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505))))))))))))))))))) (chi1128 (lambda (e1524 r1525 w1526 mod1527) (call-with-values (lambda () (syntax-type1126 e1524 r1525 w1526 #f #f mod1527)) (lambda (type1528 value1529 e1530 w1531 s1532 mod1533) (chi-expr1129 type1528 value1529 e1530 r1525 w1531 s1532 mod1533))))) (chi-top1127 (lambda (e1534 r1535 w1536 m1537 esew1538 mod1539) (call-with-values (lambda () (syntax-type1126 e1534 r1535 w1536 #f #f mod1539)) (lambda (type1547 value1548 e1549 w1550 s1551 mod1552) (let ((t1553 type1547)) (if (memv t1553 (quote (begin-form))) ((lambda (tmp1554) ((lambda (tmp1555) (if tmp1555 (apply (lambda (_1556) (chi-void1136)) tmp1555) ((lambda (tmp1557) (if tmp1557 (apply (lambda (_1558 e11559 e21560) (chi-top-sequence1123 (cons e11559 e21560) r1535 w1550 s1551 m1537 esew1538 mod1552)) tmp1557) (syntax-error tmp1554))) (syntax-dispatch tmp1554 (quote (any any . each-any)))))) (syntax-dispatch tmp1554 (quote (any))))) e1549) (if (memv t1553 (quote (local-syntax-form))) (chi-local-syntax1134 value1548 e1549 r1535 w1550 s1551 mod1552 (lambda (body1562 r1563 w1564 s1565 mod1566) (chi-top-sequence1123 body1562 r1563 w1564 s1565 m1537 esew1538 mod1566))) (if (memv t1553 (quote (eval-when-form))) ((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569 x1570 e11571 e21572) (let ((when-list1573 (chi-when-list1125 e1549 x1570 w1550)) (body1574 (cons e11571 e21572))) (cond ((eq? m1537 (quote e)) (if (memq (quote eval) when-list1573) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote e) (quote (eval)) mod1552) (chi-void1136))) ((memq (quote load) when-list1573) (if (or (memq (quote compile) when-list1573) (and (eq? m1537 (quote c&e)) (memq (quote eval) when-list1573))) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote c&e) (quote (compile load)) mod1552) (if (memq m1537 (quote (c c&e))) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote c) (quote (load)) mod1552) (chi-void1136)))) ((or (memq (quote compile) when-list1573) (and (eq? m1537 (quote c&e)) (memq (quote eval) when-list1573))) (top-level-eval-hook1063 (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote e) (quote (eval)) mod1552) mod1552) (chi-void1136)) (else (chi-void1136))))) tmp1568) (syntax-error tmp1567))) (syntax-dispatch tmp1567 (quote (any each-any any . each-any))))) e1549) (if (memv t1553 (quote (define-syntax-form))) (let ((n1577 (id-var-name1114 value1548 w1550)) (r1578 (macros-only-env1088 r1535))) (let ((t1579 m1537)) (if (memv t1579 (quote (c))) (if (memq (quote compile) esew1538) (let ((e1580 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)))) (begin (top-level-eval-hook1063 e1580 mod1552) (if (memq (quote load) esew1538) e1580 (chi-void1136)))) (if (memq (quote load) esew1538) (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)) (chi-void1136))) (if (memv t1579 (quote (c&e))) (let ((e1581 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)))) (begin (top-level-eval-hook1063 e1581 mod1552) e1581)) (begin (if (memq (quote eval) esew1538) (top-level-eval-hook1063 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)) mod1552)) (chi-void1136)))))) (if (memv t1553 (quote (define-form))) (let ((n1582 (id-var-name1114 value1548 w1550))) (let ((type1583 (binding-type1084 (lookup1089 n1582 r1535 mod1552)))) (let ((t1584 type1583)) (if (memv t1584 (quote (global))) (let ((x1585 (build-annotated1069 s1551 (list (quote define) n1582 (chi1128 e1549 r1535 w1550 mod1552))))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1585 mod1552)) x1585)) (if (memv t1584 (quote (displaced-lexical))) (syntax-error (wrap1120 value1548 w1550 mod1552) "identifier out of context") (if (memv t1584 (quote (core macro module-ref))) (begin (remove-global-definition-hook1067 n1582 mod1552) (let ((x1586 (build-annotated1069 s1551 (list (quote define) n1582 (chi1128 e1549 r1535 w1550 mod1552))))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1586 mod1552)) x1586))) (syntax-error (wrap1120 value1548 w1550 mod1552) "cannot define keyword at top level"))))))) (let ((x1587 (chi-expr1129 type1547 value1548 e1549 r1535 w1550 s1551 mod1552))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1587 mod1552)) x1587)))))))))))) (syntax-type1126 (lambda (e1588 r1589 w1590 s1591 rib1592 mod1593) (cond ((symbol? e1588) (let ((n1594 (id-var-name1114 e1588 w1590))) (let ((b1595 (lookup1089 n1594 r1589 mod1593))) (let ((type1596 (binding-type1084 b1595))) (let ((t1597 type1596)) (if (memv t1597 (quote (lexical))) (values type1596 (binding-value1085 b1595) e1588 w1590 s1591 mod1593) (if (memv t1597 (quote (global))) (values type1596 n1594 e1588 w1590 s1591 mod1593) (if (memv t1597 (quote (macro))) (syntax-type1126 (chi-macro1131 (binding-value1085 b1595) e1588 r1589 w1590 rib1592 mod1593) r1589 (quote (())) s1591 rib1592 mod1593) (values type1596 (binding-value1085 b1595) e1588 w1590 s1591 mod1593))))))))) ((pair? e1588) (let ((first1598 (car e1588))) (if (id?1092 first1598) (let ((n1599 (id-var-name1114 first1598 w1590))) (let ((b1600 (lookup1089 n1599 r1589 (or (and (syntax-object?1076 first1598) (syntax-object-module1079 first1598)) mod1593)))) (let ((type1601 (binding-type1084 b1600))) (let ((t1602 type1601)) (if (memv t1602 (quote (lexical))) (values (quote lexical-call) (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (global))) (values (quote global-call) n1599 e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (macro))) (syntax-type1126 (chi-macro1131 (binding-value1085 b1600) e1588 r1589 w1590 rib1592 mod1593) r1589 (quote (())) s1591 rib1592 mod1593) (if (memv t1602 (quote (core external-macro module-ref))) (values type1601 (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (begin))) (values (quote begin-form) #f e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (eval-when))) (values (quote eval-when-form) #f e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (define))) ((lambda (tmp1603) ((lambda (tmp1604) (if (if tmp1604 (apply (lambda (_1605 name1606 val1607) (id?1092 name1606)) tmp1604) #f) (apply (lambda (_1608 name1609 val1610) (values (quote define-form) name1609 val1610 w1590 s1591 mod1593)) tmp1604) ((lambda (tmp1611) (if (if tmp1611 (apply (lambda (_1612 name1613 args1614 e11615 e21616) (and (id?1092 name1613) (valid-bound-ids?1117 (lambda-var-list1141 args1614)))) tmp1611) #f) (apply (lambda (_1617 name1618 args1619 e11620 e21621) (values (quote define-form) (wrap1120 name1618 w1590 mod1593) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) (wrap1120 (cons args1619 (cons e11620 e21621)) w1590 mod1593)) (quote (())) s1591 mod1593)) tmp1611) ((lambda (tmp1623) (if (if tmp1623 (apply (lambda (_1624 name1625) (id?1092 name1625)) tmp1623) #f) (apply (lambda (_1626 name1627) (values (quote define-form) (wrap1120 name1627 w1590 mod1593) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote (())) s1591 mod1593)) tmp1623) (syntax-error tmp1603))) (syntax-dispatch tmp1603 (quote (any any)))))) (syntax-dispatch tmp1603 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1603 (quote (any any any))))) e1588) (if (memv t1602 (quote (define-syntax))) ((lambda (tmp1628) ((lambda (tmp1629) (if (if tmp1629 (apply (lambda (_1630 name1631 val1632) (id?1092 name1631)) tmp1629) #f) (apply (lambda (_1633 name1634 val1635) (values (quote define-syntax-form) name1634 val1635 w1590 s1591 mod1593)) tmp1629) (syntax-error tmp1628))) (syntax-dispatch tmp1628 (quote (any any any))))) e1588) (values (quote call) #f e1588 w1590 s1591 mod1593)))))))))))))) (values (quote call) #f e1588 w1590 s1591 mod1593)))) ((syntax-object?1076 e1588) (syntax-type1126 (syntax-object-expression1077 e1588) r1589 (join-wraps1111 w1590 (syntax-object-wrap1078 e1588)) #f rib1592 (or (syntax-object-module1079 e1588) mod1593))) ((annotation? e1588) (syntax-type1126 (annotation-expression e1588) r1589 w1590 (annotation-source e1588) rib1592 mod1593)) ((self-evaluating? e1588) (values (quote constant) #f e1588 w1590 s1591 mod1593)) (else (values (quote other) #f e1588 w1590 s1591 mod1593))))) (chi-when-list1125 (lambda (e1636 when-list1637 w1638) (let f1639 ((when-list1640 when-list1637) (situations1641 (quote ()))) (if (null? when-list1640) situations1641 (f1639 (cdr when-list1640) (cons (let ((x1642 (car when-list1640))) (cond ((free-id=?1115 x1642 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote compile)) ((free-id=?1115 x1642 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote load)) ((free-id=?1115 x1642 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote eval)) (else (syntax-error (wrap1120 x1642 w1638 #f) "invalid eval-when situation")))) situations1641)))))) (chi-install-global1124 (lambda (name1643 e1644) (build-annotated1069 #f (list (build-annotated1069 #f (quote install-global-transformer)) (build-data1070 #f name1643) e1644)))) (chi-top-sequence1123 (lambda (body1645 r1646 w1647 s1648 m1649 esew1650 mod1651) (build-sequence1071 s1648 (let dobody1652 ((body1653 body1645) (r1654 r1646) (w1655 w1647) (m1656 m1649) (esew1657 esew1650) (mod1658 mod1651)) (if (null? body1653) (quote ()) (let ((first1659 (chi-top1127 (car body1653) r1654 w1655 m1656 esew1657 mod1658))) (cons first1659 (dobody1652 (cdr body1653) r1654 w1655 m1656 esew1657 mod1658)))))))) (chi-sequence1122 (lambda (body1660 r1661 w1662 s1663 mod1664) (build-sequence1071 s1663 (let dobody1665 ((body1666 body1660) (r1667 r1661) (w1668 w1662) (mod1669 mod1664)) (if (null? body1666) (quote ()) (let ((first1670 (chi1128 (car body1666) r1667 w1668 mod1669))) (cons first1670 (dobody1665 (cdr body1666) r1667 w1668 mod1669)))))))) (source-wrap1121 (lambda (x1671 w1672 s1673 defmod1674) (wrap1120 (if s1673 (make-annotation x1671 s1673 #f) x1671) w1672 defmod1674))) (wrap1120 (lambda (x1675 w1676 defmod1677) (cond ((and (null? (wrap-marks1095 w1676)) (null? (wrap-subst1096 w1676))) x1675) ((syntax-object?1076 x1675) (make-syntax-object1075 (syntax-object-expression1077 x1675) (join-wraps1111 w1676 (syntax-object-wrap1078 x1675)) (syntax-object-module1079 x1675))) ((null? x1675) x1675) (else (make-syntax-object1075 x1675 w1676 defmod1677))))) (bound-id-member?1119 (lambda (x1678 list1679) (and (not (null? list1679)) (or (bound-id=?1116 x1678 (car list1679)) (bound-id-member?1119 x1678 (cdr list1679)))))) (distinct-bound-ids?1118 (lambda (ids1680) (let distinct?1681 ((ids1682 ids1680)) (or (null? ids1682) (and (not (bound-id-member?1119 (car ids1682) (cdr ids1682))) (distinct?1681 (cdr ids1682))))))) (valid-bound-ids?1117 (lambda (ids1683) (and (let all-ids?1684 ((ids1685 ids1683)) (or (null? ids1685) (and (id?1092 (car ids1685)) (all-ids?1684 (cdr ids1685))))) (distinct-bound-ids?1118 ids1683)))) (bound-id=?1116 (lambda (i1686 j1687) (if (and (syntax-object?1076 i1686) (syntax-object?1076 j1687)) (and (eq? (let ((e1688 (syntax-object-expression1077 i1686))) (if (annotation? e1688) (annotation-expression e1688) e1688)) (let ((e1689 (syntax-object-expression1077 j1687))) (if (annotation? e1689) (annotation-expression e1689) e1689))) (same-marks?1113 (wrap-marks1095 (syntax-object-wrap1078 i1686)) (wrap-marks1095 (syntax-object-wrap1078 j1687)))) (eq? (let ((e1690 i1686)) (if (annotation? e1690) (annotation-expression e1690) e1690)) (let ((e1691 j1687)) (if (annotation? e1691) (annotation-expression e1691) e1691)))))) (free-id=?1115 (lambda (i1692 j1693) (and (eq? (let ((x1694 i1692)) (let ((e1695 (if (syntax-object?1076 x1694) (syntax-object-expression1077 x1694) x1694))) (if (annotation? e1695) (annotation-expression e1695) e1695))) (let ((x1696 j1693)) (let ((e1697 (if (syntax-object?1076 x1696) (syntax-object-expression1077 x1696) x1696))) (if (annotation? e1697) (annotation-expression e1697) e1697)))) (eq? (id-var-name1114 i1692 (quote (()))) (id-var-name1114 j1693 (quote (()))))))) (id-var-name1114 (lambda (id1698 w1699) (letrec ((search-vector-rib1702 (lambda (sym1708 subst1709 marks1710 symnames1711 ribcage1712) (let ((n1713 (vector-length symnames1711))) (let f1714 ((i1715 0)) (cond ((fx=1061 i1715 n1713) (search1700 sym1708 (cdr subst1709) marks1710)) ((and (eq? (vector-ref symnames1711 i1715) sym1708) (same-marks?1113 marks1710 (vector-ref (ribcage-marks1102 ribcage1712) i1715))) (values (vector-ref (ribcage-labels1103 ribcage1712) i1715) marks1710)) (else (f1714 (fx+1059 i1715 1)))))))) (search-list-rib1701 (lambda (sym1716 subst1717 marks1718 symnames1719 ribcage1720) (let f1721 ((symnames1722 symnames1719) (i1723 0)) (cond ((null? symnames1722) (search1700 sym1716 (cdr subst1717) marks1718)) ((and (eq? (car symnames1722) sym1716) (same-marks?1113 marks1718 (list-ref (ribcage-marks1102 ribcage1720) i1723))) (values (list-ref (ribcage-labels1103 ribcage1720) i1723) marks1718)) (else (f1721 (cdr symnames1722) (fx+1059 i1723 1))))))) (search1700 (lambda (sym1724 subst1725 marks1726) (if (null? subst1725) (values #f marks1726) (let ((fst1727 (car subst1725))) (if (eq? fst1727 (quote shift)) (search1700 sym1724 (cdr subst1725) (cdr marks1726)) (let ((symnames1728 (ribcage-symnames1101 fst1727))) (if (vector? symnames1728) (search-vector-rib1702 sym1724 subst1725 marks1726 symnames1728 fst1727) (search-list-rib1701 sym1724 subst1725 marks1726 symnames1728 fst1727))))))))) (cond ((symbol? id1698) (or (call-with-values (lambda () (search1700 id1698 (wrap-subst1096 w1699) (wrap-marks1095 w1699))) (lambda (x1730 . ignore1729) x1730)) id1698)) ((syntax-object?1076 id1698) (let ((id1731 (let ((e1733 (syntax-object-expression1077 id1698))) (if (annotation? e1733) (annotation-expression e1733) e1733))) (w11732 (syntax-object-wrap1078 id1698))) (let ((marks1734 (join-marks1112 (wrap-marks1095 w1699) (wrap-marks1095 w11732)))) (call-with-values (lambda () (search1700 id1731 (wrap-subst1096 w1699) marks1734)) (lambda (new-id1735 marks1736) (or new-id1735 (call-with-values (lambda () (search1700 id1731 (wrap-subst1096 w11732) marks1736)) (lambda (x1738 . ignore1737) x1738)) id1731)))))) ((annotation? id1698) (let ((id1739 (let ((e1740 id1698)) (if (annotation? e1740) (annotation-expression e1740) e1740)))) (or (call-with-values (lambda () (search1700 id1739 (wrap-subst1096 w1699) (wrap-marks1095 w1699))) (lambda (x1742 . ignore1741) x1742)) id1739))) (else (error-hook1065 (quote id-var-name) "invalid id" id1698)))))) (same-marks?1113 (lambda (x1743 y1744) (or (eq? x1743 y1744) (and (not (null? x1743)) (not (null? y1744)) (eq? (car x1743) (car y1744)) (same-marks?1113 (cdr x1743) (cdr y1744)))))) (join-marks1112 (lambda (m11745 m21746) (smart-append1110 m11745 m21746))) (join-wraps1111 (lambda (w11747 w21748) (let ((m11749 (wrap-marks1095 w11747)) (s11750 (wrap-subst1096 w11747))) (if (null? m11749) (if (null? s11750) w21748 (make-wrap1094 (wrap-marks1095 w21748) (smart-append1110 s11750 (wrap-subst1096 w21748)))) (make-wrap1094 (smart-append1110 m11749 (wrap-marks1095 w21748)) (smart-append1110 s11750 (wrap-subst1096 w21748))))))) (smart-append1110 (lambda (m11751 m21752) (if (null? m21752) m11751 (append m11751 m21752)))) (make-binding-wrap1109 (lambda (ids1753 labels1754 w1755) (if (null? ids1753) w1755 (make-wrap1094 (wrap-marks1095 w1755) (cons (let ((labelvec1756 (list->vector labels1754))) (let ((n1757 (vector-length labelvec1756))) (let ((symnamevec1758 (make-vector n1757)) (marksvec1759 (make-vector n1757))) (begin (let f1760 ((ids1761 ids1753) (i1762 0)) (if (not (null? ids1761)) (call-with-values (lambda () (id-sym-name&marks1093 (car ids1761) w1755)) (lambda (symname1763 marks1764) (begin (vector-set! symnamevec1758 i1762 symname1763) (vector-set! marksvec1759 i1762 marks1764) (f1760 (cdr ids1761) (fx+1059 i1762 1))))))) (make-ribcage1099 symnamevec1758 marksvec1759 labelvec1756))))) (wrap-subst1096 w1755)))))) (extend-ribcage!1108 (lambda (ribcage1765 id1766 label1767) (begin (set-ribcage-symnames!1104 ribcage1765 (cons (let ((e1768 (syntax-object-expression1077 id1766))) (if (annotation? e1768) (annotation-expression e1768) e1768)) (ribcage-symnames1101 ribcage1765))) (set-ribcage-marks!1105 ribcage1765 (cons (wrap-marks1095 (syntax-object-wrap1078 id1766)) (ribcage-marks1102 ribcage1765))) (set-ribcage-labels!1106 ribcage1765 (cons label1767 (ribcage-labels1103 ribcage1765)))))) (anti-mark1107 (lambda (w1769) (make-wrap1094 (cons #f (wrap-marks1095 w1769)) (cons (quote shift) (wrap-subst1096 w1769))))) (set-ribcage-labels!1106 (lambda (x1770 update1771) (vector-set! x1770 3 update1771))) (set-ribcage-marks!1105 (lambda (x1772 update1773) (vector-set! x1772 2 update1773))) (set-ribcage-symnames!1104 (lambda (x1774 update1775) (vector-set! x1774 1 update1775))) (ribcage-labels1103 (lambda (x1776) (vector-ref x1776 3))) (ribcage-marks1102 (lambda (x1777) (vector-ref x1777 2))) (ribcage-symnames1101 (lambda (x1778) (vector-ref x1778 1))) (ribcage?1100 (lambda (x1779) (and (vector? x1779) (= (vector-length x1779) 4) (eq? (vector-ref x1779 0) (quote ribcage))))) (make-ribcage1099 (lambda (symnames1780 marks1781 labels1782) (vector (quote ribcage) symnames1780 marks1781 labels1782))) (gen-labels1098 (lambda (ls1783) (if (null? ls1783) (quote ()) (cons (gen-label1097) (gen-labels1098 (cdr ls1783)))))) (gen-label1097 (lambda () (string #\i))) (wrap-subst1096 cdr) (wrap-marks1095 car) (make-wrap1094 cons) (id-sym-name&marks1093 (lambda (x1784 w1785) (if (syntax-object?1076 x1784) (values (let ((e1786 (syntax-object-expression1077 x1784))) (if (annotation? e1786) (annotation-expression e1786) e1786)) (join-marks1112 (wrap-marks1095 w1785) (wrap-marks1095 (syntax-object-wrap1078 x1784)))) (values (let ((e1787 x1784)) (if (annotation? e1787) (annotation-expression e1787) e1787)) (wrap-marks1095 w1785))))) (id?1092 (lambda (x1788) (cond ((symbol? x1788) #t) ((syntax-object?1076 x1788) (symbol? (let ((e1789 (syntax-object-expression1077 x1788))) (if (annotation? e1789) (annotation-expression e1789) e1789)))) ((annotation? x1788) (symbol? (annotation-expression x1788))) (else #f)))) (nonsymbol-id?1091 (lambda (x1790) (and (syntax-object?1076 x1790) (symbol? (let ((e1791 (syntax-object-expression1077 x1790))) (if (annotation? e1791) (annotation-expression e1791) e1791)))))) (global-extend1090 (lambda (type1792 sym1793 val1794) (put-global-definition-hook1066 sym1793 (cons type1792 val1794) (module-name (current-module))))) (lookup1089 (lambda (x1795 r1796 mod1797) (cond ((assq x1795 r1796) => cdr) ((symbol? x1795) (or (get-global-definition-hook1068 x1795 mod1797) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1088 (lambda (r1798) (if (null? r1798) (quote ()) (let ((a1799 (car r1798))) (if (eq? (cadr a1799) (quote macro)) (cons a1799 (macros-only-env1088 (cdr r1798))) (macros-only-env1088 (cdr r1798))))))) (extend-var-env1087 (lambda (labels1800 vars1801 r1802) (if (null? labels1800) r1802 (extend-var-env1087 (cdr labels1800) (cdr vars1801) (cons (cons (car labels1800) (cons (quote lexical) (car vars1801))) r1802))))) (extend-env1086 (lambda (labels1803 bindings1804 r1805) (if (null? labels1803) r1805 (extend-env1086 (cdr labels1803) (cdr bindings1804) (cons (cons (car labels1803) (car bindings1804)) r1805))))) (binding-value1085 cdr) (binding-type1084 car) (source-annotation1083 (lambda (x1806) (cond ((annotation? x1806) (annotation-source x1806)) ((syntax-object?1076 x1806) (source-annotation1083 (syntax-object-expression1077 x1806))) (else #f)))) (set-syntax-object-module!1082 (lambda (x1807 update1808) (vector-set! x1807 3 update1808))) (set-syntax-object-wrap!1081 (lambda (x1809 update1810) (vector-set! x1809 2 update1810))) (set-syntax-object-expression!1080 (lambda (x1811 update1812) (vector-set! x1811 1 update1812))) (syntax-object-module1079 (lambda (x1813) (vector-ref x1813 3))) (syntax-object-wrap1078 (lambda (x1814) (vector-ref x1814 2))) (syntax-object-expression1077 (lambda (x1815) (vector-ref x1815 1))) (syntax-object?1076 (lambda (x1816) (and (vector? x1816) (= (vector-length x1816) 4) (eq? (vector-ref x1816 0) (quote syntax-object))))) (make-syntax-object1075 (lambda (expression1817 wrap1818 module1819) (vector (quote syntax-object) expression1817 wrap1818 module1819))) (build-letrec1074 (lambda (src1820 vars1821 val-exps1822 body-exp1823) (if (null? vars1821) (build-annotated1069 src1820 body-exp1823) (build-annotated1069 src1820 (list (quote letrec) (map list vars1821 val-exps1822) body-exp1823))))) (build-named-let1073 (lambda (src1824 vars1825 val-exps1826 body-exp1827) (if (null? vars1825) (build-annotated1069 src1824 body-exp1827) (build-annotated1069 src1824 (list (quote let) (car vars1825) (map list (cdr vars1825) val-exps1826) body-exp1827))))) (build-let1072 (lambda (src1828 vars1829 val-exps1830 body-exp1831) (if (null? vars1829) (build-annotated1069 src1828 body-exp1831) (build-annotated1069 src1828 (list (quote let) (map list vars1829 val-exps1830) body-exp1831))))) (build-sequence1071 (lambda (src1832 exps1833) (if (null? (cdr exps1833)) (build-annotated1069 src1832 (car exps1833)) (build-annotated1069 src1832 (cons (quote begin) exps1833))))) (build-data1070 (lambda (src1834 exp1835) (if (and (self-evaluating? exp1835) (not (vector? exp1835))) (build-annotated1069 src1834 exp1835) (build-annotated1069 src1834 (list (quote quote) exp1835))))) (build-annotated1069 (lambda (src1836 exp1837) (if (and src1836 (not (annotation? exp1837))) (make-annotation exp1837 src1836 #t) exp1837))) (get-global-definition-hook1068 (lambda (symbol1838 module1839) (let ((module1840 (if module1839 (resolve-module module1839) (warn "wha" symbol1838 (current-module))))) (let ((v1841 (module-variable module1840 symbol1838))) (and v1841 (or (object-property v1841 (quote *sc-expander*)) (and (variable-bound? v1841) (macro? (variable-ref v1841)) (macro-transformer (variable-ref v1841)) guile-macro))))))) (remove-global-definition-hook1067 (lambda (symbol1842 modname1843) (let ((module1844 (if modname1843 (resolve-module modname1843) (current-module)))) (let ((v1845 (module-local-variable module1844 symbol1842))) (if v1845 (let ((p1846 (assq (quote *sc-expander*) (object-properties v1845)))) (set-object-properties! v1845 (delq p1846 (object-properties v1845))))))))) (put-global-definition-hook1066 (lambda (symbol1847 binding1848 modname1849) (let ((module1850 (if modname1849 (resolve-module modname1849) (current-module)))) (let ((v1851 (or (module-variable module1850 symbol1847) (let ((v1852 (make-variable (quote sc-macro)))) (begin (module-add! module1850 symbol1847 v1852) v1852))))) (begin (if (not (variable-bound? v1851)) (variable-set! v1851 (gensym))) (set-object-property! v1851 (quote *sc-expander*) binding1848)))))) (error-hook1065 (lambda (who1853 why1854 what1855) (error who1853 "~a ~s" why1854 what1855))) (local-eval-hook1064 (lambda (x1856 mod1857) (eval (list noexpand1058 x1856) (if mod1857 (resolve-module mod1857) (interaction-environment))))) (top-level-eval-hook1063 (lambda (x1858 mod1859) (eval (list noexpand1058 x1858) (if mod1859 (resolve-module mod1859) (interaction-environment))))) (fx<1062 <) (fx=1061 =) (fx-1060 -) (fx+1059 +) (noexpand1058 "noexpand")) (begin (global-extend1090 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1090 (quote local-syntax) (quote let-syntax) #f) (global-extend1090 (quote core) (quote fluid-let-syntax) (lambda (e1860 r1861 w1862 s1863 mod1864) ((lambda (tmp1865) ((lambda (tmp1866) (if (if tmp1866 (apply (lambda (_1867 var1868 val1869 e11870 e21871) (valid-bound-ids?1117 var1868)) tmp1866) #f) (apply (lambda (_1873 var1874 val1875 e11876 e21877) (let ((names1878 (map (lambda (x1879) (id-var-name1114 x1879 w1862)) var1874))) (begin (for-each (lambda (id1881 n1882) (let ((t1883 (binding-type1084 (lookup1089 n1882 r1861 mod1864)))) (if (memv t1883 (quote (displaced-lexical))) (syntax-error (source-wrap1121 id1881 w1862 s1863 mod1864) "identifier out of context")))) var1874 names1878) (chi-body1132 (cons e11876 e21877) (source-wrap1121 e1860 w1862 s1863 mod1864) (extend-env1086 names1878 (let ((trans-r1886 (macros-only-env1088 r1861))) (map (lambda (x1887) (cons (quote macro) (eval-local-transformer1135 (chi1128 x1887 trans-r1886 w1862 mod1864) mod1864))) val1875)) r1861) w1862 mod1864)))) tmp1866) ((lambda (_1889) (syntax-error (source-wrap1121 e1860 w1862 s1863 mod1864))) tmp1865))) (syntax-dispatch tmp1865 (quote (any #(each (any any)) any . each-any))))) e1860))) (global-extend1090 (quote core) (quote quote) (lambda (e1890 r1891 w1892 s1893 mod1894) ((lambda (tmp1895) ((lambda (tmp1896) (if tmp1896 (apply (lambda (_1897 e1898) (build-data1070 s1893 (strip1139 e1898 w1892))) tmp1896) ((lambda (_1899) (syntax-error (source-wrap1121 e1890 w1892 s1893 mod1894))) tmp1895))) (syntax-dispatch tmp1895 (quote (any any))))) e1890))) (global-extend1090 (quote core) (quote syntax) (letrec ((regen1907 (lambda (x1908) (let ((t1909 (car x1908))) (if (memv t1909 (quote (ref))) (build-annotated1069 #f (cadr x1908)) (if (memv t1909 (quote (primitive))) (build-annotated1069 #f (cadr x1908)) (if (memv t1909 (quote (quote))) (build-data1070 #f (cadr x1908)) (if (memv t1909 (quote (lambda))) (build-annotated1069 #f (list (quote lambda) (cadr x1908) (regen1907 (caddr x1908)))) (if (memv t1909 (quote (map))) (let ((ls1910 (map regen1907 (cdr x1908)))) (build-annotated1069 #f (cons (if (fx=1061 (length ls1910) 2) (build-annotated1069 #f (quote map)) (build-annotated1069 #f (quote map))) ls1910))) (build-annotated1069 #f (cons (build-annotated1069 #f (car x1908)) (map regen1907 (cdr x1908)))))))))))) (gen-vector1906 (lambda (x1911) (cond ((eq? (car x1911) (quote list)) (cons (quote vector) (cdr x1911))) ((eq? (car x1911) (quote quote)) (list (quote quote) (list->vector (cadr x1911)))) (else (list (quote list->vector) x1911))))) (gen-append1905 (lambda (x1912 y1913) (if (equal? y1913 (quote (quote ()))) x1912 (list (quote append) x1912 y1913)))) (gen-cons1904 (lambda (x1914 y1915) (let ((t1916 (car y1915))) (if (memv t1916 (quote (quote))) (if (eq? (car x1914) (quote quote)) (list (quote quote) (cons (cadr x1914) (cadr y1915))) (if (eq? (cadr y1915) (quote ())) (list (quote list) x1914) (list (quote cons) x1914 y1915))) (if (memv t1916 (quote (list))) (cons (quote list) (cons x1914 (cdr y1915))) (list (quote cons) x1914 y1915)))))) (gen-map1903 (lambda (e1917 map-env1918) (let ((formals1919 (map cdr map-env1918)) (actuals1920 (map (lambda (x1921) (list (quote ref) (car x1921))) map-env1918))) (cond ((eq? (car e1917) (quote ref)) (car actuals1920)) ((andmap (lambda (x1922) (and (eq? (car x1922) (quote ref)) (memq (cadr x1922) formals1919))) (cdr e1917)) (cons (quote map) (cons (list (quote primitive) (car e1917)) (map (let ((r1923 (map cons formals1919 actuals1920))) (lambda (x1924) (cdr (assq (cadr x1924) r1923)))) (cdr e1917))))) (else (cons (quote map) (cons (list (quote lambda) formals1919 e1917) actuals1920))))))) (gen-mappend1902 (lambda (e1925 map-env1926) (list (quote apply) (quote (primitive append)) (gen-map1903 e1925 map-env1926)))) (gen-ref1901 (lambda (src1927 var1928 level1929 maps1930) (if (fx=1061 level1929 0) (values var1928 maps1930) (if (null? maps1930) (syntax-error src1927 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1901 src1927 var1928 (fx-1060 level1929 1) (cdr maps1930))) (lambda (outer-var1931 outer-maps1932) (let ((b1933 (assq outer-var1931 (car maps1930)))) (if b1933 (values (cdr b1933) maps1930) (let ((inner-var1934 (gen-var1140 (quote tmp)))) (values inner-var1934 (cons (cons (cons outer-var1931 inner-var1934) (car maps1930)) outer-maps1932))))))))))) (gen-syntax1900 (lambda (src1935 e1936 r1937 maps1938 ellipsis?1939 mod1940) (if (id?1092 e1936) (let ((label1941 (id-var-name1114 e1936 (quote (()))))) (let ((b1942 (lookup1089 label1941 r1937 mod1940))) (if (eq? (binding-type1084 b1942) (quote syntax)) (call-with-values (lambda () (let ((var.lev1943 (binding-value1085 b1942))) (gen-ref1901 src1935 (car var.lev1943) (cdr var.lev1943) maps1938))) (lambda (var1944 maps1945) (values (list (quote ref) var1944) maps1945))) (if (ellipsis?1939 e1936) (syntax-error src1935 "misplaced ellipsis in syntax form") (values (list (quote quote) e1936) maps1938))))) ((lambda (tmp1946) ((lambda (tmp1947) (if (if tmp1947 (apply (lambda (dots1948 e1949) (ellipsis?1939 dots1948)) tmp1947) #f) (apply (lambda (dots1950 e1951) (gen-syntax1900 src1935 e1951 r1937 maps1938 (lambda (x1952) #f) mod1940)) tmp1947) ((lambda (tmp1953) (if (if tmp1953 (apply (lambda (x1954 dots1955 y1956) (ellipsis?1939 dots1955)) tmp1953) #f) (apply (lambda (x1957 dots1958 y1959) (let f1960 ((y1961 y1959) (k1962 (lambda (maps1963) (call-with-values (lambda () (gen-syntax1900 src1935 x1957 r1937 (cons (quote ()) maps1963) ellipsis?1939 mod1940)) (lambda (x1964 maps1965) (if (null? (car maps1965)) (syntax-error src1935 "extra ellipsis in syntax form") (values (gen-map1903 x1964 (car maps1965)) (cdr maps1965)))))))) ((lambda (tmp1966) ((lambda (tmp1967) (if (if tmp1967 (apply (lambda (dots1968 y1969) (ellipsis?1939 dots1968)) tmp1967) #f) (apply (lambda (dots1970 y1971) (f1960 y1971 (lambda (maps1972) (call-with-values (lambda () (k1962 (cons (quote ()) maps1972))) (lambda (x1973 maps1974) (if (null? (car maps1974)) (syntax-error src1935 "extra ellipsis in syntax form") (values (gen-mappend1902 x1973 (car maps1974)) (cdr maps1974)))))))) tmp1967) ((lambda (_1975) (call-with-values (lambda () (gen-syntax1900 src1935 y1961 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (y1976 maps1977) (call-with-values (lambda () (k1962 maps1977)) (lambda (x1978 maps1979) (values (gen-append1905 x1978 y1976) maps1979)))))) tmp1966))) (syntax-dispatch tmp1966 (quote (any . any))))) y1961))) tmp1953) ((lambda (tmp1980) (if tmp1980 (apply (lambda (x1981 y1982) (call-with-values (lambda () (gen-syntax1900 src1935 x1981 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (x1983 maps1984) (call-with-values (lambda () (gen-syntax1900 src1935 y1982 r1937 maps1984 ellipsis?1939 mod1940)) (lambda (y1985 maps1986) (values (gen-cons1904 x1983 y1985) maps1986)))))) tmp1980) ((lambda (tmp1987) (if tmp1987 (apply (lambda (e11988 e21989) (call-with-values (lambda () (gen-syntax1900 src1935 (cons e11988 e21989) r1937 maps1938 ellipsis?1939 mod1940)) (lambda (e1991 maps1992) (values (gen-vector1906 e1991) maps1992)))) tmp1987) ((lambda (_1993) (values (list (quote quote) e1936) maps1938)) tmp1946))) (syntax-dispatch tmp1946 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1946 (quote (any . any)))))) (syntax-dispatch tmp1946 (quote (any any . any)))))) (syntax-dispatch tmp1946 (quote (any any))))) e1936))))) (lambda (e1994 r1995 w1996 s1997 mod1998) (let ((e1999 (source-wrap1121 e1994 w1996 s1997 mod1998))) ((lambda (tmp2000) ((lambda (tmp2001) (if tmp2001 (apply (lambda (_2002 x2003) (call-with-values (lambda () (gen-syntax1900 e1999 x2003 r1995 (quote ()) ellipsis?1137 mod1998)) (lambda (e2004 maps2005) (regen1907 e2004)))) tmp2001) ((lambda (_2006) (syntax-error e1999)) tmp2000))) (syntax-dispatch tmp2000 (quote (any any))))) e1999))))) (global-extend1090 (quote core) (quote lambda) (lambda (e2007 r2008 w2009 s2010 mod2011) ((lambda (tmp2012) ((lambda (tmp2013) (if tmp2013 (apply (lambda (_2014 c2015) (chi-lambda-clause1133 (source-wrap1121 e2007 w2009 s2010 mod2011) c2015 r2008 w2009 mod2011 (lambda (vars2016 body2017) (build-annotated1069 s2010 (list (quote lambda) vars2016 body2017))))) tmp2013) (syntax-error tmp2012))) (syntax-dispatch tmp2012 (quote (any . any))))) e2007))) (global-extend1090 (quote core) (quote let) (letrec ((chi-let2018 (lambda (e2019 r2020 w2021 s2022 mod2023 constructor2024 ids2025 vals2026 exps2027) (if (not (valid-bound-ids?1117 ids2025)) (syntax-error e2019 "duplicate bound variable in") (let ((labels2028 (gen-labels1098 ids2025)) (new-vars2029 (map gen-var1140 ids2025))) (let ((nw2030 (make-binding-wrap1109 ids2025 labels2028 w2021)) (nr2031 (extend-var-env1087 labels2028 new-vars2029 r2020))) (constructor2024 s2022 new-vars2029 (map (lambda (x2032) (chi1128 x2032 r2020 w2021 mod2023)) vals2026) (chi-body1132 exps2027 (source-wrap1121 e2019 nw2030 s2022 mod2023) nr2031 nw2030 mod2023)))))))) (lambda (e2033 r2034 w2035 s2036 mod2037) ((lambda (tmp2038) ((lambda (tmp2039) (if tmp2039 (apply (lambda (_2040 id2041 val2042 e12043 e22044) (chi-let2018 e2033 r2034 w2035 s2036 mod2037 build-let1072 id2041 val2042 (cons e12043 e22044))) tmp2039) ((lambda (tmp2048) (if (if tmp2048 (apply (lambda (_2049 f2050 id2051 val2052 e12053 e22054) (id?1092 f2050)) tmp2048) #f) (apply (lambda (_2055 f2056 id2057 val2058 e12059 e22060) (chi-let2018 e2033 r2034 w2035 s2036 mod2037 build-named-let1073 (cons f2056 id2057) val2058 (cons e12059 e22060))) tmp2048) ((lambda (_2064) (syntax-error (source-wrap1121 e2033 w2035 s2036 mod2037))) tmp2038))) (syntax-dispatch tmp2038 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2038 (quote (any #(each (any any)) any . each-any))))) e2033)))) (global-extend1090 (quote core) (quote letrec) (lambda (e2065 r2066 w2067 s2068 mod2069) ((lambda (tmp2070) ((lambda (tmp2071) (if tmp2071 (apply (lambda (_2072 id2073 val2074 e12075 e22076) (let ((ids2077 id2073)) (if (not (valid-bound-ids?1117 ids2077)) (syntax-error e2065 "duplicate bound variable in") (let ((labels2079 (gen-labels1098 ids2077)) (new-vars2080 (map gen-var1140 ids2077))) (let ((w2081 (make-binding-wrap1109 ids2077 labels2079 w2067)) (r2082 (extend-var-env1087 labels2079 new-vars2080 r2066))) (build-letrec1074 s2068 new-vars2080 (map (lambda (x2083) (chi1128 x2083 r2082 w2081 mod2069)) val2074) (chi-body1132 (cons e12075 e22076) (source-wrap1121 e2065 w2081 s2068 mod2069) r2082 w2081 mod2069))))))) tmp2071) ((lambda (_2086) (syntax-error (source-wrap1121 e2065 w2067 s2068 mod2069))) tmp2070))) (syntax-dispatch tmp2070 (quote (any #(each (any any)) any . each-any))))) e2065))) (global-extend1090 (quote core) (quote set!) (lambda (e2087 r2088 w2089 s2090 mod2091) ((lambda (tmp2092) ((lambda (tmp2093) (if (if tmp2093 (apply (lambda (_2094 id2095 val2096) (id?1092 id2095)) tmp2093) #f) (apply (lambda (_2097 id2098 val2099) (let ((val2100 (chi1128 val2099 r2088 w2089 mod2091)) (n2101 (id-var-name1114 id2098 w2089))) (let ((b2102 (lookup1089 n2101 r2088 mod2091))) (let ((t2103 (binding-type1084 b2102))) (if (memv t2103 (quote (lexical))) (build-annotated1069 s2090 (list (quote set!) (binding-value1085 b2102) val2100)) (if (memv t2103 (quote (global))) (build-annotated1069 s2090 (list (quote set!) (make-module-ref mod2091 n2101 #f) val2100)) (if (memv t2103 (quote (displaced-lexical))) (syntax-error (wrap1120 id2098 w2089 mod2091) "identifier out of context") (syntax-error (source-wrap1121 e2087 w2089 s2090 mod2091))))))))) tmp2093) ((lambda (tmp2104) (if tmp2104 (apply (lambda (_2105 head2106 tail2107 val2108) (call-with-values (lambda () (syntax-type1126 head2106 r2088 (quote (())) #f #f mod2091)) (lambda (type2109 value2110 ee2111 ww2112 ss2113 modmod2114) (let ((t2115 type2109)) (if (memv t2115 (quote (module-ref))) (call-with-values (lambda () (value2110 (cons head2106 tail2107))) (lambda (id2117 mod2118) (build-annotated1069 s2090 (list (quote set!) (make-module-ref mod2118 id2117 #f) val2108)))) (build-annotated1069 s2090 (cons (chi1128 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) head2106) r2088 w2089 mod2091) (map (lambda (e2119) (chi1128 e2119 r2088 w2089 mod2091)) (append tail2107 (list val2108)))))))))) tmp2104) ((lambda (_2121) (syntax-error (source-wrap1121 e2087 w2089 s2090 mod2091))) tmp2092))) (syntax-dispatch tmp2092 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2092 (quote (any any any))))) e2087))) (global-extend1090 (quote module-ref) (quote @) (lambda (e2122) ((lambda (tmp2123) ((lambda (tmp2124) (if (if tmp2124 (apply (lambda (_2125 mod2126 id2127) (and (andmap id?1092 mod2126) (id?1092 id2127))) tmp2124) #f) (apply (lambda (_2129 mod2130 id2131) (values (syntax-object->datum id2131) (syntax-object->datum (append mod2130 (quote (#(syntax-object %module-public-interface ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))))))) tmp2124) (syntax-error tmp2123))) (syntax-dispatch tmp2123 (quote (any each-any any))))) e2122))) (global-extend1090 (quote module-ref) (quote @@) (lambda (e2133) ((lambda (tmp2134) ((lambda (tmp2135) (if (if tmp2135 (apply (lambda (_2136 mod2137 id2138) (and (andmap id?1092 mod2137) (id?1092 id2138))) tmp2135) #f) (apply (lambda (_2140 mod2141 id2142) (values (syntax-object->datum id2142) (syntax-object->datum mod2141))) tmp2135) (syntax-error tmp2134))) (syntax-dispatch tmp2134 (quote (any each-any any))))) e2133))) (global-extend1090 (quote begin) (quote begin) (quote ())) (global-extend1090 (quote define) (quote define) (quote ())) (global-extend1090 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1090 (quote eval-when) (quote eval-when) (quote ())) (global-extend1090 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2147 (lambda (x2148 keys2149 clauses2150 r2151 mod2152) (if (null? clauses2150) (build-annotated1069 #f (list (build-annotated1069 #f (quote syntax-error)) x2148)) ((lambda (tmp2153) ((lambda (tmp2154) (if tmp2154 (apply (lambda (pat2155 exp2156) (if (and (id?1092 pat2155) (andmap (lambda (x2157) (not (free-id=?1115 pat2155 x2157))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) keys2149))) (let ((labels2158 (list (gen-label1097))) (var2159 (gen-var1140 pat2155))) (build-annotated1069 #f (list (build-annotated1069 #f (list (quote lambda) (list var2159) (chi1128 exp2156 (extend-env1086 labels2158 (list (cons (quote syntax) (cons var2159 0))) r2151) (make-binding-wrap1109 (list pat2155) labels2158 (quote (()))) mod2152))) x2148))) (gen-clause2146 x2148 keys2149 (cdr clauses2150) r2151 pat2155 #t exp2156 mod2152))) tmp2154) ((lambda (tmp2160) (if tmp2160 (apply (lambda (pat2161 fender2162 exp2163) (gen-clause2146 x2148 keys2149 (cdr clauses2150) r2151 pat2161 fender2162 exp2163 mod2152)) tmp2160) ((lambda (_2164) (syntax-error (car clauses2150) "invalid syntax-case clause")) tmp2153))) (syntax-dispatch tmp2153 (quote (any any any)))))) (syntax-dispatch tmp2153 (quote (any any))))) (car clauses2150))))) (gen-clause2146 (lambda (x2165 keys2166 clauses2167 r2168 pat2169 fender2170 exp2171 mod2172) (call-with-values (lambda () (convert-pattern2144 pat2169 keys2166)) (lambda (p2173 pvars2174) (cond ((not (distinct-bound-ids?1118 (map car pvars2174))) (syntax-error pat2169 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2175) (not (ellipsis?1137 (car x2175)))) pvars2174)) (syntax-error pat2169 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2176 (gen-var1140 (quote tmp)))) (build-annotated1069 #f (list (build-annotated1069 #f (list (quote lambda) (list y2176) (let ((y2177 (build-annotated1069 #f y2176))) (build-annotated1069 #f (list (quote if) ((lambda (tmp2178) ((lambda (tmp2179) (if tmp2179 (apply (lambda () y2177) tmp2179) ((lambda (_2180) (build-annotated1069 #f (list (quote if) y2177 (build-dispatch-call2145 pvars2174 fender2170 y2177 r2168 mod2172) (build-data1070 #f #f)))) tmp2178))) (syntax-dispatch tmp2178 (quote #(atom #t))))) fender2170) (build-dispatch-call2145 pvars2174 exp2171 y2177 r2168 mod2172) (gen-syntax-case2147 x2165 keys2166 clauses2167 r2168 mod2172)))))) (if (eq? p2173 (quote any)) (build-annotated1069 #f (list (build-annotated1069 #f (quote list)) x2165)) (build-annotated1069 #f (list (build-annotated1069 #f (quote syntax-dispatch)) x2165 (build-data1070 #f p2173))))))))))))) (build-dispatch-call2145 (lambda (pvars2181 exp2182 y2183 r2184 mod2185) (let ((ids2186 (map car pvars2181)) (levels2187 (map cdr pvars2181))) (let ((labels2188 (gen-labels1098 ids2186)) (new-vars2189 (map gen-var1140 ids2186))) (build-annotated1069 #f (list (build-annotated1069 #f (quote apply)) (build-annotated1069 #f (list (quote lambda) new-vars2189 (chi1128 exp2182 (extend-env1086 labels2188 (map (lambda (var2190 level2191) (cons (quote syntax) (cons var2190 level2191))) new-vars2189 (map cdr pvars2181)) r2184) (make-binding-wrap1109 ids2186 labels2188 (quote (()))) mod2185))) y2183)))))) (convert-pattern2144 (lambda (pattern2192 keys2193) (let cvt2194 ((p2195 pattern2192) (n2196 0) (ids2197 (quote ()))) (if (id?1092 p2195) (if (bound-id-member?1119 p2195 keys2193) (values (vector (quote free-id) p2195) ids2197) (values (quote any) (cons (cons p2195 n2196) ids2197))) ((lambda (tmp2198) ((lambda (tmp2199) (if (if tmp2199 (apply (lambda (x2200 dots2201) (ellipsis?1137 dots2201)) tmp2199) #f) (apply (lambda (x2202 dots2203) (call-with-values (lambda () (cvt2194 x2202 (fx+1059 n2196 1) ids2197)) (lambda (p2204 ids2205) (values (if (eq? p2204 (quote any)) (quote each-any) (vector (quote each) p2204)) ids2205)))) tmp2199) ((lambda (tmp2206) (if tmp2206 (apply (lambda (x2207 y2208) (call-with-values (lambda () (cvt2194 y2208 n2196 ids2197)) (lambda (y2209 ids2210) (call-with-values (lambda () (cvt2194 x2207 n2196 ids2210)) (lambda (x2211 ids2212) (values (cons x2211 y2209) ids2212)))))) tmp2206) ((lambda (tmp2213) (if tmp2213 (apply (lambda () (values (quote ()) ids2197)) tmp2213) ((lambda (tmp2214) (if tmp2214 (apply (lambda (x2215) (call-with-values (lambda () (cvt2194 x2215 n2196 ids2197)) (lambda (p2217 ids2218) (values (vector (quote vector) p2217) ids2218)))) tmp2214) ((lambda (x2219) (values (vector (quote atom) (strip1139 p2195 (quote (())))) ids2197)) tmp2198))) (syntax-dispatch tmp2198 (quote #(vector each-any)))))) (syntax-dispatch tmp2198 (quote ()))))) (syntax-dispatch tmp2198 (quote (any . any)))))) (syntax-dispatch tmp2198 (quote (any any))))) p2195)))))) (lambda (e2220 r2221 w2222 s2223 mod2224) (let ((e2225 (source-wrap1121 e2220 w2222 s2223 mod2224))) ((lambda (tmp2226) ((lambda (tmp2227) (if tmp2227 (apply (lambda (_2228 val2229 key2230 m2231) (if (andmap (lambda (x2232) (and (id?1092 x2232) (not (ellipsis?1137 x2232)))) key2230) (let ((x2234 (gen-var1140 (quote tmp)))) (build-annotated1069 s2223 (list (build-annotated1069 #f (list (quote lambda) (list x2234) (gen-syntax-case2147 (build-annotated1069 #f x2234) key2230 m2231 r2221 mod2224))) (chi1128 val2229 r2221 (quote (())) mod2224)))) (syntax-error e2225 "invalid literals list in"))) tmp2227) (syntax-error tmp2226))) (syntax-dispatch tmp2226 (quote (any any each-any . each-any))))) e2225))))) (set! sc-expand (let ((m2237 (quote e)) (esew2238 (quote (eval)))) (lambda (x2239) (if (and (pair? x2239) (equal? (car x2239) noexpand1058)) (cadr x2239) (chi-top1127 x2239 (quote ()) (quote ((top))) m2237 esew2238 (module-name (current-module))))))) (set! sc-expand3 (let ((m2240 (quote e)) (esew2241 (quote (eval)))) (lambda (x2243 . rest2242) (if (and (pair? x2243) (equal? (car x2243) noexpand1058)) (cadr x2243) (chi-top1127 x2243 (quote ()) (quote ((top))) (if (null? rest2242) m2240 (car rest2242)) (if (or (null? rest2242) (null? (cdr rest2242))) esew2241 (cadr rest2242)) (module-name (current-module))))))) (set! identifier? (lambda (x2244) (nonsymbol-id?1091 x2244))) (set! datum->syntax-object (lambda (id2245 datum2246) (make-syntax-object1075 datum2246 (syntax-object-wrap1078 id2245) #f))) (set! syntax-object->datum (lambda (x2247) (strip1139 x2247 (quote (()))))) (set! generate-temporaries (lambda (ls2248) (begin (let ((x2249 ls2248)) (if (not (list? x2249)) (error-hook1065 (quote generate-temporaries) "invalid argument" x2249))) (map (lambda (x2250) (wrap1120 (gensym) (quote ((top))) #f)) ls2248)))) (set! free-identifier=? (lambda (x2251 y2252) (begin (let ((x2253 x2251)) (if (not (nonsymbol-id?1091 x2253)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2253))) (let ((x2254 y2252)) (if (not (nonsymbol-id?1091 x2254)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2254))) (free-id=?1115 x2251 y2252)))) (set! bound-identifier=? (lambda (x2255 y2256) (begin (let ((x2257 x2255)) (if (not (nonsymbol-id?1091 x2257)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2257))) (let ((x2258 y2256)) (if (not (nonsymbol-id?1091 x2258)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2258))) (bound-id=?1116 x2255 y2256)))) (set! syntax-error (lambda (object2260 . messages2259) (begin (for-each (lambda (x2261) (let ((x2262 x2261)) (if (not (string? x2262)) (error-hook1065 (quote syntax-error) "invalid argument" x2262)))) messages2259) (let ((message2263 (if (null? messages2259) "invalid syntax" (apply string-append messages2259)))) (error-hook1065 #f message2263 (strip1139 object2260 (quote (())))))))) (set! install-global-transformer (lambda (sym2264 v2265) (begin (let ((x2266 sym2264)) (if (not (symbol? x2266)) (error-hook1065 (quote define-syntax) "invalid argument" x2266))) (let ((x2267 v2265)) (if (not (procedure? x2267)) (error-hook1065 (quote define-syntax) "invalid argument" x2267))) (global-extend1090 (quote macro) sym2264 v2265)))) (letrec ((match2272 (lambda (e2273 p2274 w2275 r2276 mod2277) (cond ((not r2276) #f) ((eq? p2274 (quote any)) (cons (wrap1120 e2273 w2275 mod2277) r2276)) ((syntax-object?1076 e2273) (match*2271 (let ((e2278 (syntax-object-expression1077 e2273))) (if (annotation? e2278) (annotation-expression e2278) e2278)) p2274 (join-wraps1111 w2275 (syntax-object-wrap1078 e2273)) r2276 (syntax-object-module1079 e2273))) (else (match*2271 (let ((e2279 e2273)) (if (annotation? e2279) (annotation-expression e2279) e2279)) p2274 w2275 r2276 mod2277))))) (match*2271 (lambda (e2280 p2281 w2282 r2283 mod2284) (cond ((null? p2281) (and (null? e2280) r2283)) ((pair? p2281) (and (pair? e2280) (match2272 (car e2280) (car p2281) w2282 (match2272 (cdr e2280) (cdr p2281) w2282 r2283 mod2284) mod2284))) ((eq? p2281 (quote each-any)) (let ((l2285 (match-each-any2269 e2280 w2282 mod2284))) (and l2285 (cons l2285 r2283)))) (else (let ((t2286 (vector-ref p2281 0))) (if (memv t2286 (quote (each))) (if (null? e2280) (match-empty2270 (vector-ref p2281 1) r2283) (let ((l2287 (match-each2268 e2280 (vector-ref p2281 1) w2282 mod2284))) (and l2287 (let collect2288 ((l2289 l2287)) (if (null? (car l2289)) r2283 (cons (map car l2289) (collect2288 (map cdr l2289)))))))) (if (memv t2286 (quote (free-id))) (and (id?1092 e2280) (free-id=?1115 (wrap1120 e2280 w2282 mod2284) (vector-ref p2281 1)) r2283) (if (memv t2286 (quote (atom))) (and (equal? (vector-ref p2281 1) (strip1139 e2280 w2282)) r2283) (if (memv t2286 (quote (vector))) (and (vector? e2280) (match2272 (vector->list e2280) (vector-ref p2281 1) w2282 r2283 mod2284))))))))))) (match-empty2270 (lambda (p2290 r2291) (cond ((null? p2290) r2291) ((eq? p2290 (quote any)) (cons (quote ()) r2291)) ((pair? p2290) (match-empty2270 (car p2290) (match-empty2270 (cdr p2290) r2291))) ((eq? p2290 (quote each-any)) (cons (quote ()) r2291)) (else (let ((t2292 (vector-ref p2290 0))) (if (memv t2292 (quote (each))) (match-empty2270 (vector-ref p2290 1) r2291) (if (memv t2292 (quote (free-id atom))) r2291 (if (memv t2292 (quote (vector))) (match-empty2270 (vector-ref p2290 1) r2291))))))))) (match-each-any2269 (lambda (e2293 w2294 mod2295) (cond ((annotation? e2293) (match-each-any2269 (annotation-expression e2293) w2294 mod2295)) ((pair? e2293) (let ((l2296 (match-each-any2269 (cdr e2293) w2294 mod2295))) (and l2296 (cons (wrap1120 (car e2293) w2294 mod2295) l2296)))) ((null? e2293) (quote ())) ((syntax-object?1076 e2293) (match-each-any2269 (syntax-object-expression1077 e2293) (join-wraps1111 w2294 (syntax-object-wrap1078 e2293)) mod2295)) (else #f)))) (match-each2268 (lambda (e2297 p2298 w2299 mod2300) (cond ((annotation? e2297) (match-each2268 (annotation-expression e2297) p2298 w2299 mod2300)) ((pair? e2297) (let ((first2301 (match2272 (car e2297) p2298 w2299 (quote ()) mod2300))) (and first2301 (let ((rest2302 (match-each2268 (cdr e2297) p2298 w2299 mod2300))) (and rest2302 (cons first2301 rest2302)))))) ((null? e2297) (quote ())) ((syntax-object?1076 e2297) (match-each2268 (syntax-object-expression1077 e2297) p2298 (join-wraps1111 w2299 (syntax-object-wrap1078 e2297)) (syntax-object-module1079 e2297))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2303 p2304) (cond ((eq? p2304 (quote any)) (list e2303)) ((syntax-object?1076 e2303) (match*2271 (let ((e2305 (syntax-object-expression1077 e2303))) (if (annotation? e2305) (annotation-expression e2305) e2305)) p2304 (syntax-object-wrap1078 e2303) (quote ()) (syntax-object-module1079 e2303))) (else (match*2271 (let ((e2306 e2303)) (if (annotation? e2306) (annotation-expression e2306) e2306)) p2304 (quote (())) (quote ()) #f))))) (set! sc-chi chi1128))))) -(install-global-transformer (quote with-syntax) (lambda (x2307) ((lambda (tmp2308) ((lambda (tmp2309) (if tmp2309 (apply (lambda (_2310 e12311 e22312) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12311 e22312))) tmp2309) ((lambda (tmp2314) (if tmp2314 (apply (lambda (_2315 out2316 in2317 e12318 e22319) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2317 (quote ()) (list out2316 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12318 e22319))))) tmp2314) ((lambda (tmp2321) (if tmp2321 (apply (lambda (_2322 out2323 in2324 e12325 e22326) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2324) (quote ()) (list out2323 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12325 e22326))))) tmp2321) (syntax-error tmp2308))) (syntax-dispatch tmp2308 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2308 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2308 (quote (any () any . each-any))))) x2307))) -(install-global-transformer (quote syntax-rules) (lambda (x2330) ((lambda (tmp2331) ((lambda (tmp2332) (if tmp2332 (apply (lambda (_2333 k2334 keyword2335 pattern2336 template2337) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons k2334 (map (lambda (tmp2340 tmp2339) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2339) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2340))) template2337 pattern2336)))))) tmp2332) (syntax-error tmp2331))) (syntax-dispatch tmp2331 (quote (any each-any . #(each ((any . any) any))))))) x2330))) -(install-global-transformer (quote let*) (lambda (x2341) ((lambda (tmp2342) ((lambda (tmp2343) (if (if tmp2343 (apply (lambda (let*2344 x2345 v2346 e12347 e22348) (andmap identifier? x2345)) tmp2343) #f) (apply (lambda (let*2350 x2351 v2352 e12353 e22354) (let f2355 ((bindings2356 (map list x2351 v2352))) (if (null? bindings2356) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote ()) (cons e12353 e22354))) ((lambda (tmp2360) ((lambda (tmp2361) (if tmp2361 (apply (lambda (body2362 binding2363) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list binding2363) body2362)) tmp2361) (syntax-error tmp2360))) (syntax-dispatch tmp2360 (quote (any any))))) (list (f2355 (cdr bindings2356)) (car bindings2356)))))) tmp2343) (syntax-error tmp2342))) (syntax-dispatch tmp2342 (quote (any #(each (any any)) any . each-any))))) x2341))) -(install-global-transformer (quote do) (lambda (orig-x2364) ((lambda (tmp2365) ((lambda (tmp2366) (if tmp2366 (apply (lambda (_2367 var2368 init2369 step2370 e02371 e12372 c2373) ((lambda (tmp2374) ((lambda (tmp2375) (if tmp2375 (apply (lambda (step2376) ((lambda (tmp2377) ((lambda (tmp2378) (if tmp2378 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2368 init2369) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02371) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2373 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2376))))))) tmp2378) ((lambda (tmp2383) (if tmp2383 (apply (lambda (e12384 e22385) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2368 init2369) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02371 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (cons e12384 e22385)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2373 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2376))))))) tmp2383) (syntax-error tmp2377))) (syntax-dispatch tmp2377 (quote (any . each-any)))))) (syntax-dispatch tmp2377 (quote ())))) e12372)) tmp2375) (syntax-error tmp2374))) (syntax-dispatch tmp2374 (quote each-any)))) (map (lambda (v2392 s2393) ((lambda (tmp2394) ((lambda (tmp2395) (if tmp2395 (apply (lambda () v2392) tmp2395) ((lambda (tmp2396) (if tmp2396 (apply (lambda (e2397) e2397) tmp2396) ((lambda (_2398) (syntax-error orig-x2364)) tmp2394))) (syntax-dispatch tmp2394 (quote (any)))))) (syntax-dispatch tmp2394 (quote ())))) s2393)) var2368 step2370))) tmp2366) (syntax-error tmp2365))) (syntax-dispatch tmp2365 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2364))) -(install-global-transformer (quote quasiquote) (letrec ((quasicons2401 (lambda (x2405 y2406) ((lambda (tmp2407) ((lambda (tmp2408) (if tmp2408 (apply (lambda (x2409 y2410) ((lambda (tmp2411) ((lambda (tmp2412) (if tmp2412 (apply (lambda (dy2413) ((lambda (tmp2414) ((lambda (tmp2415) (if tmp2415 (apply (lambda (dx2416) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons dx2416 dy2413))) tmp2415) ((lambda (_2417) (if (null? dy2413) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409 y2410))) tmp2414))) (syntax-dispatch tmp2414 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) x2409)) tmp2412) ((lambda (tmp2418) (if tmp2418 (apply (lambda (stuff2419) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons x2409 stuff2419))) tmp2418) ((lambda (else2420) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2409 y2410)) tmp2411))) (syntax-dispatch tmp2411 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . any)))))) (syntax-dispatch tmp2411 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) y2410)) tmp2408) (syntax-error tmp2407))) (syntax-dispatch tmp2407 (quote (any any))))) (list x2405 y2406)))) (quasiappend2402 (lambda (x2421 y2422) ((lambda (tmp2423) ((lambda (tmp2424) (if tmp2424 (apply (lambda (x2425 y2426) ((lambda (tmp2427) ((lambda (tmp2428) (if tmp2428 (apply (lambda () x2425) tmp2428) ((lambda (_2429) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2425 y2426)) tmp2427))) (syntax-dispatch tmp2427 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) ()))))) y2426)) tmp2424) (syntax-error tmp2423))) (syntax-dispatch tmp2423 (quote (any any))))) (list x2421 y2422)))) (quasivector2403 (lambda (x2430) ((lambda (tmp2431) ((lambda (x2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda (x2435) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (list->vector x2435))) tmp2434) ((lambda (tmp2437) (if tmp2437 (apply (lambda (x2438) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2438)) tmp2437) ((lambda (_2440) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2432)) tmp2433))) (syntax-dispatch tmp2433 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . each-any)))))) (syntax-dispatch tmp2433 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) each-any))))) x2432)) tmp2431)) x2430))) (quasi2404 (lambda (p2441 lev2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (p2445) (if (= lev2442 0) p2445 (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2445) (- lev2442 1))))) tmp2444) ((lambda (tmp2446) (if tmp2446 (apply (lambda (p2447 q2448) (if (= lev2442 0) (quasiappend2402 p2447 (quasi2404 q2448 lev2442)) (quasicons2401 (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2447) (- lev2442 1))) (quasi2404 q2448 lev2442)))) tmp2446) ((lambda (tmp2449) (if tmp2449 (apply (lambda (p2450) (quasicons2401 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2404 (list p2450) (+ lev2442 1)))) tmp2449) ((lambda (tmp2451) (if tmp2451 (apply (lambda (p2452 q2453) (quasicons2401 (quasi2404 p2452 lev2442) (quasi2404 q2453 lev2442))) tmp2451) ((lambda (tmp2454) (if tmp2454 (apply (lambda (x2455) (quasivector2403 (quasi2404 x2455 lev2442))) tmp2454) ((lambda (p2457) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) p2457)) tmp2443))) (syntax-dispatch tmp2443 (quote #(vector each-any)))))) (syntax-dispatch tmp2443 (quote (any . any)))))) (syntax-dispatch tmp2443 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any)))))) (syntax-dispatch tmp2443 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any) . any)))))) (syntax-dispatch tmp2443 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) p2441)))) (lambda (x2458) ((lambda (tmp2459) ((lambda (tmp2460) (if tmp2460 (apply (lambda (_2461 e2462) (quasi2404 e2462 0)) tmp2460) (syntax-error tmp2459))) (syntax-dispatch tmp2459 (quote (any any))))) x2458)))) -(install-global-transformer (quote include) (lambda (x2463) (letrec ((read-file2464 (lambda (fn2465 k2466) (let ((p2467 (open-input-file fn2465))) (let f2468 ((x2469 (read p2467))) (if (eof-object? x2469) (begin (close-input-port p2467) (quote ())) (cons (datum->syntax-object k2466 x2469) (f2468 (read p2467))))))))) ((lambda (tmp2470) ((lambda (tmp2471) (if tmp2471 (apply (lambda (k2472 filename2473) (let ((fn2474 (syntax-object->datum filename2473))) ((lambda (tmp2475) ((lambda (tmp2476) (if tmp2476 (apply (lambda (exp2477) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (guile))) exp2477)) tmp2476) (syntax-error tmp2475))) (syntax-dispatch tmp2475 (quote each-any)))) (read-file2464 fn2474 k2472)))) tmp2471) (syntax-error tmp2470))) (syntax-dispatch tmp2470 (quote (any any))))) x2463)))) -(install-global-transformer (quote unquote) (lambda (x2479) ((lambda (tmp2480) ((lambda (tmp2481) (if tmp2481 (apply (lambda (_2482 e2483) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2483))) tmp2481) (syntax-error tmp2480))) (syntax-dispatch tmp2480 (quote (any any))))) x2479))) -(install-global-transformer (quote unquote-splicing) (lambda (x2484) ((lambda (tmp2485) ((lambda (tmp2486) (if tmp2486 (apply (lambda (_2487 e2488) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2488))) tmp2486) (syntax-error tmp2485))) (syntax-dispatch tmp2485 (quote (any any))))) x2484))) -(install-global-transformer (quote case) (lambda (x2489) ((lambda (tmp2490) ((lambda (tmp2491) (if tmp2491 (apply (lambda (_2492 e2493 m12494 m22495) ((lambda (tmp2496) ((lambda (body2497) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2493)) body2497)) tmp2496)) (let f2498 ((clause2499 m12494) (clauses2500 m22495)) (if (null? clauses2500) ((lambda (tmp2502) ((lambda (tmp2503) (if tmp2503 (apply (lambda (e12504 e22505) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12504 e22505))) tmp2503) ((lambda (tmp2507) (if tmp2507 (apply (lambda (k2508 e12509 e22510) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2508)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12509 e22510)))) tmp2507) ((lambda (_2513) (syntax-error x2489)) tmp2502))) (syntax-dispatch tmp2502 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2502 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) any . each-any))))) clause2499) ((lambda (tmp2514) ((lambda (rest2515) ((lambda (tmp2516) ((lambda (tmp2517) (if tmp2517 (apply (lambda (k2518 e12519 e22520) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2518)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12519 e22520)) rest2515)) tmp2517) ((lambda (_2523) (syntax-error x2489)) tmp2516))) (syntax-dispatch tmp2516 (quote (each-any any . each-any))))) clause2499)) tmp2514)) (f2498 (car clauses2500) (cdr clauses2500))))))) tmp2491) (syntax-error tmp2490))) (syntax-dispatch tmp2490 (quote (any any any . each-any))))) x2489))) -(install-global-transformer (quote identifier-syntax) (lambda (x2524) ((lambda (tmp2525) ((lambda (tmp2526) (if tmp2526 (apply (lambda (_2527 e2528) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2528)) (list (cons _2527 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e2528 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))))))))) tmp2526) (syntax-error tmp2525))) (syntax-dispatch tmp2525 (quote (any any))))) x2524))) +(letrec ((lambda-var-list1141 (lambda (vars1340) (let lvl1341 ((vars1342 vars1340) (ls1343 (quote ())) (w1344 (quote (())))) (cond ((pair? vars1342) (lvl1341 (cdr vars1342) (cons (wrap1120 (car vars1342) w1344 #f) ls1343) w1344)) ((id?1092 vars1342) (cons (wrap1120 vars1342 w1344 #f) ls1343)) ((null? vars1342) ls1343) ((syntax-object?1076 vars1342) (lvl1341 (syntax-object-expression1077 vars1342) ls1343 (join-wraps1111 w1344 (syntax-object-wrap1078 vars1342)))) ((annotation? vars1342) (lvl1341 (annotation-expression vars1342) ls1343 w1344)) (else (cons vars1342 ls1343)))))) (gen-var1140 (lambda (id1345) (let ((id1346 (if (syntax-object?1076 id1345) (syntax-object-expression1077 id1345) id1345))) (if (annotation? id1346) (build-annotated1069 (annotation-source id1346) (gensym (symbol->string (annotation-expression id1346)))) (build-annotated1069 #f (gensym (symbol->string id1346))))))) (strip1139 (lambda (x1347 w1348) (if (memq (quote top) (wrap-marks1095 w1348)) (if (or (annotation? x1347) (and (pair? x1347) (annotation? (car x1347)))) (strip-annotation1138 x1347 #f) x1347) (let f1349 ((x1350 x1347)) (cond ((syntax-object?1076 x1350) (strip1139 (syntax-object-expression1077 x1350) (syntax-object-wrap1078 x1350))) ((pair? x1350) (let ((a1351 (f1349 (car x1350))) (d1352 (f1349 (cdr x1350)))) (if (and (eq? a1351 (car x1350)) (eq? d1352 (cdr x1350))) x1350 (cons a1351 d1352)))) ((vector? x1350) (let ((old1353 (vector->list x1350))) (let ((new1354 (map f1349 old1353))) (if (andmap eq? old1353 new1354) x1350 (list->vector new1354))))) (else x1350)))))) (strip-annotation1138 (lambda (x1355 parent1356) (cond ((pair? x1355) (let ((new1357 (cons #f #f))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1357)) (set-car! new1357 (strip-annotation1138 (car x1355) #f)) (set-cdr! new1357 (strip-annotation1138 (cdr x1355) #f)) new1357))) ((annotation? x1355) (or (annotation-stripped x1355) (strip-annotation1138 (annotation-expression x1355) x1355))) ((vector? x1355) (let ((new1358 (make-vector (vector-length x1355)))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1358)) (let loop1359 ((i1360 (- (vector-length x1355) 1))) (unless (fx<1062 i1360 0) (vector-set! new1358 i1360 (strip-annotation1138 (vector-ref x1355 i1360) #f)) (loop1359 (fx-1060 i1360 1)))) new1358))) (else x1355)))) (ellipsis?1137 (lambda (x1361) (and (nonsymbol-id?1091 x1361) (free-id=?1115 x1361 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))))))) (chi-void1136 (lambda () (build-annotated1069 #f (list (build-annotated1069 #f (quote void)))))) (eval-local-transformer1135 (lambda (expanded1362 mod1363) (let ((p1364 (local-eval-hook1064 expanded1362 mod1363))) (if (procedure? p1364) p1364 (syntax-error p1364 "nonprocedure transformer"))))) (chi-local-syntax1134 (lambda (rec?1365 e1366 r1367 w1368 s1369 mod1370 k1371) ((lambda (tmp1372) ((lambda (tmp1373) (if tmp1373 (apply (lambda (_1374 id1375 val1376 e11377 e21378) (let ((ids1379 id1375)) (if (not (valid-bound-ids?1117 ids1379)) (syntax-error e1366 "duplicate bound keyword in") (let ((labels1381 (gen-labels1098 ids1379))) (let ((new-w1382 (make-binding-wrap1109 ids1379 labels1381 w1368))) (k1371 (cons e11377 e21378) (extend-env1086 labels1381 (let ((w1384 (if rec?1365 new-w1382 w1368)) (trans-r1385 (macros-only-env1088 r1367))) (map (lambda (x1386) (cons (quote macro) (eval-local-transformer1135 (chi1128 x1386 trans-r1385 w1384 mod1370) mod1370))) val1376)) r1367) new-w1382 s1369 mod1370)))))) tmp1373) ((lambda (_1388) (syntax-error (source-wrap1121 e1366 w1368 s1369 mod1370))) tmp1372))) (syntax-dispatch tmp1372 (quote (any #(each (any any)) any . each-any))))) e1366))) (chi-lambda-clause1133 (lambda (e1389 c1390 r1391 w1392 mod1393 k1394) ((lambda (tmp1395) ((lambda (tmp1396) (if tmp1396 (apply (lambda (id1397 e11398 e21399) (let ((ids1400 id1397)) (if (not (valid-bound-ids?1117 ids1400)) (syntax-error e1389 "invalid parameter list in") (let ((labels1402 (gen-labels1098 ids1400)) (new-vars1403 (map gen-var1140 ids1400))) (k1394 new-vars1403 (chi-body1132 (cons e11398 e21399) e1389 (extend-var-env1087 labels1402 new-vars1403 r1391) (make-binding-wrap1109 ids1400 labels1402 w1392) mod1393)))))) tmp1396) ((lambda (tmp1405) (if tmp1405 (apply (lambda (ids1406 e11407 e21408) (let ((old-ids1409 (lambda-var-list1141 ids1406))) (if (not (valid-bound-ids?1117 old-ids1409)) (syntax-error e1389 "invalid parameter list in") (let ((labels1410 (gen-labels1098 old-ids1409)) (new-vars1411 (map gen-var1140 old-ids1409))) (k1394 (let f1412 ((ls11413 (cdr new-vars1411)) (ls21414 (car new-vars1411))) (if (null? ls11413) ls21414 (f1412 (cdr ls11413) (cons (car ls11413) ls21414)))) (chi-body1132 (cons e11407 e21408) e1389 (extend-var-env1087 labels1410 new-vars1411 r1391) (make-binding-wrap1109 old-ids1409 labels1410 w1392) mod1393)))))) tmp1405) ((lambda (_1416) (syntax-error e1389)) tmp1395))) (syntax-dispatch tmp1395 (quote (any any . each-any)))))) (syntax-dispatch tmp1395 (quote (each-any any . each-any))))) c1390))) (chi-body1132 (lambda (body1417 outer-form1418 r1419 w1420 mod1421) (let ((r1422 (cons (quote ("placeholder" placeholder)) r1419))) (let ((ribcage1423 (make-ribcage1099 (quote ()) (quote ()) (quote ())))) (let ((w1424 (make-wrap1094 (wrap-marks1095 w1420) (cons ribcage1423 (wrap-subst1096 w1420))))) (let parse1425 ((body1426 (map (lambda (x1432) (cons r1422 (wrap1120 x1432 w1424 mod1421))) body1417)) (ids1427 (quote ())) (labels1428 (quote ())) (vars1429 (quote ())) (vals1430 (quote ())) (bindings1431 (quote ()))) (if (null? body1426) (syntax-error outer-form1418 "no expressions in body") (let ((e1433 (cdar body1426)) (er1434 (caar body1426))) (call-with-values (lambda () (syntax-type1126 e1433 er1434 (quote (())) #f ribcage1423 mod1421)) (lambda (type1435 value1436 e1437 w1438 s1439 mod1440) (let ((t1441 type1435)) (if (memv t1441 (quote (define-form))) (let ((id1442 (wrap1120 value1436 w1438 mod1440)) (label1443 (gen-label1097))) (let ((var1444 (gen-var1140 id1442))) (begin (extend-ribcage!1108 ribcage1423 id1442 label1443) (parse1425 (cdr body1426) (cons id1442 ids1427) (cons label1443 labels1428) (cons var1444 vars1429) (cons (cons er1434 (wrap1120 e1437 w1438 mod1440)) vals1430) (cons (cons (quote lexical) var1444) bindings1431))))) (if (memv t1441 (quote (define-syntax-form))) (let ((id1445 (wrap1120 value1436 w1438 mod1440)) (label1446 (gen-label1097))) (begin (extend-ribcage!1108 ribcage1423 id1445 label1446) (parse1425 (cdr body1426) (cons id1445 ids1427) (cons label1446 labels1428) vars1429 vals1430 (cons (cons (quote macro) (cons er1434 (wrap1120 e1437 w1438 mod1440))) bindings1431)))) (if (memv t1441 (quote (begin-form))) ((lambda (tmp1447) ((lambda (tmp1448) (if tmp1448 (apply (lambda (_1449 e11450) (parse1425 (let f1451 ((forms1452 e11450)) (if (null? forms1452) (cdr body1426) (cons (cons er1434 (wrap1120 (car forms1452) w1438 mod1440)) (f1451 (cdr forms1452))))) ids1427 labels1428 vars1429 vals1430 bindings1431)) tmp1448) (syntax-error tmp1447))) (syntax-dispatch tmp1447 (quote (any . each-any))))) e1437) (if (memv t1441 (quote (local-syntax-form))) (chi-local-syntax1134 value1436 e1437 er1434 w1438 s1439 mod1440 (lambda (forms1454 er1455 w1456 s1457 mod1458) (parse1425 (let f1459 ((forms1460 forms1454)) (if (null? forms1460) (cdr body1426) (cons (cons er1455 (wrap1120 (car forms1460) w1456 mod1458)) (f1459 (cdr forms1460))))) ids1427 labels1428 vars1429 vals1430 bindings1431))) (if (null? ids1427) (build-sequence1071 #f (map (lambda (x1461) (chi1128 (cdr x1461) (car x1461) (quote (())) mod1440)) (cons (cons er1434 (source-wrap1121 e1437 w1438 s1439 mod1440)) (cdr body1426)))) (begin (if (not (valid-bound-ids?1117 ids1427)) (syntax-error outer-form1418 "invalid or duplicate identifier in definition")) (let loop1462 ((bs1463 bindings1431) (er-cache1464 #f) (r-cache1465 #f)) (if (not (null? bs1463)) (let ((b1466 (car bs1463))) (if (eq? (car b1466) (quote macro)) (let ((er1467 (cadr b1466))) (let ((r-cache1468 (if (eq? er1467 er-cache1464) r-cache1465 (macros-only-env1088 er1467)))) (begin (set-cdr! b1466 (eval-local-transformer1135 (chi1128 (cddr b1466) r-cache1468 (quote (())) mod1440) mod1440)) (loop1462 (cdr bs1463) er1467 r-cache1468)))) (loop1462 (cdr bs1463) er-cache1464 r-cache1465))))) (set-cdr! r1422 (extend-env1086 labels1428 bindings1431 (cdr r1422))) (build-letrec1074 #f vars1429 (map (lambda (x1469) (chi1128 (cdr x1469) (car x1469) (quote (())) mod1440)) vals1430) (build-sequence1071 #f (map (lambda (x1470) (chi1128 (cdr x1470) (car x1470) (quote (())) mod1440)) (cons (cons er1434 (source-wrap1121 e1437 w1438 s1439 mod1440)) (cdr body1426)))))))))))))))))))))) (chi-macro1131 (lambda (p1471 e1472 r1473 w1474 rib1475 mod1476) (letrec ((rebuild-macro-output1477 (lambda (x1478 m1479) (cond ((pair? x1478) (cons (rebuild-macro-output1477 (car x1478) m1479) (rebuild-macro-output1477 (cdr x1478) m1479))) ((syntax-object?1076 x1478) (let ((w1480 (syntax-object-wrap1078 x1478))) (let ((ms1481 (wrap-marks1095 w1480)) (s1482 (wrap-subst1096 w1480))) (if (and (pair? ms1481) (eq? (car ms1481) #f)) (make-syntax-object1075 (syntax-object-expression1077 x1478) (make-wrap1094 (cdr ms1481) (if rib1475 (cons rib1475 (cdr s1482)) (cdr s1482))) (syntax-object-module1079 x1478)) (make-syntax-object1075 (syntax-object-expression1077 x1478) (make-wrap1094 (cons m1479 ms1481) (if rib1475 (cons rib1475 (cons (quote shift) s1482)) (cons (quote shift) s1482))) (module-name (procedure-module p1471))))))) ((vector? x1478) (let ((n1483 (vector-length x1478))) (let ((v1484 (make-vector n1483))) (let doloop1485 ((i1486 0)) (if (fx=1061 i1486 n1483) v1484 (begin (vector-set! v1484 i1486 (rebuild-macro-output1477 (vector-ref x1478 i1486) m1479)) (doloop1485 (fx+1059 i1486 1)))))))) ((symbol? x1478) (syntax-error x1478 "encountered raw symbol in macro output")) (else x1478))))) (rebuild-macro-output1477 (p1471 (wrap1120 e1472 (anti-mark1107 w1474) mod1476)) (string #\m))))) (chi-application1130 (lambda (x1487 e1488 r1489 w1490 s1491 mod1492) ((lambda (tmp1493) ((lambda (tmp1494) (if tmp1494 (apply (lambda (e01495 e11496) (build-annotated1069 s1491 (cons x1487 (map (lambda (e1497) (chi1128 e1497 r1489 w1490 mod1492)) e11496)))) tmp1494) (syntax-error tmp1493))) (syntax-dispatch tmp1493 (quote (any . each-any))))) e1488))) (chi-expr1129 (lambda (type1499 value1500 e1501 r1502 w1503 s1504 mod1505) (let ((t1506 type1499)) (if (memv t1506 (quote (lexical))) (build-annotated1069 s1504 value1500) (if (memv t1506 (quote (core external-macro))) (value1500 e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (module-ref))) (call-with-values (lambda () (value1500 e1501)) (lambda (id1507 mod1508) (build-annotated1069 s1504 (make-module-ref mod1508 id1507 #f)))) (if (memv t1506 (quote (lexical-call))) (chi-application1130 (build-annotated1069 (source-annotation1083 (car e1501)) value1500) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (global-call))) (chi-application1130 (build-annotated1069 (source-annotation1083 (car e1501)) (make-module-ref (if (syntax-object?1076 (car e1501)) (syntax-object-module1079 (car e1501)) mod1505) value1500 #f)) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (constant))) (build-data1070 s1504 (strip1139 (source-wrap1121 e1501 w1503 s1504 mod1505) (quote (())))) (if (memv t1506 (quote (global))) (build-annotated1069 s1504 (make-module-ref mod1505 value1500 #f)) (if (memv t1506 (quote (call))) (chi-application1130 (chi1128 (car e1501) r1502 w1503 mod1505) e1501 r1502 w1503 s1504 mod1505) (if (memv t1506 (quote (begin-form))) ((lambda (tmp1509) ((lambda (tmp1510) (if tmp1510 (apply (lambda (_1511 e11512 e21513) (chi-sequence1122 (cons e11512 e21513) r1502 w1503 s1504 mod1505)) tmp1510) (syntax-error tmp1509))) (syntax-dispatch tmp1509 (quote (any any . each-any))))) e1501) (if (memv t1506 (quote (local-syntax-form))) (chi-local-syntax1134 value1500 e1501 r1502 w1503 s1504 mod1505 chi-sequence1122) (if (memv t1506 (quote (eval-when-form))) ((lambda (tmp1515) ((lambda (tmp1516) (if tmp1516 (apply (lambda (_1517 x1518 e11519 e21520) (let ((when-list1521 (chi-when-list1125 e1501 x1518 w1503))) (if (memq (quote eval) when-list1521) (chi-sequence1122 (cons e11519 e21520) r1502 w1503 s1504 mod1505) (chi-void1136)))) tmp1516) (syntax-error tmp1515))) (syntax-dispatch tmp1515 (quote (any each-any any . each-any))))) e1501) (if (memv t1506 (quote (define-form define-syntax-form))) (syntax-error (wrap1120 value1500 w1503 mod1505) "invalid context for definition of") (if (memv t1506 (quote (syntax))) (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505) "reference to pattern variable outside syntax form") (if (memv t1506 (quote (displaced-lexical))) (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505) "reference to identifier outside its scope") (syntax-error (source-wrap1121 e1501 w1503 s1504 mod1505))))))))))))))))))) (chi1128 (lambda (e1524 r1525 w1526 mod1527) (call-with-values (lambda () (syntax-type1126 e1524 r1525 w1526 #f #f mod1527)) (lambda (type1528 value1529 e1530 w1531 s1532 mod1533) (chi-expr1129 type1528 value1529 e1530 r1525 w1531 s1532 mod1533))))) (chi-top1127 (lambda (e1534 r1535 w1536 m1537 esew1538 mod1539) (call-with-values (lambda () (syntax-type1126 e1534 r1535 w1536 #f #f mod1539)) (lambda (type1547 value1548 e1549 w1550 s1551 mod1552) (let ((t1553 type1547)) (if (memv t1553 (quote (begin-form))) ((lambda (tmp1554) ((lambda (tmp1555) (if tmp1555 (apply (lambda (_1556) (chi-void1136)) tmp1555) ((lambda (tmp1557) (if tmp1557 (apply (lambda (_1558 e11559 e21560) (chi-top-sequence1123 (cons e11559 e21560) r1535 w1550 s1551 m1537 esew1538 mod1552)) tmp1557) (syntax-error tmp1554))) (syntax-dispatch tmp1554 (quote (any any . each-any)))))) (syntax-dispatch tmp1554 (quote (any))))) e1549) (if (memv t1553 (quote (local-syntax-form))) (chi-local-syntax1134 value1548 e1549 r1535 w1550 s1551 mod1552 (lambda (body1562 r1563 w1564 s1565 mod1566) (chi-top-sequence1123 body1562 r1563 w1564 s1565 m1537 esew1538 mod1566))) (if (memv t1553 (quote (eval-when-form))) ((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569 x1570 e11571 e21572) (let ((when-list1573 (chi-when-list1125 e1549 x1570 w1550)) (body1574 (cons e11571 e21572))) (cond ((eq? m1537 (quote e)) (if (memq (quote eval) when-list1573) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote e) (quote (eval)) mod1552) (chi-void1136))) ((memq (quote load) when-list1573) (if (or (memq (quote compile) when-list1573) (and (eq? m1537 (quote c&e)) (memq (quote eval) when-list1573))) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote c&e) (quote (compile load)) mod1552) (if (memq m1537 (quote (c c&e))) (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote c) (quote (load)) mod1552) (chi-void1136)))) ((or (memq (quote compile) when-list1573) (and (eq? m1537 (quote c&e)) (memq (quote eval) when-list1573))) (top-level-eval-hook1063 (chi-top-sequence1123 body1574 r1535 w1550 s1551 (quote e) (quote (eval)) mod1552) mod1552) (chi-void1136)) (else (chi-void1136))))) tmp1568) (syntax-error tmp1567))) (syntax-dispatch tmp1567 (quote (any each-any any . each-any))))) e1549) (if (memv t1553 (quote (define-syntax-form))) (let ((n1577 (id-var-name1114 value1548 w1550)) (r1578 (macros-only-env1088 r1535))) (let ((t1579 m1537)) (if (memv t1579 (quote (c))) (if (memq (quote compile) esew1538) (let ((e1580 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)))) (begin (top-level-eval-hook1063 e1580 mod1552) (if (memq (quote load) esew1538) e1580 (chi-void1136)))) (if (memq (quote load) esew1538) (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)) (chi-void1136))) (if (memv t1579 (quote (c&e))) (let ((e1581 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)))) (begin (top-level-eval-hook1063 e1581 mod1552) e1581)) (begin (if (memq (quote eval) esew1538) (top-level-eval-hook1063 (chi-install-global1124 n1577 (chi1128 e1549 r1578 w1550 mod1552)) mod1552)) (chi-void1136)))))) (if (memv t1553 (quote (define-form))) (let ((n1582 (id-var-name1114 value1548 w1550))) (let ((type1583 (binding-type1084 (lookup1089 n1582 r1535 mod1552)))) (let ((t1584 type1583)) (if (memv t1584 (quote (global))) (let ((x1585 (build-annotated1069 s1551 (list (quote define) n1582 (chi1128 e1549 r1535 w1550 mod1552))))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1585 mod1552)) x1585)) (if (memv t1584 (quote (displaced-lexical))) (syntax-error (wrap1120 value1548 w1550 mod1552) "identifier out of context") (if (memv t1584 (quote (core macro module-ref))) (begin (remove-global-definition-hook1067 n1582 mod1552) (let ((x1586 (build-annotated1069 s1551 (list (quote define) n1582 (chi1128 e1549 r1535 w1550 mod1552))))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1586 mod1552)) x1586))) (syntax-error (wrap1120 value1548 w1550 mod1552) "cannot define keyword at top level"))))))) (let ((x1587 (chi-expr1129 type1547 value1548 e1549 r1535 w1550 s1551 mod1552))) (begin (if (eq? m1537 (quote c&e)) (top-level-eval-hook1063 x1587 mod1552)) x1587)))))))))))) (syntax-type1126 (lambda (e1588 r1589 w1590 s1591 rib1592 mod1593) (cond ((symbol? e1588) (let ((n1594 (id-var-name1114 e1588 w1590))) (let ((b1595 (lookup1089 n1594 r1589 mod1593))) (let ((type1596 (binding-type1084 b1595))) (let ((t1597 type1596)) (if (memv t1597 (quote (lexical))) (values type1596 (binding-value1085 b1595) e1588 w1590 s1591 mod1593) (if (memv t1597 (quote (global))) (values type1596 n1594 e1588 w1590 s1591 mod1593) (if (memv t1597 (quote (macro))) (syntax-type1126 (chi-macro1131 (binding-value1085 b1595) e1588 r1589 w1590 rib1592 mod1593) r1589 (quote (())) s1591 rib1592 mod1593) (values type1596 (binding-value1085 b1595) e1588 w1590 s1591 mod1593))))))))) ((pair? e1588) (let ((first1598 (car e1588))) (if (id?1092 first1598) (let ((n1599 (id-var-name1114 first1598 w1590))) (let ((b1600 (lookup1089 n1599 r1589 (or (and (syntax-object?1076 first1598) (syntax-object-module1079 first1598)) mod1593)))) (let ((type1601 (binding-type1084 b1600))) (let ((t1602 type1601)) (if (memv t1602 (quote (lexical))) (values (quote lexical-call) (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (global))) (values (quote global-call) n1599 e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (macro))) (syntax-type1126 (chi-macro1131 (binding-value1085 b1600) e1588 r1589 w1590 rib1592 mod1593) r1589 (quote (())) s1591 rib1592 mod1593) (if (memv t1602 (quote (core external-macro module-ref))) (values type1601 (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1085 b1600) e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (begin))) (values (quote begin-form) #f e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (eval-when))) (values (quote eval-when-form) #f e1588 w1590 s1591 mod1593) (if (memv t1602 (quote (define))) ((lambda (tmp1603) ((lambda (tmp1604) (if (if tmp1604 (apply (lambda (_1605 name1606 val1607) (id?1092 name1606)) tmp1604) #f) (apply (lambda (_1608 name1609 val1610) (values (quote define-form) name1609 val1610 w1590 s1591 mod1593)) tmp1604) ((lambda (tmp1611) (if (if tmp1611 (apply (lambda (_1612 name1613 args1614 e11615 e21616) (and (id?1092 name1613) (valid-bound-ids?1117 (lambda-var-list1141 args1614)))) tmp1611) #f) (apply (lambda (_1617 name1618 args1619 e11620 e21621) (values (quote define-form) (wrap1120 name1618 w1590 mod1593) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) (wrap1120 (cons args1619 (cons e11620 e21621)) w1590 mod1593)) (quote (())) s1591 mod1593)) tmp1611) ((lambda (tmp1623) (if (if tmp1623 (apply (lambda (_1624 name1625) (id?1092 name1625)) tmp1623) #f) (apply (lambda (_1626 name1627) (values (quote define-form) (wrap1120 name1627 w1590 mod1593) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote (())) s1591 mod1593)) tmp1623) (syntax-error tmp1603))) (syntax-dispatch tmp1603 (quote (any any)))))) (syntax-dispatch tmp1603 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1603 (quote (any any any))))) e1588) (if (memv t1602 (quote (define-syntax))) ((lambda (tmp1628) ((lambda (tmp1629) (if (if tmp1629 (apply (lambda (_1630 name1631 val1632) (id?1092 name1631)) tmp1629) #f) (apply (lambda (_1633 name1634 val1635) (values (quote define-syntax-form) name1634 val1635 w1590 s1591 mod1593)) tmp1629) (syntax-error tmp1628))) (syntax-dispatch tmp1628 (quote (any any any))))) e1588) (values (quote call) #f e1588 w1590 s1591 mod1593)))))))))))))) (values (quote call) #f e1588 w1590 s1591 mod1593)))) ((syntax-object?1076 e1588) (syntax-type1126 (syntax-object-expression1077 e1588) r1589 (join-wraps1111 w1590 (syntax-object-wrap1078 e1588)) #f rib1592 (or (syntax-object-module1079 e1588) mod1593))) ((annotation? e1588) (syntax-type1126 (annotation-expression e1588) r1589 w1590 (annotation-source e1588) rib1592 mod1593)) ((self-evaluating? e1588) (values (quote constant) #f e1588 w1590 s1591 mod1593)) (else (values (quote other) #f e1588 w1590 s1591 mod1593))))) (chi-when-list1125 (lambda (e1636 when-list1637 w1638) (let f1639 ((when-list1640 when-list1637) (situations1641 (quote ()))) (if (null? when-list1640) situations1641 (f1639 (cdr when-list1640) (cons (let ((x1642 (car when-list1640))) (cond ((free-id=?1115 x1642 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote compile)) ((free-id=?1115 x1642 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote load)) ((free-id=?1115 x1642 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote eval)) (else (syntax-error (wrap1120 x1642 w1638 #f) "invalid eval-when situation")))) situations1641)))))) (chi-install-global1124 (lambda (name1643 e1644) (build-annotated1069 #f (list (build-annotated1069 #f (quote install-global-transformer)) (build-data1070 #f name1643) e1644)))) (chi-top-sequence1123 (lambda (body1645 r1646 w1647 s1648 m1649 esew1650 mod1651) (build-sequence1071 s1648 (let dobody1652 ((body1653 body1645) (r1654 r1646) (w1655 w1647) (m1656 m1649) (esew1657 esew1650) (mod1658 mod1651)) (if (null? body1653) (quote ()) (let ((first1659 (chi-top1127 (car body1653) r1654 w1655 m1656 esew1657 mod1658))) (cons first1659 (dobody1652 (cdr body1653) r1654 w1655 m1656 esew1657 mod1658)))))))) (chi-sequence1122 (lambda (body1660 r1661 w1662 s1663 mod1664) (build-sequence1071 s1663 (let dobody1665 ((body1666 body1660) (r1667 r1661) (w1668 w1662) (mod1669 mod1664)) (if (null? body1666) (quote ()) (let ((first1670 (chi1128 (car body1666) r1667 w1668 mod1669))) (cons first1670 (dobody1665 (cdr body1666) r1667 w1668 mod1669)))))))) (source-wrap1121 (lambda (x1671 w1672 s1673 defmod1674) (wrap1120 (if s1673 (make-annotation x1671 s1673 #f) x1671) w1672 defmod1674))) (wrap1120 (lambda (x1675 w1676 defmod1677) (cond ((and (null? (wrap-marks1095 w1676)) (null? (wrap-subst1096 w1676))) x1675) ((syntax-object?1076 x1675) (make-syntax-object1075 (syntax-object-expression1077 x1675) (join-wraps1111 w1676 (syntax-object-wrap1078 x1675)) (syntax-object-module1079 x1675))) ((null? x1675) x1675) (else (make-syntax-object1075 x1675 w1676 defmod1677))))) (bound-id-member?1119 (lambda (x1678 list1679) (and (not (null? list1679)) (or (bound-id=?1116 x1678 (car list1679)) (bound-id-member?1119 x1678 (cdr list1679)))))) (distinct-bound-ids?1118 (lambda (ids1680) (let distinct?1681 ((ids1682 ids1680)) (or (null? ids1682) (and (not (bound-id-member?1119 (car ids1682) (cdr ids1682))) (distinct?1681 (cdr ids1682))))))) (valid-bound-ids?1117 (lambda (ids1683) (and (let all-ids?1684 ((ids1685 ids1683)) (or (null? ids1685) (and (id?1092 (car ids1685)) (all-ids?1684 (cdr ids1685))))) (distinct-bound-ids?1118 ids1683)))) (bound-id=?1116 (lambda (i1686 j1687) (if (and (syntax-object?1076 i1686) (syntax-object?1076 j1687)) (and (eq? (let ((e1688 (syntax-object-expression1077 i1686))) (if (annotation? e1688) (annotation-expression e1688) e1688)) (let ((e1689 (syntax-object-expression1077 j1687))) (if (annotation? e1689) (annotation-expression e1689) e1689))) (same-marks?1113 (wrap-marks1095 (syntax-object-wrap1078 i1686)) (wrap-marks1095 (syntax-object-wrap1078 j1687)))) (eq? (let ((e1690 i1686)) (if (annotation? e1690) (annotation-expression e1690) e1690)) (let ((e1691 j1687)) (if (annotation? e1691) (annotation-expression e1691) e1691)))))) (free-id=?1115 (lambda (i1692 j1693) (and (eq? (let ((x1694 i1692)) (let ((e1695 (if (syntax-object?1076 x1694) (syntax-object-expression1077 x1694) x1694))) (if (annotation? e1695) (annotation-expression e1695) e1695))) (let ((x1696 j1693)) (let ((e1697 (if (syntax-object?1076 x1696) (syntax-object-expression1077 x1696) x1696))) (if (annotation? e1697) (annotation-expression e1697) e1697)))) (eq? (id-var-name1114 i1692 (quote (()))) (id-var-name1114 j1693 (quote (()))))))) (id-var-name1114 (lambda (id1698 w1699) (letrec ((search-vector-rib1702 (lambda (sym1708 subst1709 marks1710 symnames1711 ribcage1712) (let ((n1713 (vector-length symnames1711))) (let f1714 ((i1715 0)) (cond ((fx=1061 i1715 n1713) (search1700 sym1708 (cdr subst1709) marks1710)) ((and (eq? (vector-ref symnames1711 i1715) sym1708) (same-marks?1113 marks1710 (vector-ref (ribcage-marks1102 ribcage1712) i1715))) (values (vector-ref (ribcage-labels1103 ribcage1712) i1715) marks1710)) (else (f1714 (fx+1059 i1715 1)))))))) (search-list-rib1701 (lambda (sym1716 subst1717 marks1718 symnames1719 ribcage1720) (let f1721 ((symnames1722 symnames1719) (i1723 0)) (cond ((null? symnames1722) (search1700 sym1716 (cdr subst1717) marks1718)) ((and (eq? (car symnames1722) sym1716) (same-marks?1113 marks1718 (list-ref (ribcage-marks1102 ribcage1720) i1723))) (values (list-ref (ribcage-labels1103 ribcage1720) i1723) marks1718)) (else (f1721 (cdr symnames1722) (fx+1059 i1723 1))))))) (search1700 (lambda (sym1724 subst1725 marks1726) (if (null? subst1725) (values #f marks1726) (let ((fst1727 (car subst1725))) (if (eq? fst1727 (quote shift)) (search1700 sym1724 (cdr subst1725) (cdr marks1726)) (let ((symnames1728 (ribcage-symnames1101 fst1727))) (if (vector? symnames1728) (search-vector-rib1702 sym1724 subst1725 marks1726 symnames1728 fst1727) (search-list-rib1701 sym1724 subst1725 marks1726 symnames1728 fst1727))))))))) (cond ((symbol? id1698) (or (call-with-values (lambda () (search1700 id1698 (wrap-subst1096 w1699) (wrap-marks1095 w1699))) (lambda (x1730 . ignore1729) x1730)) id1698)) ((syntax-object?1076 id1698) (let ((id1731 (let ((e1733 (syntax-object-expression1077 id1698))) (if (annotation? e1733) (annotation-expression e1733) e1733))) (w11732 (syntax-object-wrap1078 id1698))) (let ((marks1734 (join-marks1112 (wrap-marks1095 w1699) (wrap-marks1095 w11732)))) (call-with-values (lambda () (search1700 id1731 (wrap-subst1096 w1699) marks1734)) (lambda (new-id1735 marks1736) (or new-id1735 (call-with-values (lambda () (search1700 id1731 (wrap-subst1096 w11732) marks1736)) (lambda (x1738 . ignore1737) x1738)) id1731)))))) ((annotation? id1698) (let ((id1739 (let ((e1740 id1698)) (if (annotation? e1740) (annotation-expression e1740) e1740)))) (or (call-with-values (lambda () (search1700 id1739 (wrap-subst1096 w1699) (wrap-marks1095 w1699))) (lambda (x1742 . ignore1741) x1742)) id1739))) (else (error-hook1065 (quote id-var-name) "invalid id" id1698)))))) (same-marks?1113 (lambda (x1743 y1744) (or (eq? x1743 y1744) (and (not (null? x1743)) (not (null? y1744)) (eq? (car x1743) (car y1744)) (same-marks?1113 (cdr x1743) (cdr y1744)))))) (join-marks1112 (lambda (m11745 m21746) (smart-append1110 m11745 m21746))) (join-wraps1111 (lambda (w11747 w21748) (let ((m11749 (wrap-marks1095 w11747)) (s11750 (wrap-subst1096 w11747))) (if (null? m11749) (if (null? s11750) w21748 (make-wrap1094 (wrap-marks1095 w21748) (smart-append1110 s11750 (wrap-subst1096 w21748)))) (make-wrap1094 (smart-append1110 m11749 (wrap-marks1095 w21748)) (smart-append1110 s11750 (wrap-subst1096 w21748))))))) (smart-append1110 (lambda (m11751 m21752) (if (null? m21752) m11751 (append m11751 m21752)))) (make-binding-wrap1109 (lambda (ids1753 labels1754 w1755) (if (null? ids1753) w1755 (make-wrap1094 (wrap-marks1095 w1755) (cons (let ((labelvec1756 (list->vector labels1754))) (let ((n1757 (vector-length labelvec1756))) (let ((symnamevec1758 (make-vector n1757)) (marksvec1759 (make-vector n1757))) (begin (let f1760 ((ids1761 ids1753) (i1762 0)) (if (not (null? ids1761)) (call-with-values (lambda () (id-sym-name&marks1093 (car ids1761) w1755)) (lambda (symname1763 marks1764) (begin (vector-set! symnamevec1758 i1762 symname1763) (vector-set! marksvec1759 i1762 marks1764) (f1760 (cdr ids1761) (fx+1059 i1762 1))))))) (make-ribcage1099 symnamevec1758 marksvec1759 labelvec1756))))) (wrap-subst1096 w1755)))))) (extend-ribcage!1108 (lambda (ribcage1765 id1766 label1767) (begin (set-ribcage-symnames!1104 ribcage1765 (cons (let ((e1768 (syntax-object-expression1077 id1766))) (if (annotation? e1768) (annotation-expression e1768) e1768)) (ribcage-symnames1101 ribcage1765))) (set-ribcage-marks!1105 ribcage1765 (cons (wrap-marks1095 (syntax-object-wrap1078 id1766)) (ribcage-marks1102 ribcage1765))) (set-ribcage-labels!1106 ribcage1765 (cons label1767 (ribcage-labels1103 ribcage1765)))))) (anti-mark1107 (lambda (w1769) (make-wrap1094 (cons #f (wrap-marks1095 w1769)) (cons (quote shift) (wrap-subst1096 w1769))))) (set-ribcage-labels!1106 (lambda (x1770 update1771) (vector-set! x1770 3 update1771))) (set-ribcage-marks!1105 (lambda (x1772 update1773) (vector-set! x1772 2 update1773))) (set-ribcage-symnames!1104 (lambda (x1774 update1775) (vector-set! x1774 1 update1775))) (ribcage-labels1103 (lambda (x1776) (vector-ref x1776 3))) (ribcage-marks1102 (lambda (x1777) (vector-ref x1777 2))) (ribcage-symnames1101 (lambda (x1778) (vector-ref x1778 1))) (ribcage?1100 (lambda (x1779) (and (vector? x1779) (= (vector-length x1779) 4) (eq? (vector-ref x1779 0) (quote ribcage))))) (make-ribcage1099 (lambda (symnames1780 marks1781 labels1782) (vector (quote ribcage) symnames1780 marks1781 labels1782))) (gen-labels1098 (lambda (ls1783) (if (null? ls1783) (quote ()) (cons (gen-label1097) (gen-labels1098 (cdr ls1783)))))) (gen-label1097 (lambda () (string #\i))) (wrap-subst1096 cdr) (wrap-marks1095 car) (make-wrap1094 cons) (id-sym-name&marks1093 (lambda (x1784 w1785) (if (syntax-object?1076 x1784) (values (let ((e1786 (syntax-object-expression1077 x1784))) (if (annotation? e1786) (annotation-expression e1786) e1786)) (join-marks1112 (wrap-marks1095 w1785) (wrap-marks1095 (syntax-object-wrap1078 x1784)))) (values (let ((e1787 x1784)) (if (annotation? e1787) (annotation-expression e1787) e1787)) (wrap-marks1095 w1785))))) (id?1092 (lambda (x1788) (cond ((symbol? x1788) #t) ((syntax-object?1076 x1788) (symbol? (let ((e1789 (syntax-object-expression1077 x1788))) (if (annotation? e1789) (annotation-expression e1789) e1789)))) ((annotation? x1788) (symbol? (annotation-expression x1788))) (else #f)))) (nonsymbol-id?1091 (lambda (x1790) (and (syntax-object?1076 x1790) (symbol? (let ((e1791 (syntax-object-expression1077 x1790))) (if (annotation? e1791) (annotation-expression e1791) e1791)))))) (global-extend1090 (lambda (type1792 sym1793 val1794) (put-global-definition-hook1066 sym1793 (cons type1792 val1794) (module-name (current-module))))) (lookup1089 (lambda (x1795 r1796 mod1797) (cond ((assq x1795 r1796) => cdr) ((symbol? x1795) (or (get-global-definition-hook1068 x1795 mod1797) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1088 (lambda (r1798) (if (null? r1798) (quote ()) (let ((a1799 (car r1798))) (if (eq? (cadr a1799) (quote macro)) (cons a1799 (macros-only-env1088 (cdr r1798))) (macros-only-env1088 (cdr r1798))))))) (extend-var-env1087 (lambda (labels1800 vars1801 r1802) (if (null? labels1800) r1802 (extend-var-env1087 (cdr labels1800) (cdr vars1801) (cons (cons (car labels1800) (cons (quote lexical) (car vars1801))) r1802))))) (extend-env1086 (lambda (labels1803 bindings1804 r1805) (if (null? labels1803) r1805 (extend-env1086 (cdr labels1803) (cdr bindings1804) (cons (cons (car labels1803) (car bindings1804)) r1805))))) (binding-value1085 cdr) (binding-type1084 car) (source-annotation1083 (lambda (x1806) (cond ((annotation? x1806) (annotation-source x1806)) ((syntax-object?1076 x1806) (source-annotation1083 (syntax-object-expression1077 x1806))) (else #f)))) (set-syntax-object-module!1082 (lambda (x1807 update1808) (vector-set! x1807 3 update1808))) (set-syntax-object-wrap!1081 (lambda (x1809 update1810) (vector-set! x1809 2 update1810))) (set-syntax-object-expression!1080 (lambda (x1811 update1812) (vector-set! x1811 1 update1812))) (syntax-object-module1079 (lambda (x1813) (vector-ref x1813 3))) (syntax-object-wrap1078 (lambda (x1814) (vector-ref x1814 2))) (syntax-object-expression1077 (lambda (x1815) (vector-ref x1815 1))) (syntax-object?1076 (lambda (x1816) (and (vector? x1816) (= (vector-length x1816) 4) (eq? (vector-ref x1816 0) (quote syntax-object))))) (make-syntax-object1075 (lambda (expression1817 wrap1818 module1819) (vector (quote syntax-object) expression1817 wrap1818 module1819))) (build-letrec1074 (lambda (src1820 vars1821 val-exps1822 body-exp1823) (if (null? vars1821) (build-annotated1069 src1820 body-exp1823) (build-annotated1069 src1820 (list (quote letrec) (map list vars1821 val-exps1822) body-exp1823))))) (build-named-let1073 (lambda (src1824 vars1825 val-exps1826 body-exp1827) (if (null? vars1825) (build-annotated1069 src1824 body-exp1827) (build-annotated1069 src1824 (list (quote let) (car vars1825) (map list (cdr vars1825) val-exps1826) body-exp1827))))) (build-let1072 (lambda (src1828 vars1829 val-exps1830 body-exp1831) (if (null? vars1829) (build-annotated1069 src1828 body-exp1831) (build-annotated1069 src1828 (list (quote let) (map list vars1829 val-exps1830) body-exp1831))))) (build-sequence1071 (lambda (src1832 exps1833) (if (null? (cdr exps1833)) (build-annotated1069 src1832 (car exps1833)) (build-annotated1069 src1832 (cons (quote begin) exps1833))))) (build-data1070 (lambda (src1834 exp1835) (if (and (self-evaluating? exp1835) (not (vector? exp1835))) (build-annotated1069 src1834 exp1835) (build-annotated1069 src1834 (list (quote quote) exp1835))))) (build-annotated1069 (lambda (src1836 exp1837) (if (and src1836 (not (annotation? exp1837))) (make-annotation exp1837 src1836 #t) exp1837))) (get-global-definition-hook1068 (lambda (symbol1838 module1839) (let ((module1840 (if module1839 (resolve-module module1839) (let ((mod1841 (current-module))) (begin (if mod1841 (warn "wha" symbol1838)) mod1841))))) (let ((v1842 (module-variable module1840 symbol1838))) (and v1842 (or (object-property v1842 (quote *sc-expander*)) (and (variable-bound? v1842) (macro? (variable-ref v1842)) (macro-transformer (variable-ref v1842)) guile-macro))))))) (remove-global-definition-hook1067 (lambda (symbol1843 modname1844) (let ((module1845 (if modname1844 (resolve-module modname1844) (current-module)))) (let ((v1846 (module-local-variable module1845 symbol1843))) (if v1846 (let ((p1847 (assq (quote *sc-expander*) (object-properties v1846)))) (set-object-properties! v1846 (delq p1847 (object-properties v1846))))))))) (put-global-definition-hook1066 (lambda (symbol1848 binding1849 modname1850) (let ((module1851 (if modname1850 (resolve-module modname1850) (current-module)))) (let ((v1852 (or (module-variable module1851 symbol1848) (let ((v1853 (make-variable (gensym)))) (begin (module-add! module1851 symbol1848 v1853) v1853))))) (begin (if (not (variable-bound? v1852)) (variable-set! v1852 (gensym))) (set-object-property! v1852 (quote *sc-expander*) binding1849)))))) (error-hook1065 (lambda (who1854 why1855 what1856) (error who1854 "~a ~s" why1855 what1856))) (local-eval-hook1064 (lambda (x1857 mod1858) (eval (list noexpand1058 x1857) (if mod1858 (resolve-module mod1858) (interaction-environment))))) (top-level-eval-hook1063 (lambda (x1859 mod1860) (eval (list noexpand1058 x1859) (if mod1860 (resolve-module mod1860) (interaction-environment))))) (fx<1062 <) (fx=1061 =) (fx-1060 -) (fx+1059 +) (noexpand1058 "noexpand")) (begin (global-extend1090 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1090 (quote local-syntax) (quote let-syntax) #f) (global-extend1090 (quote core) (quote fluid-let-syntax) (lambda (e1861 r1862 w1863 s1864 mod1865) ((lambda (tmp1866) ((lambda (tmp1867) (if (if tmp1867 (apply (lambda (_1868 var1869 val1870 e11871 e21872) (valid-bound-ids?1117 var1869)) tmp1867) #f) (apply (lambda (_1874 var1875 val1876 e11877 e21878) (let ((names1879 (map (lambda (x1880) (id-var-name1114 x1880 w1863)) var1875))) (begin (for-each (lambda (id1882 n1883) (let ((t1884 (binding-type1084 (lookup1089 n1883 r1862 mod1865)))) (if (memv t1884 (quote (displaced-lexical))) (syntax-error (source-wrap1121 id1882 w1863 s1864 mod1865) "identifier out of context")))) var1875 names1879) (chi-body1132 (cons e11877 e21878) (source-wrap1121 e1861 w1863 s1864 mod1865) (extend-env1086 names1879 (let ((trans-r1887 (macros-only-env1088 r1862))) (map (lambda (x1888) (cons (quote macro) (eval-local-transformer1135 (chi1128 x1888 trans-r1887 w1863 mod1865) mod1865))) val1876)) r1862) w1863 mod1865)))) tmp1867) ((lambda (_1890) (syntax-error (source-wrap1121 e1861 w1863 s1864 mod1865))) tmp1866))) (syntax-dispatch tmp1866 (quote (any #(each (any any)) any . each-any))))) e1861))) (global-extend1090 (quote core) (quote quote) (lambda (e1891 r1892 w1893 s1894 mod1895) ((lambda (tmp1896) ((lambda (tmp1897) (if tmp1897 (apply (lambda (_1898 e1899) (build-data1070 s1894 (strip1139 e1899 w1893))) tmp1897) ((lambda (_1900) (syntax-error (source-wrap1121 e1891 w1893 s1894 mod1895))) tmp1896))) (syntax-dispatch tmp1896 (quote (any any))))) e1891))) (global-extend1090 (quote core) (quote syntax) (letrec ((regen1908 (lambda (x1909) (let ((t1910 (car x1909))) (if (memv t1910 (quote (ref))) (build-annotated1069 #f (cadr x1909)) (if (memv t1910 (quote (primitive))) (build-annotated1069 #f (cadr x1909)) (if (memv t1910 (quote (quote))) (build-data1070 #f (cadr x1909)) (if (memv t1910 (quote (lambda))) (build-annotated1069 #f (list (quote lambda) (cadr x1909) (regen1908 (caddr x1909)))) (if (memv t1910 (quote (map))) (let ((ls1911 (map regen1908 (cdr x1909)))) (build-annotated1069 #f (cons (if (fx=1061 (length ls1911) 2) (build-annotated1069 #f (quote map)) (build-annotated1069 #f (quote map))) ls1911))) (build-annotated1069 #f (cons (build-annotated1069 #f (car x1909)) (map regen1908 (cdr x1909)))))))))))) (gen-vector1907 (lambda (x1912) (cond ((eq? (car x1912) (quote list)) (cons (quote vector) (cdr x1912))) ((eq? (car x1912) (quote quote)) (list (quote quote) (list->vector (cadr x1912)))) (else (list (quote list->vector) x1912))))) (gen-append1906 (lambda (x1913 y1914) (if (equal? y1914 (quote (quote ()))) x1913 (list (quote append) x1913 y1914)))) (gen-cons1905 (lambda (x1915 y1916) (let ((t1917 (car y1916))) (if (memv t1917 (quote (quote))) (if (eq? (car x1915) (quote quote)) (list (quote quote) (cons (cadr x1915) (cadr y1916))) (if (eq? (cadr y1916) (quote ())) (list (quote list) x1915) (list (quote cons) x1915 y1916))) (if (memv t1917 (quote (list))) (cons (quote list) (cons x1915 (cdr y1916))) (list (quote cons) x1915 y1916)))))) (gen-map1904 (lambda (e1918 map-env1919) (let ((formals1920 (map cdr map-env1919)) (actuals1921 (map (lambda (x1922) (list (quote ref) (car x1922))) map-env1919))) (cond ((eq? (car e1918) (quote ref)) (car actuals1921)) ((andmap (lambda (x1923) (and (eq? (car x1923) (quote ref)) (memq (cadr x1923) formals1920))) (cdr e1918)) (cons (quote map) (cons (list (quote primitive) (car e1918)) (map (let ((r1924 (map cons formals1920 actuals1921))) (lambda (x1925) (cdr (assq (cadr x1925) r1924)))) (cdr e1918))))) (else (cons (quote map) (cons (list (quote lambda) formals1920 e1918) actuals1921))))))) (gen-mappend1903 (lambda (e1926 map-env1927) (list (quote apply) (quote (primitive append)) (gen-map1904 e1926 map-env1927)))) (gen-ref1902 (lambda (src1928 var1929 level1930 maps1931) (if (fx=1061 level1930 0) (values var1929 maps1931) (if (null? maps1931) (syntax-error src1928 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1902 src1928 var1929 (fx-1060 level1930 1) (cdr maps1931))) (lambda (outer-var1932 outer-maps1933) (let ((b1934 (assq outer-var1932 (car maps1931)))) (if b1934 (values (cdr b1934) maps1931) (let ((inner-var1935 (gen-var1140 (quote tmp)))) (values inner-var1935 (cons (cons (cons outer-var1932 inner-var1935) (car maps1931)) outer-maps1933))))))))))) (gen-syntax1901 (lambda (src1936 e1937 r1938 maps1939 ellipsis?1940 mod1941) (if (id?1092 e1937) (let ((label1942 (id-var-name1114 e1937 (quote (()))))) (let ((b1943 (lookup1089 label1942 r1938 mod1941))) (if (eq? (binding-type1084 b1943) (quote syntax)) (call-with-values (lambda () (let ((var.lev1944 (binding-value1085 b1943))) (gen-ref1902 src1936 (car var.lev1944) (cdr var.lev1944) maps1939))) (lambda (var1945 maps1946) (values (list (quote ref) var1945) maps1946))) (if (ellipsis?1940 e1937) (syntax-error src1936 "misplaced ellipsis in syntax form") (values (list (quote quote) e1937) maps1939))))) ((lambda (tmp1947) ((lambda (tmp1948) (if (if tmp1948 (apply (lambda (dots1949 e1950) (ellipsis?1940 dots1949)) tmp1948) #f) (apply (lambda (dots1951 e1952) (gen-syntax1901 src1936 e1952 r1938 maps1939 (lambda (x1953) #f) mod1941)) tmp1948) ((lambda (tmp1954) (if (if tmp1954 (apply (lambda (x1955 dots1956 y1957) (ellipsis?1940 dots1956)) tmp1954) #f) (apply (lambda (x1958 dots1959 y1960) (let f1961 ((y1962 y1960) (k1963 (lambda (maps1964) (call-with-values (lambda () (gen-syntax1901 src1936 x1958 r1938 (cons (quote ()) maps1964) ellipsis?1940 mod1941)) (lambda (x1965 maps1966) (if (null? (car maps1966)) (syntax-error src1936 "extra ellipsis in syntax form") (values (gen-map1904 x1965 (car maps1966)) (cdr maps1966)))))))) ((lambda (tmp1967) ((lambda (tmp1968) (if (if tmp1968 (apply (lambda (dots1969 y1970) (ellipsis?1940 dots1969)) tmp1968) #f) (apply (lambda (dots1971 y1972) (f1961 y1972 (lambda (maps1973) (call-with-values (lambda () (k1963 (cons (quote ()) maps1973))) (lambda (x1974 maps1975) (if (null? (car maps1975)) (syntax-error src1936 "extra ellipsis in syntax form") (values (gen-mappend1903 x1974 (car maps1975)) (cdr maps1975)))))))) tmp1968) ((lambda (_1976) (call-with-values (lambda () (gen-syntax1901 src1936 y1962 r1938 maps1939 ellipsis?1940 mod1941)) (lambda (y1977 maps1978) (call-with-values (lambda () (k1963 maps1978)) (lambda (x1979 maps1980) (values (gen-append1906 x1979 y1977) maps1980)))))) tmp1967))) (syntax-dispatch tmp1967 (quote (any . any))))) y1962))) tmp1954) ((lambda (tmp1981) (if tmp1981 (apply (lambda (x1982 y1983) (call-with-values (lambda () (gen-syntax1901 src1936 x1982 r1938 maps1939 ellipsis?1940 mod1941)) (lambda (x1984 maps1985) (call-with-values (lambda () (gen-syntax1901 src1936 y1983 r1938 maps1985 ellipsis?1940 mod1941)) (lambda (y1986 maps1987) (values (gen-cons1905 x1984 y1986) maps1987)))))) tmp1981) ((lambda (tmp1988) (if tmp1988 (apply (lambda (e11989 e21990) (call-with-values (lambda () (gen-syntax1901 src1936 (cons e11989 e21990) r1938 maps1939 ellipsis?1940 mod1941)) (lambda (e1992 maps1993) (values (gen-vector1907 e1992) maps1993)))) tmp1988) ((lambda (_1994) (values (list (quote quote) e1937) maps1939)) tmp1947))) (syntax-dispatch tmp1947 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1947 (quote (any . any)))))) (syntax-dispatch tmp1947 (quote (any any . any)))))) (syntax-dispatch tmp1947 (quote (any any))))) e1937))))) (lambda (e1995 r1996 w1997 s1998 mod1999) (let ((e2000 (source-wrap1121 e1995 w1997 s1998 mod1999))) ((lambda (tmp2001) ((lambda (tmp2002) (if tmp2002 (apply (lambda (_2003 x2004) (call-with-values (lambda () (gen-syntax1901 e2000 x2004 r1996 (quote ()) ellipsis?1137 mod1999)) (lambda (e2005 maps2006) (regen1908 e2005)))) tmp2002) ((lambda (_2007) (syntax-error e2000)) tmp2001))) (syntax-dispatch tmp2001 (quote (any any))))) e2000))))) (global-extend1090 (quote core) (quote lambda) (lambda (e2008 r2009 w2010 s2011 mod2012) ((lambda (tmp2013) ((lambda (tmp2014) (if tmp2014 (apply (lambda (_2015 c2016) (chi-lambda-clause1133 (source-wrap1121 e2008 w2010 s2011 mod2012) c2016 r2009 w2010 mod2012 (lambda (vars2017 body2018) (build-annotated1069 s2011 (list (quote lambda) vars2017 body2018))))) tmp2014) (syntax-error tmp2013))) (syntax-dispatch tmp2013 (quote (any . any))))) e2008))) (global-extend1090 (quote core) (quote let) (letrec ((chi-let2019 (lambda (e2020 r2021 w2022 s2023 mod2024 constructor2025 ids2026 vals2027 exps2028) (if (not (valid-bound-ids?1117 ids2026)) (syntax-error e2020 "duplicate bound variable in") (let ((labels2029 (gen-labels1098 ids2026)) (new-vars2030 (map gen-var1140 ids2026))) (let ((nw2031 (make-binding-wrap1109 ids2026 labels2029 w2022)) (nr2032 (extend-var-env1087 labels2029 new-vars2030 r2021))) (constructor2025 s2023 new-vars2030 (map (lambda (x2033) (chi1128 x2033 r2021 w2022 mod2024)) vals2027) (chi-body1132 exps2028 (source-wrap1121 e2020 nw2031 s2023 mod2024) nr2032 nw2031 mod2024)))))))) (lambda (e2034 r2035 w2036 s2037 mod2038) ((lambda (tmp2039) ((lambda (tmp2040) (if tmp2040 (apply (lambda (_2041 id2042 val2043 e12044 e22045) (chi-let2019 e2034 r2035 w2036 s2037 mod2038 build-let1072 id2042 val2043 (cons e12044 e22045))) tmp2040) ((lambda (tmp2049) (if (if tmp2049 (apply (lambda (_2050 f2051 id2052 val2053 e12054 e22055) (id?1092 f2051)) tmp2049) #f) (apply (lambda (_2056 f2057 id2058 val2059 e12060 e22061) (chi-let2019 e2034 r2035 w2036 s2037 mod2038 build-named-let1073 (cons f2057 id2058) val2059 (cons e12060 e22061))) tmp2049) ((lambda (_2065) (syntax-error (source-wrap1121 e2034 w2036 s2037 mod2038))) tmp2039))) (syntax-dispatch tmp2039 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2039 (quote (any #(each (any any)) any . each-any))))) e2034)))) (global-extend1090 (quote core) (quote letrec) (lambda (e2066 r2067 w2068 s2069 mod2070) ((lambda (tmp2071) ((lambda (tmp2072) (if tmp2072 (apply (lambda (_2073 id2074 val2075 e12076 e22077) (let ((ids2078 id2074)) (if (not (valid-bound-ids?1117 ids2078)) (syntax-error e2066 "duplicate bound variable in") (let ((labels2080 (gen-labels1098 ids2078)) (new-vars2081 (map gen-var1140 ids2078))) (let ((w2082 (make-binding-wrap1109 ids2078 labels2080 w2068)) (r2083 (extend-var-env1087 labels2080 new-vars2081 r2067))) (build-letrec1074 s2069 new-vars2081 (map (lambda (x2084) (chi1128 x2084 r2083 w2082 mod2070)) val2075) (chi-body1132 (cons e12076 e22077) (source-wrap1121 e2066 w2082 s2069 mod2070) r2083 w2082 mod2070))))))) tmp2072) ((lambda (_2087) (syntax-error (source-wrap1121 e2066 w2068 s2069 mod2070))) tmp2071))) (syntax-dispatch tmp2071 (quote (any #(each (any any)) any . each-any))))) e2066))) (global-extend1090 (quote core) (quote set!) (lambda (e2088 r2089 w2090 s2091 mod2092) ((lambda (tmp2093) ((lambda (tmp2094) (if (if tmp2094 (apply (lambda (_2095 id2096 val2097) (id?1092 id2096)) tmp2094) #f) (apply (lambda (_2098 id2099 val2100) (let ((val2101 (chi1128 val2100 r2089 w2090 mod2092)) (n2102 (id-var-name1114 id2099 w2090))) (let ((b2103 (lookup1089 n2102 r2089 mod2092))) (let ((t2104 (binding-type1084 b2103))) (if (memv t2104 (quote (lexical))) (build-annotated1069 s2091 (list (quote set!) (binding-value1085 b2103) val2101)) (if (memv t2104 (quote (global))) (build-annotated1069 s2091 (list (quote set!) (make-module-ref mod2092 n2102 #f) val2101)) (if (memv t2104 (quote (displaced-lexical))) (syntax-error (wrap1120 id2099 w2090 mod2092) "identifier out of context") (syntax-error (source-wrap1121 e2088 w2090 s2091 mod2092))))))))) tmp2094) ((lambda (tmp2105) (if tmp2105 (apply (lambda (_2106 head2107 tail2108 val2109) (call-with-values (lambda () (syntax-type1126 head2107 r2089 (quote (())) #f #f mod2092)) (lambda (type2110 value2111 ee2112 ww2113 ss2114 modmod2115) (let ((t2116 type2110)) (if (memv t2116 (quote (module-ref))) (let ((val2117 (chi1128 val2109 r2089 w2090 mod2092))) (call-with-values (lambda () (value2111 (cons head2107 tail2108))) (lambda (id2119 mod2120) (build-annotated1069 s2091 (list (quote set!) (make-module-ref mod2120 id2119 #f) val2117))))) (build-annotated1069 s2091 (cons (chi1128 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) head2107) r2089 w2090 mod2092) (map (lambda (e2121) (chi1128 e2121 r2089 w2090 mod2092)) (append tail2108 (list val2109)))))))))) tmp2105) ((lambda (_2123) (syntax-error (source-wrap1121 e2088 w2090 s2091 mod2092))) tmp2093))) (syntax-dispatch tmp2093 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2093 (quote (any any any))))) e2088))) (global-extend1090 (quote module-ref) (quote @) (lambda (e2124) ((lambda (tmp2125) ((lambda (tmp2126) (if (if tmp2126 (apply (lambda (_2127 mod2128 id2129) (and (andmap id?1092 mod2128) (id?1092 id2129))) tmp2126) #f) (apply (lambda (_2131 mod2132 id2133) (values (syntax-object->datum id2133) (syntax-object->datum (append mod2132 (quote (#(syntax-object %module-public-interface ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))))))) tmp2126) (syntax-error tmp2125))) (syntax-dispatch tmp2125 (quote (any each-any any))))) e2124))) (global-extend1090 (quote module-ref) (quote @@) (lambda (e2135) ((lambda (tmp2136) ((lambda (tmp2137) (if (if tmp2137 (apply (lambda (_2138 mod2139 id2140) (and (andmap id?1092 mod2139) (id?1092 id2140))) tmp2137) #f) (apply (lambda (_2142 mod2143 id2144) (values (syntax-object->datum id2144) (syntax-object->datum mod2143))) tmp2137) (syntax-error tmp2136))) (syntax-dispatch tmp2136 (quote (any each-any any))))) e2135))) (global-extend1090 (quote begin) (quote begin) (quote ())) (global-extend1090 (quote define) (quote define) (quote ())) (global-extend1090 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1090 (quote eval-when) (quote eval-when) (quote ())) (global-extend1090 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2149 (lambda (x2150 keys2151 clauses2152 r2153 mod2154) (if (null? clauses2152) (build-annotated1069 #f (list (build-annotated1069 #f (quote syntax-error)) x2150)) ((lambda (tmp2155) ((lambda (tmp2156) (if tmp2156 (apply (lambda (pat2157 exp2158) (if (and (id?1092 pat2157) (andmap (lambda (x2159) (not (free-id=?1115 pat2157 x2159))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) keys2151))) (let ((labels2160 (list (gen-label1097))) (var2161 (gen-var1140 pat2157))) (build-annotated1069 #f (list (build-annotated1069 #f (list (quote lambda) (list var2161) (chi1128 exp2158 (extend-env1086 labels2160 (list (cons (quote syntax) (cons var2161 0))) r2153) (make-binding-wrap1109 (list pat2157) labels2160 (quote (()))) mod2154))) x2150))) (gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2157 #t exp2158 mod2154))) tmp2156) ((lambda (tmp2162) (if tmp2162 (apply (lambda (pat2163 fender2164 exp2165) (gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2163 fender2164 exp2165 mod2154)) tmp2162) ((lambda (_2166) (syntax-error (car clauses2152) "invalid syntax-case clause")) tmp2155))) (syntax-dispatch tmp2155 (quote (any any any)))))) (syntax-dispatch tmp2155 (quote (any any))))) (car clauses2152))))) (gen-clause2148 (lambda (x2167 keys2168 clauses2169 r2170 pat2171 fender2172 exp2173 mod2174) (call-with-values (lambda () (convert-pattern2146 pat2171 keys2168)) (lambda (p2175 pvars2176) (cond ((not (distinct-bound-ids?1118 (map car pvars2176))) (syntax-error pat2171 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2177) (not (ellipsis?1137 (car x2177)))) pvars2176)) (syntax-error pat2171 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2178 (gen-var1140 (quote tmp)))) (build-annotated1069 #f (list (build-annotated1069 #f (list (quote lambda) (list y2178) (let ((y2179 (build-annotated1069 #f y2178))) (build-annotated1069 #f (list (quote if) ((lambda (tmp2180) ((lambda (tmp2181) (if tmp2181 (apply (lambda () y2179) tmp2181) ((lambda (_2182) (build-annotated1069 #f (list (quote if) y2179 (build-dispatch-call2147 pvars2176 fender2172 y2179 r2170 mod2174) (build-data1070 #f #f)))) tmp2180))) (syntax-dispatch tmp2180 (quote #(atom #t))))) fender2172) (build-dispatch-call2147 pvars2176 exp2173 y2179 r2170 mod2174) (gen-syntax-case2149 x2167 keys2168 clauses2169 r2170 mod2174)))))) (if (eq? p2175 (quote any)) (build-annotated1069 #f (list (build-annotated1069 #f (quote list)) x2167)) (build-annotated1069 #f (list (build-annotated1069 #f (quote syntax-dispatch)) x2167 (build-data1070 #f p2175))))))))))))) (build-dispatch-call2147 (lambda (pvars2183 exp2184 y2185 r2186 mod2187) (let ((ids2188 (map car pvars2183)) (levels2189 (map cdr pvars2183))) (let ((labels2190 (gen-labels1098 ids2188)) (new-vars2191 (map gen-var1140 ids2188))) (build-annotated1069 #f (list (build-annotated1069 #f (quote apply)) (build-annotated1069 #f (list (quote lambda) new-vars2191 (chi1128 exp2184 (extend-env1086 labels2190 (map (lambda (var2192 level2193) (cons (quote syntax) (cons var2192 level2193))) new-vars2191 (map cdr pvars2183)) r2186) (make-binding-wrap1109 ids2188 labels2190 (quote (()))) mod2187))) y2185)))))) (convert-pattern2146 (lambda (pattern2194 keys2195) (let cvt2196 ((p2197 pattern2194) (n2198 0) (ids2199 (quote ()))) (if (id?1092 p2197) (if (bound-id-member?1119 p2197 keys2195) (values (vector (quote free-id) p2197) ids2199) (values (quote any) (cons (cons p2197 n2198) ids2199))) ((lambda (tmp2200) ((lambda (tmp2201) (if (if tmp2201 (apply (lambda (x2202 dots2203) (ellipsis?1137 dots2203)) tmp2201) #f) (apply (lambda (x2204 dots2205) (call-with-values (lambda () (cvt2196 x2204 (fx+1059 n2198 1) ids2199)) (lambda (p2206 ids2207) (values (if (eq? p2206 (quote any)) (quote each-any) (vector (quote each) p2206)) ids2207)))) tmp2201) ((lambda (tmp2208) (if tmp2208 (apply (lambda (x2209 y2210) (call-with-values (lambda () (cvt2196 y2210 n2198 ids2199)) (lambda (y2211 ids2212) (call-with-values (lambda () (cvt2196 x2209 n2198 ids2212)) (lambda (x2213 ids2214) (values (cons x2213 y2211) ids2214)))))) tmp2208) ((lambda (tmp2215) (if tmp2215 (apply (lambda () (values (quote ()) ids2199)) tmp2215) ((lambda (tmp2216) (if tmp2216 (apply (lambda (x2217) (call-with-values (lambda () (cvt2196 x2217 n2198 ids2199)) (lambda (p2219 ids2220) (values (vector (quote vector) p2219) ids2220)))) tmp2216) ((lambda (x2221) (values (vector (quote atom) (strip1139 p2197 (quote (())))) ids2199)) tmp2200))) (syntax-dispatch tmp2200 (quote #(vector each-any)))))) (syntax-dispatch tmp2200 (quote ()))))) (syntax-dispatch tmp2200 (quote (any . any)))))) (syntax-dispatch tmp2200 (quote (any any))))) p2197)))))) (lambda (e2222 r2223 w2224 s2225 mod2226) (let ((e2227 (source-wrap1121 e2222 w2224 s2225 mod2226))) ((lambda (tmp2228) ((lambda (tmp2229) (if tmp2229 (apply (lambda (_2230 val2231 key2232 m2233) (if (andmap (lambda (x2234) (and (id?1092 x2234) (not (ellipsis?1137 x2234)))) key2232) (let ((x2236 (gen-var1140 (quote tmp)))) (build-annotated1069 s2225 (list (build-annotated1069 #f (list (quote lambda) (list x2236) (gen-syntax-case2149 (build-annotated1069 #f x2236) key2232 m2233 r2223 mod2226))) (chi1128 val2231 r2223 (quote (())) mod2226)))) (syntax-error e2227 "invalid literals list in"))) tmp2229) (syntax-error tmp2228))) (syntax-dispatch tmp2228 (quote (any any each-any . each-any))))) e2227))))) (set! sc-expand (let ((m2239 (quote e)) (esew2240 (quote (eval)))) (lambda (x2241) (if (and (pair? x2241) (equal? (car x2241) noexpand1058)) (cadr x2241) (chi-top1127 x2241 (quote ()) (quote ((top))) m2239 esew2240 (module-name (current-module))))))) (set! sc-expand3 (let ((m2242 (quote e)) (esew2243 (quote (eval)))) (lambda (x2245 . rest2244) (if (and (pair? x2245) (equal? (car x2245) noexpand1058)) (cadr x2245) (chi-top1127 x2245 (quote ()) (quote ((top))) (if (null? rest2244) m2242 (car rest2244)) (if (or (null? rest2244) (null? (cdr rest2244))) esew2243 (cadr rest2244)) (module-name (current-module))))))) (set! identifier? (lambda (x2246) (nonsymbol-id?1091 x2246))) (set! datum->syntax-object (lambda (id2247 datum2248) (make-syntax-object1075 datum2248 (syntax-object-wrap1078 id2247) #f))) (set! syntax-object->datum (lambda (x2249) (strip1139 x2249 (quote (()))))) (set! generate-temporaries (lambda (ls2250) (begin (let ((x2251 ls2250)) (if (not (list? x2251)) (error-hook1065 (quote generate-temporaries) "invalid argument" x2251))) (map (lambda (x2252) (wrap1120 (gensym) (quote ((top))) #f)) ls2250)))) (set! free-identifier=? (lambda (x2253 y2254) (begin (let ((x2255 x2253)) (if (not (nonsymbol-id?1091 x2255)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2255))) (let ((x2256 y2254)) (if (not (nonsymbol-id?1091 x2256)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2256))) (free-id=?1115 x2253 y2254)))) (set! bound-identifier=? (lambda (x2257 y2258) (begin (let ((x2259 x2257)) (if (not (nonsymbol-id?1091 x2259)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2259))) (let ((x2260 y2258)) (if (not (nonsymbol-id?1091 x2260)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2260))) (bound-id=?1116 x2257 y2258)))) (set! syntax-error (lambda (object2262 . messages2261) (begin (for-each (lambda (x2263) (let ((x2264 x2263)) (if (not (string? x2264)) (error-hook1065 (quote syntax-error) "invalid argument" x2264)))) messages2261) (let ((message2265 (if (null? messages2261) "invalid syntax" (apply string-append messages2261)))) (error-hook1065 #f message2265 (strip1139 object2262 (quote (())))))))) (set! install-global-transformer (lambda (sym2266 v2267) (begin (let ((x2268 sym2266)) (if (not (symbol? x2268)) (error-hook1065 (quote define-syntax) "invalid argument" x2268))) (let ((x2269 v2267)) (if (not (procedure? x2269)) (error-hook1065 (quote define-syntax) "invalid argument" x2269))) (global-extend1090 (quote macro) sym2266 v2267)))) (letrec ((match2274 (lambda (e2275 p2276 w2277 r2278 mod2279) (cond ((not r2278) #f) ((eq? p2276 (quote any)) (cons (wrap1120 e2275 w2277 mod2279) r2278)) ((syntax-object?1076 e2275) (match*2273 (let ((e2280 (syntax-object-expression1077 e2275))) (if (annotation? e2280) (annotation-expression e2280) e2280)) p2276 (join-wraps1111 w2277 (syntax-object-wrap1078 e2275)) r2278 (syntax-object-module1079 e2275))) (else (match*2273 (let ((e2281 e2275)) (if (annotation? e2281) (annotation-expression e2281) e2281)) p2276 w2277 r2278 mod2279))))) (match*2273 (lambda (e2282 p2283 w2284 r2285 mod2286) (cond ((null? p2283) (and (null? e2282) r2285)) ((pair? p2283) (and (pair? e2282) (match2274 (car e2282) (car p2283) w2284 (match2274 (cdr e2282) (cdr p2283) w2284 r2285 mod2286) mod2286))) ((eq? p2283 (quote each-any)) (let ((l2287 (match-each-any2271 e2282 w2284 mod2286))) (and l2287 (cons l2287 r2285)))) (else (let ((t2288 (vector-ref p2283 0))) (if (memv t2288 (quote (each))) (if (null? e2282) (match-empty2272 (vector-ref p2283 1) r2285) (let ((l2289 (match-each2270 e2282 (vector-ref p2283 1) w2284 mod2286))) (and l2289 (let collect2290 ((l2291 l2289)) (if (null? (car l2291)) r2285 (cons (map car l2291) (collect2290 (map cdr l2291)))))))) (if (memv t2288 (quote (free-id))) (and (id?1092 e2282) (free-id=?1115 (wrap1120 e2282 w2284 mod2286) (vector-ref p2283 1)) r2285) (if (memv t2288 (quote (atom))) (and (equal? (vector-ref p2283 1) (strip1139 e2282 w2284)) r2285) (if (memv t2288 (quote (vector))) (and (vector? e2282) (match2274 (vector->list e2282) (vector-ref p2283 1) w2284 r2285 mod2286))))))))))) (match-empty2272 (lambda (p2292 r2293) (cond ((null? p2292) r2293) ((eq? p2292 (quote any)) (cons (quote ()) r2293)) ((pair? p2292) (match-empty2272 (car p2292) (match-empty2272 (cdr p2292) r2293))) ((eq? p2292 (quote each-any)) (cons (quote ()) r2293)) (else (let ((t2294 (vector-ref p2292 0))) (if (memv t2294 (quote (each))) (match-empty2272 (vector-ref p2292 1) r2293) (if (memv t2294 (quote (free-id atom))) r2293 (if (memv t2294 (quote (vector))) (match-empty2272 (vector-ref p2292 1) r2293))))))))) (match-each-any2271 (lambda (e2295 w2296 mod2297) (cond ((annotation? e2295) (match-each-any2271 (annotation-expression e2295) w2296 mod2297)) ((pair? e2295) (let ((l2298 (match-each-any2271 (cdr e2295) w2296 mod2297))) (and l2298 (cons (wrap1120 (car e2295) w2296 mod2297) l2298)))) ((null? e2295) (quote ())) ((syntax-object?1076 e2295) (match-each-any2271 (syntax-object-expression1077 e2295) (join-wraps1111 w2296 (syntax-object-wrap1078 e2295)) mod2297)) (else #f)))) (match-each2270 (lambda (e2299 p2300 w2301 mod2302) (cond ((annotation? e2299) (match-each2270 (annotation-expression e2299) p2300 w2301 mod2302)) ((pair? e2299) (let ((first2303 (match2274 (car e2299) p2300 w2301 (quote ()) mod2302))) (and first2303 (let ((rest2304 (match-each2270 (cdr e2299) p2300 w2301 mod2302))) (and rest2304 (cons first2303 rest2304)))))) ((null? e2299) (quote ())) ((syntax-object?1076 e2299) (match-each2270 (syntax-object-expression1077 e2299) p2300 (join-wraps1111 w2301 (syntax-object-wrap1078 e2299)) (syntax-object-module1079 e2299))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2305 p2306) (cond ((eq? p2306 (quote any)) (list e2305)) ((syntax-object?1076 e2305) (match*2273 (let ((e2307 (syntax-object-expression1077 e2305))) (if (annotation? e2307) (annotation-expression e2307) e2307)) p2306 (syntax-object-wrap1078 e2305) (quote ()) (syntax-object-module1079 e2305))) (else (match*2273 (let ((e2308 e2305)) (if (annotation? e2308) (annotation-expression e2308) e2308)) p2306 (quote (())) (quote ()) #f))))) (set! sc-chi chi1128))))) +(install-global-transformer (quote with-syntax) (lambda (x2309) ((lambda (tmp2310) ((lambda (tmp2311) (if tmp2311 (apply (lambda (_2312 e12313 e22314) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12313 e22314))) tmp2311) ((lambda (tmp2316) (if tmp2316 (apply (lambda (_2317 out2318 in2319 e12320 e22321) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) in2319 (quote ()) (list out2318 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12320 e22321))))) tmp2316) ((lambda (tmp2323) (if tmp2323 (apply (lambda (_2324 out2325 in2326 e12327 e22328) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) 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"))) (guile))) (cons e12327 e22328))))) tmp2323) (syntax-error tmp2310))) (syntax-dispatch tmp2310 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2310 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2310 (quote (any () any . each-any))))) x2309))) +(install-global-transformer (quote syntax-rules) (lambda (x2332) ((lambda (tmp2333) ((lambda (tmp2334) (if tmp2334 (apply (lambda (_2335 k2336 keyword2337 pattern2338 template2339) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons k2336 (map (lambda (tmp2342 tmp2341) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2341) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) tmp2342))) template2339 pattern2338)))))) tmp2334) (syntax-error tmp2333))) (syntax-dispatch tmp2333 (quote (any each-any . #(each ((any . any) any))))))) x2332))) +(install-global-transformer (quote let*) (lambda (x2343) ((lambda (tmp2344) ((lambda (tmp2345) (if (if tmp2345 (apply (lambda (let*2346 x2347 v2348 e12349 e22350) (andmap identifier? x2347)) tmp2345) #f) (apply (lambda (let*2352 x2353 v2354 e12355 e22356) (let f2357 ((bindings2358 (map list x2353 v2354))) (if (null? bindings2358) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote ()) (cons e12355 e22356))) ((lambda (tmp2362) ((lambda (tmp2363) (if tmp2363 (apply (lambda (body2364 binding2365) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list binding2365) body2364)) tmp2363) (syntax-error tmp2362))) (syntax-dispatch tmp2362 (quote (any any))))) (list (f2357 (cdr bindings2358)) (car bindings2358)))))) tmp2345) (syntax-error tmp2344))) (syntax-dispatch tmp2344 (quote (any #(each (any any)) any . each-any))))) x2343))) +(install-global-transformer (quote do) (lambda (orig-x2366) ((lambda (tmp2367) ((lambda (tmp2368) (if tmp2368 (apply (lambda (_2369 var2370 init2371 step2372 e02373 e12374 c2375) ((lambda (tmp2376) ((lambda (tmp2377) (if tmp2377 (apply (lambda (step2378) ((lambda (tmp2379) ((lambda (tmp2380) (if tmp2380 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2370 init2371) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02373) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2375 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2378))))))) tmp2380) ((lambda (tmp2385) (if tmp2385 (apply (lambda (e12386 e22387) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (map list var2370 init2371) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) e02373 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (cons e12386 e22387)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) (append c2375 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (guile))) step2378))))))) tmp2385) (syntax-error tmp2379))) (syntax-dispatch tmp2379 (quote (any . each-any)))))) (syntax-dispatch tmp2379 (quote ())))) e12374)) tmp2377) (syntax-error tmp2376))) (syntax-dispatch tmp2376 (quote each-any)))) (map (lambda (v2394 s2395) ((lambda (tmp2396) ((lambda (tmp2397) (if tmp2397 (apply (lambda () v2394) tmp2397) ((lambda (tmp2398) (if tmp2398 (apply (lambda (e2399) e2399) tmp2398) ((lambda (_2400) (syntax-error orig-x2366)) tmp2396))) (syntax-dispatch tmp2396 (quote (any)))))) (syntax-dispatch tmp2396 (quote ())))) s2395)) var2370 step2372))) tmp2368) (syntax-error tmp2367))) (syntax-dispatch tmp2367 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2366))) +(install-global-transformer (quote quasiquote) (letrec ((quasicons2403 (lambda (x2407 y2408) ((lambda (tmp2409) ((lambda (tmp2410) (if tmp2410 (apply (lambda (x2411 y2412) ((lambda (tmp2413) ((lambda (tmp2414) (if tmp2414 (apply (lambda (dy2415) ((lambda (tmp2416) ((lambda (tmp2417) (if tmp2417 (apply (lambda (dx2418) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons dx2418 dy2415))) tmp2417) ((lambda (_2419) (if (null? dy2415) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2411) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2411 y2412))) tmp2416))) (syntax-dispatch tmp2416 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) x2411)) tmp2414) ((lambda (tmp2420) (if tmp2420 (apply (lambda (stuff2421) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (cons x2411 stuff2421))) tmp2420) ((lambda (else2422) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2411 y2412)) tmp2413))) (syntax-dispatch tmp2413 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . any)))))) (syntax-dispatch tmp2413 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) y2412)) tmp2410) (syntax-error tmp2409))) (syntax-dispatch tmp2409 (quote (any any))))) (list x2407 y2408)))) (quasiappend2404 (lambda (x2423 y2424) ((lambda (tmp2425) ((lambda (tmp2426) (if tmp2426 (apply (lambda (x2427 y2428) ((lambda (tmp2429) ((lambda (tmp2430) (if tmp2430 (apply (lambda () x2427) tmp2430) ((lambda (_2431) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2427 y2428)) tmp2429))) (syntax-dispatch tmp2429 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) ()))))) y2428)) tmp2426) (syntax-error tmp2425))) (syntax-dispatch tmp2425 (quote (any any))))) (list x2423 y2424)))) (quasivector2405 (lambda (x2432) ((lambda (tmp2433) ((lambda (x2434) ((lambda (tmp2435) ((lambda (tmp2436) (if tmp2436 (apply (lambda (x2437) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) (list->vector x2437))) tmp2436) ((lambda (tmp2439) (if tmp2439 (apply (lambda (x2440) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2440)) tmp2439) ((lambda (_2442) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) x2434)) tmp2435))) (syntax-dispatch tmp2435 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) . each-any)))))) (syntax-dispatch tmp2435 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) each-any))))) x2434)) tmp2433)) x2432))) (quasi2406 (lambda (p2443 lev2444) ((lambda (tmp2445) ((lambda (tmp2446) (if tmp2446 (apply (lambda (p2447) (if (= lev2444 0) p2447 (quasicons2403 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2406 (list p2447) (- lev2444 1))))) tmp2446) ((lambda (tmp2448) (if tmp2448 (apply (lambda (p2449 q2450) (if (= lev2444 0) (quasiappend2404 p2449 (quasi2406 q2450 lev2444)) (quasicons2403 (quasicons2403 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2406 (list p2449) (- lev2444 1))) (quasi2406 q2450 lev2444)))) tmp2448) ((lambda (tmp2451) (if tmp2451 (apply (lambda (p2452) (quasicons2403 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile)))) (quasi2406 (list p2452) (+ lev2444 1)))) tmp2451) ((lambda (tmp2453) (if tmp2453 (apply (lambda (p2454 q2455) (quasicons2403 (quasi2406 p2454 lev2444) (quasi2406 q2455 lev2444))) tmp2453) ((lambda (tmp2456) (if tmp2456 (apply (lambda (x2457) (quasivector2405 (quasi2406 x2457 lev2444))) tmp2456) ((lambda (p2459) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) p2459)) tmp2445))) (syntax-dispatch tmp2445 (quote #(vector each-any)))))) (syntax-dispatch tmp2445 (quote (any . any)))))) (syntax-dispatch tmp2445 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any)))))) (syntax-dispatch tmp2445 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any) . any)))))) (syntax-dispatch tmp2445 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (guile))) any))))) p2443)))) (lambda (x2460) ((lambda (tmp2461) ((lambda (tmp2462) (if tmp2462 (apply (lambda (_2463 e2464) (quasi2406 e2464 0)) tmp2462) (syntax-error tmp2461))) (syntax-dispatch tmp2461 (quote (any any))))) x2460)))) +(install-global-transformer (quote include) (lambda (x2465) (letrec ((read-file2466 (lambda (fn2467 k2468) (let ((p2469 (open-input-file fn2467))) (let f2470 ((x2471 (read p2469))) (if (eof-object? x2471) (begin (close-input-port p2469) (quote ())) (cons (datum->syntax-object k2468 x2471) (f2470 (read p2469))))))))) ((lambda (tmp2472) ((lambda (tmp2473) (if tmp2473 (apply (lambda (k2474 filename2475) (let ((fn2476 (syntax-object->datum filename2475))) ((lambda (tmp2477) ((lambda (tmp2478) (if tmp2478 (apply (lambda (exp2479) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (guile))) exp2479)) tmp2478) (syntax-error tmp2477))) (syntax-dispatch tmp2477 (quote each-any)))) (read-file2466 fn2476 k2474)))) tmp2473) (syntax-error tmp2472))) (syntax-dispatch tmp2472 (quote (any any))))) x2465)))) +(install-global-transformer (quote unquote) (lambda (x2481) ((lambda (tmp2482) ((lambda (tmp2483) (if tmp2483 (apply (lambda (_2484 e2485) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2485))) tmp2483) (syntax-error tmp2482))) (syntax-dispatch tmp2482 (quote (any any))))) x2481))) +(install-global-transformer (quote unquote-splicing) (lambda (x2486) ((lambda (tmp2487) ((lambda (tmp2488) (if tmp2488 (apply (lambda (_2489 e2490) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2490))) tmp2488) (syntax-error tmp2487))) (syntax-dispatch tmp2487 (quote (any any))))) x2486))) +(install-global-transformer (quote case) (lambda (x2491) ((lambda (tmp2492) ((lambda (tmp2493) (if tmp2493 (apply (lambda (_2494 e2495 m12496 m22497) ((lambda (tmp2498) ((lambda (body2499) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2495)) body2499)) tmp2498)) (let f2500 ((clause2501 m12496) (clauses2502 m22497)) (if (null? clauses2502) ((lambda (tmp2504) ((lambda (tmp2505) (if tmp2505 (apply (lambda (e12506 e22507) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12506 e22507))) tmp2505) ((lambda (tmp2509) (if tmp2509 (apply (lambda (k2510 e12511 e22512) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2510)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12511 e22512)))) tmp2509) ((lambda (_2515) (syntax-error x2491)) tmp2504))) (syntax-dispatch tmp2504 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2504 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) any . each-any))))) clause2501) ((lambda (tmp2516) ((lambda (rest2517) ((lambda (tmp2518) ((lambda (tmp2519) (if tmp2519 (apply (lambda (k2520 e12521 e22522) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) k2520)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12521 e22522)) rest2517)) tmp2519) ((lambda (_2525) (syntax-error x2491)) tmp2518))) (syntax-dispatch tmp2518 (quote (each-any any . each-any))))) clause2501)) tmp2516)) (f2500 (car clauses2502) (cdr clauses2502))))))) tmp2493) (syntax-error tmp2492))) (syntax-dispatch tmp2492 (quote (any any any . each-any))))) x2491))) +(install-global-transformer (quote identifier-syntax) (lambda (x2526) ((lambda (tmp2527) ((lambda (tmp2528) (if tmp2528 (apply (lambda (_2529 e2530) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2530)) (list (cons _2529 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e2530 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))))))))) tmp2528) (syntax-error tmp2527))) (syntax-dispatch tmp2527 (quote (any any))))) x2526))) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 5707d5f0d..2deca5762 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -342,7 +342,7 @@ (resolve-module modname) (current-module))) (v (or (module-variable module symbol) - (let ((v (make-variable 'sc-macro))) + (let ((v (make-variable (gensym)))) (module-add! module symbol v) v)))) (if (not (variable-bound? v)) @@ -364,7 +364,9 @@ (lambda (symbol module) (let* ((module (if module (resolve-module module) - (warn "wha" symbol (current-module)))) + (let ((mod (current-module))) + (if mod (warn "wha" symbol)) + mod))) (v (module-variable module symbol))) (and v (or (object-property v '*sc-expander*) @@ -1786,9 +1788,10 @@ (lambda (type value ee ww ss modmod) (case type ((module-ref) - (call-with-values (lambda () (value (syntax (head tail ...)))) - (lambda (id mod) - (build-global-assignment s id (syntax val) mod)))) + (let ((val (chi (syntax val) r w mod))) + (call-with-values (lambda () (value (syntax (head tail ...)))) + (lambda (id mod) + (build-global-assignment s id val mod))))) (else (build-application s (chi (syntax (setter head)) r w mod) diff --git a/module/language/glil.scm b/module/language/glil.scm index 01b680194..51e7efac4 100644 --- a/module/language/glil.scm +++ b/module/language/glil.scm @@ -131,7 +131,7 @@ ((toplevel ,op ,name) (make-glil-toplevel op name)) ((module public ,op ,mod ,name) (make-glil-module op mod name #t)) ((module private ,op ,mod ,name) (make-glil-module op mod name #f)) - ((label ,label) (make-label ,label)) + ((label ,label) (make-label label)) ((branch ,inst ,label) (make-glil-branch inst label)) ((call ,inst ,nargs) (make-glil-call inst nargs)) ((mv-call ,nargs ,ra) (make-glil-mv-call nargs ra)) diff --git a/module/language/scheme/compile-ghil.scm b/module/language/scheme/compile-ghil.scm index 86234059e..45d6c204f 100644 --- a/module/language/scheme/compile-ghil.scm +++ b/module/language/scheme/compile-ghil.scm @@ -27,12 +27,11 @@ #:use-module (system vm objcode) #:use-module (ice-9 receive) #:use-module (ice-9 optargs) - #:use-module (ice-9 expand-support) - #:use-module ((ice-9 syncase) #:select (sc-macro)) #:use-module ((system base compile) #:select (syntax-error)) #:export (compile-ghil translate-1 *translate-table* define-scheme-translator)) +(module-ref (current-module) 'receive) ;;; environment := #f ;;; | MODULE @@ -70,12 +69,13 @@ (and=> (cenv-module e) set-current-module) (call-with-ghil-environment (cenv-ghil-env e) '() (lambda (env vars) - (let ((x (make-ghil-lambda env #f vars #f '() - (translate-1 env #f x))) - (cenv (make-cenv (current-module) - (ghil-env-parent env) - (if e (cenv-externals e) '())))) - (values x cenv cenv))))))) + (let ((x (sc-expand3 x 'c '(compile load eval)))) + (let ((x (make-ghil-lambda env #f vars #f '() + (translate-1 env #f x))) + (cenv (make-cenv (current-module) + (ghil-env-parent env) + (if e (cenv-externals e) '())))) + (values x cenv cenv)))))))) ;;; @@ -104,9 +104,6 @@ (let* ((mod (current-module)) (val (cond ((symbol? head) (module-ref/safe mod head)) - ;; allow macros to be unquoted into the output of a macro - ;; expansion - ((macro? head) head) ((pmatch head ((@ ,modname ,sym) (module-ref/safe (resolve-interface modname) sym)) @@ -117,18 +114,6 @@ (cond ((hashq-ref *translate-table* val)) - ((defmacro? val) - (lambda (env loc exp) - (retrans (apply (defmacro-transformer val) (cdr exp))))) - - ((eq? val sc-macro) - ;; syncase! - (let ((sc-expand3 (@@ (ice-9 syncase) sc-expand3))) - (lambda (env loc exp) - (retrans - (strip-expansion-structures - (sc-expand3 exp 'c '(compile load eval))))))) - ((primitive-macro? val) (syntax-error #f "unhandled primitive macro" head)) @@ -180,7 +165,7 @@ (define-macro (define-scheme-translator sym . clauses) `(hashq-set! (@ (language scheme compile-ghil) *translate-table*) - ,sym + (module-ref (current-module) ',sym) (lambda (e l exp) (define (retrans x) ((@ (language scheme compile-ghil) translate-1)