1 (letrec ((syntmp-lambda-var-list-167
2 (lambda (syntmp-vars-552)
3 (let syntmp-lvl-553 ((syntmp-vars-554 syntmp-vars-552)
4 (syntmp-ls-555 (quote ()))
5 (syntmp-w-556 (quote (()))))
6 (cond ((pair? syntmp-vars-554)
14 ((syntmp-id?-118 syntmp-vars-554)
15 (cons (syntmp-wrap-146 syntmp-vars-554 syntmp-w-556)
17 ((null? syntmp-vars-554) syntmp-ls-555)
18 ((syntmp-syntax-object?-104 syntmp-vars-554)
20 (syntmp-syntax-object-expression-105
23 (syntmp-join-wraps-137
25 (syntmp-syntax-object-wrap-106 syntmp-vars-554))))
26 ((syntmp-annotation?-92 syntmp-vars-554)
28 (annotation-expression syntmp-vars-554)
31 (else (cons syntmp-vars-554 syntmp-ls-555))))))
33 (lambda (syntmp-id-557)
35 (if (syntmp-syntax-object?-104 syntmp-id-557)
36 (syntmp-syntax-object-expression-105
39 (if (syntmp-annotation?-92 syntmp-id-558)
42 (annotation-expression syntmp-id-558)))
43 (gensym (symbol->string syntmp-id-558))))))
45 (lambda (syntmp-x-559 syntmp-w-560)
47 (syntmp-wrap-marks-121 syntmp-w-560))
48 (if (or (syntmp-annotation?-92 syntmp-x-559)
49 (and (pair? syntmp-x-559)
50 (syntmp-annotation?-92 (car syntmp-x-559))))
51 (syntmp-strip-annotation-164 syntmp-x-559 #f)
53 (let syntmp-f-561 ((syntmp-x-562 syntmp-x-559))
54 (cond ((syntmp-syntax-object?-104 syntmp-x-562)
56 (syntmp-syntax-object-expression-105
58 (syntmp-syntax-object-wrap-106 syntmp-x-562)))
60 (let ((syntmp-a-563 (syntmp-f-561 (car syntmp-x-562)))
61 (syntmp-d-564 (syntmp-f-561 (cdr syntmp-x-562))))
62 (if (and (eq? syntmp-a-563 (car syntmp-x-562))
63 (eq? syntmp-d-564 (cdr syntmp-x-562)))
65 (cons syntmp-a-563 syntmp-d-564))))
66 ((vector? syntmp-x-562)
67 (let ((syntmp-old-565 (vector->list syntmp-x-562)))
69 (map syntmp-f-561 syntmp-old-565)))
70 (if (andmap eq? syntmp-old-565 syntmp-new-566)
72 (list->vector syntmp-new-566)))))
73 (else syntmp-x-562))))))
74 (syntmp-strip-annotation-164
75 (lambda (syntmp-x-567 syntmp-parent-568)
76 (cond ((pair? syntmp-x-567)
77 (let ((syntmp-new-569 (cons #f #f)))
79 (when syntmp-parent-568
80 (set-annotation-stripped!
85 (syntmp-strip-annotation-164
90 (syntmp-strip-annotation-164
94 ((syntmp-annotation?-92 syntmp-x-567)
95 (or (annotation-stripped syntmp-x-567)
96 (syntmp-strip-annotation-164
97 (annotation-expression syntmp-x-567)
99 ((vector? syntmp-x-567)
100 (let ((syntmp-new-570
101 (make-vector (vector-length syntmp-x-567))))
103 (when syntmp-parent-568
104 (set-annotation-stripped!
107 (let syntmp-loop-571 ((syntmp-i-572
108 (- (vector-length syntmp-x-567)
111 (syntmp-fx<-91 syntmp-i-572 0)
115 (syntmp-strip-annotation-164
116 (vector-ref syntmp-x-567 syntmp-i-572)
118 (syntmp-loop-571 (syntmp-fx--89 syntmp-i-572 1))))
120 (else syntmp-x-567))))
121 (syntmp-ellipsis?-163
122 (lambda (syntmp-e-573 syntmp-r-574)
123 (and (syntmp-nonsymbol-id?-117 syntmp-e-573)
125 (syntmp-make-syntax-object-103
127 (syntmp-syntax-object-wrap-106 syntmp-e-573))))
129 (syntmp-id-var-name-140
133 (syntmp-lookup-115 syntmp-n-576 syntmp-r-574)))
134 (if (eq? (syntmp-binding-type-110 syntmp-b-577)
136 (syntmp-bound-id=?-142
138 (syntmp-binding-value-111 syntmp-b-577))
139 (syntmp-free-id=?-141
146 #(ribcage #(b) #((top)) #("i"))
148 #(ribcage #(n) #((top)) #("i"))
150 #(ribcage #(id) #((top)) #("i"))
152 #(ribcage #(e r) #((top) (top)) #("i" "i"))
160 eval-local-transformer
197 set-ribcage-symnames!
230 set-syntax-object-wrap!
231 set-syntax-object-expression!
233 syntax-object-expression
244 build-global-definition
245 build-global-assignment
246 build-global-reference
247 build-lexical-assignment
248 build-lexical-reference
251 get-global-definition-hook
252 put-global-definition-hook
486 (lambda () (list (quote void))))
487 (syntmp-eval-local-transformer-161
488 (lambda (syntmp-expanded-578)
490 (syntmp-local-eval-hook-94 syntmp-expanded-578)))
491 (if (procedure? syntmp-p-579)
495 "nonprocedure transformer")))))
496 (syntmp-chi-local-syntax-160
497 (lambda (syntmp-rec?-580
503 ((lambda (syntmp-tmp-586)
504 ((lambda (syntmp-tmp-587)
506 (apply (lambda (syntmp-_-588
511 (let ((syntmp-ids-593 syntmp-id-589))
512 (if (not (syntmp-valid-bound-ids?-143
516 "duplicate bound keyword in")
517 (let ((syntmp-labels-595
518 (syntmp-gen-labels-124
520 (let ((syntmp-new-w-596
521 (syntmp-make-binding-wrap-135
526 (cons syntmp-e1-591 syntmp-e2-592)
527 (syntmp-extend-env-112
534 (syntmp-macros-only-env-114
536 (map (lambda (syntmp-x-600)
538 (syntmp-eval-local-transformer-161
548 ((lambda (syntmp-_-602)
550 (syntmp-source-wrap-147
557 '(any #(each (any any)) any . each-any))))
559 (syntmp-chi-lambda-clause-159
560 (lambda (syntmp-e-603
565 ((lambda (syntmp-tmp-608)
566 ((lambda (syntmp-tmp-609)
568 (apply (lambda (syntmp-id-610 syntmp-e1-611 syntmp-e2-612)
569 (let ((syntmp-ids-613 syntmp-id-610))
570 (if (not (syntmp-valid-bound-ids?-143
574 "invalid parameter list in")
575 (let ((syntmp-labels-615
576 (syntmp-gen-labels-124
579 (map syntmp-gen-var-166
584 (cons syntmp-e1-611 syntmp-e2-612)
586 (syntmp-extend-var-env-113
590 (syntmp-make-binding-wrap-135
595 ((lambda (syntmp-tmp-618)
597 (apply (lambda (syntmp-ids-619
600 (let ((syntmp-old-ids-622
601 (syntmp-lambda-var-list-167
603 (if (not (syntmp-valid-bound-ids?-143
607 "invalid parameter list in")
608 (let ((syntmp-labels-623
609 (syntmp-gen-labels-124
612 (map syntmp-gen-var-166
613 syntmp-old-ids-622)))
615 (let syntmp-f-625 ((syntmp-ls1-626
616 (cdr syntmp-new-vars-624))
618 (car syntmp-new-vars-624)))
619 (if (null? syntmp-ls1-626)
623 (cons (car syntmp-ls1-626)
626 (cons syntmp-e1-620 syntmp-e2-621)
628 (syntmp-extend-var-env-113
632 (syntmp-make-binding-wrap-135
637 ((lambda (syntmp-_-629)
638 (syntax-error syntmp-e-603))
642 '(any any . each-any)))))
645 '(each-any any . each-any))))
648 (lambda (syntmp-body-630
649 syntmp-outer-form-631
653 (cons '("placeholder" placeholder)
655 (let ((syntmp-ribcage-635
656 (syntmp-make-ribcage-125
661 (syntmp-make-wrap-120
662 (syntmp-wrap-marks-121 syntmp-w-633)
663 (cons syntmp-ribcage-635
664 (syntmp-wrap-subst-122 syntmp-w-633)))))
665 (let syntmp-parse-637 ((syntmp-body-638
666 (map (lambda (syntmp-x-644)
672 (syntmp-ids-639 (quote ()))
673 (syntmp-labels-640 (quote ()))
674 (syntmp-vars-641 (quote ()))
675 (syntmp-vals-642 (quote ()))
676 (syntmp-bindings-643 (quote ())))
677 (if (null? syntmp-body-638)
679 syntmp-outer-form-631
680 "no expressions in body")
681 (let ((syntmp-e-645 (cdar syntmp-body-638))
682 (syntmp-er-646 (caar syntmp-body-638)))
685 (syntmp-syntax-type-152
691 (lambda (syntmp-type-647
696 (let ((syntmp-t-652 syntmp-type-647))
697 (if (memv syntmp-t-652 (quote (define-form)))
703 (syntmp-gen-label-123)))
704 (let ((syntmp-var-655
705 (syntmp-gen-var-166 syntmp-id-653)))
707 (syntmp-extend-ribcage!-134
712 (cdr syntmp-body-638)
713 (cons syntmp-id-653 syntmp-ids-639)
714 (cons syntmp-label-654
716 (cons syntmp-var-655 syntmp-vars-641)
717 (cons (cons syntmp-er-646
724 syntmp-bindings-643)))))
725 (if (memv syntmp-t-652
726 '(define-syntax-form))
732 (syntmp-gen-label-123)))
734 (syntmp-extend-ribcage!-134
739 (cdr syntmp-body-638)
740 (cons syntmp-id-656 syntmp-ids-639)
741 (cons syntmp-label-657
750 syntmp-bindings-643))))
751 (if (memv syntmp-t-652 (quote (begin-form)))
752 ((lambda (syntmp-tmp-658)
753 ((lambda (syntmp-tmp-659)
755 (apply (lambda (syntmp-_-660
758 (let syntmp-f-662 ((syntmp-forms-663
760 (if (null? syntmp-forms-663)
761 (cdr syntmp-body-638)
762 (cons (cons syntmp-er-646
764 (car syntmp-forms-663)
767 (cdr syntmp-forms-663)))))
772 syntmp-bindings-643))
774 (syntax-error syntmp-tmp-658)))
779 (if (memv syntmp-t-652
780 '(local-syntax-form))
781 (syntmp-chi-local-syntax-160
787 (lambda (syntmp-forms-665
792 (let syntmp-f-669 ((syntmp-forms-670
794 (if (null? syntmp-forms-670)
795 (cdr syntmp-body-638)
796 (cons (cons syntmp-er-666
798 (car syntmp-forms-670)
801 (cdr syntmp-forms-670)))))
806 syntmp-bindings-643)))
807 (if (null? syntmp-ids-639)
808 (syntmp-build-sequence-99
810 (map (lambda (syntmp-x-671)
815 (cons (cons syntmp-er-646
816 (syntmp-source-wrap-147
820 (cdr syntmp-body-638))))
822 (if (not (syntmp-valid-bound-ids?-143
825 syntmp-outer-form-631
826 "invalid or duplicate identifier in definition"))
827 (let syntmp-loop-672 ((syntmp-bs-673
833 (if (not (null? syntmp-bs-673))
835 (car syntmp-bs-673)))
836 (if (eq? (car syntmp-b-676)
839 (cadr syntmp-b-676)))
840 (let ((syntmp-r-cache-678
841 (if (eq? syntmp-er-677
844 (syntmp-macros-only-env-114
849 (syntmp-eval-local-transformer-161
857 syntmp-r-cache-678))))
861 syntmp-r-cache-675)))))
864 (syntmp-extend-env-112
868 (syntmp-build-letrec-102
871 (map (lambda (syntmp-x-679)
877 (syntmp-build-sequence-99
879 (map (lambda (syntmp-x-680)
884 (cons (cons syntmp-er-646
885 (syntmp-source-wrap-147
889 (cdr syntmp-body-638))))))))))))))))))))))
890 (syntmp-chi-macro-157
891 (lambda (syntmp-p-681
896 (letrec ((syntmp-rebuild-macro-output-686
897 (lambda (syntmp-x-687 syntmp-m-688)
898 (cond ((pair? syntmp-x-687)
899 (cons (syntmp-rebuild-macro-output-686
902 (syntmp-rebuild-macro-output-686
905 ((syntmp-syntax-object?-104 syntmp-x-687)
907 (syntmp-syntax-object-wrap-106
910 (syntmp-wrap-marks-121
913 (syntmp-wrap-subst-122
915 (syntmp-make-syntax-object-103
916 (syntmp-syntax-object-expression-105
918 (if (and (pair? syntmp-ms-690)
919 (eq? (car syntmp-ms-690) #f))
920 (syntmp-make-wrap-120
926 (syntmp-make-wrap-120
927 (cons syntmp-m-688 syntmp-ms-690)
934 ((vector? syntmp-x-687)
936 (vector-length syntmp-x-687)))
938 (make-vector syntmp-n-692)))
939 (let syntmp-doloop-694 ((syntmp-i-695 0))
948 (syntmp-rebuild-macro-output-686
957 ((symbol? syntmp-x-687)
960 "encountered raw symbol in macro output"))
961 (else syntmp-x-687)))))
962 (syntmp-rebuild-macro-output-686
966 (syntmp-anti-mark-133 syntmp-w-684)))
968 (syntmp-chi-application-156
969 (lambda (syntmp-x-696
974 ((lambda (syntmp-tmp-701)
975 ((lambda (syntmp-tmp-702)
977 (apply (lambda (syntmp-e0-703 syntmp-e1-704)
979 (map (lambda (syntmp-e-705)
986 (syntax-error syntmp-tmp-701)))
992 (lambda (syntmp-type-707
998 (let ((syntmp-t-713 syntmp-type-707))
999 (if (memv syntmp-t-713 (quote (lexical)))
1001 (if (memv syntmp-t-713 (quote (core external-macro)))
1007 (if (memv syntmp-t-713 (quote (lexical-call)))
1008 (syntmp-chi-application-156
1014 (if (memv syntmp-t-713 (quote (global-call)))
1015 (syntmp-chi-application-156
1021 (if (memv syntmp-t-713 (quote (constant)))
1022 (syntmp-build-data-98
1025 (syntmp-source-wrap-147
1030 (if (memv syntmp-t-713 (quote (global)))
1032 (if (memv syntmp-t-713 (quote (call)))
1033 (syntmp-chi-application-156
1042 (if (memv syntmp-t-713 (quote (begin-form)))
1043 ((lambda (syntmp-tmp-714)
1044 ((lambda (syntmp-tmp-715)
1046 (apply (lambda (syntmp-_-716
1049 (syntmp-chi-sequence-148
1056 (syntax-error syntmp-tmp-714)))
1059 '(any any . each-any))))
1061 (if (memv syntmp-t-713
1062 '(local-syntax-form))
1063 (syntmp-chi-local-syntax-160
1069 syntmp-chi-sequence-148)
1070 (if (memv syntmp-t-713
1072 ((lambda (syntmp-tmp-720)
1073 ((lambda (syntmp-tmp-721)
1075 (apply (lambda (syntmp-_-722
1079 (let ((syntmp-when-list-726
1080 (syntmp-chi-when-list-151
1085 syntmp-when-list-726)
1086 (syntmp-chi-sequence-148
1092 (syntmp-chi-void-162))))
1094 (syntax-error syntmp-tmp-720)))
1097 '(any each-any any . each-any))))
1099 (if (memv syntmp-t-713
1100 '(define-form define-syntax-form))
1105 "invalid context for definition of")
1106 (if (memv syntmp-t-713 (quote (syntax)))
1108 (syntmp-source-wrap-147
1112 "reference to pattern variable outside syntax form")
1113 (if (memv syntmp-t-713
1114 '(displaced-lexical))
1116 (syntmp-source-wrap-147
1120 "reference to identifier outside its scope")
1122 (syntmp-source-wrap-147
1125 syntmp-s-712))))))))))))))))))
1127 (lambda (syntmp-e-729 syntmp-r-730 syntmp-w-731)
1130 (syntmp-syntax-type-152
1136 (lambda (syntmp-type-732
1141 (syntmp-chi-expr-155
1149 (lambda (syntmp-e-737
1156 (syntmp-syntax-type-152
1162 (lambda (syntmp-type-754
1167 (let ((syntmp-t-759 syntmp-type-754))
1168 (if (memv syntmp-t-759 (quote (begin-form)))
1169 ((lambda (syntmp-tmp-760)
1170 ((lambda (syntmp-tmp-761)
1172 (apply (lambda (syntmp-_-762)
1173 (syntmp-chi-void-162))
1175 ((lambda (syntmp-tmp-763)
1177 (apply (lambda (syntmp-_-764
1180 (syntmp-chi-top-sequence-149
1181 (cons syntmp-e1-765 syntmp-e2-766)
1188 (syntax-error syntmp-tmp-760)))
1191 '(any any . each-any)))))
1192 (syntax-dispatch syntmp-tmp-760 (quote (any)))))
1194 (if (memv syntmp-t-759 (quote (local-syntax-form)))
1195 (syntmp-chi-local-syntax-160
1201 (lambda (syntmp-body-768
1205 (syntmp-chi-top-sequence-149
1212 (if (memv syntmp-t-759 (quote (eval-when-form)))
1213 ((lambda (syntmp-tmp-772)
1214 ((lambda (syntmp-tmp-773)
1216 (apply (lambda (syntmp-_-774
1220 (let ((syntmp-when-list-778
1221 (syntmp-chi-when-list-151
1228 (cond ((eq? syntmp-m-740 (quote e))
1230 syntmp-when-list-778)
1231 (syntmp-chi-top-sequence-149
1238 (syntmp-chi-void-162)))
1240 syntmp-when-list-778)
1241 (if (or (memq 'compile
1242 syntmp-when-list-778)
1243 (and (eq? syntmp-m-740
1246 syntmp-when-list-778)))
1247 (syntmp-chi-top-sequence-149
1254 (if (memq syntmp-m-740
1256 (syntmp-chi-top-sequence-149
1263 (syntmp-chi-void-162))))
1265 syntmp-when-list-778)
1266 (and (eq? syntmp-m-740
1269 syntmp-when-list-778)))
1270 (syntmp-top-level-eval-hook-93
1271 (syntmp-chi-top-sequence-149
1278 (syntmp-chi-void-162))
1280 (syntmp-chi-void-162)))))
1282 (syntax-error syntmp-tmp-772)))
1285 '(any each-any any . each-any))))
1287 (if (memv syntmp-t-759 (quote (define-syntax-form)))
1289 (syntmp-id-var-name-140
1293 (syntmp-macros-only-env-114 syntmp-r-738)))
1294 (let ((syntmp-t-784 syntmp-m-740))
1295 (if (memv syntmp-t-784 (quote (c)))
1296 (if (memq (quote compile) syntmp-esew-741)
1298 (syntmp-chi-install-global-150
1305 (syntmp-top-level-eval-hook-93
1307 (if (memq (quote load) syntmp-esew-741)
1309 (syntmp-chi-void-162))))
1310 (if (memq (quote load) syntmp-esew-741)
1311 (syntmp-chi-install-global-150
1317 (syntmp-chi-void-162)))
1318 (if (memv syntmp-t-784 (quote (c&e)))
1320 (syntmp-chi-install-global-150
1327 (syntmp-top-level-eval-hook-93
1331 (if (memq (quote eval) syntmp-esew-741)
1332 (syntmp-top-level-eval-hook-93
1333 (syntmp-chi-install-global-150
1339 (syntmp-chi-void-162))))))
1340 (if (memv syntmp-t-759 (quote (define-form)))
1342 (syntmp-id-var-name-140
1345 (let ((syntmp-type-788
1346 (syntmp-binding-type-110
1350 (let ((syntmp-t-789 syntmp-type-788))
1351 (if (memv syntmp-t-789 (quote (global)))
1360 (if (eq? syntmp-m-740 (quote c&e))
1361 (syntmp-top-level-eval-hook-93
1364 (if (memv syntmp-t-789
1365 '(displaced-lexical))
1370 "identifier out of context")
1371 (if (eq? syntmp-type-788
1381 (if (eq? syntmp-m-740 (quote c&e))
1382 (syntmp-top-level-eval-hook-93
1389 "cannot define keyword at top level")))))))
1391 (syntmp-chi-expr-155
1399 (if (eq? syntmp-m-740 (quote c&e))
1400 (syntmp-top-level-eval-hook-93
1402 syntmp-x-792))))))))))))
1403 (syntmp-syntax-type-152
1404 (lambda (syntmp-e-793
1409 (cond ((symbol? syntmp-e-793)
1411 (syntmp-id-var-name-140
1415 (syntmp-lookup-115 syntmp-n-798 syntmp-r-794)))
1416 (let ((syntmp-type-800
1417 (syntmp-binding-type-110 syntmp-b-799)))
1418 (let ((syntmp-t-801 syntmp-type-800))
1419 (if (memv syntmp-t-801 (quote (lexical)))
1422 (syntmp-binding-value-111 syntmp-b-799)
1426 (if (memv syntmp-t-801 (quote (global)))
1433 (if (memv syntmp-t-801 (quote (macro)))
1434 (syntmp-syntax-type-152
1435 (syntmp-chi-macro-157
1436 (syntmp-binding-value-111 syntmp-b-799)
1447 (syntmp-binding-value-111 syntmp-b-799)
1450 syntmp-s-796)))))))))
1451 ((pair? syntmp-e-793)
1452 (let ((syntmp-first-802 (car syntmp-e-793)))
1453 (if (syntmp-id?-118 syntmp-first-802)
1455 (syntmp-id-var-name-140
1462 (let ((syntmp-type-805
1463 (syntmp-binding-type-110 syntmp-b-804)))
1464 (let ((syntmp-t-806 syntmp-type-805))
1465 (if (memv syntmp-t-806 (quote (lexical)))
1468 (syntmp-binding-value-111 syntmp-b-804)
1472 (if (memv syntmp-t-806 (quote (global)))
1479 (if (memv syntmp-t-806 (quote (macro)))
1480 (syntmp-syntax-type-152
1481 (syntmp-chi-macro-157
1482 (syntmp-binding-value-111
1492 (if (memv syntmp-t-806
1493 '(core external-macro))
1496 (syntmp-binding-value-111
1501 (if (memv syntmp-t-806
1505 (syntmp-binding-value-111
1510 (if (memv syntmp-t-806
1518 (if (memv syntmp-t-806
1526 (if (memv syntmp-t-806
1528 ((lambda (syntmp-tmp-807)
1529 ((lambda (syntmp-tmp-808)
1530 (if (if syntmp-tmp-808
1531 (apply (lambda (syntmp-_-809
1538 (apply (lambda (syntmp-_-812
1548 ((lambda (syntmp-tmp-815)
1549 (if (if syntmp-tmp-815
1550 (apply (lambda (syntmp-_-816
1555 (and (syntmp-id?-118
1557 (syntmp-valid-bound-ids?-143
1558 (syntmp-lambda-var-list-167
1562 (apply (lambda (syntmp-_-821
1572 (cons '#(syntax-object
1667 eval-local-transformer
1704 set-ribcage-symnames!
1737 set-syntax-object-wrap!
1738 set-syntax-object-expression!
1740 syntax-object-expression
1751 build-global-definition
1752 build-global-assignment
1753 build-global-reference
1754 build-lexical-assignment
1755 build-lexical-reference
1758 get-global-definition-hook
1759 put-global-definition-hook
1993 (cons syntmp-args-823
2000 ((lambda (syntmp-tmp-827)
2001 (if (if syntmp-tmp-827
2002 (apply (lambda (syntmp-_-828
2008 (apply (lambda (syntmp-_-830