* module/ice-9/boot-9.scm: Comment some more things.
* module/ice-9/psyntax.scm: Remove error-hook -- callers should just use
syntax-violation. Change all callers.
* module/ice-9/psyntax-pp.scm: Regenerated.
(define (resolve-module . args)
#f)
+;; Output hook for syncase. It's here because we want to be able to
+;; replace its definition, for compiling; but that isn't implemented
+;; yet.
(define (make-module-ref mod var kind)
(case kind
((public) (if mod `(@ ,mod ,var) var))
var))
(else (error "foo" mod var kind))))
-;;; API provided by psyntax
+;; Input hook to syncase -- so that we might be able to pass annotated
+;; expressions in. Currently disabled. Maybe we should just use
+;; source-properties directly.
+(define (annotation? x) #f)
+
+;; API provided by psyntax
(define syntax-violation #f)
(define datum->syntax #f)
(define syntax->datum #f)
(define sc-expand #f)
(define sc-expand3 #f)
-;;; Implementation detail of psyntax -- the thing that does expand-time
-;;; dispatch for syntax-case macros
+;; $sc-expand is an implementation detail of psyntax. It is used by
+;; expanded macros, to dispatch an input against a set of patterns.
(define $sc-dispatch #f)
-;;; Useless crap I'd like to get rid of
-(define (annotation? x) #f)
-
+;; Load it up!
(primitive-load-path "ice-9/psyntax-pp")
-;; Until the module system is booted, this will be the current expander.
+;; %pre-modules-transformer is the Scheme expander from now until the
+;; module system has booted up.
(define %pre-modules-transformer sc-expand)
\f
;;; {Defmacros}
;;;
-;;; Depends on: features, eval-case
-;;;
(define-syntax define-macro
(lambda (x)
-(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
-(void)
-(letrec ((and-map*1002 (lambda (f1042 first1041 . rest1040) (or (null? first1041) (if (null? rest1040) (let andmap1043 ((first1044 first1041)) (let ((x1045 (car first1044)) (first1046 (cdr first1044))) (if (null? first1046) (f1042 x1045) (and (f1042 x1045) (andmap1043 first1046))))) (let andmap1047 ((first1048 first1041) (rest1049 rest1040)) (let ((x1050 (car first1048)) (xr1051 (map car rest1049)) (first1052 (cdr first1048)) (rest1053 (map cdr rest1049))) (if (null? first1052) (apply f1042 (cons x1050 xr1051)) (and (apply f1042 (cons x1050 xr1051)) (andmap1047 first1052 rest1053)))))))))) (letrec ((lambda-var-list1136 (lambda (vars1341) (let lvl1342 ((vars1343 vars1341) (ls1344 (quote ())) (w1345 (quote (())))) (cond ((pair? vars1343) (lvl1342 (cdr vars1343) (cons (wrap1115 (car vars1343) w1345 #f) ls1344) w1345)) ((id?1087 vars1343) (cons (wrap1115 vars1343 w1345 #f) ls1344)) ((null? vars1343) ls1344) ((syntax-object?1071 vars1343) (lvl1342 (syntax-object-expression1072 vars1343) ls1344 (join-wraps1106 w1345 (syntax-object-wrap1073 vars1343)))) ((annotation? vars1343) (lvl1342 (annotation-expression vars1343) ls1344 w1345)) (else (cons vars1343 ls1344)))))) (gen-var1135 (lambda (id1346) (let ((id1347 (if (syntax-object?1071 id1346) (syntax-object-expression1072 id1346) id1346))) (if (annotation? id1347) (build-annotated1064 (annotation-source id1347) (gensym (symbol->string (annotation-expression id1347)))) (build-annotated1064 #f (gensym (symbol->string id1347))))))) (strip1134 (lambda (x1348 w1349) (if (memq (quote top) (wrap-marks1090 w1349)) (if (or (annotation? x1348) (and (pair? x1348) (annotation? (car x1348)))) (strip-annotation1133 x1348 #f) x1348) (let f1350 ((x1351 x1348)) (cond ((syntax-object?1071 x1351) (strip1134 (syntax-object-expression1072 x1351) (syntax-object-wrap1073 x1351))) ((pair? x1351) (let ((a1352 (f1350 (car x1351))) (d1353 (f1350 (cdr x1351)))) (if (and (eq? a1352 (car x1351)) (eq? d1353 (cdr x1351))) x1351 (cons a1352 d1353)))) ((vector? x1351) (let ((old1354 (vector->list x1351))) (let ((new1355 (map f1350 old1354))) (if (and-map*1002 eq? old1354 new1355) x1351 (list->vector new1355))))) (else x1351)))))) (strip-annotation1133 (lambda (x1356 parent1357) (cond ((pair? x1356) (let ((new1358 (cons #f #f))) (begin (if parent1357 (set-annotation-stripped! parent1357 new1358)) (set-car! new1358 (strip-annotation1133 (car x1356) #f)) (set-cdr! new1358 (strip-annotation1133 (cdr x1356) #f)) new1358))) ((annotation? x1356) (or (annotation-stripped x1356) (strip-annotation1133 (annotation-expression x1356) x1356))) ((vector? x1356) (let ((new1359 (make-vector (vector-length x1356)))) (begin (if parent1357 (set-annotation-stripped! parent1357 new1359)) (let loop1360 ((i1361 (- (vector-length x1356) 1))) (unless (fx<1058 i1361 0) (vector-set! new1359 i1361 (strip-annotation1133 (vector-ref x1356 i1361) #f)) (loop1360 (fx-1056 i1361 1)))) new1359))) (else x1356)))) (ellipsis?1132 (lambda (x1362) (and (nonsymbol-id?1086 x1362) (free-id=?1110 x1362 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))))))) (chi-void1131 (lambda () (build-annotated1064 #f (list (build-annotated1064 #f (quote void)))))) (eval-local-transformer1130 (lambda (expanded1363 mod1364) (let ((p1365 (local-eval-hook1060 expanded1363 mod1364))) (if (procedure? p1365) p1365 (syntax-violation #f "nonprocedure transformer" p1365))))) (chi-local-syntax1129 (lambda (rec?1366 e1367 r1368 w1369 s1370 mod1371 k1372) ((lambda (tmp1373) ((lambda (tmp1374) (if tmp1374 (apply (lambda (_1375 id1376 val1377 e11378 e21379) (let ((ids1380 id1376)) (if (not (valid-bound-ids?1112 ids1380)) (syntax-violation #f "duplicate bound keyword" e1367) (let ((labels1382 (gen-labels1093 ids1380))) (let ((new-w1383 (make-binding-wrap1104 ids1380 labels1382 w1369))) (k1372 (cons e11378 e21379) (extend-env1081 labels1382 (let ((w1385 (if rec?1366 new-w1383 w1369)) (trans-r1386 (macros-only-env1083 r1368))) (map (lambda (x1387) (cons (quote macro) (eval-local-transformer1130 (chi1123 x1387 trans-r1386 w1385 mod1371) mod1371))) val1377)) r1368) new-w1383 s1370 mod1371)))))) tmp1374) ((lambda (_1389) (syntax-violation #f "bad local syntax definition" (source-wrap1116 e1367 w1369 s1370 mod1371))) tmp1373))) ($sc-dispatch tmp1373 (quote (any #(each (any any)) any . each-any))))) e1367))) (chi-lambda-clause1128 (lambda (e1390 docstring1391 c1392 r1393 w1394 mod1395 k1396) ((lambda (tmp1397) ((lambda (tmp1398) (if (if tmp1398 (apply (lambda (args1399 doc1400 e11401 e21402) (and (string? (syntax->datum doc1400)) (not docstring1391))) tmp1398) #f) (apply (lambda (args1403 doc1404 e11405 e21406) (chi-lambda-clause1128 e1390 doc1404 (cons args1403 (cons e11405 e21406)) r1393 w1394 mod1395 k1396)) tmp1398) ((lambda (tmp1408) (if tmp1408 (apply (lambda (id1409 e11410 e21411) (let ((ids1412 id1409)) (if (not (valid-bound-ids?1112 ids1412)) (syntax-violation (quote lambda) "invalid parameter list" e1390) (let ((labels1414 (gen-labels1093 ids1412)) (new-vars1415 (map gen-var1135 ids1412))) (k1396 new-vars1415 docstring1391 (chi-body1127 (cons e11410 e21411) e1390 (extend-var-env1082 labels1414 new-vars1415 r1393) (make-binding-wrap1104 ids1412 labels1414 w1394) mod1395)))))) tmp1408) ((lambda (tmp1417) (if tmp1417 (apply (lambda (ids1418 e11419 e21420) (let ((old-ids1421 (lambda-var-list1136 ids1418))) (if (not (valid-bound-ids?1112 old-ids1421)) (syntax-violation (quote lambda) "invalid parameter list" e1390) (let ((labels1422 (gen-labels1093 old-ids1421)) (new-vars1423 (map gen-var1135 old-ids1421))) (k1396 (let f1424 ((ls11425 (cdr new-vars1423)) (ls21426 (car new-vars1423))) (if (null? ls11425) ls21426 (f1424 (cdr ls11425) (cons (car ls11425) ls21426)))) docstring1391 (chi-body1127 (cons e11419 e21420) e1390 (extend-var-env1082 labels1422 new-vars1423 r1393) (make-binding-wrap1104 old-ids1421 labels1422 w1394) mod1395)))))) tmp1417) ((lambda (_1428) (syntax-violation (quote lambda) "bad lambda" e1390)) tmp1397))) ($sc-dispatch tmp1397 (quote (any any . each-any)))))) ($sc-dispatch tmp1397 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1397 (quote (any any any . each-any))))) c1392))) (chi-body1127 (lambda (body1429 outer-form1430 r1431 w1432 mod1433) (let ((r1434 (cons (quote ("placeholder" placeholder)) r1431))) (let ((ribcage1435 (make-ribcage1094 (quote ()) (quote ()) (quote ())))) (let ((w1436 (make-wrap1089 (wrap-marks1090 w1432) (cons ribcage1435 (wrap-subst1091 w1432))))) (let parse1437 ((body1438 (map (lambda (x1444) (cons r1434 (wrap1115 x1444 w1436 mod1433))) body1429)) (ids1439 (quote ())) (labels1440 (quote ())) (vars1441 (quote ())) (vals1442 (quote ())) (bindings1443 (quote ()))) (if (null? body1438) (syntax-violation #f "no expressions in body" outer-form1430) (let ((e1445 (cdar body1438)) (er1446 (caar body1438))) (call-with-values (lambda () (syntax-type1121 e1445 er1446 (quote (())) #f ribcage1435 mod1433)) (lambda (type1447 value1448 e1449 w1450 s1451 mod1452) (let ((t1453 type1447)) (if (memv t1453 (quote (define-form))) (let ((id1454 (wrap1115 value1448 w1450 mod1452)) (label1455 (gen-label1092))) (let ((var1456 (gen-var1135 id1454))) (begin (extend-ribcage!1103 ribcage1435 id1454 label1455) (parse1437 (cdr body1438) (cons id1454 ids1439) (cons label1455 labels1440) (cons var1456 vars1441) (cons (cons er1446 (wrap1115 e1449 w1450 mod1452)) vals1442) (cons (cons (quote lexical) var1456) bindings1443))))) (if (memv t1453 (quote (define-syntax-form))) (let ((id1457 (wrap1115 value1448 w1450 mod1452)) (label1458 (gen-label1092))) (begin (extend-ribcage!1103 ribcage1435 id1457 label1458) (parse1437 (cdr body1438) (cons id1457 ids1439) (cons label1458 labels1440) vars1441 vals1442 (cons (cons (quote macro) (cons er1446 (wrap1115 e1449 w1450 mod1452))) bindings1443)))) (if (memv t1453 (quote (begin-form))) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (_1461 e11462) (parse1437 (let f1463 ((forms1464 e11462)) (if (null? forms1464) (cdr body1438) (cons (cons er1446 (wrap1115 (car forms1464) w1450 mod1452)) (f1463 (cdr forms1464))))) ids1439 labels1440 vars1441 vals1442 bindings1443)) tmp1460) (syntax-violation #f "source expression failed to match any pattern" tmp1459))) ($sc-dispatch tmp1459 (quote (any . each-any))))) e1449) (if (memv t1453 (quote (local-syntax-form))) (chi-local-syntax1129 value1448 e1449 er1446 w1450 s1451 mod1452 (lambda (forms1466 er1467 w1468 s1469 mod1470) (parse1437 (let f1471 ((forms1472 forms1466)) (if (null? forms1472) (cdr body1438) (cons (cons er1467 (wrap1115 (car forms1472) w1468 mod1470)) (f1471 (cdr forms1472))))) ids1439 labels1440 vars1441 vals1442 bindings1443))) (if (null? ids1439) (build-sequence1066 #f (map (lambda (x1473) (chi1123 (cdr x1473) (car x1473) (quote (())) mod1452)) (cons (cons er1446 (source-wrap1116 e1449 w1450 s1451 mod1452)) (cdr body1438)))) (begin (if (not (valid-bound-ids?1112 ids1439)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1430)) (let loop1474 ((bs1475 bindings1443) (er-cache1476 #f) (r-cache1477 #f)) (if (not (null? bs1475)) (let ((b1478 (car bs1475))) (if (eq? (car b1478) (quote macro)) (let ((er1479 (cadr b1478))) (let ((r-cache1480 (if (eq? er1479 er-cache1476) r-cache1477 (macros-only-env1083 er1479)))) (begin (set-cdr! b1478 (eval-local-transformer1130 (chi1123 (cddr b1478) r-cache1480 (quote (())) mod1452) mod1452)) (loop1474 (cdr bs1475) er1479 r-cache1480)))) (loop1474 (cdr bs1475) er-cache1476 r-cache1477))))) (set-cdr! r1434 (extend-env1081 labels1440 bindings1443 (cdr r1434))) (build-letrec1069 #f vars1441 (map (lambda (x1481) (chi1123 (cdr x1481) (car x1481) (quote (())) mod1452)) vals1442) (build-sequence1066 #f (map (lambda (x1482) (chi1123 (cdr x1482) (car x1482) (quote (())) mod1452)) (cons (cons er1446 (source-wrap1116 e1449 w1450 s1451 mod1452)) (cdr body1438)))))))))))))))))))))) (chi-macro1126 (lambda (p1483 e1484 r1485 w1486 rib1487 mod1488) (letrec ((rebuild-macro-output1489 (lambda (x1490 m1491) (cond ((pair? x1490) (cons (rebuild-macro-output1489 (car x1490) m1491) (rebuild-macro-output1489 (cdr x1490) m1491))) ((syntax-object?1071 x1490) (let ((w1492 (syntax-object-wrap1073 x1490))) (let ((ms1493 (wrap-marks1090 w1492)) (s1494 (wrap-subst1091 w1492))) (if (and (pair? ms1493) (eq? (car ms1493) #f)) (make-syntax-object1070 (syntax-object-expression1072 x1490) (make-wrap1089 (cdr ms1493) (if rib1487 (cons rib1487 (cdr s1494)) (cdr s1494))) (syntax-object-module1074 x1490)) (make-syntax-object1070 (syntax-object-expression1072 x1490) (make-wrap1089 (cons m1491 ms1493) (if rib1487 (cons rib1487 (cons (quote shift) s1494)) (cons (quote shift) s1494))) (let ((pmod1495 (procedure-module p1483))) (if pmod1495 (cons (quote hygiene) (module-name pmod1495)) (quote (hygiene guile))))))))) ((vector? x1490) (let ((n1496 (vector-length x1490))) (let ((v1497 (make-vector n1496))) (let doloop1498 ((i1499 0)) (if (fx=1057 i1499 n1496) v1497 (begin (vector-set! v1497 i1499 (rebuild-macro-output1489 (vector-ref x1490 i1499) m1491)) (doloop1498 (fx+1055 i1499 1)))))))) ((symbol? x1490) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1116 e1484 w1486 s mod1488) x1490)) (else x1490))))) (rebuild-macro-output1489 (p1483 (wrap1115 e1484 (anti-mark1102 w1486) mod1488)) (string #\m))))) (chi-application1125 (lambda (x1500 e1501 r1502 w1503 s1504 mod1505) ((lambda (tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (e01508 e11509) (build-annotated1064 s1504 (cons x1500 (map (lambda (e1510) (chi1123 e1510 r1502 w1503 mod1505)) e11509)))) tmp1507) (syntax-violation #f "source expression failed to match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any . each-any))))) e1501))) (chi-expr1124 (lambda (type1512 value1513 e1514 r1515 w1516 s1517 mod1518) (let ((t1519 type1512)) (if (memv t1519 (quote (lexical))) (build-annotated1064 s1517 value1513) (if (memv t1519 (quote (core external-macro))) (value1513 e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (module-ref))) (call-with-values (lambda () (value1513 e1514)) (lambda (id1520 mod1521) (build-annotated1064 s1517 (if mod1521 (make-module-ref (cdr mod1521) id1520 (car mod1521)) (make-module-ref mod1521 id1520 (quote bare)))))) (if (memv t1519 (quote (lexical-call))) (chi-application1125 (build-annotated1064 (source-annotation1078 (car e1514)) value1513) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (global-call))) (chi-application1125 (build-annotated1064 (source-annotation1078 (car e1514)) (if (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518) (make-module-ref (cdr (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518)) value1513 (car (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518))) (make-module-ref (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518) value1513 (quote bare)))) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (constant))) (build-data1065 s1517 (strip1134 (source-wrap1116 e1514 w1516 s1517 mod1518) (quote (())))) (if (memv t1519 (quote (global))) (build-annotated1064 s1517 (if mod1518 (make-module-ref (cdr mod1518) value1513 (car mod1518)) (make-module-ref mod1518 value1513 (quote bare)))) (if (memv t1519 (quote (call))) (chi-application1125 (chi1123 (car e1514) r1515 w1516 mod1518) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (begin-form))) ((lambda (tmp1522) ((lambda (tmp1523) (if tmp1523 (apply (lambda (_1524 e11525 e21526) (chi-sequence1117 (cons e11525 e21526) r1515 w1516 s1517 mod1518)) tmp1523) (syntax-violation #f "source expression failed to match any pattern" tmp1522))) ($sc-dispatch tmp1522 (quote (any any . each-any))))) e1514) (if (memv t1519 (quote (local-syntax-form))) (chi-local-syntax1129 value1513 e1514 r1515 w1516 s1517 mod1518 chi-sequence1117) (if (memv t1519 (quote (eval-when-form))) ((lambda (tmp1528) ((lambda (tmp1529) (if tmp1529 (apply (lambda (_1530 x1531 e11532 e21533) (let ((when-list1534 (chi-when-list1120 e1514 x1531 w1516))) (if (memq (quote eval) when-list1534) (chi-sequence1117 (cons e11532 e21533) r1515 w1516 s1517 mod1518) (chi-void1131)))) tmp1529) (syntax-violation #f "source expression failed to match any pattern" tmp1528))) ($sc-dispatch tmp1528 (quote (any each-any any . each-any))))) e1514) (if (memv t1519 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1514 (wrap1115 value1513 w1516 mod1518)) (if (memv t1519 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1116 e1514 w1516 s1517 mod1518)) (if (memv t1519 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1116 e1514 w1516 s1517 mod1518)) (syntax-violation #f "unexpected syntax" (source-wrap1116 e1514 w1516 s1517 mod1518))))))))))))))))))) (chi1123 (lambda (e1537 r1538 w1539 mod1540) (call-with-values (lambda () (syntax-type1121 e1537 r1538 w1539 #f #f mod1540)) (lambda (type1541 value1542 e1543 w1544 s1545 mod1546) (chi-expr1124 type1541 value1542 e1543 r1538 w1544 s1545 mod1546))))) (chi-top1122 (lambda (e1547 r1548 w1549 m1550 esew1551 mod1552) (call-with-values (lambda () (syntax-type1121 e1547 r1548 w1549 #f #f mod1552)) (lambda (type1560 value1561 e1562 w1563 s1564 mod1565) (let ((t1566 type1560)) (if (memv t1566 (quote (begin-form))) ((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569) (chi-void1131)) tmp1568) ((lambda (tmp1570) (if tmp1570 (apply (lambda (_1571 e11572 e21573) (chi-top-sequence1118 (cons e11572 e21573) r1548 w1563 s1564 m1550 esew1551 mod1565)) tmp1570) (syntax-violation #f "source expression failed to match any pattern" tmp1567))) ($sc-dispatch tmp1567 (quote (any any . each-any)))))) ($sc-dispatch tmp1567 (quote (any))))) e1562) (if (memv t1566 (quote (local-syntax-form))) (chi-local-syntax1129 value1561 e1562 r1548 w1563 s1564 mod1565 (lambda (body1575 r1576 w1577 s1578 mod1579) (chi-top-sequence1118 body1575 r1576 w1577 s1578 m1550 esew1551 mod1579))) (if (memv t1566 (quote (eval-when-form))) ((lambda (tmp1580) ((lambda (tmp1581) (if tmp1581 (apply (lambda (_1582 x1583 e11584 e21585) (let ((when-list1586 (chi-when-list1120 e1562 x1583 w1563)) (body1587 (cons e11584 e21585))) (cond ((eq? m1550 (quote e)) (if (memq (quote eval) when-list1586) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote e) (quote (eval)) mod1565) (chi-void1131))) ((memq (quote load) when-list1586) (if (or (memq (quote compile) when-list1586) (and (eq? m1550 (quote c&e)) (memq (quote eval) when-list1586))) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote c&e) (quote (compile load)) mod1565) (if (memq m1550 (quote (c c&e))) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote c) (quote (load)) mod1565) (chi-void1131)))) ((or (memq (quote compile) when-list1586) (and (eq? m1550 (quote c&e)) (memq (quote eval) when-list1586))) (top-level-eval-hook1059 (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote e) (quote (eval)) mod1565) mod1565) (chi-void1131)) (else (chi-void1131))))) tmp1581) (syntax-violation #f "source expression failed to match any pattern" tmp1580))) ($sc-dispatch tmp1580 (quote (any each-any any . each-any))))) e1562) (if (memv t1566 (quote (define-syntax-form))) (let ((n1590 (id-var-name1109 value1561 w1563)) (r1591 (macros-only-env1083 r1548))) (let ((t1592 m1550)) (if (memv t1592 (quote (c))) (if (memq (quote compile) esew1551) (let ((e1593 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)))) (begin (top-level-eval-hook1059 e1593 mod1565) (if (memq (quote load) esew1551) e1593 (chi-void1131)))) (if (memq (quote load) esew1551) (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)) (chi-void1131))) (if (memv t1592 (quote (c&e))) (let ((e1594 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)))) (begin (top-level-eval-hook1059 e1594 mod1565) e1594)) (begin (if (memq (quote eval) esew1551) (top-level-eval-hook1059 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)) mod1565)) (chi-void1131)))))) (if (memv t1566 (quote (define-form))) (let ((n1595 (id-var-name1109 value1561 w1563))) (let ((type1596 (binding-type1079 (lookup1084 n1595 r1548 mod1565)))) (let ((t1597 type1596)) (if (memv t1597 (quote (global core macro module-ref))) (let ((x1598 (build-annotated1064 s1564 (list (quote define) n1595 (chi1123 e1562 r1548 w1563 mod1565))))) (begin (if (eq? m1550 (quote c&e)) (top-level-eval-hook1059 x1598 mod1565)) x1598)) (if (memv t1597 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1562 (wrap1115 value1561 w1563 mod1565)) (syntax-violation #f "cannot define keyword at top level" e1562 (wrap1115 value1561 w1563 mod1565))))))) (let ((x1599 (chi-expr1124 type1560 value1561 e1562 r1548 w1563 s1564 mod1565))) (begin (if (eq? m1550 (quote c&e)) (top-level-eval-hook1059 x1599 mod1565)) x1599)))))))))))) (syntax-type1121 (lambda (e1600 r1601 w1602 s1603 rib1604 mod1605) (cond ((symbol? e1600) (let ((n1606 (id-var-name1109 e1600 w1602))) (let ((b1607 (lookup1084 n1606 r1601 mod1605))) (let ((type1608 (binding-type1079 b1607))) (let ((t1609 type1608)) (if (memv t1609 (quote (lexical))) (values type1608 (binding-value1080 b1607) e1600 w1602 s1603 mod1605) (if (memv t1609 (quote (global))) (values type1608 n1606 e1600 w1602 s1603 mod1605) (if (memv t1609 (quote (macro))) (syntax-type1121 (chi-macro1126 (binding-value1080 b1607) e1600 r1601 w1602 rib1604 mod1605) r1601 (quote (())) s1603 rib1604 mod1605) (values type1608 (binding-value1080 b1607) e1600 w1602 s1603 mod1605))))))))) ((pair? e1600) (let ((first1610 (car e1600))) (if (id?1087 first1610) (let ((n1611 (id-var-name1109 first1610 w1602))) (let ((b1612 (lookup1084 n1611 r1601 (or (and (syntax-object?1071 first1610) (syntax-object-module1074 first1610)) mod1605)))) (let ((type1613 (binding-type1079 b1612))) (let ((t1614 type1613)) (if (memv t1614 (quote (lexical))) (values (quote lexical-call) (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (global))) (values (quote global-call) n1611 e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (macro))) (syntax-type1121 (chi-macro1126 (binding-value1080 b1612) e1600 r1601 w1602 rib1604 mod1605) r1601 (quote (())) s1603 rib1604 mod1605) (if (memv t1614 (quote (core external-macro module-ref))) (values type1613 (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (begin))) (values (quote begin-form) #f e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (eval-when))) (values (quote eval-when-form) #f e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (define))) ((lambda (tmp1615) ((lambda (tmp1616) (if (if tmp1616 (apply (lambda (_1617 name1618 val1619) (id?1087 name1618)) tmp1616) #f) (apply (lambda (_1620 name1621 val1622) (values (quote define-form) name1621 val1622 w1602 s1603 mod1605)) tmp1616) ((lambda (tmp1623) (if (if tmp1623 (apply (lambda (_1624 name1625 args1626 e11627 e21628) (and (id?1087 name1625) (valid-bound-ids?1112 (lambda-var-list1136 args1626)))) tmp1623) #f) (apply (lambda (_1629 name1630 args1631 e11632 e21633) (values (quote define-form) (wrap1115 name1630 w1602 mod1605) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap1115 (cons args1631 (cons e11632 e21633)) w1602 mod1605)) (quote (())) s1603 mod1605)) tmp1623) ((lambda (tmp1635) (if (if tmp1635 (apply (lambda (_1636 name1637) (id?1087 name1637)) tmp1635) #f) (apply (lambda (_1638 name1639) (values (quote define-form) (wrap1115 name1639 w1602 mod1605) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s1603 mod1605)) tmp1635) (syntax-violation #f "source expression failed to match any pattern" tmp1615))) ($sc-dispatch tmp1615 (quote (any any)))))) ($sc-dispatch tmp1615 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1615 (quote (any any any))))) e1600) (if (memv t1614 (quote (define-syntax))) ((lambda (tmp1640) ((lambda (tmp1641) (if (if tmp1641 (apply (lambda (_1642 name1643 val1644) (id?1087 name1643)) tmp1641) #f) (apply (lambda (_1645 name1646 val1647) (values (quote define-syntax-form) name1646 val1647 w1602 s1603 mod1605)) tmp1641) (syntax-violation #f "source expression failed to match any pattern" tmp1640))) ($sc-dispatch tmp1640 (quote (any any any))))) e1600) (values (quote call) #f e1600 w1602 s1603 mod1605)))))))))))))) (values (quote call) #f e1600 w1602 s1603 mod1605)))) ((syntax-object?1071 e1600) (syntax-type1121 (syntax-object-expression1072 e1600) r1601 (join-wraps1106 w1602 (syntax-object-wrap1073 e1600)) #f rib1604 (or (syntax-object-module1074 e1600) mod1605))) ((annotation? e1600) (syntax-type1121 (annotation-expression e1600) r1601 w1602 (annotation-source e1600) rib1604 mod1605)) ((self-evaluating? e1600) (values (quote constant) #f e1600 w1602 s1603 mod1605)) (else (values (quote other) #f e1600 w1602 s1603 mod1605))))) (chi-when-list1120 (lambda (e1648 when-list1649 w1650) (let f1651 ((when-list1652 when-list1649) (situations1653 (quote ()))) (if (null? when-list1652) situations1653 (f1651 (cdr when-list1652) (cons (let ((x1654 (car when-list1652))) (cond ((free-id=?1110 x1654 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile)) ((free-id=?1110 x1654 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load)) ((free-id=?1110 x1654 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1648 (wrap1115 x1654 w1650 #f))))) situations1653)))))) (chi-install-global1119 (lambda (name1655 e1656) (build-annotated1064 #f (list (build-annotated1064 #f (quote define)) name1655 (if (let ((v1657 (module-variable (current-module) name1655))) (and v1657 (variable-bound? v1657) (macro? (variable-ref v1657)) (not (eq? (macro-type (variable-ref v1657)) (quote syncase-macro))))) (build-annotated1064 #f (list (build-annotated1064 #f (quote make-extended-syncase-macro)) (build-annotated1064 #f (list (build-annotated1064 #f (quote module-ref)) (build-annotated1064 #f (quote (current-module))) (build-data1065 #f name1655))) (build-data1065 #f (quote macro)) e1656)) (build-annotated1064 #f (list (build-annotated1064 #f (quote make-syncase-macro)) (build-data1065 #f (quote macro)) e1656))))))) (chi-top-sequence1118 (lambda (body1658 r1659 w1660 s1661 m1662 esew1663 mod1664) (build-sequence1066 s1661 (let dobody1665 ((body1666 body1658) (r1667 r1659) (w1668 w1660) (m1669 m1662) (esew1670 esew1663) (mod1671 mod1664)) (if (null? body1666) (quote ()) (let ((first1672 (chi-top1122 (car body1666) r1667 w1668 m1669 esew1670 mod1671))) (cons first1672 (dobody1665 (cdr body1666) r1667 w1668 m1669 esew1670 mod1671)))))))) (chi-sequence1117 (lambda (body1673 r1674 w1675 s1676 mod1677) (build-sequence1066 s1676 (let dobody1678 ((body1679 body1673) (r1680 r1674) (w1681 w1675) (mod1682 mod1677)) (if (null? body1679) (quote ()) (let ((first1683 (chi1123 (car body1679) r1680 w1681 mod1682))) (cons first1683 (dobody1678 (cdr body1679) r1680 w1681 mod1682)))))))) (source-wrap1116 (lambda (x1684 w1685 s1686 defmod1687) (wrap1115 (if s1686 (make-annotation x1684 s1686 #f) x1684) w1685 defmod1687))) (wrap1115 (lambda (x1688 w1689 defmod1690) (cond ((and (null? (wrap-marks1090 w1689)) (null? (wrap-subst1091 w1689))) x1688) ((syntax-object?1071 x1688) (make-syntax-object1070 (syntax-object-expression1072 x1688) (join-wraps1106 w1689 (syntax-object-wrap1073 x1688)) (syntax-object-module1074 x1688))) ((null? x1688) x1688) (else (make-syntax-object1070 x1688 w1689 defmod1690))))) (bound-id-member?1114 (lambda (x1691 list1692) (and (not (null? list1692)) (or (bound-id=?1111 x1691 (car list1692)) (bound-id-member?1114 x1691 (cdr list1692)))))) (distinct-bound-ids?1113 (lambda (ids1693) (let distinct?1694 ((ids1695 ids1693)) (or (null? ids1695) (and (not (bound-id-member?1114 (car ids1695) (cdr ids1695))) (distinct?1694 (cdr ids1695))))))) (valid-bound-ids?1112 (lambda (ids1696) (and (let all-ids?1697 ((ids1698 ids1696)) (or (null? ids1698) (and (id?1087 (car ids1698)) (all-ids?1697 (cdr ids1698))))) (distinct-bound-ids?1113 ids1696)))) (bound-id=?1111 (lambda (i1699 j1700) (if (and (syntax-object?1071 i1699) (syntax-object?1071 j1700)) (and (eq? (let ((e1701 (syntax-object-expression1072 i1699))) (if (annotation? e1701) (annotation-expression e1701) e1701)) (let ((e1702 (syntax-object-expression1072 j1700))) (if (annotation? e1702) (annotation-expression e1702) e1702))) (same-marks?1108 (wrap-marks1090 (syntax-object-wrap1073 i1699)) (wrap-marks1090 (syntax-object-wrap1073 j1700)))) (eq? (let ((e1703 i1699)) (if (annotation? e1703) (annotation-expression e1703) e1703)) (let ((e1704 j1700)) (if (annotation? e1704) (annotation-expression e1704) e1704)))))) (free-id=?1110 (lambda (i1705 j1706) (and (eq? (let ((x1707 i1705)) (let ((e1708 (if (syntax-object?1071 x1707) (syntax-object-expression1072 x1707) x1707))) (if (annotation? e1708) (annotation-expression e1708) e1708))) (let ((x1709 j1706)) (let ((e1710 (if (syntax-object?1071 x1709) (syntax-object-expression1072 x1709) x1709))) (if (annotation? e1710) (annotation-expression e1710) e1710)))) (eq? (id-var-name1109 i1705 (quote (()))) (id-var-name1109 j1706 (quote (()))))))) (id-var-name1109 (lambda (id1711 w1712) (letrec ((search-vector-rib1715 (lambda (sym1721 subst1722 marks1723 symnames1724 ribcage1725) (let ((n1726 (vector-length symnames1724))) (let f1727 ((i1728 0)) (cond ((fx=1057 i1728 n1726) (search1713 sym1721 (cdr subst1722) marks1723)) ((and (eq? (vector-ref symnames1724 i1728) sym1721) (same-marks?1108 marks1723 (vector-ref (ribcage-marks1097 ribcage1725) i1728))) (values (vector-ref (ribcage-labels1098 ribcage1725) i1728) marks1723)) (else (f1727 (fx+1055 i1728 1)))))))) (search-list-rib1714 (lambda (sym1729 subst1730 marks1731 symnames1732 ribcage1733) (let f1734 ((symnames1735 symnames1732) (i1736 0)) (cond ((null? symnames1735) (search1713 sym1729 (cdr subst1730) marks1731)) ((and (eq? (car symnames1735) sym1729) (same-marks?1108 marks1731 (list-ref (ribcage-marks1097 ribcage1733) i1736))) (values (list-ref (ribcage-labels1098 ribcage1733) i1736) marks1731)) (else (f1734 (cdr symnames1735) (fx+1055 i1736 1))))))) (search1713 (lambda (sym1737 subst1738 marks1739) (if (null? subst1738) (values #f marks1739) (let ((fst1740 (car subst1738))) (if (eq? fst1740 (quote shift)) (search1713 sym1737 (cdr subst1738) (cdr marks1739)) (let ((symnames1741 (ribcage-symnames1096 fst1740))) (if (vector? symnames1741) (search-vector-rib1715 sym1737 subst1738 marks1739 symnames1741 fst1740) (search-list-rib1714 sym1737 subst1738 marks1739 symnames1741 fst1740))))))))) (cond ((symbol? id1711) (or (call-with-values (lambda () (search1713 id1711 (wrap-subst1091 w1712) (wrap-marks1090 w1712))) (lambda (x1743 . ignore1742) x1743)) id1711)) ((syntax-object?1071 id1711) (let ((id1744 (let ((e1746 (syntax-object-expression1072 id1711))) (if (annotation? e1746) (annotation-expression e1746) e1746))) (w11745 (syntax-object-wrap1073 id1711))) (let ((marks1747 (join-marks1107 (wrap-marks1090 w1712) (wrap-marks1090 w11745)))) (call-with-values (lambda () (search1713 id1744 (wrap-subst1091 w1712) marks1747)) (lambda (new-id1748 marks1749) (or new-id1748 (call-with-values (lambda () (search1713 id1744 (wrap-subst1091 w11745) marks1749)) (lambda (x1751 . ignore1750) x1751)) id1744)))))) ((annotation? id1711) (let ((id1752 (let ((e1753 id1711)) (if (annotation? e1753) (annotation-expression e1753) e1753)))) (or (call-with-values (lambda () (search1713 id1752 (wrap-subst1091 w1712) (wrap-marks1090 w1712))) (lambda (x1755 . ignore1754) x1755)) id1752))) (else (error-hook1061 (quote id-var-name) "invalid id" id1711)))))) (same-marks?1108 (lambda (x1756 y1757) (or (eq? x1756 y1757) (and (not (null? x1756)) (not (null? y1757)) (eq? (car x1756) (car y1757)) (same-marks?1108 (cdr x1756) (cdr y1757)))))) (join-marks1107 (lambda (m11758 m21759) (smart-append1105 m11758 m21759))) (join-wraps1106 (lambda (w11760 w21761) (let ((m11762 (wrap-marks1090 w11760)) (s11763 (wrap-subst1091 w11760))) (if (null? m11762) (if (null? s11763) w21761 (make-wrap1089 (wrap-marks1090 w21761) (smart-append1105 s11763 (wrap-subst1091 w21761)))) (make-wrap1089 (smart-append1105 m11762 (wrap-marks1090 w21761)) (smart-append1105 s11763 (wrap-subst1091 w21761))))))) (smart-append1105 (lambda (m11764 m21765) (if (null? m21765) m11764 (append m11764 m21765)))) (make-binding-wrap1104 (lambda (ids1766 labels1767 w1768) (if (null? ids1766) w1768 (make-wrap1089 (wrap-marks1090 w1768) (cons (let ((labelvec1769 (list->vector labels1767))) (let ((n1770 (vector-length labelvec1769))) (let ((symnamevec1771 (make-vector n1770)) (marksvec1772 (make-vector n1770))) (begin (let f1773 ((ids1774 ids1766) (i1775 0)) (if (not (null? ids1774)) (call-with-values (lambda () (id-sym-name&marks1088 (car ids1774) w1768)) (lambda (symname1776 marks1777) (begin (vector-set! symnamevec1771 i1775 symname1776) (vector-set! marksvec1772 i1775 marks1777) (f1773 (cdr ids1774) (fx+1055 i1775 1))))))) (make-ribcage1094 symnamevec1771 marksvec1772 labelvec1769))))) (wrap-subst1091 w1768)))))) (extend-ribcage!1103 (lambda (ribcage1778 id1779 label1780) (begin (set-ribcage-symnames!1099 ribcage1778 (cons (let ((e1781 (syntax-object-expression1072 id1779))) (if (annotation? e1781) (annotation-expression e1781) e1781)) (ribcage-symnames1096 ribcage1778))) (set-ribcage-marks!1100 ribcage1778 (cons (wrap-marks1090 (syntax-object-wrap1073 id1779)) (ribcage-marks1097 ribcage1778))) (set-ribcage-labels!1101 ribcage1778 (cons label1780 (ribcage-labels1098 ribcage1778)))))) (anti-mark1102 (lambda (w1782) (make-wrap1089 (cons #f (wrap-marks1090 w1782)) (cons (quote shift) (wrap-subst1091 w1782))))) (set-ribcage-labels!1101 (lambda (x1783 update1784) (vector-set! x1783 3 update1784))) (set-ribcage-marks!1100 (lambda (x1785 update1786) (vector-set! x1785 2 update1786))) (set-ribcage-symnames!1099 (lambda (x1787 update1788) (vector-set! x1787 1 update1788))) (ribcage-labels1098 (lambda (x1789) (vector-ref x1789 3))) (ribcage-marks1097 (lambda (x1790) (vector-ref x1790 2))) (ribcage-symnames1096 (lambda (x1791) (vector-ref x1791 1))) (ribcage?1095 (lambda (x1792) (and (vector? x1792) (= (vector-length x1792) 4) (eq? (vector-ref x1792 0) (quote ribcage))))) (make-ribcage1094 (lambda (symnames1793 marks1794 labels1795) (vector (quote ribcage) symnames1793 marks1794 labels1795))) (gen-labels1093 (lambda (ls1796) (if (null? ls1796) (quote ()) (cons (gen-label1092) (gen-labels1093 (cdr ls1796)))))) (gen-label1092 (lambda () (string #\i))) (wrap-subst1091 cdr) (wrap-marks1090 car) (make-wrap1089 cons) (id-sym-name&marks1088 (lambda (x1797 w1798) (if (syntax-object?1071 x1797) (values (let ((e1799 (syntax-object-expression1072 x1797))) (if (annotation? e1799) (annotation-expression e1799) e1799)) (join-marks1107 (wrap-marks1090 w1798) (wrap-marks1090 (syntax-object-wrap1073 x1797)))) (values (let ((e1800 x1797)) (if (annotation? e1800) (annotation-expression e1800) e1800)) (wrap-marks1090 w1798))))) (id?1087 (lambda (x1801) (cond ((symbol? x1801) #t) ((syntax-object?1071 x1801) (symbol? (let ((e1802 (syntax-object-expression1072 x1801))) (if (annotation? e1802) (annotation-expression e1802) e1802)))) ((annotation? x1801) (symbol? (annotation-expression x1801))) (else #f)))) (nonsymbol-id?1086 (lambda (x1803) (and (syntax-object?1071 x1803) (symbol? (let ((e1804 (syntax-object-expression1072 x1803))) (if (annotation? e1804) (annotation-expression e1804) e1804)))))) (global-extend1085 (lambda (type1805 sym1806 val1807) (put-global-definition-hook1062 sym1806 type1805 val1807))) (lookup1084 (lambda (x1808 r1809 mod1810) (cond ((assq x1808 r1809) => cdr) ((symbol? x1808) (or (get-global-definition-hook1063 x1808 mod1810) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1083 (lambda (r1811) (if (null? r1811) (quote ()) (let ((a1812 (car r1811))) (if (eq? (cadr a1812) (quote macro)) (cons a1812 (macros-only-env1083 (cdr r1811))) (macros-only-env1083 (cdr r1811))))))) (extend-var-env1082 (lambda (labels1813 vars1814 r1815) (if (null? labels1813) r1815 (extend-var-env1082 (cdr labels1813) (cdr vars1814) (cons (cons (car labels1813) (cons (quote lexical) (car vars1814))) r1815))))) (extend-env1081 (lambda (labels1816 bindings1817 r1818) (if (null? labels1816) r1818 (extend-env1081 (cdr labels1816) (cdr bindings1817) (cons (cons (car labels1816) (car bindings1817)) r1818))))) (binding-value1080 cdr) (binding-type1079 car) (source-annotation1078 (lambda (x1819) (cond ((annotation? x1819) (annotation-source x1819)) ((syntax-object?1071 x1819) (source-annotation1078 (syntax-object-expression1072 x1819))) (else #f)))) (set-syntax-object-module!1077 (lambda (x1820 update1821) (vector-set! x1820 3 update1821))) (set-syntax-object-wrap!1076 (lambda (x1822 update1823) (vector-set! x1822 2 update1823))) (set-syntax-object-expression!1075 (lambda (x1824 update1825) (vector-set! x1824 1 update1825))) (syntax-object-module1074 (lambda (x1826) (vector-ref x1826 3))) (syntax-object-wrap1073 (lambda (x1827) (vector-ref x1827 2))) (syntax-object-expression1072 (lambda (x1828) (vector-ref x1828 1))) (syntax-object?1071 (lambda (x1829) (and (vector? x1829) (= (vector-length x1829) 4) (eq? (vector-ref x1829 0) (quote syntax-object))))) (make-syntax-object1070 (lambda (expression1830 wrap1831 module1832) (vector (quote syntax-object) expression1830 wrap1831 module1832))) (build-letrec1069 (lambda (src1833 vars1834 val-exps1835 body-exp1836) (if (null? vars1834) (build-annotated1064 src1833 body-exp1836) (build-annotated1064 src1833 (list (quote letrec) (map list vars1834 val-exps1835) body-exp1836))))) (build-named-let1068 (lambda (src1837 vars1838 val-exps1839 body-exp1840) (if (null? vars1838) (build-annotated1064 src1837 body-exp1840) (build-annotated1064 src1837 (list (quote let) (car vars1838) (map list (cdr vars1838) val-exps1839) body-exp1840))))) (build-let1067 (lambda (src1841 vars1842 val-exps1843 body-exp1844) (if (null? vars1842) (build-annotated1064 src1841 body-exp1844) (build-annotated1064 src1841 (list (quote let) (map list vars1842 val-exps1843) body-exp1844))))) (build-sequence1066 (lambda (src1845 exps1846) (if (null? (cdr exps1846)) (build-annotated1064 src1845 (car exps1846)) (build-annotated1064 src1845 (cons (quote begin) exps1846))))) (build-data1065 (lambda (src1847 exp1848) (if (and (self-evaluating? exp1848) (not (vector? exp1848))) (build-annotated1064 src1847 exp1848) (build-annotated1064 src1847 (list (quote quote) exp1848))))) (build-annotated1064 (lambda (src1849 exp1850) (if (and src1849 (not (annotation? exp1850))) (make-annotation exp1850 src1849 #t) exp1850))) (get-global-definition-hook1063 (lambda (symbol1851 module1852) (begin (if (and (not module1852) (current-module)) (warn "module system is booted, we should have a module" symbol1851)) (let ((v1853 (module-variable (if module1852 (resolve-module (cdr module1852)) (current-module)) symbol1851))) (and v1853 (variable-bound? v1853) (let ((val1854 (variable-ref v1853))) (and (macro? val1854) (syncase-macro-type val1854) (cons (syncase-macro-type val1854) (syncase-macro-binding val1854))))))))) (put-global-definition-hook1062 (lambda (symbol1855 type1856 val1857) (let ((existing1858 (let ((v1859 (module-variable (current-module) symbol1855))) (and v1859 (variable-bound? v1859) (let ((val1860 (variable-ref v1859))) (and (macro? val1860) (not (syncase-macro-type val1860)) val1860)))))) (module-define! (current-module) symbol1855 (if existing1858 (make-extended-syncase-macro existing1858 type1856 val1857) (make-syncase-macro type1856 val1857)))))) (error-hook1061 (lambda (who1861 why1862 what1863) (error who1861 "~a ~s" why1862 what1863))) (local-eval-hook1060 (lambda (x1864 mod1865) (primitive-eval (list noexpand1054 x1864)))) (top-level-eval-hook1059 (lambda (x1866 mod1867) (primitive-eval (list noexpand1054 x1866)))) (fx<1058 <) (fx=1057 =) (fx-1056 -) (fx+1055 +) (noexpand1054 "noexpand")) (begin (global-extend1085 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1085 (quote local-syntax) (quote let-syntax) #f) (global-extend1085 (quote core) (quote fluid-let-syntax) (lambda (e1868 r1869 w1870 s1871 mod1872) ((lambda (tmp1873) ((lambda (tmp1874) (if (if tmp1874 (apply (lambda (_1875 var1876 val1877 e11878 e21879) (valid-bound-ids?1112 var1876)) tmp1874) #f) (apply (lambda (_1881 var1882 val1883 e11884 e21885) (let ((names1886 (map (lambda (x1887) (id-var-name1109 x1887 w1870)) var1882))) (begin (for-each (lambda (id1889 n1890) (let ((t1891 (binding-type1079 (lookup1084 n1890 r1869 mod1872)))) (if (memv t1891 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1868 (source-wrap1116 id1889 w1870 s1871 mod1872))))) var1882 names1886) (chi-body1127 (cons e11884 e21885) (source-wrap1116 e1868 w1870 s1871 mod1872) (extend-env1081 names1886 (let ((trans-r1894 (macros-only-env1083 r1869))) (map (lambda (x1895) (cons (quote macro) (eval-local-transformer1130 (chi1123 x1895 trans-r1894 w1870 mod1872) mod1872))) val1883)) r1869) w1870 mod1872)))) tmp1874) ((lambda (_1897) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1116 e1868 w1870 s1871 mod1872))) tmp1873))) ($sc-dispatch tmp1873 (quote (any #(each (any any)) any . each-any))))) e1868))) (global-extend1085 (quote core) (quote quote) (lambda (e1898 r1899 w1900 s1901 mod1902) ((lambda (tmp1903) ((lambda (tmp1904) (if tmp1904 (apply (lambda (_1905 e1906) (build-data1065 s1901 (strip1134 e1906 w1900))) tmp1904) ((lambda (_1907) (syntax-violation (quote quote) "bad syntax" (source-wrap1116 e1898 w1900 s1901 mod1902))) tmp1903))) ($sc-dispatch tmp1903 (quote (any any))))) e1898))) (global-extend1085 (quote core) (quote syntax) (letrec ((regen1915 (lambda (x1916) (let ((t1917 (car x1916))) (if (memv t1917 (quote (ref))) (build-annotated1064 #f (cadr x1916)) (if (memv t1917 (quote (primitive))) (build-annotated1064 #f (cadr x1916)) (if (memv t1917 (quote (quote))) (build-data1065 #f (cadr x1916)) (if (memv t1917 (quote (lambda))) (build-annotated1064 #f (list (quote lambda) (cadr x1916) (regen1915 (caddr x1916)))) (if (memv t1917 (quote (map))) (let ((ls1918 (map regen1915 (cdr x1916)))) (build-annotated1064 #f (cons (if (fx=1057 (length ls1918) 2) (build-annotated1064 #f (quote map)) (build-annotated1064 #f (quote map))) ls1918))) (build-annotated1064 #f (cons (build-annotated1064 #f (car x1916)) (map regen1915 (cdr x1916)))))))))))) (gen-vector1914 (lambda (x1919) (cond ((eq? (car x1919) (quote list)) (cons (quote vector) (cdr x1919))) ((eq? (car x1919) (quote quote)) (list (quote quote) (list->vector (cadr x1919)))) (else (list (quote list->vector) x1919))))) (gen-append1913 (lambda (x1920 y1921) (if (equal? y1921 (quote (quote ()))) x1920 (list (quote append) x1920 y1921)))) (gen-cons1912 (lambda (x1922 y1923) (let ((t1924 (car y1923))) (if (memv t1924 (quote (quote))) (if (eq? (car x1922) (quote quote)) (list (quote quote) (cons (cadr x1922) (cadr y1923))) (if (eq? (cadr y1923) (quote ())) (list (quote list) x1922) (list (quote cons) x1922 y1923))) (if (memv t1924 (quote (list))) (cons (quote list) (cons x1922 (cdr y1923))) (list (quote cons) x1922 y1923)))))) (gen-map1911 (lambda (e1925 map-env1926) (let ((formals1927 (map cdr map-env1926)) (actuals1928 (map (lambda (x1929) (list (quote ref) (car x1929))) map-env1926))) (cond ((eq? (car e1925) (quote ref)) (car actuals1928)) ((and-map (lambda (x1930) (and (eq? (car x1930) (quote ref)) (memq (cadr x1930) formals1927))) (cdr e1925)) (cons (quote map) (cons (list (quote primitive) (car e1925)) (map (let ((r1931 (map cons formals1927 actuals1928))) (lambda (x1932) (cdr (assq (cadr x1932) r1931)))) (cdr e1925))))) (else (cons (quote map) (cons (list (quote lambda) formals1927 e1925) actuals1928))))))) (gen-mappend1910 (lambda (e1933 map-env1934) (list (quote apply) (quote (primitive append)) (gen-map1911 e1933 map-env1934)))) (gen-ref1909 (lambda (src1935 var1936 level1937 maps1938) (if (fx=1057 level1937 0) (values var1936 maps1938) (if (null? maps1938) (syntax-violation (quote syntax) "missing ellipsis" src1935) (call-with-values (lambda () (gen-ref1909 src1935 var1936 (fx-1056 level1937 1) (cdr maps1938))) (lambda (outer-var1939 outer-maps1940) (let ((b1941 (assq outer-var1939 (car maps1938)))) (if b1941 (values (cdr b1941) maps1938) (let ((inner-var1942 (gen-var1135 (quote tmp)))) (values inner-var1942 (cons (cons (cons outer-var1939 inner-var1942) (car maps1938)) outer-maps1940))))))))))) (gen-syntax1908 (lambda (src1943 e1944 r1945 maps1946 ellipsis?1947 mod1948) (if (id?1087 e1944) (let ((label1949 (id-var-name1109 e1944 (quote (()))))) (let ((b1950 (lookup1084 label1949 r1945 mod1948))) (if (eq? (binding-type1079 b1950) (quote syntax)) (call-with-values (lambda () (let ((var.lev1951 (binding-value1080 b1950))) (gen-ref1909 src1943 (car var.lev1951) (cdr var.lev1951) maps1946))) (lambda (var1952 maps1953) (values (list (quote ref) var1952) maps1953))) (if (ellipsis?1947 e1944) (syntax-violation (quote syntax) "misplaced ellipsis" src1943) (values (list (quote quote) e1944) maps1946))))) ((lambda (tmp1954) ((lambda (tmp1955) (if (if tmp1955 (apply (lambda (dots1956 e1957) (ellipsis?1947 dots1956)) tmp1955) #f) (apply (lambda (dots1958 e1959) (gen-syntax1908 src1943 e1959 r1945 maps1946 (lambda (x1960) #f) mod1948)) tmp1955) ((lambda (tmp1961) (if (if tmp1961 (apply (lambda (x1962 dots1963 y1964) (ellipsis?1947 dots1963)) tmp1961) #f) (apply (lambda (x1965 dots1966 y1967) (let f1968 ((y1969 y1967) (k1970 (lambda (maps1971) (call-with-values (lambda () (gen-syntax1908 src1943 x1965 r1945 (cons (quote ()) maps1971) ellipsis?1947 mod1948)) (lambda (x1972 maps1973) (if (null? (car maps1973)) (syntax-violation (quote syntax) "extra ellipsis" src1943) (values (gen-map1911 x1972 (car maps1973)) (cdr maps1973)))))))) ((lambda (tmp1974) ((lambda (tmp1975) (if (if tmp1975 (apply (lambda (dots1976 y1977) (ellipsis?1947 dots1976)) tmp1975) #f) (apply (lambda (dots1978 y1979) (f1968 y1979 (lambda (maps1980) (call-with-values (lambda () (k1970 (cons (quote ()) maps1980))) (lambda (x1981 maps1982) (if (null? (car maps1982)) (syntax-violation (quote syntax) "extra ellipsis" src1943) (values (gen-mappend1910 x1981 (car maps1982)) (cdr maps1982)))))))) tmp1975) ((lambda (_1983) (call-with-values (lambda () (gen-syntax1908 src1943 y1969 r1945 maps1946 ellipsis?1947 mod1948)) (lambda (y1984 maps1985) (call-with-values (lambda () (k1970 maps1985)) (lambda (x1986 maps1987) (values (gen-append1913 x1986 y1984) maps1987)))))) tmp1974))) ($sc-dispatch tmp1974 (quote (any . any))))) y1969))) tmp1961) ((lambda (tmp1988) (if tmp1988 (apply (lambda (x1989 y1990) (call-with-values (lambda () (gen-syntax1908 src1943 x1989 r1945 maps1946 ellipsis?1947 mod1948)) (lambda (x1991 maps1992) (call-with-values (lambda () (gen-syntax1908 src1943 y1990 r1945 maps1992 ellipsis?1947 mod1948)) (lambda (y1993 maps1994) (values (gen-cons1912 x1991 y1993) maps1994)))))) tmp1988) ((lambda (tmp1995) (if tmp1995 (apply (lambda (e11996 e21997) (call-with-values (lambda () (gen-syntax1908 src1943 (cons e11996 e21997) r1945 maps1946 ellipsis?1947 mod1948)) (lambda (e1999 maps2000) (values (gen-vector1914 e1999) maps2000)))) tmp1995) ((lambda (_2001) (values (list (quote quote) e1944) maps1946)) tmp1954))) ($sc-dispatch tmp1954 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1954 (quote (any . any)))))) ($sc-dispatch tmp1954 (quote (any any . any)))))) ($sc-dispatch tmp1954 (quote (any any))))) e1944))))) (lambda (e2002 r2003 w2004 s2005 mod2006) (let ((e2007 (source-wrap1116 e2002 w2004 s2005 mod2006))) ((lambda (tmp2008) ((lambda (tmp2009) (if tmp2009 (apply (lambda (_2010 x2011) (call-with-values (lambda () (gen-syntax1908 e2007 x2011 r2003 (quote ()) ellipsis?1132 mod2006)) (lambda (e2012 maps2013) (regen1915 e2012)))) tmp2009) ((lambda (_2014) (syntax-violation (quote syntax) "bad `syntax' form" e2007)) tmp2008))) ($sc-dispatch tmp2008 (quote (any any))))) e2007))))) (global-extend1085 (quote core) (quote lambda) (lambda (e2015 r2016 w2017 s2018 mod2019) ((lambda (tmp2020) ((lambda (tmp2021) (if tmp2021 (apply (lambda (_2022 c2023) (chi-lambda-clause1128 (source-wrap1116 e2015 w2017 s2018 mod2019) #f c2023 r2016 w2017 mod2019 (lambda (vars2024 docstring2025 body2026) (build-annotated1064 s2018 (cons (quote lambda) (cons vars2024 (append (if docstring2025 (list docstring2025) (quote ())) (list body2026)))))))) tmp2021) (syntax-violation #f "source expression failed to match any pattern" tmp2020))) ($sc-dispatch tmp2020 (quote (any . any))))) e2015))) (global-extend1085 (quote core) (quote let) (letrec ((chi-let2027 (lambda (e2028 r2029 w2030 s2031 mod2032 constructor2033 ids2034 vals2035 exps2036) (if (not (valid-bound-ids?1112 ids2034)) (syntax-violation (quote let) "duplicate bound variable" e2028) (let ((labels2037 (gen-labels1093 ids2034)) (new-vars2038 (map gen-var1135 ids2034))) (let ((nw2039 (make-binding-wrap1104 ids2034 labels2037 w2030)) (nr2040 (extend-var-env1082 labels2037 new-vars2038 r2029))) (constructor2033 s2031 new-vars2038 (map (lambda (x2041) (chi1123 x2041 r2029 w2030 mod2032)) vals2035) (chi-body1127 exps2036 (source-wrap1116 e2028 nw2039 s2031 mod2032) nr2040 nw2039 mod2032)))))))) (lambda (e2042 r2043 w2044 s2045 mod2046) ((lambda (tmp2047) ((lambda (tmp2048) (if tmp2048 (apply (lambda (_2049 id2050 val2051 e12052 e22053) (chi-let2027 e2042 r2043 w2044 s2045 mod2046 build-let1067 id2050 val2051 (cons e12052 e22053))) tmp2048) ((lambda (tmp2057) (if (if tmp2057 (apply (lambda (_2058 f2059 id2060 val2061 e12062 e22063) (id?1087 f2059)) tmp2057) #f) (apply (lambda (_2064 f2065 id2066 val2067 e12068 e22069) (chi-let2027 e2042 r2043 w2044 s2045 mod2046 build-named-let1068 (cons f2065 id2066) val2067 (cons e12068 e22069))) tmp2057) ((lambda (_2073) (syntax-violation (quote let) "bad let" (source-wrap1116 e2042 w2044 s2045 mod2046))) tmp2047))) ($sc-dispatch tmp2047 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2047 (quote (any #(each (any any)) any . each-any))))) e2042)))) (global-extend1085 (quote core) (quote letrec) (lambda (e2074 r2075 w2076 s2077 mod2078) ((lambda (tmp2079) ((lambda (tmp2080) (if tmp2080 (apply (lambda (_2081 id2082 val2083 e12084 e22085) (let ((ids2086 id2082)) (if (not (valid-bound-ids?1112 ids2086)) (syntax-violation (quote letrec) "duplicate bound variable" e2074) (let ((labels2088 (gen-labels1093 ids2086)) (new-vars2089 (map gen-var1135 ids2086))) (let ((w2090 (make-binding-wrap1104 ids2086 labels2088 w2076)) (r2091 (extend-var-env1082 labels2088 new-vars2089 r2075))) (build-letrec1069 s2077 new-vars2089 (map (lambda (x2092) (chi1123 x2092 r2091 w2090 mod2078)) val2083) (chi-body1127 (cons e12084 e22085) (source-wrap1116 e2074 w2090 s2077 mod2078) r2091 w2090 mod2078))))))) tmp2080) ((lambda (_2095) (syntax-violation (quote letrec) "bad letrec" (source-wrap1116 e2074 w2076 s2077 mod2078))) tmp2079))) ($sc-dispatch tmp2079 (quote (any #(each (any any)) any . each-any))))) e2074))) (global-extend1085 (quote core) (quote set!) (lambda (e2096 r2097 w2098 s2099 mod2100) ((lambda (tmp2101) ((lambda (tmp2102) (if (if tmp2102 (apply (lambda (_2103 id2104 val2105) (id?1087 id2104)) tmp2102) #f) (apply (lambda (_2106 id2107 val2108) (let ((val2109 (chi1123 val2108 r2097 w2098 mod2100)) (n2110 (id-var-name1109 id2107 w2098))) (let ((b2111 (lookup1084 n2110 r2097 mod2100))) (let ((t2112 (binding-type1079 b2111))) (if (memv t2112 (quote (lexical))) (build-annotated1064 s2099 (list (quote set!) (binding-value1080 b2111) val2109)) (if (memv t2112 (quote (global))) (build-annotated1064 s2099 (list (quote set!) (if mod2100 (make-module-ref (cdr mod2100) n2110 (car mod2100)) (make-module-ref mod2100 n2110 (quote bare))) val2109)) (if (memv t2112 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1115 id2107 w2098 mod2100)) (syntax-violation (quote set!) "bad set!" (source-wrap1116 e2096 w2098 s2099 mod2100))))))))) tmp2102) ((lambda (tmp2113) (if tmp2113 (apply (lambda (_2114 head2115 tail2116 val2117) (call-with-values (lambda () (syntax-type1121 head2115 r2097 (quote (())) #f #f mod2100)) (lambda (type2118 value2119 ee2120 ww2121 ss2122 modmod2123) (let ((t2124 type2118)) (if (memv t2124 (quote (module-ref))) (let ((val2125 (chi1123 val2117 r2097 w2098 mod2100))) (call-with-values (lambda () (value2119 (cons head2115 tail2116))) (lambda (id2127 mod2128) (build-annotated1064 s2099 (list (quote set!) (if mod2128 (make-module-ref (cdr mod2128) id2127 (car mod2128)) (make-module-ref mod2128 id2127 (quote bare))) val2125))))) (build-annotated1064 s2099 (cons (chi1123 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head2115) r2097 w2098 mod2100) (map (lambda (e2129) (chi1123 e2129 r2097 w2098 mod2100)) (append tail2116 (list val2117)))))))))) tmp2113) ((lambda (_2131) (syntax-violation (quote set!) "bad set!" (source-wrap1116 e2096 w2098 s2099 mod2100))) tmp2101))) ($sc-dispatch tmp2101 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2101 (quote (any any any))))) e2096))) (global-extend1085 (quote module-ref) (quote @) (lambda (e2132) ((lambda (tmp2133) ((lambda (tmp2134) (if (if tmp2134 (apply (lambda (_2135 mod2136 id2137) (and (and-map id?1087 mod2136) (id?1087 id2137))) tmp2134) #f) (apply (lambda (_2139 mod2140 id2141) (values (syntax->datum id2141) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2140)))) tmp2134) (syntax-violation #f "source expression failed to match any pattern" tmp2133))) ($sc-dispatch tmp2133 (quote (any each-any any))))) e2132))) (global-extend1085 (quote module-ref) (quote @@) (lambda (e2143) ((lambda (tmp2144) ((lambda (tmp2145) (if (if tmp2145 (apply (lambda (_2146 mod2147 id2148) (and (and-map id?1087 mod2147) (id?1087 id2148))) tmp2145) #f) (apply (lambda (_2150 mod2151 id2152) (values (syntax->datum id2152) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2151)))) tmp2145) (syntax-violation #f "source expression failed to match any pattern" tmp2144))) ($sc-dispatch tmp2144 (quote (any each-any any))))) e2143))) (global-extend1085 (quote begin) (quote begin) (quote ())) (global-extend1085 (quote define) (quote define) (quote ())) (global-extend1085 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1085 (quote eval-when) (quote eval-when) (quote ())) (global-extend1085 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2157 (lambda (x2158 keys2159 clauses2160 r2161 mod2162) (if (null? clauses2160) (build-annotated1064 #f (list (build-annotated1064 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2158)) ((lambda (tmp2163) ((lambda (tmp2164) (if tmp2164 (apply (lambda (pat2165 exp2166) (if (and (id?1087 pat2165) (and-map (lambda (x2167) (not (free-id=?1110 pat2165 x2167))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys2159))) (let ((labels2168 (list (gen-label1092))) (var2169 (gen-var1135 pat2165))) (build-annotated1064 #f (list (build-annotated1064 #f (list (quote lambda) (list var2169) (chi1123 exp2166 (extend-env1081 labels2168 (list (cons (quote syntax) (cons var2169 0))) r2161) (make-binding-wrap1104 (list pat2165) labels2168 (quote (()))) mod2162))) x2158))) (gen-clause2156 x2158 keys2159 (cdr clauses2160) r2161 pat2165 #t exp2166 mod2162))) tmp2164) ((lambda (tmp2170) (if tmp2170 (apply (lambda (pat2171 fender2172 exp2173) (gen-clause2156 x2158 keys2159 (cdr clauses2160) r2161 pat2171 fender2172 exp2173 mod2162)) tmp2170) ((lambda (_2174) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2160))) tmp2163))) ($sc-dispatch tmp2163 (quote (any any any)))))) ($sc-dispatch tmp2163 (quote (any any))))) (car clauses2160))))) (gen-clause2156 (lambda (x2175 keys2176 clauses2177 r2178 pat2179 fender2180 exp2181 mod2182) (call-with-values (lambda () (convert-pattern2154 pat2179 keys2176)) (lambda (p2183 pvars2184) (cond ((not (distinct-bound-ids?1113 (map car pvars2184))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2179)) ((not (and-map (lambda (x2185) (not (ellipsis?1132 (car x2185)))) pvars2184)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2179)) (else (let ((y2186 (gen-var1135 (quote tmp)))) (build-annotated1064 #f (list (build-annotated1064 #f (list (quote lambda) (list y2186) (let ((y2187 (build-annotated1064 #f y2186))) (build-annotated1064 #f (list (quote if) ((lambda (tmp2188) ((lambda (tmp2189) (if tmp2189 (apply (lambda () y2187) tmp2189) ((lambda (_2190) (build-annotated1064 #f (list (quote if) y2187 (build-dispatch-call2155 pvars2184 fender2180 y2187 r2178 mod2182) (build-data1065 #f #f)))) tmp2188))) ($sc-dispatch tmp2188 (quote #(atom #t))))) fender2180) (build-dispatch-call2155 pvars2184 exp2181 y2187 r2178 mod2182) (gen-syntax-case2157 x2175 keys2176 clauses2177 r2178 mod2182)))))) (if (eq? p2183 (quote any)) (build-annotated1064 #f (list (build-annotated1064 #f (quote list)) x2175)) (build-annotated1064 #f (list (build-annotated1064 #f (quote $sc-dispatch)) x2175 (build-data1065 #f p2183))))))))))))) (build-dispatch-call2155 (lambda (pvars2191 exp2192 y2193 r2194 mod2195) (let ((ids2196 (map car pvars2191)) (levels2197 (map cdr pvars2191))) (let ((labels2198 (gen-labels1093 ids2196)) (new-vars2199 (map gen-var1135 ids2196))) (build-annotated1064 #f (list (build-annotated1064 #f (quote apply)) (build-annotated1064 #f (list (quote lambda) new-vars2199 (chi1123 exp2192 (extend-env1081 labels2198 (map (lambda (var2200 level2201) (cons (quote syntax) (cons var2200 level2201))) new-vars2199 (map cdr pvars2191)) r2194) (make-binding-wrap1104 ids2196 labels2198 (quote (()))) mod2195))) y2193)))))) (convert-pattern2154 (lambda (pattern2202 keys2203) (let cvt2204 ((p2205 pattern2202) (n2206 0) (ids2207 (quote ()))) (if (id?1087 p2205) (if (bound-id-member?1114 p2205 keys2203) (values (vector (quote free-id) p2205) ids2207) (values (quote any) (cons (cons p2205 n2206) ids2207))) ((lambda (tmp2208) ((lambda (tmp2209) (if (if tmp2209 (apply (lambda (x2210 dots2211) (ellipsis?1132 dots2211)) tmp2209) #f) (apply (lambda (x2212 dots2213) (call-with-values (lambda () (cvt2204 x2212 (fx+1055 n2206 1) ids2207)) (lambda (p2214 ids2215) (values (if (eq? p2214 (quote any)) (quote each-any) (vector (quote each) p2214)) ids2215)))) tmp2209) ((lambda (tmp2216) (if tmp2216 (apply (lambda (x2217 y2218) (call-with-values (lambda () (cvt2204 y2218 n2206 ids2207)) (lambda (y2219 ids2220) (call-with-values (lambda () (cvt2204 x2217 n2206 ids2220)) (lambda (x2221 ids2222) (values (cons x2221 y2219) ids2222)))))) tmp2216) ((lambda (tmp2223) (if tmp2223 (apply (lambda () (values (quote ()) ids2207)) tmp2223) ((lambda (tmp2224) (if tmp2224 (apply (lambda (x2225) (call-with-values (lambda () (cvt2204 x2225 n2206 ids2207)) (lambda (p2227 ids2228) (values (vector (quote vector) p2227) ids2228)))) tmp2224) ((lambda (x2229) (values (vector (quote atom) (strip1134 p2205 (quote (())))) ids2207)) tmp2208))) ($sc-dispatch tmp2208 (quote #(vector each-any)))))) ($sc-dispatch tmp2208 (quote ()))))) ($sc-dispatch tmp2208 (quote (any . any)))))) ($sc-dispatch tmp2208 (quote (any any))))) p2205)))))) (lambda (e2230 r2231 w2232 s2233 mod2234) (let ((e2235 (source-wrap1116 e2230 w2232 s2233 mod2234))) ((lambda (tmp2236) ((lambda (tmp2237) (if tmp2237 (apply (lambda (_2238 val2239 key2240 m2241) (if (and-map (lambda (x2242) (and (id?1087 x2242) (not (ellipsis?1132 x2242)))) key2240) (let ((x2244 (gen-var1135 (quote tmp)))) (build-annotated1064 s2233 (list (build-annotated1064 #f (list (quote lambda) (list x2244) (gen-syntax-case2157 (build-annotated1064 #f x2244) key2240 m2241 r2231 mod2234))) (chi1123 val2239 r2231 (quote (())) mod2234)))) (syntax-violation (quote syntax-case) "invalid literals list" e2235))) tmp2237) (syntax-violation #f "source expression failed to match any pattern" tmp2236))) ($sc-dispatch tmp2236 (quote (any any each-any . each-any))))) e2235))))) (set! sc-expand (let ((m2247 (quote e)) (esew2248 (quote (eval)))) (lambda (x2249) (if (and (pair? x2249) (equal? (car x2249) noexpand1054)) (cadr x2249) (chi-top1122 x2249 (quote ()) (quote ((top))) m2247 esew2248 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2250 (quote e)) (esew2251 (quote (eval)))) (lambda (x2253 . rest2252) (if (and (pair? x2253) (equal? (car x2253) noexpand1054)) (cadr x2253) (chi-top1122 x2253 (quote ()) (quote ((top))) (if (null? rest2252) m2250 (car rest2252)) (if (or (null? rest2252) (null? (cdr rest2252))) esew2251 (cadr rest2252)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2254) (nonsymbol-id?1086 x2254))) (set! datum->syntax (lambda (id2255 datum2256) (make-syntax-object1070 datum2256 (syntax-object-wrap1073 id2255) #f))) (set! syntax->datum (lambda (x2257) (strip1134 x2257 (quote (()))))) (set! generate-temporaries (lambda (ls2258) (begin (let ((x2259 ls2258)) (if (not (list? x2259)) (error-hook1061 (quote generate-temporaries) "invalid argument" x2259))) (map (lambda (x2260) (wrap1115 (gensym) (quote ((top))) #f)) ls2258)))) (set! free-identifier=? (lambda (x2261 y2262) (begin (let ((x2263 x2261)) (if (not (nonsymbol-id?1086 x2263)) (error-hook1061 (quote free-identifier=?) "invalid argument" x2263))) (let ((x2264 y2262)) (if (not (nonsymbol-id?1086 x2264)) (error-hook1061 (quote free-identifier=?) "invalid argument" x2264))) (free-id=?1110 x2261 y2262)))) (set! bound-identifier=? (lambda (x2265 y2266) (begin (let ((x2267 x2265)) (if (not (nonsymbol-id?1086 x2267)) (error-hook1061 (quote bound-identifier=?) "invalid argument" x2267))) (let ((x2268 y2266)) (if (not (nonsymbol-id?1086 x2268)) (error-hook1061 (quote bound-identifier=?) "invalid argument" x2268))) (bound-id=?1111 x2265 y2266)))) (set! syntax-violation (lambda (who2272 message2271 form2270 . subform2269) (begin (let ((x2273 who2272)) (if (not ((lambda (x2274) (or (not x2274) (string? x2274) (symbol? x2274))) x2273)) (error-hook1061 (quote syntax-violation) "invalid argument" x2273))) (let ((x2275 message2271)) (if (not (string? x2275)) (error-hook1061 (quote syntax-violation) "invalid argument" x2275))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2272 "~a: " "") "~a " (if (null? subform2269) "in ~a" "in subform `~s' of `~s'")) (let ((tail2276 (cons message2271 (map (lambda (x2277) (strip1134 x2277 (quote (())))) (append subform2269 (list form2270)))))) (if who2272 (cons who2272 tail2276) tail2276)) #f)))) (letrec ((match2282 (lambda (e2283 p2284 w2285 r2286 mod2287) (cond ((not r2286) #f) ((eq? p2284 (quote any)) (cons (wrap1115 e2283 w2285 mod2287) r2286)) ((syntax-object?1071 e2283) (match*2281 (let ((e2288 (syntax-object-expression1072 e2283))) (if (annotation? e2288) (annotation-expression e2288) e2288)) p2284 (join-wraps1106 w2285 (syntax-object-wrap1073 e2283)) r2286 (syntax-object-module1074 e2283))) (else (match*2281 (let ((e2289 e2283)) (if (annotation? e2289) (annotation-expression e2289) e2289)) p2284 w2285 r2286 mod2287))))) (match*2281 (lambda (e2290 p2291 w2292 r2293 mod2294) (cond ((null? p2291) (and (null? e2290) r2293)) ((pair? p2291) (and (pair? e2290) (match2282 (car e2290) (car p2291) w2292 (match2282 (cdr e2290) (cdr p2291) w2292 r2293 mod2294) mod2294))) ((eq? p2291 (quote each-any)) (let ((l2295 (match-each-any2279 e2290 w2292 mod2294))) (and l2295 (cons l2295 r2293)))) (else (let ((t2296 (vector-ref p2291 0))) (if (memv t2296 (quote (each))) (if (null? e2290) (match-empty2280 (vector-ref p2291 1) r2293) (let ((l2297 (match-each2278 e2290 (vector-ref p2291 1) w2292 mod2294))) (and l2297 (let collect2298 ((l2299 l2297)) (if (null? (car l2299)) r2293 (cons (map car l2299) (collect2298 (map cdr l2299)))))))) (if (memv t2296 (quote (free-id))) (and (id?1087 e2290) (free-id=?1110 (wrap1115 e2290 w2292 mod2294) (vector-ref p2291 1)) r2293) (if (memv t2296 (quote (atom))) (and (equal? (vector-ref p2291 1) (strip1134 e2290 w2292)) r2293) (if (memv t2296 (quote (vector))) (and (vector? e2290) (match2282 (vector->list e2290) (vector-ref p2291 1) w2292 r2293 mod2294))))))))))) (match-empty2280 (lambda (p2300 r2301) (cond ((null? p2300) r2301) ((eq? p2300 (quote any)) (cons (quote ()) r2301)) ((pair? p2300) (match-empty2280 (car p2300) (match-empty2280 (cdr p2300) r2301))) ((eq? p2300 (quote each-any)) (cons (quote ()) r2301)) (else (let ((t2302 (vector-ref p2300 0))) (if (memv t2302 (quote (each))) (match-empty2280 (vector-ref p2300 1) r2301) (if (memv t2302 (quote (free-id atom))) r2301 (if (memv t2302 (quote (vector))) (match-empty2280 (vector-ref p2300 1) r2301))))))))) (match-each-any2279 (lambda (e2303 w2304 mod2305) (cond ((annotation? e2303) (match-each-any2279 (annotation-expression e2303) w2304 mod2305)) ((pair? e2303) (let ((l2306 (match-each-any2279 (cdr e2303) w2304 mod2305))) (and l2306 (cons (wrap1115 (car e2303) w2304 mod2305) l2306)))) ((null? e2303) (quote ())) ((syntax-object?1071 e2303) (match-each-any2279 (syntax-object-expression1072 e2303) (join-wraps1106 w2304 (syntax-object-wrap1073 e2303)) mod2305)) (else #f)))) (match-each2278 (lambda (e2307 p2308 w2309 mod2310) (cond ((annotation? e2307) (match-each2278 (annotation-expression e2307) p2308 w2309 mod2310)) ((pair? e2307) (let ((first2311 (match2282 (car e2307) p2308 w2309 (quote ()) mod2310))) (and first2311 (let ((rest2312 (match-each2278 (cdr e2307) p2308 w2309 mod2310))) (and rest2312 (cons first2311 rest2312)))))) ((null? e2307) (quote ())) ((syntax-object?1071 e2307) (match-each2278 (syntax-object-expression1072 e2307) p2308 (join-wraps1106 w2309 (syntax-object-wrap1073 e2307)) (syntax-object-module1074 e2307))) (else #f))))) (set! $sc-dispatch (lambda (e2313 p2314) (cond ((eq? p2314 (quote any)) (list e2313)) ((syntax-object?1071 e2313) (match*2281 (let ((e2315 (syntax-object-expression1072 e2313))) (if (annotation? e2315) (annotation-expression e2315) e2315)) p2314 (syntax-object-wrap1073 e2313) (quote ()) (syntax-object-module1074 e2313))) (else (match*2281 (let ((e2316 e2313)) (if (annotation? e2316) (annotation-expression e2316) e2316)) p2314 (quote (())) (quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x2317) ((lambda (tmp2318) ((lambda (tmp2319) (if tmp2319 (apply (lambda (_2320 e12321 e22322) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12321 e22322))) tmp2319) ((lambda (tmp2324) (if tmp2324 (apply (lambda (_2325 out2326 in2327 e12328 e22329) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2327 (quote ()) (list out2326 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12328 e22329))))) tmp2324) ((lambda (tmp2331) (if tmp2331 (apply (lambda (_2332 out2333 in2334 e12335 e22336) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2334) (quote ()) (list out2333 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12335 e22336))))) tmp2331) (syntax-violation #f "source expression failed to match any pattern" tmp2318))) ($sc-dispatch tmp2318 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2318 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2318 (quote (any () any . each-any))))) x2317))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2340) ((lambda (tmp2341) ((lambda (tmp2342) (if tmp2342 (apply (lambda (_2343 k2344 keyword2345 pattern2346 template2347) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k2344 (map (lambda (tmp2350 tmp2349) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2349) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2350))) template2347 pattern2346)))))) tmp2342) (syntax-violation #f "source expression failed to match any pattern" tmp2341))) ($sc-dispatch tmp2341 (quote (any each-any . #(each ((any . any) any))))))) x2340))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2351) ((lambda (tmp2352) ((lambda (tmp2353) (if (if tmp2353 (apply (lambda (let*2354 x2355 v2356 e12357 e22358) (and-map identifier? x2355)) tmp2353) #f) (apply (lambda (let*2360 x2361 v2362 e12363 e22364) (let f2365 ((bindings2366 (map list x2361 v2362))) (if (null? bindings2366) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e12363 e22364))) ((lambda (tmp2370) ((lambda (tmp2371) (if tmp2371 (apply (lambda (body2372 binding2373) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding2373) body2372)) tmp2371) (syntax-violation #f "source expression failed to match any pattern" tmp2370))) ($sc-dispatch tmp2370 (quote (any any))))) (list (f2365 (cdr bindings2366)) (car bindings2366)))))) tmp2353) (syntax-violation #f "source expression failed to match any pattern" tmp2352))) ($sc-dispatch tmp2352 (quote (any #(each (any any)) any . each-any))))) x2351))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2374) ((lambda (tmp2375) ((lambda (tmp2376) (if tmp2376 (apply (lambda (_2377 var2378 init2379 step2380 e02381 e12382 c2383) ((lambda (tmp2384) ((lambda (tmp2385) (if tmp2385 (apply (lambda (step2386) ((lambda (tmp2387) ((lambda (tmp2388) (if tmp2388 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2378 init2379) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02381) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2383 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2386))))))) tmp2388) ((lambda (tmp2393) (if tmp2393 (apply (lambda (e12394 e22395) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2378 init2379) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02381 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e12394 e22395)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2383 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2386))))))) tmp2393) (syntax-violation #f "source expression failed to match any pattern" tmp2387))) ($sc-dispatch tmp2387 (quote (any . each-any)))))) ($sc-dispatch tmp2387 (quote ())))) e12382)) tmp2385) (syntax-violation #f "source expression failed to match any pattern" tmp2384))) ($sc-dispatch tmp2384 (quote each-any)))) (map (lambda (v2402 s2403) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda () v2402) tmp2405) ((lambda (tmp2406) (if tmp2406 (apply (lambda (e2407) e2407) tmp2406) ((lambda (_2408) (syntax-violation (quote do) "bad step expression" orig-x2374 s2403)) tmp2404))) ($sc-dispatch tmp2404 (quote (any)))))) ($sc-dispatch tmp2404 (quote ())))) s2403)) var2378 step2380))) tmp2376) (syntax-violation #f "source expression failed to match any pattern" tmp2375))) ($sc-dispatch tmp2375 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2374))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2411 (lambda (x2415 y2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (x2419 y2420) ((lambda (tmp2421) ((lambda (tmp2422) (if tmp2422 (apply (lambda (dy2423) ((lambda (tmp2424) ((lambda (tmp2425) (if tmp2425 (apply (lambda (dx2426) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx2426 dy2423))) tmp2425) ((lambda (_2427) (if (null? dy2423) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2419) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2419 y2420))) tmp2424))) ($sc-dispatch tmp2424 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x2419)) tmp2422) ((lambda (tmp2428) (if tmp2428 (apply (lambda (stuff2429) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x2419 stuff2429))) tmp2428) ((lambda (else2430) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2419 y2420)) tmp2421))) ($sc-dispatch tmp2421 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp2421 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y2420)) tmp2418) (syntax-violation #f "source expression failed to match any pattern" tmp2417))) ($sc-dispatch tmp2417 (quote (any any))))) (list x2415 y2416)))) (quasiappend2412 (lambda (x2431 y2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda (x2435 y2436) ((lambda (tmp2437) ((lambda (tmp2438) (if tmp2438 (apply (lambda () x2435) tmp2438) ((lambda (_2439) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2435 y2436)) tmp2437))) ($sc-dispatch tmp2437 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y2436)) tmp2434) (syntax-violation #f "source expression failed to match any pattern" tmp2433))) ($sc-dispatch tmp2433 (quote (any any))))) (list x2431 y2432)))) (quasivector2413 (lambda (x2440) ((lambda (tmp2441) ((lambda (x2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (x2445) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x2445))) tmp2444) ((lambda (tmp2447) (if tmp2447 (apply (lambda (x2448) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2448)) tmp2447) ((lambda (_2450) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2442)) tmp2443))) ($sc-dispatch tmp2443 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp2443 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x2442)) tmp2441)) x2440))) (quasi2414 (lambda (p2451 lev2452) ((lambda (tmp2453) ((lambda (tmp2454) (if tmp2454 (apply (lambda (p2455) (if (= lev2452 0) p2455 (quasicons2411 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2414 (list p2455) (- lev2452 1))))) tmp2454) ((lambda (tmp2456) (if tmp2456 (apply (lambda (p2457 q2458) (if (= lev2452 0) (quasiappend2412 p2457 (quasi2414 q2458 lev2452)) (quasicons2411 (quasicons2411 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2414 (list p2457) (- lev2452 1))) (quasi2414 q2458 lev2452)))) tmp2456) ((lambda (tmp2459) (if tmp2459 (apply (lambda (p2460) (quasicons2411 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2414 (list p2460) (+ lev2452 1)))) tmp2459) ((lambda (tmp2461) (if tmp2461 (apply (lambda (p2462 q2463) (quasicons2411 (quasi2414 p2462 lev2452) (quasi2414 q2463 lev2452))) tmp2461) ((lambda (tmp2464) (if tmp2464 (apply (lambda (x2465) (quasivector2413 (quasi2414 x2465 lev2452))) tmp2464) ((lambda (p2467) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p2467)) tmp2453))) ($sc-dispatch tmp2453 (quote #(vector each-any)))))) ($sc-dispatch tmp2453 (quote (any . any)))))) ($sc-dispatch tmp2453 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp2453 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp2453 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p2451)))) (lambda (x2468) ((lambda (tmp2469) ((lambda (tmp2470) (if tmp2470 (apply (lambda (_2471 e2472) (quasi2414 e2472 0)) tmp2470) (syntax-violation #f "source expression failed to match any pattern" tmp2469))) ($sc-dispatch tmp2469 (quote (any any))))) x2468)))))
-(define include (make-syncase-macro (quote macro) (lambda (x2473) (letrec ((read-file2474 (lambda (fn2475 k2476) (let ((p2477 (open-input-file fn2475))) (let f2478 ((x2479 (read p2477))) (if (eof-object? x2479) (begin (close-input-port p2477) (quote ())) (cons (datum->syntax k2476 x2479) (f2478 (read p2477))))))))) ((lambda (tmp2480) ((lambda (tmp2481) (if tmp2481 (apply (lambda (k2482 filename2483) (let ((fn2484 (syntax->datum filename2483))) ((lambda (tmp2485) ((lambda (tmp2486) (if tmp2486 (apply (lambda (exp2487) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp2487)) tmp2486) (syntax-violation #f "source expression failed to match any pattern" tmp2485))) ($sc-dispatch tmp2485 (quote each-any)))) (read-file2474 fn2484 k2482)))) tmp2481) (syntax-violation #f "source expression failed to match any pattern" tmp2480))) ($sc-dispatch tmp2480 (quote (any any))))) x2473)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x2489) ((lambda (tmp2490) ((lambda (tmp2491) (if tmp2491 (apply (lambda (_2492 e2493) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2493))) tmp2491) (syntax-violation #f "source expression failed to match any pattern" tmp2490))) ($sc-dispatch tmp2490 (quote (any any))))) x2489))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2494) ((lambda (tmp2495) ((lambda (tmp2496) (if tmp2496 (apply (lambda (_2497 e2498) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2498))) tmp2496) (syntax-violation #f "source expression failed to match any pattern" tmp2495))) ($sc-dispatch tmp2495 (quote (any any))))) x2494))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2499) ((lambda (tmp2500) ((lambda (tmp2501) (if tmp2501 (apply (lambda (_2502 e2503 m12504 m22505) ((lambda (tmp2506) ((lambda (body2507) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2503)) body2507)) tmp2506)) (let f2508 ((clause2509 m12504) (clauses2510 m22505)) (if (null? clauses2510) ((lambda (tmp2512) ((lambda (tmp2513) (if tmp2513 (apply (lambda (e12514 e22515) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12514 e22515))) tmp2513) ((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 () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2518)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12519 e22520)))) tmp2517) ((lambda (_2523) (syntax-violation (quote case) "bad clause" x2499 clause2509)) tmp2512))) ($sc-dispatch tmp2512 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2512 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause2509) ((lambda (tmp2524) ((lambda (rest2525) ((lambda (tmp2526) ((lambda (tmp2527) (if tmp2527 (apply (lambda (k2528 e12529 e22530) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2528)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12529 e22530)) rest2525)) tmp2527) ((lambda (_2533) (syntax-violation (quote case) "bad clause" x2499 clause2509)) tmp2526))) ($sc-dispatch tmp2526 (quote (each-any any . each-any))))) clause2509)) tmp2524)) (f2508 (car clauses2510) (cdr clauses2510))))))) tmp2501) (syntax-violation #f "source expression failed to match any pattern" tmp2500))) ($sc-dispatch tmp2500 (quote (any any any . each-any))))) x2499))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2534) ((lambda (tmp2535) ((lambda (tmp2536) (if tmp2536 (apply (lambda (_2537 e2538) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2538)) (list (cons _2537 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e2538 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp2536) (syntax-violation #f "source expression failed to match any pattern" tmp2535))) ($sc-dispatch tmp2535 (quote (any any))))) x2534))))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(void)
+(letrec ((and-map*17 (lambda (f57 first56 . rest55) (or (null? first56) (if (null? rest55) (let andmap58 ((first59 first56)) (let ((x60 (car first59)) (first61 (cdr first59))) (if (null? first61) (f57 x60) (and (f57 x60) (andmap58 first61))))) (let andmap62 ((first63 first56) (rest64 rest55)) (let ((x65 (car first63)) (xr66 (map car rest64)) (first67 (cdr first63)) (rest68 (map cdr rest64))) (if (null? first67) (apply f57 (cons x65 xr66)) (and (apply f57 (cons x65 xr66)) (andmap62 first67 rest68)))))))))) (letrec ((lambda-var-list150 (lambda (vars355) (let lvl356 ((vars357 vars355) (ls358 (quote ())) (w359 (quote (())))) (cond ((pair? vars357) (lvl356 (cdr vars357) (cons (wrap129 (car vars357) w359 #f) ls358) w359)) ((id?101 vars357) (cons (wrap129 vars357 w359 #f) ls358)) ((null? vars357) ls358) ((syntax-object?85 vars357) (lvl356 (syntax-object-expression86 vars357) ls358 (join-wraps120 w359 (syntax-object-wrap87 vars357)))) ((annotation? vars357) (lvl356 (annotation-expression vars357) ls358 w359)) (else (cons vars357 ls358)))))) (gen-var149 (lambda (id360) (let ((id361 (if (syntax-object?85 id360) (syntax-object-expression86 id360) id360))) (if (annotation? id361) (build-annotated78 (annotation-source id361) (gensym (symbol->string (annotation-expression id361)))) (build-annotated78 #f (gensym (symbol->string id361))))))) (strip148 (lambda (x362 w363) (if (memq (quote top) (wrap-marks104 w363)) (if (or (annotation? x362) (and (pair? x362) (annotation? (car x362)))) (strip-annotation147 x362 #f) x362) (let f364 ((x365 x362)) (cond ((syntax-object?85 x365) (strip148 (syntax-object-expression86 x365) (syntax-object-wrap87 x365))) ((pair? x365) (let ((a366 (f364 (car x365))) (d367 (f364 (cdr x365)))) (if (and (eq? a366 (car x365)) (eq? d367 (cdr x365))) x365 (cons a366 d367)))) ((vector? x365) (let ((old368 (vector->list x365))) (let ((new369 (map f364 old368))) (if (and-map*17 eq? old368 new369) x365 (list->vector new369))))) (else x365)))))) (strip-annotation147 (lambda (x370 parent371) (cond ((pair? x370) (let ((new372 (cons #f #f))) (begin (if parent371 (set-annotation-stripped! parent371 new372)) (set-car! new372 (strip-annotation147 (car x370) #f)) (set-cdr! new372 (strip-annotation147 (cdr x370) #f)) new372))) ((annotation? x370) (or (annotation-stripped x370) (strip-annotation147 (annotation-expression x370) x370))) ((vector? x370) (let ((new373 (make-vector (vector-length x370)))) (begin (if parent371 (set-annotation-stripped! parent371 new373)) (let loop374 ((i375 (- (vector-length x370) 1))) (unless (fx<73 i375 0) (vector-set! new373 i375 (strip-annotation147 (vector-ref x370 i375) #f)) (loop374 (fx-71 i375 1)))) new373))) (else x370)))) (ellipsis?146 (lambda (x376) (and (nonsymbol-id?100 x376) (free-id=?124 x376 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))))))) (chi-void145 (lambda () (build-annotated78 #f (list (build-annotated78 #f (quote void)))))) (eval-local-transformer144 (lambda (expanded377 mod378) (let ((p379 (local-eval-hook75 expanded377 mod378))) (if (procedure? p379) p379 (syntax-violation #f "nonprocedure transformer" p379))))) (chi-local-syntax143 (lambda (rec?380 e381 r382 w383 s384 mod385 k386) ((lambda (tmp387) ((lambda (tmp388) (if tmp388 (apply (lambda (_389 id390 val391 e1392 e2393) (let ((ids394 id390)) (if (not (valid-bound-ids?126 ids394)) (syntax-violation #f "duplicate bound keyword" e381) (let ((labels396 (gen-labels107 ids394))) (let ((new-w397 (make-binding-wrap118 ids394 labels396 w383))) (k386 (cons e1392 e2393) (extend-env95 labels396 (let ((w399 (if rec?380 new-w397 w383)) (trans-r400 (macros-only-env97 r382))) (map (lambda (x401) (cons (quote macro) (eval-local-transformer144 (chi137 x401 trans-r400 w399 mod385) mod385))) val391)) r382) new-w397 s384 mod385)))))) tmp388) ((lambda (_403) (syntax-violation #f "bad local syntax definition" (source-wrap130 e381 w383 s384 mod385))) tmp387))) ($sc-dispatch tmp387 (quote (any #(each (any any)) any . each-any))))) e381))) (chi-lambda-clause142 (lambda (e404 docstring405 c406 r407 w408 mod409 k410) ((lambda (tmp411) ((lambda (tmp412) (if (if tmp412 (apply (lambda (args413 doc414 e1415 e2416) (and (string? (syntax->datum doc414)) (not docstring405))) tmp412) #f) (apply (lambda (args417 doc418 e1419 e2420) (chi-lambda-clause142 e404 doc418 (cons args417 (cons e1419 e2420)) r407 w408 mod409 k410)) tmp412) ((lambda (tmp422) (if tmp422 (apply (lambda (id423 e1424 e2425) (let ((ids426 id423)) (if (not (valid-bound-ids?126 ids426)) (syntax-violation (quote lambda) "invalid parameter list" e404) (let ((labels428 (gen-labels107 ids426)) (new-vars429 (map gen-var149 ids426))) (k410 new-vars429 docstring405 (chi-body141 (cons e1424 e2425) e404 (extend-var-env96 labels428 new-vars429 r407) (make-binding-wrap118 ids426 labels428 w408) mod409)))))) tmp422) ((lambda (tmp431) (if tmp431 (apply (lambda (ids432 e1433 e2434) (let ((old-ids435 (lambda-var-list150 ids432))) (if (not (valid-bound-ids?126 old-ids435)) (syntax-violation (quote lambda) "invalid parameter list" e404) (let ((labels436 (gen-labels107 old-ids435)) (new-vars437 (map gen-var149 old-ids435))) (k410 (let f438 ((ls1439 (cdr new-vars437)) (ls2440 (car new-vars437))) (if (null? ls1439) ls2440 (f438 (cdr ls1439) (cons (car ls1439) ls2440)))) docstring405 (chi-body141 (cons e1433 e2434) e404 (extend-var-env96 labels436 new-vars437 r407) (make-binding-wrap118 old-ids435 labels436 w408) mod409)))))) tmp431) ((lambda (_442) (syntax-violation (quote lambda) "bad lambda" e404)) tmp411))) ($sc-dispatch tmp411 (quote (any any . each-any)))))) ($sc-dispatch tmp411 (quote (each-any any . each-any)))))) ($sc-dispatch tmp411 (quote (any any any . each-any))))) c406))) (chi-body141 (lambda (body443 outer-form444 r445 w446 mod447) (let ((r448 (cons (quote ("placeholder" placeholder)) r445))) (let ((ribcage449 (make-ribcage108 (quote ()) (quote ()) (quote ())))) (let ((w450 (make-wrap103 (wrap-marks104 w446) (cons ribcage449 (wrap-subst105 w446))))) (let parse451 ((body452 (map (lambda (x458) (cons r448 (wrap129 x458 w450 mod447))) body443)) (ids453 (quote ())) (labels454 (quote ())) (vars455 (quote ())) (vals456 (quote ())) (bindings457 (quote ()))) (if (null? body452) (syntax-violation #f "no expressions in body" outer-form444) (let ((e459 (cdar body452)) (er460 (caar body452))) (call-with-values (lambda () (syntax-type135 e459 er460 (quote (())) #f ribcage449 mod447)) (lambda (type461 value462 e463 w464 s465 mod466) (let ((t467 type461)) (if (memv t467 (quote (define-form))) (let ((id468 (wrap129 value462 w464 mod466)) (label469 (gen-label106))) (let ((var470 (gen-var149 id468))) (begin (extend-ribcage!117 ribcage449 id468 label469) (parse451 (cdr body452) (cons id468 ids453) (cons label469 labels454) (cons var470 vars455) (cons (cons er460 (wrap129 e463 w464 mod466)) vals456) (cons (cons (quote lexical) var470) bindings457))))) (if (memv t467 (quote (define-syntax-form))) (let ((id471 (wrap129 value462 w464 mod466)) (label472 (gen-label106))) (begin (extend-ribcage!117 ribcage449 id471 label472) (parse451 (cdr body452) (cons id471 ids453) (cons label472 labels454) vars455 vals456 (cons (cons (quote macro) (cons er460 (wrap129 e463 w464 mod466))) bindings457)))) (if (memv t467 (quote (begin-form))) ((lambda (tmp473) ((lambda (tmp474) (if tmp474 (apply (lambda (_475 e1476) (parse451 (let f477 ((forms478 e1476)) (if (null? forms478) (cdr body452) (cons (cons er460 (wrap129 (car forms478) w464 mod466)) (f477 (cdr forms478))))) ids453 labels454 vars455 vals456 bindings457)) tmp474) (syntax-violation #f "source expression failed to match any pattern" tmp473))) ($sc-dispatch tmp473 (quote (any . each-any))))) e463) (if (memv t467 (quote (local-syntax-form))) (chi-local-syntax143 value462 e463 er460 w464 s465 mod466 (lambda (forms480 er481 w482 s483 mod484) (parse451 (let f485 ((forms486 forms480)) (if (null? forms486) (cdr body452) (cons (cons er481 (wrap129 (car forms486) w482 mod484)) (f485 (cdr forms486))))) ids453 labels454 vars455 vals456 bindings457))) (if (null? ids453) (build-sequence80 #f (map (lambda (x487) (chi137 (cdr x487) (car x487) (quote (())) mod466)) (cons (cons er460 (source-wrap130 e463 w464 s465 mod466)) (cdr body452)))) (begin (if (not (valid-bound-ids?126 ids453)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form444)) (let loop488 ((bs489 bindings457) (er-cache490 #f) (r-cache491 #f)) (if (not (null? bs489)) (let ((b492 (car bs489))) (if (eq? (car b492) (quote macro)) (let ((er493 (cadr b492))) (let ((r-cache494 (if (eq? er493 er-cache490) r-cache491 (macros-only-env97 er493)))) (begin (set-cdr! b492 (eval-local-transformer144 (chi137 (cddr b492) r-cache494 (quote (())) mod466) mod466)) (loop488 (cdr bs489) er493 r-cache494)))) (loop488 (cdr bs489) er-cache490 r-cache491))))) (set-cdr! r448 (extend-env95 labels454 bindings457 (cdr r448))) (build-letrec83 #f vars455 (map (lambda (x495) (chi137 (cdr x495) (car x495) (quote (())) mod466)) vals456) (build-sequence80 #f (map (lambda (x496) (chi137 (cdr x496) (car x496) (quote (())) mod466)) (cons (cons er460 (source-wrap130 e463 w464 s465 mod466)) (cdr body452)))))))))))))))))))))) (chi-macro140 (lambda (p497 e498 r499 w500 rib501 mod502) (letrec ((rebuild-macro-output503 (lambda (x504 m505) (cond ((pair? x504) (cons (rebuild-macro-output503 (car x504) m505) (rebuild-macro-output503 (cdr x504) m505))) ((syntax-object?85 x504) (let ((w506 (syntax-object-wrap87 x504))) (let ((ms507 (wrap-marks104 w506)) (s508 (wrap-subst105 w506))) (if (and (pair? ms507) (eq? (car ms507) #f)) (make-syntax-object84 (syntax-object-expression86 x504) (make-wrap103 (cdr ms507) (if rib501 (cons rib501 (cdr s508)) (cdr s508))) (syntax-object-module88 x504)) (make-syntax-object84 (syntax-object-expression86 x504) (make-wrap103 (cons m505 ms507) (if rib501 (cons rib501 (cons (quote shift) s508)) (cons (quote shift) s508))) (let ((pmod509 (procedure-module p497))) (if pmod509 (cons (quote hygiene) (module-name pmod509)) (quote (hygiene guile))))))))) ((vector? x504) (let ((n510 (vector-length x504))) (let ((v511 (make-vector n510))) (let doloop512 ((i513 0)) (if (fx=72 i513 n510) v511 (begin (vector-set! v511 i513 (rebuild-macro-output503 (vector-ref x504 i513) m505)) (doloop512 (fx+70 i513 1)))))))) ((symbol? x504) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap130 e498 w500 s mod502) x504)) (else x504))))) (rebuild-macro-output503 (p497 (wrap129 e498 (anti-mark116 w500) mod502)) (string #\m))))) (chi-application139 (lambda (x514 e515 r516 w517 s518 mod519) ((lambda (tmp520) ((lambda (tmp521) (if tmp521 (apply (lambda (e0522 e1523) (build-annotated78 s518 (cons x514 (map (lambda (e524) (chi137 e524 r516 w517 mod519)) e1523)))) tmp521) (syntax-violation #f "source expression failed to match any pattern" tmp520))) ($sc-dispatch tmp520 (quote (any . each-any))))) e515))) (chi-expr138 (lambda (type526 value527 e528 r529 w530 s531 mod532) (let ((t533 type526)) (if (memv t533 (quote (lexical))) (build-annotated78 s531 value527) (if (memv t533 (quote (core external-macro))) (value527 e528 r529 w530 s531 mod532) (if (memv t533 (quote (module-ref))) (call-with-values (lambda () (value527 e528)) (lambda (id534 mod535) (build-annotated78 s531 (if mod535 (make-module-ref (cdr mod535) id534 (car mod535)) (make-module-ref mod535 id534 (quote bare)))))) (if (memv t533 (quote (lexical-call))) (chi-application139 (build-annotated78 (source-annotation92 (car e528)) value527) e528 r529 w530 s531 mod532) (if (memv t533 (quote (global-call))) (chi-application139 (build-annotated78 (source-annotation92 (car e528)) (if (if (syntax-object?85 (car e528)) (syntax-object-module88 (car e528)) mod532) (make-module-ref (cdr (if (syntax-object?85 (car e528)) (syntax-object-module88 (car e528)) mod532)) value527 (car (if (syntax-object?85 (car e528)) (syntax-object-module88 (car e528)) mod532))) (make-module-ref (if (syntax-object?85 (car e528)) (syntax-object-module88 (car e528)) mod532) value527 (quote bare)))) e528 r529 w530 s531 mod532) (if (memv t533 (quote (constant))) (build-data79 s531 (strip148 (source-wrap130 e528 w530 s531 mod532) (quote (())))) (if (memv t533 (quote (global))) (build-annotated78 s531 (if mod532 (make-module-ref (cdr mod532) value527 (car mod532)) (make-module-ref mod532 value527 (quote bare)))) (if (memv t533 (quote (call))) (chi-application139 (chi137 (car e528) r529 w530 mod532) e528 r529 w530 s531 mod532) (if (memv t533 (quote (begin-form))) ((lambda (tmp536) ((lambda (tmp537) (if tmp537 (apply (lambda (_538 e1539 e2540) (chi-sequence131 (cons e1539 e2540) r529 w530 s531 mod532)) tmp537) (syntax-violation #f "source expression failed to match any pattern" tmp536))) ($sc-dispatch tmp536 (quote (any any . each-any))))) e528) (if (memv t533 (quote (local-syntax-form))) (chi-local-syntax143 value527 e528 r529 w530 s531 mod532 chi-sequence131) (if (memv t533 (quote (eval-when-form))) ((lambda (tmp542) ((lambda (tmp543) (if tmp543 (apply (lambda (_544 x545 e1546 e2547) (let ((when-list548 (chi-when-list134 e528 x545 w530))) (if (memq (quote eval) when-list548) (chi-sequence131 (cons e1546 e2547) r529 w530 s531 mod532) (chi-void145)))) tmp543) (syntax-violation #f "source expression failed to match any pattern" tmp542))) ($sc-dispatch tmp542 (quote (any each-any any . each-any))))) e528) (if (memv t533 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e528 (wrap129 value527 w530 mod532)) (if (memv t533 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap130 e528 w530 s531 mod532)) (if (memv t533 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap130 e528 w530 s531 mod532)) (syntax-violation #f "unexpected syntax" (source-wrap130 e528 w530 s531 mod532))))))))))))))))))) (chi137 (lambda (e551 r552 w553 mod554) (call-with-values (lambda () (syntax-type135 e551 r552 w553 #f #f mod554)) (lambda (type555 value556 e557 w558 s559 mod560) (chi-expr138 type555 value556 e557 r552 w558 s559 mod560))))) (chi-top136 (lambda (e561 r562 w563 m564 esew565 mod566) (call-with-values (lambda () (syntax-type135 e561 r562 w563 #f #f mod566)) (lambda (type574 value575 e576 w577 s578 mod579) (let ((t580 type574)) (if (memv t580 (quote (begin-form))) ((lambda (tmp581) ((lambda (tmp582) (if tmp582 (apply (lambda (_583) (chi-void145)) tmp582) ((lambda (tmp584) (if tmp584 (apply (lambda (_585 e1586 e2587) (chi-top-sequence132 (cons e1586 e2587) r562 w577 s578 m564 esew565 mod579)) tmp584) (syntax-violation #f "source expression failed to match any pattern" tmp581))) ($sc-dispatch tmp581 (quote (any any . each-any)))))) ($sc-dispatch tmp581 (quote (any))))) e576) (if (memv t580 (quote (local-syntax-form))) (chi-local-syntax143 value575 e576 r562 w577 s578 mod579 (lambda (body589 r590 w591 s592 mod593) (chi-top-sequence132 body589 r590 w591 s592 m564 esew565 mod593))) (if (memv t580 (quote (eval-when-form))) ((lambda (tmp594) ((lambda (tmp595) (if tmp595 (apply (lambda (_596 x597 e1598 e2599) (let ((when-list600 (chi-when-list134 e576 x597 w577)) (body601 (cons e1598 e2599))) (cond ((eq? m564 (quote e)) (if (memq (quote eval) when-list600) (chi-top-sequence132 body601 r562 w577 s578 (quote e) (quote (eval)) mod579) (chi-void145))) ((memq (quote load) when-list600) (if (or (memq (quote compile) when-list600) (and (eq? m564 (quote c&e)) (memq (quote eval) when-list600))) (chi-top-sequence132 body601 r562 w577 s578 (quote c&e) (quote (compile load)) mod579) (if (memq m564 (quote (c c&e))) (chi-top-sequence132 body601 r562 w577 s578 (quote c) (quote (load)) mod579) (chi-void145)))) ((or (memq (quote compile) when-list600) (and (eq? m564 (quote c&e)) (memq (quote eval) when-list600))) (top-level-eval-hook74 (chi-top-sequence132 body601 r562 w577 s578 (quote e) (quote (eval)) mod579) mod579) (chi-void145)) (else (chi-void145))))) tmp595) (syntax-violation #f "source expression failed to match any pattern" tmp594))) ($sc-dispatch tmp594 (quote (any each-any any . each-any))))) e576) (if (memv t580 (quote (define-syntax-form))) (let ((n604 (id-var-name123 value575 w577)) (r605 (macros-only-env97 r562))) (let ((t606 m564)) (if (memv t606 (quote (c))) (if (memq (quote compile) esew565) (let ((e607 (chi-install-global133 n604 (chi137 e576 r605 w577 mod579)))) (begin (top-level-eval-hook74 e607 mod579) (if (memq (quote load) esew565) e607 (chi-void145)))) (if (memq (quote load) esew565) (chi-install-global133 n604 (chi137 e576 r605 w577 mod579)) (chi-void145))) (if (memv t606 (quote (c&e))) (let ((e608 (chi-install-global133 n604 (chi137 e576 r605 w577 mod579)))) (begin (top-level-eval-hook74 e608 mod579) e608)) (begin (if (memq (quote eval) esew565) (top-level-eval-hook74 (chi-install-global133 n604 (chi137 e576 r605 w577 mod579)) mod579)) (chi-void145)))))) (if (memv t580 (quote (define-form))) (let ((n609 (id-var-name123 value575 w577))) (let ((type610 (binding-type93 (lookup98 n609 r562 mod579)))) (let ((t611 type610)) (if (memv t611 (quote (global core macro module-ref))) (let ((x612 (build-annotated78 s578 (list (quote define) n609 (chi137 e576 r562 w577 mod579))))) (begin (if (eq? m564 (quote c&e)) (top-level-eval-hook74 x612 mod579)) x612)) (if (memv t611 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e576 (wrap129 value575 w577 mod579)) (syntax-violation #f "cannot define keyword at top level" e576 (wrap129 value575 w577 mod579))))))) (let ((x613 (chi-expr138 type574 value575 e576 r562 w577 s578 mod579))) (begin (if (eq? m564 (quote c&e)) (top-level-eval-hook74 x613 mod579)) x613)))))))))))) (syntax-type135 (lambda (e614 r615 w616 s617 rib618 mod619) (cond ((symbol? e614) (let ((n620 (id-var-name123 e614 w616))) (let ((b621 (lookup98 n620 r615 mod619))) (let ((type622 (binding-type93 b621))) (let ((t623 type622)) (if (memv t623 (quote (lexical))) (values type622 (binding-value94 b621) e614 w616 s617 mod619) (if (memv t623 (quote (global))) (values type622 n620 e614 w616 s617 mod619) (if (memv t623 (quote (macro))) (syntax-type135 (chi-macro140 (binding-value94 b621) e614 r615 w616 rib618 mod619) r615 (quote (())) s617 rib618 mod619) (values type622 (binding-value94 b621) e614 w616 s617 mod619))))))))) ((pair? e614) (let ((first624 (car e614))) (if (id?101 first624) (let ((n625 (id-var-name123 first624 w616))) (let ((b626 (lookup98 n625 r615 (or (and (syntax-object?85 first624) (syntax-object-module88 first624)) mod619)))) (let ((type627 (binding-type93 b626))) (let ((t628 type627)) (if (memv t628 (quote (lexical))) (values (quote lexical-call) (binding-value94 b626) e614 w616 s617 mod619) (if (memv t628 (quote (global))) (values (quote global-call) n625 e614 w616 s617 mod619) (if (memv t628 (quote (macro))) (syntax-type135 (chi-macro140 (binding-value94 b626) e614 r615 w616 rib618 mod619) r615 (quote (())) s617 rib618 mod619) (if (memv t628 (quote (core external-macro module-ref))) (values type627 (binding-value94 b626) e614 w616 s617 mod619) (if (memv t628 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value94 b626) e614 w616 s617 mod619) (if (memv t628 (quote (begin))) (values (quote begin-form) #f e614 w616 s617 mod619) (if (memv t628 (quote (eval-when))) (values (quote eval-when-form) #f e614 w616 s617 mod619) (if (memv t628 (quote (define))) ((lambda (tmp629) ((lambda (tmp630) (if (if tmp630 (apply (lambda (_631 name632 val633) (id?101 name632)) tmp630) #f) (apply (lambda (_634 name635 val636) (values (quote define-form) name635 val636 w616 s617 mod619)) tmp630) ((lambda (tmp637) (if (if tmp637 (apply (lambda (_638 name639 args640 e1641 e2642) (and (id?101 name639) (valid-bound-ids?126 (lambda-var-list150 args640)))) tmp637) #f) (apply (lambda (_643 name644 args645 e1646 e2647) (values (quote define-form) (wrap129 name644 w616 mod619) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap129 (cons args645 (cons e1646 e2647)) w616 mod619)) (quote (())) s617 mod619)) tmp637) ((lambda (tmp649) (if (if tmp649 (apply (lambda (_650 name651) (id?101 name651)) tmp649) #f) (apply (lambda (_652 name653) (values (quote define-form) (wrap129 name653 w616 mod619) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s617 mod619)) tmp649) (syntax-violation #f "source expression failed to match any pattern" tmp629))) ($sc-dispatch tmp629 (quote (any any)))))) ($sc-dispatch tmp629 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp629 (quote (any any any))))) e614) (if (memv t628 (quote (define-syntax))) ((lambda (tmp654) ((lambda (tmp655) (if (if tmp655 (apply (lambda (_656 name657 val658) (id?101 name657)) tmp655) #f) (apply (lambda (_659 name660 val661) (values (quote define-syntax-form) name660 val661 w616 s617 mod619)) tmp655) (syntax-violation #f "source expression failed to match any pattern" tmp654))) ($sc-dispatch tmp654 (quote (any any any))))) e614) (values (quote call) #f e614 w616 s617 mod619)))))))))))))) (values (quote call) #f e614 w616 s617 mod619)))) ((syntax-object?85 e614) (syntax-type135 (syntax-object-expression86 e614) r615 (join-wraps120 w616 (syntax-object-wrap87 e614)) #f rib618 (or (syntax-object-module88 e614) mod619))) ((annotation? e614) (syntax-type135 (annotation-expression e614) r615 w616 (annotation-source e614) rib618 mod619)) ((self-evaluating? e614) (values (quote constant) #f e614 w616 s617 mod619)) (else (values (quote other) #f e614 w616 s617 mod619))))) (chi-when-list134 (lambda (e662 when-list663 w664) (let f665 ((when-list666 when-list663) (situations667 (quote ()))) (if (null? when-list666) situations667 (f665 (cdr when-list666) (cons (let ((x668 (car when-list666))) (cond ((free-id=?124 x668 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile)) ((free-id=?124 x668 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load)) ((free-id=?124 x668 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e662 (wrap129 x668 w664 #f))))) situations667)))))) (chi-install-global133 (lambda (name669 e670) (build-annotated78 #f (list (build-annotated78 #f (quote define)) name669 (if (let ((v671 (module-variable (current-module) name669))) (and v671 (variable-bound? v671) (macro? (variable-ref v671)) (not (eq? (macro-type (variable-ref v671)) (quote syncase-macro))))) (build-annotated78 #f (list (build-annotated78 #f (quote make-extended-syncase-macro)) (build-annotated78 #f (list (build-annotated78 #f (quote module-ref)) (build-annotated78 #f (quote (current-module))) (build-data79 #f name669))) (build-data79 #f (quote macro)) e670)) (build-annotated78 #f (list (build-annotated78 #f (quote make-syncase-macro)) (build-data79 #f (quote macro)) e670))))))) (chi-top-sequence132 (lambda (body672 r673 w674 s675 m676 esew677 mod678) (build-sequence80 s675 (let dobody679 ((body680 body672) (r681 r673) (w682 w674) (m683 m676) (esew684 esew677) (mod685 mod678)) (if (null? body680) (quote ()) (let ((first686 (chi-top136 (car body680) r681 w682 m683 esew684 mod685))) (cons first686 (dobody679 (cdr body680) r681 w682 m683 esew684 mod685)))))))) (chi-sequence131 (lambda (body687 r688 w689 s690 mod691) (build-sequence80 s690 (let dobody692 ((body693 body687) (r694 r688) (w695 w689) (mod696 mod691)) (if (null? body693) (quote ()) (let ((first697 (chi137 (car body693) r694 w695 mod696))) (cons first697 (dobody692 (cdr body693) r694 w695 mod696)))))))) (source-wrap130 (lambda (x698 w699 s700 defmod701) (wrap129 (if s700 (make-annotation x698 s700 #f) x698) w699 defmod701))) (wrap129 (lambda (x702 w703 defmod704) (cond ((and (null? (wrap-marks104 w703)) (null? (wrap-subst105 w703))) x702) ((syntax-object?85 x702) (make-syntax-object84 (syntax-object-expression86 x702) (join-wraps120 w703 (syntax-object-wrap87 x702)) (syntax-object-module88 x702))) ((null? x702) x702) (else (make-syntax-object84 x702 w703 defmod704))))) (bound-id-member?128 (lambda (x705 list706) (and (not (null? list706)) (or (bound-id=?125 x705 (car list706)) (bound-id-member?128 x705 (cdr list706)))))) (distinct-bound-ids?127 (lambda (ids707) (let distinct?708 ((ids709 ids707)) (or (null? ids709) (and (not (bound-id-member?128 (car ids709) (cdr ids709))) (distinct?708 (cdr ids709))))))) (valid-bound-ids?126 (lambda (ids710) (and (let all-ids?711 ((ids712 ids710)) (or (null? ids712) (and (id?101 (car ids712)) (all-ids?711 (cdr ids712))))) (distinct-bound-ids?127 ids710)))) (bound-id=?125 (lambda (i713 j714) (if (and (syntax-object?85 i713) (syntax-object?85 j714)) (and (eq? (let ((e715 (syntax-object-expression86 i713))) (if (annotation? e715) (annotation-expression e715) e715)) (let ((e716 (syntax-object-expression86 j714))) (if (annotation? e716) (annotation-expression e716) e716))) (same-marks?122 (wrap-marks104 (syntax-object-wrap87 i713)) (wrap-marks104 (syntax-object-wrap87 j714)))) (eq? (let ((e717 i713)) (if (annotation? e717) (annotation-expression e717) e717)) (let ((e718 j714)) (if (annotation? e718) (annotation-expression e718) e718)))))) (free-id=?124 (lambda (i719 j720) (and (eq? (let ((x721 i719)) (let ((e722 (if (syntax-object?85 x721) (syntax-object-expression86 x721) x721))) (if (annotation? e722) (annotation-expression e722) e722))) (let ((x723 j720)) (let ((e724 (if (syntax-object?85 x723) (syntax-object-expression86 x723) x723))) (if (annotation? e724) (annotation-expression e724) e724)))) (eq? (id-var-name123 i719 (quote (()))) (id-var-name123 j720 (quote (()))))))) (id-var-name123 (lambda (id725 w726) (letrec ((search-vector-rib729 (lambda (sym735 subst736 marks737 symnames738 ribcage739) (let ((n740 (vector-length symnames738))) (let f741 ((i742 0)) (cond ((fx=72 i742 n740) (search727 sym735 (cdr subst736) marks737)) ((and (eq? (vector-ref symnames738 i742) sym735) (same-marks?122 marks737 (vector-ref (ribcage-marks111 ribcage739) i742))) (values (vector-ref (ribcage-labels112 ribcage739) i742) marks737)) (else (f741 (fx+70 i742 1)))))))) (search-list-rib728 (lambda (sym743 subst744 marks745 symnames746 ribcage747) (let f748 ((symnames749 symnames746) (i750 0)) (cond ((null? symnames749) (search727 sym743 (cdr subst744) marks745)) ((and (eq? (car symnames749) sym743) (same-marks?122 marks745 (list-ref (ribcage-marks111 ribcage747) i750))) (values (list-ref (ribcage-labels112 ribcage747) i750) marks745)) (else (f748 (cdr symnames749) (fx+70 i750 1))))))) (search727 (lambda (sym751 subst752 marks753) (if (null? subst752) (values #f marks753) (let ((fst754 (car subst752))) (if (eq? fst754 (quote shift)) (search727 sym751 (cdr subst752) (cdr marks753)) (let ((symnames755 (ribcage-symnames110 fst754))) (if (vector? symnames755) (search-vector-rib729 sym751 subst752 marks753 symnames755 fst754) (search-list-rib728 sym751 subst752 marks753 symnames755 fst754))))))))) (cond ((symbol? id725) (or (call-with-values (lambda () (search727 id725 (wrap-subst105 w726) (wrap-marks104 w726))) (lambda (x757 . ignore756) x757)) id725)) ((syntax-object?85 id725) (let ((id758 (let ((e760 (syntax-object-expression86 id725))) (if (annotation? e760) (annotation-expression e760) e760))) (w1759 (syntax-object-wrap87 id725))) (let ((marks761 (join-marks121 (wrap-marks104 w726) (wrap-marks104 w1759)))) (call-with-values (lambda () (search727 id758 (wrap-subst105 w726) marks761)) (lambda (new-id762 marks763) (or new-id762 (call-with-values (lambda () (search727 id758 (wrap-subst105 w1759) marks763)) (lambda (x765 . ignore764) x765)) id758)))))) ((annotation? id725) (let ((id766 (let ((e767 id725)) (if (annotation? e767) (annotation-expression e767) e767)))) (or (call-with-values (lambda () (search727 id766 (wrap-subst105 w726) (wrap-marks104 w726))) (lambda (x769 . ignore768) x769)) id766))) (else (syntax-violation (quote id-var-name) "invalid id" id725)))))) (same-marks?122 (lambda (x770 y771) (or (eq? x770 y771) (and (not (null? x770)) (not (null? y771)) (eq? (car x770) (car y771)) (same-marks?122 (cdr x770) (cdr y771)))))) (join-marks121 (lambda (m1772 m2773) (smart-append119 m1772 m2773))) (join-wraps120 (lambda (w1774 w2775) (let ((m1776 (wrap-marks104 w1774)) (s1777 (wrap-subst105 w1774))) (if (null? m1776) (if (null? s1777) w2775 (make-wrap103 (wrap-marks104 w2775) (smart-append119 s1777 (wrap-subst105 w2775)))) (make-wrap103 (smart-append119 m1776 (wrap-marks104 w2775)) (smart-append119 s1777 (wrap-subst105 w2775))))))) (smart-append119 (lambda (m1778 m2779) (if (null? m2779) m1778 (append m1778 m2779)))) (make-binding-wrap118 (lambda (ids780 labels781 w782) (if (null? ids780) w782 (make-wrap103 (wrap-marks104 w782) (cons (let ((labelvec783 (list->vector labels781))) (let ((n784 (vector-length labelvec783))) (let ((symnamevec785 (make-vector n784)) (marksvec786 (make-vector n784))) (begin (let f787 ((ids788 ids780) (i789 0)) (if (not (null? ids788)) (call-with-values (lambda () (id-sym-name&marks102 (car ids788) w782)) (lambda (symname790 marks791) (begin (vector-set! symnamevec785 i789 symname790) (vector-set! marksvec786 i789 marks791) (f787 (cdr ids788) (fx+70 i789 1))))))) (make-ribcage108 symnamevec785 marksvec786 labelvec783))))) (wrap-subst105 w782)))))) (extend-ribcage!117 (lambda (ribcage792 id793 label794) (begin (set-ribcage-symnames!113 ribcage792 (cons (let ((e795 (syntax-object-expression86 id793))) (if (annotation? e795) (annotation-expression e795) e795)) (ribcage-symnames110 ribcage792))) (set-ribcage-marks!114 ribcage792 (cons (wrap-marks104 (syntax-object-wrap87 id793)) (ribcage-marks111 ribcage792))) (set-ribcage-labels!115 ribcage792 (cons label794 (ribcage-labels112 ribcage792)))))) (anti-mark116 (lambda (w796) (make-wrap103 (cons #f (wrap-marks104 w796)) (cons (quote shift) (wrap-subst105 w796))))) (set-ribcage-labels!115 (lambda (x797 update798) (vector-set! x797 3 update798))) (set-ribcage-marks!114 (lambda (x799 update800) (vector-set! x799 2 update800))) (set-ribcage-symnames!113 (lambda (x801 update802) (vector-set! x801 1 update802))) (ribcage-labels112 (lambda (x803) (vector-ref x803 3))) (ribcage-marks111 (lambda (x804) (vector-ref x804 2))) (ribcage-symnames110 (lambda (x805) (vector-ref x805 1))) (ribcage?109 (lambda (x806) (and (vector? x806) (= (vector-length x806) 4) (eq? (vector-ref x806 0) (quote ribcage))))) (make-ribcage108 (lambda (symnames807 marks808 labels809) (vector (quote ribcage) symnames807 marks808 labels809))) (gen-labels107 (lambda (ls810) (if (null? ls810) (quote ()) (cons (gen-label106) (gen-labels107 (cdr ls810)))))) (gen-label106 (lambda () (string #\i))) (wrap-subst105 cdr) (wrap-marks104 car) (make-wrap103 cons) (id-sym-name&marks102 (lambda (x811 w812) (if (syntax-object?85 x811) (values (let ((e813 (syntax-object-expression86 x811))) (if (annotation? e813) (annotation-expression e813) e813)) (join-marks121 (wrap-marks104 w812) (wrap-marks104 (syntax-object-wrap87 x811)))) (values (let ((e814 x811)) (if (annotation? e814) (annotation-expression e814) e814)) (wrap-marks104 w812))))) (id?101 (lambda (x815) (cond ((symbol? x815) #t) ((syntax-object?85 x815) (symbol? (let ((e816 (syntax-object-expression86 x815))) (if (annotation? e816) (annotation-expression e816) e816)))) ((annotation? x815) (symbol? (annotation-expression x815))) (else #f)))) (nonsymbol-id?100 (lambda (x817) (and (syntax-object?85 x817) (symbol? (let ((e818 (syntax-object-expression86 x817))) (if (annotation? e818) (annotation-expression e818) e818)))))) (global-extend99 (lambda (type819 sym820 val821) (put-global-definition-hook76 sym820 type819 val821))) (lookup98 (lambda (x822 r823 mod824) (cond ((assq x822 r823) => cdr) ((symbol? x822) (or (get-global-definition-hook77 x822 mod824) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env97 (lambda (r825) (if (null? r825) (quote ()) (let ((a826 (car r825))) (if (eq? (cadr a826) (quote macro)) (cons a826 (macros-only-env97 (cdr r825))) (macros-only-env97 (cdr r825))))))) (extend-var-env96 (lambda (labels827 vars828 r829) (if (null? labels827) r829 (extend-var-env96 (cdr labels827) (cdr vars828) (cons (cons (car labels827) (cons (quote lexical) (car vars828))) r829))))) (extend-env95 (lambda (labels830 bindings831 r832) (if (null? labels830) r832 (extend-env95 (cdr labels830) (cdr bindings831) (cons (cons (car labels830) (car bindings831)) r832))))) (binding-value94 cdr) (binding-type93 car) (source-annotation92 (lambda (x833) (cond ((annotation? x833) (annotation-source x833)) ((syntax-object?85 x833) (source-annotation92 (syntax-object-expression86 x833))) (else #f)))) (set-syntax-object-module!91 (lambda (x834 update835) (vector-set! x834 3 update835))) (set-syntax-object-wrap!90 (lambda (x836 update837) (vector-set! x836 2 update837))) (set-syntax-object-expression!89 (lambda (x838 update839) (vector-set! x838 1 update839))) (syntax-object-module88 (lambda (x840) (vector-ref x840 3))) (syntax-object-wrap87 (lambda (x841) (vector-ref x841 2))) (syntax-object-expression86 (lambda (x842) (vector-ref x842 1))) (syntax-object?85 (lambda (x843) (and (vector? x843) (= (vector-length x843) 4) (eq? (vector-ref x843 0) (quote syntax-object))))) (make-syntax-object84 (lambda (expression844 wrap845 module846) (vector (quote syntax-object) expression844 wrap845 module846))) (build-letrec83 (lambda (src847 vars848 val-exps849 body-exp850) (if (null? vars848) (build-annotated78 src847 body-exp850) (build-annotated78 src847 (list (quote letrec) (map list vars848 val-exps849) body-exp850))))) (build-named-let82 (lambda (src851 vars852 val-exps853 body-exp854) (if (null? vars852) (build-annotated78 src851 body-exp854) (build-annotated78 src851 (list (quote let) (car vars852) (map list (cdr vars852) val-exps853) body-exp854))))) (build-let81 (lambda (src855 vars856 val-exps857 body-exp858) (if (null? vars856) (build-annotated78 src855 body-exp858) (build-annotated78 src855 (list (quote let) (map list vars856 val-exps857) body-exp858))))) (build-sequence80 (lambda (src859 exps860) (if (null? (cdr exps860)) (build-annotated78 src859 (car exps860)) (build-annotated78 src859 (cons (quote begin) exps860))))) (build-data79 (lambda (src861 exp862) (if (and (self-evaluating? exp862) (not (vector? exp862))) (build-annotated78 src861 exp862) (build-annotated78 src861 (list (quote quote) exp862))))) (build-annotated78 (lambda (src863 exp864) (if (and src863 (not (annotation? exp864))) (make-annotation exp864 src863 #t) exp864))) (get-global-definition-hook77 (lambda (symbol865 module866) (begin (if (and (not module866) (current-module)) (warn "module system is booted, we should have a module" symbol865)) (let ((v867 (module-variable (if module866 (resolve-module (cdr module866)) (current-module)) symbol865))) (and v867 (variable-bound? v867) (let ((val868 (variable-ref v867))) (and (macro? val868) (syncase-macro-type val868) (cons (syncase-macro-type val868) (syncase-macro-binding val868))))))))) (put-global-definition-hook76 (lambda (symbol869 type870 val871) (let ((existing872 (let ((v873 (module-variable (current-module) symbol869))) (and v873 (variable-bound? v873) (let ((val874 (variable-ref v873))) (and (macro? val874) (not (syncase-macro-type val874)) val874)))))) (module-define! (current-module) symbol869 (if existing872 (make-extended-syncase-macro existing872 type870 val871) (make-syncase-macro type870 val871)))))) (local-eval-hook75 (lambda (x875 mod876) (primitive-eval (list noexpand69 x875)))) (top-level-eval-hook74 (lambda (x877 mod878) (primitive-eval (list noexpand69 x877)))) (fx<73 <) (fx=72 =) (fx-71 -) (fx+70 +) (noexpand69 "noexpand")) (begin (global-extend99 (quote local-syntax) (quote letrec-syntax) #t) (global-extend99 (quote local-syntax) (quote let-syntax) #f) (global-extend99 (quote core) (quote fluid-let-syntax) (lambda (e879 r880 w881 s882 mod883) ((lambda (tmp884) ((lambda (tmp885) (if (if tmp885 (apply (lambda (_886 var887 val888 e1889 e2890) (valid-bound-ids?126 var887)) tmp885) #f) (apply (lambda (_892 var893 val894 e1895 e2896) (let ((names897 (map (lambda (x898) (id-var-name123 x898 w881)) var893))) (begin (for-each (lambda (id900 n901) (let ((t902 (binding-type93 (lookup98 n901 r880 mod883)))) (if (memv t902 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e879 (source-wrap130 id900 w881 s882 mod883))))) var893 names897) (chi-body141 (cons e1895 e2896) (source-wrap130 e879 w881 s882 mod883) (extend-env95 names897 (let ((trans-r905 (macros-only-env97 r880))) (map (lambda (x906) (cons (quote macro) (eval-local-transformer144 (chi137 x906 trans-r905 w881 mod883) mod883))) val894)) r880) w881 mod883)))) tmp885) ((lambda (_908) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap130 e879 w881 s882 mod883))) tmp884))) ($sc-dispatch tmp884 (quote (any #(each (any any)) any . each-any))))) e879))) (global-extend99 (quote core) (quote quote) (lambda (e909 r910 w911 s912 mod913) ((lambda (tmp914) ((lambda (tmp915) (if tmp915 (apply (lambda (_916 e917) (build-data79 s912 (strip148 e917 w911))) tmp915) ((lambda (_918) (syntax-violation (quote quote) "bad syntax" (source-wrap130 e909 w911 s912 mod913))) tmp914))) ($sc-dispatch tmp914 (quote (any any))))) e909))) (global-extend99 (quote core) (quote syntax) (letrec ((regen926 (lambda (x927) (let ((t928 (car x927))) (if (memv t928 (quote (ref))) (build-annotated78 #f (cadr x927)) (if (memv t928 (quote (primitive))) (build-annotated78 #f (cadr x927)) (if (memv t928 (quote (quote))) (build-data79 #f (cadr x927)) (if (memv t928 (quote (lambda))) (build-annotated78 #f (list (quote lambda) (cadr x927) (regen926 (caddr x927)))) (if (memv t928 (quote (map))) (let ((ls929 (map regen926 (cdr x927)))) (build-annotated78 #f (cons (if (fx=72 (length ls929) 2) (build-annotated78 #f (quote map)) (build-annotated78 #f (quote map))) ls929))) (build-annotated78 #f (cons (build-annotated78 #f (car x927)) (map regen926 (cdr x927)))))))))))) (gen-vector925 (lambda (x930) (cond ((eq? (car x930) (quote list)) (cons (quote vector) (cdr x930))) ((eq? (car x930) (quote quote)) (list (quote quote) (list->vector (cadr x930)))) (else (list (quote list->vector) x930))))) (gen-append924 (lambda (x931 y932) (if (equal? y932 (quote (quote ()))) x931 (list (quote append) x931 y932)))) (gen-cons923 (lambda (x933 y934) (let ((t935 (car y934))) (if (memv t935 (quote (quote))) (if (eq? (car x933) (quote quote)) (list (quote quote) (cons (cadr x933) (cadr y934))) (if (eq? (cadr y934) (quote ())) (list (quote list) x933) (list (quote cons) x933 y934))) (if (memv t935 (quote (list))) (cons (quote list) (cons x933 (cdr y934))) (list (quote cons) x933 y934)))))) (gen-map922 (lambda (e936 map-env937) (let ((formals938 (map cdr map-env937)) (actuals939 (map (lambda (x940) (list (quote ref) (car x940))) map-env937))) (cond ((eq? (car e936) (quote ref)) (car actuals939)) ((and-map (lambda (x941) (and (eq? (car x941) (quote ref)) (memq (cadr x941) formals938))) (cdr e936)) (cons (quote map) (cons (list (quote primitive) (car e936)) (map (let ((r942 (map cons formals938 actuals939))) (lambda (x943) (cdr (assq (cadr x943) r942)))) (cdr e936))))) (else (cons (quote map) (cons (list (quote lambda) formals938 e936) actuals939))))))) (gen-mappend921 (lambda (e944 map-env945) (list (quote apply) (quote (primitive append)) (gen-map922 e944 map-env945)))) (gen-ref920 (lambda (src946 var947 level948 maps949) (if (fx=72 level948 0) (values var947 maps949) (if (null? maps949) (syntax-violation (quote syntax) "missing ellipsis" src946) (call-with-values (lambda () (gen-ref920 src946 var947 (fx-71 level948 1) (cdr maps949))) (lambda (outer-var950 outer-maps951) (let ((b952 (assq outer-var950 (car maps949)))) (if b952 (values (cdr b952) maps949) (let ((inner-var953 (gen-var149 (quote tmp)))) (values inner-var953 (cons (cons (cons outer-var950 inner-var953) (car maps949)) outer-maps951))))))))))) (gen-syntax919 (lambda (src954 e955 r956 maps957 ellipsis?958 mod959) (if (id?101 e955) (let ((label960 (id-var-name123 e955 (quote (()))))) (let ((b961 (lookup98 label960 r956 mod959))) (if (eq? (binding-type93 b961) (quote syntax)) (call-with-values (lambda () (let ((var.lev962 (binding-value94 b961))) (gen-ref920 src954 (car var.lev962) (cdr var.lev962) maps957))) (lambda (var963 maps964) (values (list (quote ref) var963) maps964))) (if (ellipsis?958 e955) (syntax-violation (quote syntax) "misplaced ellipsis" src954) (values (list (quote quote) e955) maps957))))) ((lambda (tmp965) ((lambda (tmp966) (if (if tmp966 (apply (lambda (dots967 e968) (ellipsis?958 dots967)) tmp966) #f) (apply (lambda (dots969 e970) (gen-syntax919 src954 e970 r956 maps957 (lambda (x971) #f) mod959)) tmp966) ((lambda (tmp972) (if (if tmp972 (apply (lambda (x973 dots974 y975) (ellipsis?958 dots974)) tmp972) #f) (apply (lambda (x976 dots977 y978) (let f979 ((y980 y978) (k981 (lambda (maps982) (call-with-values (lambda () (gen-syntax919 src954 x976 r956 (cons (quote ()) maps982) ellipsis?958 mod959)) (lambda (x983 maps984) (if (null? (car maps984)) (syntax-violation (quote syntax) "extra ellipsis" src954) (values (gen-map922 x983 (car maps984)) (cdr maps984)))))))) ((lambda (tmp985) ((lambda (tmp986) (if (if tmp986 (apply (lambda (dots987 y988) (ellipsis?958 dots987)) tmp986) #f) (apply (lambda (dots989 y990) (f979 y990 (lambda (maps991) (call-with-values (lambda () (k981 (cons (quote ()) maps991))) (lambda (x992 maps993) (if (null? (car maps993)) (syntax-violation (quote syntax) "extra ellipsis" src954) (values (gen-mappend921 x992 (car maps993)) (cdr maps993)))))))) tmp986) ((lambda (_994) (call-with-values (lambda () (gen-syntax919 src954 y980 r956 maps957 ellipsis?958 mod959)) (lambda (y995 maps996) (call-with-values (lambda () (k981 maps996)) (lambda (x997 maps998) (values (gen-append924 x997 y995) maps998)))))) tmp985))) ($sc-dispatch tmp985 (quote (any . any))))) y980))) tmp972) ((lambda (tmp999) (if tmp999 (apply (lambda (x1000 y1001) (call-with-values (lambda () (gen-syntax919 src954 x1000 r956 maps957 ellipsis?958 mod959)) (lambda (x1002 maps1003) (call-with-values (lambda () (gen-syntax919 src954 y1001 r956 maps1003 ellipsis?958 mod959)) (lambda (y1004 maps1005) (values (gen-cons923 x1002 y1004) maps1005)))))) tmp999) ((lambda (tmp1006) (if tmp1006 (apply (lambda (e11007 e21008) (call-with-values (lambda () (gen-syntax919 src954 (cons e11007 e21008) r956 maps957 ellipsis?958 mod959)) (lambda (e1010 maps1011) (values (gen-vector925 e1010) maps1011)))) tmp1006) ((lambda (_1012) (values (list (quote quote) e955) maps957)) tmp965))) ($sc-dispatch tmp965 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp965 (quote (any . any)))))) ($sc-dispatch tmp965 (quote (any any . any)))))) ($sc-dispatch tmp965 (quote (any any))))) e955))))) (lambda (e1013 r1014 w1015 s1016 mod1017) (let ((e1018 (source-wrap130 e1013 w1015 s1016 mod1017))) ((lambda (tmp1019) ((lambda (tmp1020) (if tmp1020 (apply (lambda (_1021 x1022) (call-with-values (lambda () (gen-syntax919 e1018 x1022 r1014 (quote ()) ellipsis?146 mod1017)) (lambda (e1023 maps1024) (regen926 e1023)))) tmp1020) ((lambda (_1025) (syntax-violation (quote syntax) "bad `syntax' form" e1018)) tmp1019))) ($sc-dispatch tmp1019 (quote (any any))))) e1018))))) (global-extend99 (quote core) (quote lambda) (lambda (e1026 r1027 w1028 s1029 mod1030) ((lambda (tmp1031) ((lambda (tmp1032) (if tmp1032 (apply (lambda (_1033 c1034) (chi-lambda-clause142 (source-wrap130 e1026 w1028 s1029 mod1030) #f c1034 r1027 w1028 mod1030 (lambda (vars1035 docstring1036 body1037) (build-annotated78 s1029 (cons (quote lambda) (cons vars1035 (append (if docstring1036 (list docstring1036) (quote ())) (list body1037)))))))) tmp1032) (syntax-violation #f "source expression failed to match any pattern" tmp1031))) ($sc-dispatch tmp1031 (quote (any . any))))) e1026))) (global-extend99 (quote core) (quote let) (letrec ((chi-let1038 (lambda (e1039 r1040 w1041 s1042 mod1043 constructor1044 ids1045 vals1046 exps1047) (if (not (valid-bound-ids?126 ids1045)) (syntax-violation (quote let) "duplicate bound variable" e1039) (let ((labels1048 (gen-labels107 ids1045)) (new-vars1049 (map gen-var149 ids1045))) (let ((nw1050 (make-binding-wrap118 ids1045 labels1048 w1041)) (nr1051 (extend-var-env96 labels1048 new-vars1049 r1040))) (constructor1044 s1042 new-vars1049 (map (lambda (x1052) (chi137 x1052 r1040 w1041 mod1043)) vals1046) (chi-body141 exps1047 (source-wrap130 e1039 nw1050 s1042 mod1043) nr1051 nw1050 mod1043)))))))) (lambda (e1053 r1054 w1055 s1056 mod1057) ((lambda (tmp1058) ((lambda (tmp1059) (if tmp1059 (apply (lambda (_1060 id1061 val1062 e11063 e21064) (chi-let1038 e1053 r1054 w1055 s1056 mod1057 build-let81 id1061 val1062 (cons e11063 e21064))) tmp1059) ((lambda (tmp1068) (if (if tmp1068 (apply (lambda (_1069 f1070 id1071 val1072 e11073 e21074) (id?101 f1070)) tmp1068) #f) (apply (lambda (_1075 f1076 id1077 val1078 e11079 e21080) (chi-let1038 e1053 r1054 w1055 s1056 mod1057 build-named-let82 (cons f1076 id1077) val1078 (cons e11079 e21080))) tmp1068) ((lambda (_1084) (syntax-violation (quote let) "bad let" (source-wrap130 e1053 w1055 s1056 mod1057))) tmp1058))) ($sc-dispatch tmp1058 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1058 (quote (any #(each (any any)) any . each-any))))) e1053)))) (global-extend99 (quote core) (quote letrec) (lambda (e1085 r1086 w1087 s1088 mod1089) ((lambda (tmp1090) ((lambda (tmp1091) (if tmp1091 (apply (lambda (_1092 id1093 val1094 e11095 e21096) (let ((ids1097 id1093)) (if (not (valid-bound-ids?126 ids1097)) (syntax-violation (quote letrec) "duplicate bound variable" e1085) (let ((labels1099 (gen-labels107 ids1097)) (new-vars1100 (map gen-var149 ids1097))) (let ((w1101 (make-binding-wrap118 ids1097 labels1099 w1087)) (r1102 (extend-var-env96 labels1099 new-vars1100 r1086))) (build-letrec83 s1088 new-vars1100 (map (lambda (x1103) (chi137 x1103 r1102 w1101 mod1089)) val1094) (chi-body141 (cons e11095 e21096) (source-wrap130 e1085 w1101 s1088 mod1089) r1102 w1101 mod1089))))))) tmp1091) ((lambda (_1106) (syntax-violation (quote letrec) "bad letrec" (source-wrap130 e1085 w1087 s1088 mod1089))) tmp1090))) ($sc-dispatch tmp1090 (quote (any #(each (any any)) any . each-any))))) e1085))) (global-extend99 (quote core) (quote set!) (lambda (e1107 r1108 w1109 s1110 mod1111) ((lambda (tmp1112) ((lambda (tmp1113) (if (if tmp1113 (apply (lambda (_1114 id1115 val1116) (id?101 id1115)) tmp1113) #f) (apply (lambda (_1117 id1118 val1119) (let ((val1120 (chi137 val1119 r1108 w1109 mod1111)) (n1121 (id-var-name123 id1118 w1109))) (let ((b1122 (lookup98 n1121 r1108 mod1111))) (let ((t1123 (binding-type93 b1122))) (if (memv t1123 (quote (lexical))) (build-annotated78 s1110 (list (quote set!) (binding-value94 b1122) val1120)) (if (memv t1123 (quote (global))) (build-annotated78 s1110 (list (quote set!) (if mod1111 (make-module-ref (cdr mod1111) n1121 (car mod1111)) (make-module-ref mod1111 n1121 (quote bare))) val1120)) (if (memv t1123 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap129 id1118 w1109 mod1111)) (syntax-violation (quote set!) "bad set!" (source-wrap130 e1107 w1109 s1110 mod1111))))))))) tmp1113) ((lambda (tmp1124) (if tmp1124 (apply (lambda (_1125 head1126 tail1127 val1128) (call-with-values (lambda () (syntax-type135 head1126 r1108 (quote (())) #f #f mod1111)) (lambda (type1129 value1130 ee1131 ww1132 ss1133 modmod1134) (let ((t1135 type1129)) (if (memv t1135 (quote (module-ref))) (let ((val1136 (chi137 val1128 r1108 w1109 mod1111))) (call-with-values (lambda () (value1130 (cons head1126 tail1127))) (lambda (id1138 mod1139) (build-annotated78 s1110 (list (quote set!) (if mod1139 (make-module-ref (cdr mod1139) id1138 (car mod1139)) (make-module-ref mod1139 id1138 (quote bare))) val1136))))) (build-annotated78 s1110 (cons (chi137 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1126) r1108 w1109 mod1111) (map (lambda (e1140) (chi137 e1140 r1108 w1109 mod1111)) (append tail1127 (list val1128)))))))))) tmp1124) ((lambda (_1142) (syntax-violation (quote set!) "bad set!" (source-wrap130 e1107 w1109 s1110 mod1111))) tmp1112))) ($sc-dispatch tmp1112 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1112 (quote (any any any))))) e1107))) (global-extend99 (quote module-ref) (quote @) (lambda (e1143) ((lambda (tmp1144) ((lambda (tmp1145) (if (if tmp1145 (apply (lambda (_1146 mod1147 id1148) (and (and-map id?101 mod1147) (id?101 id1148))) tmp1145) #f) (apply (lambda (_1150 mod1151 id1152) (values (syntax->datum id1152) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1151)))) tmp1145) (syntax-violation #f "source expression failed to match any pattern" tmp1144))) ($sc-dispatch tmp1144 (quote (any each-any any))))) e1143))) (global-extend99 (quote module-ref) (quote @@) (lambda (e1154) ((lambda (tmp1155) ((lambda (tmp1156) (if (if tmp1156 (apply (lambda (_1157 mod1158 id1159) (and (and-map id?101 mod1158) (id?101 id1159))) tmp1156) #f) (apply (lambda (_1161 mod1162 id1163) (values (syntax->datum id1163) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1162)))) tmp1156) (syntax-violation #f "source expression failed to match any pattern" tmp1155))) ($sc-dispatch tmp1155 (quote (any each-any any))))) e1154))) (global-extend99 (quote begin) (quote begin) (quote ())) (global-extend99 (quote define) (quote define) (quote ())) (global-extend99 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend99 (quote eval-when) (quote eval-when) (quote ())) (global-extend99 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1168 (lambda (x1169 keys1170 clauses1171 r1172 mod1173) (if (null? clauses1171) (build-annotated78 #f (list (build-annotated78 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x1169)) ((lambda (tmp1174) ((lambda (tmp1175) (if tmp1175 (apply (lambda (pat1176 exp1177) (if (and (id?101 pat1176) (and-map (lambda (x1178) (not (free-id=?124 pat1176 x1178))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1170))) (let ((labels1179 (list (gen-label106))) (var1180 (gen-var149 pat1176))) (build-annotated78 #f (list (build-annotated78 #f (list (quote lambda) (list var1180) (chi137 exp1177 (extend-env95 labels1179 (list (cons (quote syntax) (cons var1180 0))) r1172) (make-binding-wrap118 (list pat1176) labels1179 (quote (()))) mod1173))) x1169))) (gen-clause1167 x1169 keys1170 (cdr clauses1171) r1172 pat1176 #t exp1177 mod1173))) tmp1175) ((lambda (tmp1181) (if tmp1181 (apply (lambda (pat1182 fender1183 exp1184) (gen-clause1167 x1169 keys1170 (cdr clauses1171) r1172 pat1182 fender1183 exp1184 mod1173)) tmp1181) ((lambda (_1185) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1171))) tmp1174))) ($sc-dispatch tmp1174 (quote (any any any)))))) ($sc-dispatch tmp1174 (quote (any any))))) (car clauses1171))))) (gen-clause1167 (lambda (x1186 keys1187 clauses1188 r1189 pat1190 fender1191 exp1192 mod1193) (call-with-values (lambda () (convert-pattern1165 pat1190 keys1187)) (lambda (p1194 pvars1195) (cond ((not (distinct-bound-ids?127 (map car pvars1195))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1190)) ((not (and-map (lambda (x1196) (not (ellipsis?146 (car x1196)))) pvars1195)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1190)) (else (let ((y1197 (gen-var149 (quote tmp)))) (build-annotated78 #f (list (build-annotated78 #f (list (quote lambda) (list y1197) (let ((y1198 (build-annotated78 #f y1197))) (build-annotated78 #f (list (quote if) ((lambda (tmp1199) ((lambda (tmp1200) (if tmp1200 (apply (lambda () y1198) tmp1200) ((lambda (_1201) (build-annotated78 #f (list (quote if) y1198 (build-dispatch-call1166 pvars1195 fender1191 y1198 r1189 mod1193) (build-data79 #f #f)))) tmp1199))) ($sc-dispatch tmp1199 (quote #(atom #t))))) fender1191) (build-dispatch-call1166 pvars1195 exp1192 y1198 r1189 mod1193) (gen-syntax-case1168 x1186 keys1187 clauses1188 r1189 mod1193)))))) (if (eq? p1194 (quote any)) (build-annotated78 #f (list (build-annotated78 #f (quote list)) x1186)) (build-annotated78 #f (list (build-annotated78 #f (quote $sc-dispatch)) x1186 (build-data79 #f p1194))))))))))))) (build-dispatch-call1166 (lambda (pvars1202 exp1203 y1204 r1205 mod1206) (let ((ids1207 (map car pvars1202)) (levels1208 (map cdr pvars1202))) (let ((labels1209 (gen-labels107 ids1207)) (new-vars1210 (map gen-var149 ids1207))) (build-annotated78 #f (list (build-annotated78 #f (quote apply)) (build-annotated78 #f (list (quote lambda) new-vars1210 (chi137 exp1203 (extend-env95 labels1209 (map (lambda (var1211 level1212) (cons (quote syntax) (cons var1211 level1212))) new-vars1210 (map cdr pvars1202)) r1205) (make-binding-wrap118 ids1207 labels1209 (quote (()))) mod1206))) y1204)))))) (convert-pattern1165 (lambda (pattern1213 keys1214) (let cvt1215 ((p1216 pattern1213) (n1217 0) (ids1218 (quote ()))) (if (id?101 p1216) (if (bound-id-member?128 p1216 keys1214) (values (vector (quote free-id) p1216) ids1218) (values (quote any) (cons (cons p1216 n1217) ids1218))) ((lambda (tmp1219) ((lambda (tmp1220) (if (if tmp1220 (apply (lambda (x1221 dots1222) (ellipsis?146 dots1222)) tmp1220) #f) (apply (lambda (x1223 dots1224) (call-with-values (lambda () (cvt1215 x1223 (fx+70 n1217 1) ids1218)) (lambda (p1225 ids1226) (values (if (eq? p1225 (quote any)) (quote each-any) (vector (quote each) p1225)) ids1226)))) tmp1220) ((lambda (tmp1227) (if tmp1227 (apply (lambda (x1228 y1229) (call-with-values (lambda () (cvt1215 y1229 n1217 ids1218)) (lambda (y1230 ids1231) (call-with-values (lambda () (cvt1215 x1228 n1217 ids1231)) (lambda (x1232 ids1233) (values (cons x1232 y1230) ids1233)))))) tmp1227) ((lambda (tmp1234) (if tmp1234 (apply (lambda () (values (quote ()) ids1218)) tmp1234) ((lambda (tmp1235) (if tmp1235 (apply (lambda (x1236) (call-with-values (lambda () (cvt1215 x1236 n1217 ids1218)) (lambda (p1238 ids1239) (values (vector (quote vector) p1238) ids1239)))) tmp1235) ((lambda (x1240) (values (vector (quote atom) (strip148 p1216 (quote (())))) ids1218)) tmp1219))) ($sc-dispatch tmp1219 (quote #(vector each-any)))))) ($sc-dispatch tmp1219 (quote ()))))) ($sc-dispatch tmp1219 (quote (any . any)))))) ($sc-dispatch tmp1219 (quote (any any))))) p1216)))))) (lambda (e1241 r1242 w1243 s1244 mod1245) (let ((e1246 (source-wrap130 e1241 w1243 s1244 mod1245))) ((lambda (tmp1247) ((lambda (tmp1248) (if tmp1248 (apply (lambda (_1249 val1250 key1251 m1252) (if (and-map (lambda (x1253) (and (id?101 x1253) (not (ellipsis?146 x1253)))) key1251) (let ((x1255 (gen-var149 (quote tmp)))) (build-annotated78 s1244 (list (build-annotated78 #f (list (quote lambda) (list x1255) (gen-syntax-case1168 (build-annotated78 #f x1255) key1251 m1252 r1242 mod1245))) (chi137 val1250 r1242 (quote (())) mod1245)))) (syntax-violation (quote syntax-case) "invalid literals list" e1246))) tmp1248) (syntax-violation #f "source expression failed to match any pattern" tmp1247))) ($sc-dispatch tmp1247 (quote (any any each-any . each-any))))) e1246))))) (set! sc-expand (let ((m1258 (quote e)) (esew1259 (quote (eval)))) (lambda (x1260) (if (and (pair? x1260) (equal? (car x1260) noexpand69)) (cadr x1260) (chi-top136 x1260 (quote ()) (quote ((top))) m1258 esew1259 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m1261 (quote e)) (esew1262 (quote (eval)))) (lambda (x1264 . rest1263) (if (and (pair? x1264) (equal? (car x1264) noexpand69)) (cadr x1264) (chi-top136 x1264 (quote ()) (quote ((top))) (if (null? rest1263) m1261 (car rest1263)) (if (or (null? rest1263) (null? (cdr rest1263))) esew1262 (cadr rest1263)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x1265) (nonsymbol-id?100 x1265))) (set! datum->syntax (lambda (id1266 datum1267) (make-syntax-object84 datum1267 (syntax-object-wrap87 id1266) #f))) (set! syntax->datum (lambda (x1268) (strip148 x1268 (quote (()))))) (set! generate-temporaries (lambda (ls1269) (begin (let ((x1270 ls1269)) (if (not (list? x1270)) (syntax-violation (quote generate-temporaries) "invalid argument" x1270))) (map (lambda (x1271) (wrap129 (gensym) (quote ((top))) #f)) ls1269)))) (set! free-identifier=? (lambda (x1272 y1273) (begin (let ((x1274 x1272)) (if (not (nonsymbol-id?100 x1274)) (syntax-violation (quote free-identifier=?) "invalid argument" x1274))) (let ((x1275 y1273)) (if (not (nonsymbol-id?100 x1275)) (syntax-violation (quote free-identifier=?) "invalid argument" x1275))) (free-id=?124 x1272 y1273)))) (set! bound-identifier=? (lambda (x1276 y1277) (begin (let ((x1278 x1276)) (if (not (nonsymbol-id?100 x1278)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1278))) (let ((x1279 y1277)) (if (not (nonsymbol-id?100 x1279)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1279))) (bound-id=?125 x1276 y1277)))) (set! syntax-violation (lambda (who1283 message1282 form1281 . subform1280) (begin (let ((x1284 who1283)) (if (not ((lambda (x1285) (or (not x1285) (string? x1285) (symbol? x1285))) x1284)) (syntax-violation (quote syntax-violation) "invalid argument" x1284))) (let ((x1286 message1282)) (if (not (string? x1286)) (syntax-violation (quote syntax-violation) "invalid argument" x1286))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1283 "~a: " "") "~a " (if (null? subform1280) "in ~a" "in subform `~s' of `~s'")) (let ((tail1287 (cons message1282 (map (lambda (x1288) (strip148 x1288 (quote (())))) (append subform1280 (list form1281)))))) (if who1283 (cons who1283 tail1287) tail1287)) #f)))) (letrec ((match1293 (lambda (e1294 p1295 w1296 r1297 mod1298) (cond ((not r1297) #f) ((eq? p1295 (quote any)) (cons (wrap129 e1294 w1296 mod1298) r1297)) ((syntax-object?85 e1294) (match*1292 (let ((e1299 (syntax-object-expression86 e1294))) (if (annotation? e1299) (annotation-expression e1299) e1299)) p1295 (join-wraps120 w1296 (syntax-object-wrap87 e1294)) r1297 (syntax-object-module88 e1294))) (else (match*1292 (let ((e1300 e1294)) (if (annotation? e1300) (annotation-expression e1300) e1300)) p1295 w1296 r1297 mod1298))))) (match*1292 (lambda (e1301 p1302 w1303 r1304 mod1305) (cond ((null? p1302) (and (null? e1301) r1304)) ((pair? p1302) (and (pair? e1301) (match1293 (car e1301) (car p1302) w1303 (match1293 (cdr e1301) (cdr p1302) w1303 r1304 mod1305) mod1305))) ((eq? p1302 (quote each-any)) (let ((l1306 (match-each-any1290 e1301 w1303 mod1305))) (and l1306 (cons l1306 r1304)))) (else (let ((t1307 (vector-ref p1302 0))) (if (memv t1307 (quote (each))) (if (null? e1301) (match-empty1291 (vector-ref p1302 1) r1304) (let ((l1308 (match-each1289 e1301 (vector-ref p1302 1) w1303 mod1305))) (and l1308 (let collect1309 ((l1310 l1308)) (if (null? (car l1310)) r1304 (cons (map car l1310) (collect1309 (map cdr l1310)))))))) (if (memv t1307 (quote (free-id))) (and (id?101 e1301) (free-id=?124 (wrap129 e1301 w1303 mod1305) (vector-ref p1302 1)) r1304) (if (memv t1307 (quote (atom))) (and (equal? (vector-ref p1302 1) (strip148 e1301 w1303)) r1304) (if (memv t1307 (quote (vector))) (and (vector? e1301) (match1293 (vector->list e1301) (vector-ref p1302 1) w1303 r1304 mod1305))))))))))) (match-empty1291 (lambda (p1311 r1312) (cond ((null? p1311) r1312) ((eq? p1311 (quote any)) (cons (quote ()) r1312)) ((pair? p1311) (match-empty1291 (car p1311) (match-empty1291 (cdr p1311) r1312))) ((eq? p1311 (quote each-any)) (cons (quote ()) r1312)) (else (let ((t1313 (vector-ref p1311 0))) (if (memv t1313 (quote (each))) (match-empty1291 (vector-ref p1311 1) r1312) (if (memv t1313 (quote (free-id atom))) r1312 (if (memv t1313 (quote (vector))) (match-empty1291 (vector-ref p1311 1) r1312))))))))) (match-each-any1290 (lambda (e1314 w1315 mod1316) (cond ((annotation? e1314) (match-each-any1290 (annotation-expression e1314) w1315 mod1316)) ((pair? e1314) (let ((l1317 (match-each-any1290 (cdr e1314) w1315 mod1316))) (and l1317 (cons (wrap129 (car e1314) w1315 mod1316) l1317)))) ((null? e1314) (quote ())) ((syntax-object?85 e1314) (match-each-any1290 (syntax-object-expression86 e1314) (join-wraps120 w1315 (syntax-object-wrap87 e1314)) mod1316)) (else #f)))) (match-each1289 (lambda (e1318 p1319 w1320 mod1321) (cond ((annotation? e1318) (match-each1289 (annotation-expression e1318) p1319 w1320 mod1321)) ((pair? e1318) (let ((first1322 (match1293 (car e1318) p1319 w1320 (quote ()) mod1321))) (and first1322 (let ((rest1323 (match-each1289 (cdr e1318) p1319 w1320 mod1321))) (and rest1323 (cons first1322 rest1323)))))) ((null? e1318) (quote ())) ((syntax-object?85 e1318) (match-each1289 (syntax-object-expression86 e1318) p1319 (join-wraps120 w1320 (syntax-object-wrap87 e1318)) (syntax-object-module88 e1318))) (else #f))))) (set! $sc-dispatch (lambda (e1324 p1325) (cond ((eq? p1325 (quote any)) (list e1324)) ((syntax-object?85 e1324) (match*1292 (let ((e1326 (syntax-object-expression86 e1324))) (if (annotation? e1326) (annotation-expression e1326) e1326)) p1325 (syntax-object-wrap87 e1324) (quote ()) (syntax-object-module88 e1324))) (else (match*1292 (let ((e1327 e1324)) (if (annotation? e1327) (annotation-expression e1327) e1327)) p1325 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x1328) ((lambda (tmp1329) ((lambda (tmp1330) (if tmp1330 (apply (lambda (_1331 e11332 e21333) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11332 e21333))) tmp1330) ((lambda (tmp1335) (if tmp1335 (apply (lambda (_1336 out1337 in1338 e11339 e21340) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1338 (quote ()) (list out1337 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11339 e21340))))) tmp1335) ((lambda (tmp1342) (if tmp1342 (apply (lambda (_1343 out1344 in1345 e11346 e21347) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1345) (quote ()) (list out1344 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11346 e21347))))) tmp1342) (syntax-violation #f "source expression failed to match any pattern" tmp1329))) ($sc-dispatch tmp1329 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1329 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1329 (quote (any () any . each-any))))) x1328))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1351) ((lambda (tmp1352) ((lambda (tmp1353) (if tmp1353 (apply (lambda (_1354 k1355 keyword1356 pattern1357 template1358) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k1355 (map (lambda (tmp1361 tmp1360) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1360) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1361))) template1358 pattern1357)))))) tmp1353) (syntax-violation #f "source expression failed to match any pattern" tmp1352))) ($sc-dispatch tmp1352 (quote (any each-any . #(each ((any . any) any))))))) x1351))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1362) ((lambda (tmp1363) ((lambda (tmp1364) (if (if tmp1364 (apply (lambda (let*1365 x1366 v1367 e11368 e21369) (and-map identifier? x1366)) tmp1364) #f) (apply (lambda (let*1371 x1372 v1373 e11374 e21375) (let f1376 ((bindings1377 (map list x1372 v1373))) (if (null? bindings1377) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11374 e21375))) ((lambda (tmp1381) ((lambda (tmp1382) (if tmp1382 (apply (lambda (body1383 binding1384) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding1384) body1383)) tmp1382) (syntax-violation #f "source expression failed to match any pattern" tmp1381))) ($sc-dispatch tmp1381 (quote (any any))))) (list (f1376 (cdr bindings1377)) (car bindings1377)))))) tmp1364) (syntax-violation #f "source expression failed to match any pattern" tmp1363))) ($sc-dispatch tmp1363 (quote (any #(each (any any)) any . each-any))))) x1362))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1385) ((lambda (tmp1386) ((lambda (tmp1387) (if tmp1387 (apply (lambda (_1388 var1389 init1390 step1391 e01392 e11393 c1394) ((lambda (tmp1395) ((lambda (tmp1396) (if tmp1396 (apply (lambda (step1397) ((lambda (tmp1398) ((lambda (tmp1399) (if tmp1399 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1389 init1390) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01392) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1394 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1397))))))) tmp1399) ((lambda (tmp1404) (if tmp1404 (apply (lambda (e11405 e21406) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1389 init1390) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01392 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e11405 e21406)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1394 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1397))))))) tmp1404) (syntax-violation #f "source expression failed to match any pattern" tmp1398))) ($sc-dispatch tmp1398 (quote (any . each-any)))))) ($sc-dispatch tmp1398 (quote ())))) e11393)) tmp1396) (syntax-violation #f "source expression failed to match any pattern" tmp1395))) ($sc-dispatch tmp1395 (quote each-any)))) (map (lambda (v1413 s1414) ((lambda (tmp1415) ((lambda (tmp1416) (if tmp1416 (apply (lambda () v1413) tmp1416) ((lambda (tmp1417) (if tmp1417 (apply (lambda (e1418) e1418) tmp1417) ((lambda (_1419) (syntax-violation (quote do) "bad step expression" orig-x1385 s1414)) tmp1415))) ($sc-dispatch tmp1415 (quote (any)))))) ($sc-dispatch tmp1415 (quote ())))) s1414)) var1389 step1391))) tmp1387) (syntax-violation #f "source expression failed to match any pattern" tmp1386))) ($sc-dispatch tmp1386 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1385))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1422 (lambda (x1426 y1427) ((lambda (tmp1428) ((lambda (tmp1429) (if tmp1429 (apply (lambda (x1430 y1431) ((lambda (tmp1432) ((lambda (tmp1433) (if tmp1433 (apply (lambda (dy1434) ((lambda (tmp1435) ((lambda (tmp1436) (if tmp1436 (apply (lambda (dx1437) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx1437 dy1434))) tmp1436) ((lambda (_1438) (if (null? dy1434) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1430) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1430 y1431))) tmp1435))) ($sc-dispatch tmp1435 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x1430)) tmp1433) ((lambda (tmp1439) (if tmp1439 (apply (lambda (stuff1440) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1430 stuff1440))) tmp1439) ((lambda (else1441) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1430 y1431)) tmp1432))) ($sc-dispatch tmp1432 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1432 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y1431)) tmp1429) (syntax-violation #f "source expression failed to match any pattern" tmp1428))) ($sc-dispatch tmp1428 (quote (any any))))) (list x1426 y1427)))) (quasiappend1423 (lambda (x1442 y1443) ((lambda (tmp1444) ((lambda (tmp1445) (if tmp1445 (apply (lambda (x1446 y1447) ((lambda (tmp1448) ((lambda (tmp1449) (if tmp1449 (apply (lambda () x1446) tmp1449) ((lambda (_1450) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1446 y1447)) tmp1448))) ($sc-dispatch tmp1448 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1447)) tmp1445) (syntax-violation #f "source expression failed to match any pattern" tmp1444))) ($sc-dispatch tmp1444 (quote (any any))))) (list x1442 y1443)))) (quasivector1424 (lambda (x1451) ((lambda (tmp1452) ((lambda (x1453) ((lambda (tmp1454) ((lambda (tmp1455) (if tmp1455 (apply (lambda (x1456) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x1456))) tmp1455) ((lambda (tmp1458) (if tmp1458 (apply (lambda (x1459) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1459)) tmp1458) ((lambda (_1461) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1453)) tmp1454))) ($sc-dispatch tmp1454 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp1454 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x1453)) tmp1452)) x1451))) (quasi1425 (lambda (p1462 lev1463) ((lambda (tmp1464) ((lambda (tmp1465) (if tmp1465 (apply (lambda (p1466) (if (= lev1463 0) p1466 (quasicons1422 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1425 (list p1466) (- lev1463 1))))) tmp1465) ((lambda (tmp1467) (if tmp1467 (apply (lambda (p1468 q1469) (if (= lev1463 0) (quasiappend1423 p1468 (quasi1425 q1469 lev1463)) (quasicons1422 (quasicons1422 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1425 (list p1468) (- lev1463 1))) (quasi1425 q1469 lev1463)))) tmp1467) ((lambda (tmp1470) (if tmp1470 (apply (lambda (p1471) (quasicons1422 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1425 (list p1471) (+ lev1463 1)))) tmp1470) ((lambda (tmp1472) (if tmp1472 (apply (lambda (p1473 q1474) (quasicons1422 (quasi1425 p1473 lev1463) (quasi1425 q1474 lev1463))) tmp1472) ((lambda (tmp1475) (if tmp1475 (apply (lambda (x1476) (quasivector1424 (quasi1425 x1476 lev1463))) tmp1475) ((lambda (p1478) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p1478)) tmp1464))) ($sc-dispatch tmp1464 (quote #(vector each-any)))))) ($sc-dispatch tmp1464 (quote (any . any)))))) ($sc-dispatch tmp1464 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp1464 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1464 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p1462)))) (lambda (x1479) ((lambda (tmp1480) ((lambda (tmp1481) (if tmp1481 (apply (lambda (_1482 e1483) (quasi1425 e1483 0)) tmp1481) (syntax-violation #f "source expression failed to match any pattern" tmp1480))) ($sc-dispatch tmp1480 (quote (any any))))) x1479)))))
+(define include (make-syncase-macro (quote macro) (lambda (x1484) (letrec ((read-file1485 (lambda (fn1486 k1487) (let ((p1488 (open-input-file fn1486))) (let f1489 ((x1490 (read p1488))) (if (eof-object? x1490) (begin (close-input-port p1488) (quote ())) (cons (datum->syntax k1487 x1490) (f1489 (read p1488))))))))) ((lambda (tmp1491) ((lambda (tmp1492) (if tmp1492 (apply (lambda (k1493 filename1494) (let ((fn1495 (syntax->datum filename1494))) ((lambda (tmp1496) ((lambda (tmp1497) (if tmp1497 (apply (lambda (exp1498) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp1498)) tmp1497) (syntax-violation #f "source expression failed to match any pattern" tmp1496))) ($sc-dispatch tmp1496 (quote each-any)))) (read-file1485 fn1495 k1493)))) tmp1492) (syntax-violation #f "source expression failed to match any pattern" tmp1491))) ($sc-dispatch tmp1491 (quote (any any))))) x1484)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x1500) ((lambda (tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda (_1503 e1504) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1500)) tmp1502) (syntax-violation #f "source expression failed to match any pattern" tmp1501))) ($sc-dispatch tmp1501 (quote (any any))))) x1500))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1505) ((lambda (tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (_1508 e1509) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1505)) tmp1507) (syntax-violation #f "source expression failed to match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any any))))) x1505))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1510) ((lambda (tmp1511) ((lambda (tmp1512) (if tmp1512 (apply (lambda (_1513 e1514 m11515 m21516) ((lambda (tmp1517) ((lambda (body1518) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1514)) body1518)) tmp1517)) (let f1519 ((clause1520 m11515) (clauses1521 m21516)) (if (null? clauses1521) ((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (e11525 e21526) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11525 e21526))) tmp1524) ((lambda (tmp1528) (if tmp1528 (apply (lambda (k1529 e11530 e21531) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1529)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11530 e21531)))) tmp1528) ((lambda (_1534) (syntax-violation (quote case) "bad clause" x1510 clause1520)) tmp1523))) ($sc-dispatch tmp1523 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1523 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause1520) ((lambda (tmp1535) ((lambda (rest1536) ((lambda (tmp1537) ((lambda (tmp1538) (if tmp1538 (apply (lambda (k1539 e11540 e21541) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1539)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11540 e21541)) rest1536)) tmp1538) ((lambda (_1544) (syntax-violation (quote case) "bad clause" x1510 clause1520)) tmp1537))) ($sc-dispatch tmp1537 (quote (each-any any . each-any))))) clause1520)) tmp1535)) (f1519 (car clauses1521) (cdr clauses1521))))))) tmp1512) (syntax-violation #f "source expression failed to match any pattern" tmp1511))) ($sc-dispatch tmp1511 (quote (any any any . each-any))))) x1510))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1545) ((lambda (tmp1546) ((lambda (tmp1547) (if tmp1547 (apply (lambda (_1548 e1549) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1549)) (list (cons _1548 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e1549 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp1547) (syntax-violation #f "source expression failed to match any pattern" tmp1546))) ($sc-dispatch tmp1546 (quote (any any))))) x1545))))
;;; by eval, and eval accepts one argument, nothing special must be done
;;; to support the "noexpand" flag, since it is handled by sc-expand.
;;;
-;;; (error who format-string why what)
-;;; where who is either a symbol or #f, format-string is always "~a ~s",
-;;; why is always a string, and what may be any object. error should
-;;; signal an error with a message something like
-;;;
-;;; "error in <who>: <why> <what>"
-;;;
;;; (gensym)
;;; returns a unique symbol each time it's called
;;;
(lambda (x mod)
(primitive-eval `(,noexpand ,x))))
-(define error-hook
- (lambda (who why what)
- (error who "~a ~s" why what)))
-
(define-syntax gensym-hook
(syntax-rules ()
((_) (gensym))))
(syntax-rules ()
((_ pred? e who)
(let ((x e))
- (if (not (pred? x)) (error-hook who "invalid argument" x))))))
+ (if (not (pred? x)) (syntax-violation who "invalid argument" x))))))
;;; compile-time environments
((annotation? id)
(let ((id (unannotate id)))
(or (first (search id (wrap-subst w) (wrap-marks w))) id)))
- (else (error-hook 'id-var-name "invalid id" id)))))
+ (else (syntax-violation 'id-var-name "invalid id" id)))))
;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
(syntax (begin exp ...))))))))
(define-syntax unquote
- (lambda (x)
- (syntax-case x ()
- ((_ e)
- (error 'unquote
- "expression ,~s not valid outside of quasiquote"
- (syntax->datum (syntax e)))))))
+ (lambda (x)
+ (syntax-case x ()
+ ((_ e)
+ (syntax-violation 'unquote
+ "expression not valid outside of quasiquote"
+ x)))))
(define-syntax unquote-splicing
- (lambda (x)
- (syntax-case x ()
- ((_ e)
- (error 'unquote-splicing
- "expression ,@~s not valid outside of quasiquote"
- (syntax->datum (syntax e)))))))
+ (lambda (x)
+ (syntax-case x ()
+ ((_ e)
+ (syntax-violation 'unquote-splicing
+ "expression not valid outside of quasiquote"
+ x)))))
(define-syntax case
(lambda (x)
HCoop / bpt / guile.git / commitdiff