* psyntax.ss (self-evaluating?): Allow procedures implanted in

source.  (Guile uses this internally.)

2 files changed, 3 insertions, 2 deletions

diff --git a/ice-9/psyntax.pp b/ice-9/psyntax.pp
index 3d11eef27..1dc789f8a 100644
--- a/ice-9/psyntax.pp
+++ b/ice-9/psyntax.pp
@@ -1,4 +1,4 @@
-(letrec ((syntmp-lambda-var-list-164 (lambda (syntmp-vars-559) (let syntmp-lvl-560 ((syntmp-vars-561 syntmp-vars-559) (syntmp-ls-562 (quote ())) (syntmp-w-563 (quote (())))) (cond ((pair? syntmp-vars-561) (syntmp-lvl-560 (cdr syntmp-vars-561) (cons (syntmp-wrap-143 (car syntmp-vars-561) syntmp-w-563) syntmp-ls-562) syntmp-w-563)) ((syntmp-id?-115 syntmp-vars-561) (cons (syntmp-wrap-143 syntmp-vars-561 syntmp-w-563) syntmp-ls-562)) ((null? syntmp-vars-561) syntmp-ls-562) ((syntmp-syntax-object?-101 syntmp-vars-561) (syntmp-lvl-560 (syntmp-syntax-object-expression-102 syntmp-vars-561) syntmp-ls-562 (syntmp-join-wraps-134 syntmp-w-563 (syntmp-syntax-object-wrap-103 syntmp-vars-561)))) ((syntmp-annotation?-89 syntmp-vars-561) (syntmp-lvl-560 (annotation-expression syntmp-vars-561) syntmp-ls-562 syntmp-w-563)) (else (cons syntmp-vars-561 syntmp-ls-562)))))) (syntmp-gen-var-163 (lambda (syntmp-id-564) (let ((syntmp-id-565 (if (syntmp-syntax-object?-101 syntmp-id-564) (syntmp-syntax-object-expression-102 syntmp-id-564) syntmp-id-564))) (if (syntmp-annotation?-89 syntmp-id-565) (gensym (symbol->string (annotation-expression syntmp-id-565))) (gensym (symbol->string syntmp-id-565)))))) (syntmp-strip-162 (lambda (syntmp-x-566 syntmp-w-567) (if (memq (quote top) (syntmp-wrap-marks-118 syntmp-w-567)) (if (or (syntmp-annotation?-89 syntmp-x-566) (and (pair? syntmp-x-566) (syntmp-annotation?-89 (car syntmp-x-566)))) (syntmp-strip-annotation-161 syntmp-x-566 #f) syntmp-x-566) (let syntmp-f-568 ((syntmp-x-569 syntmp-x-566)) (cond ((syntmp-syntax-object?-101 syntmp-x-569) (syntmp-strip-162 (syntmp-syntax-object-expression-102 syntmp-x-569) (syntmp-syntax-object-wrap-103 syntmp-x-569))) ((pair? syntmp-x-569) (let ((syntmp-a-570 (syntmp-f-568 (car syntmp-x-569))) (syntmp-d-571 (syntmp-f-568 (cdr syntmp-x-569)))) (if (and (eq? syntmp-a-570 (car syntmp-x-569)) (eq? syntmp-d-571 (cdr syntmp-x-569))) syntmp-x-569 (cons syntmp-a-570 syntmp-d-571)))) ((vector? syntmp-x-569) (let ((syntmp-old-572 (vector->list syntmp-x-569))) (let ((syntmp-new-573 (map syntmp-f-568 syntmp-old-572))) (if (andmap eq? syntmp-old-572 syntmp-new-573) syntmp-x-569 (list->vector syntmp-new-573))))) (else syntmp-x-569)))))) (syntmp-strip-annotation-161 (lambda (syntmp-x-574 syntmp-parent-575) (cond ((pair? syntmp-x-574) (let ((syntmp-new-576 (cons #f #f))) (begin (when syntmp-parent-575 (set-annotation-stripped! syntmp-parent-575 syntmp-new-576)) (set-car! syntmp-new-576 (syntmp-strip-annotation-161 (car syntmp-x-574) #f)) (set-cdr! syntmp-new-576 (syntmp-strip-annotation-161 (cdr syntmp-x-574) #f)) syntmp-new-576))) ((syntmp-annotation?-89 syntmp-x-574) (or (annotation-stripped syntmp-x-574) (syntmp-strip-annotation-161 (annotation-expression syntmp-x-574) syntmp-x-574))) ((vector? syntmp-x-574) (let ((syntmp-new-577 (make-vector (vector-length syntmp-x-574)))) (begin (when syntmp-parent-575 (set-annotation-stripped! syntmp-parent-575 syntmp-new-577)) (let syntmp-loop-578 ((syntmp-i-579 (- (vector-length syntmp-x-574) 1))) (unless (syntmp-fx<-88 syntmp-i-579 0) (vector-set! syntmp-new-577 syntmp-i-579 (syntmp-strip-annotation-161 (vector-ref syntmp-x-574 syntmp-i-579) #f)) (syntmp-loop-578 (syntmp-fx--86 syntmp-i-579 1)))) syntmp-new-577))) (else syntmp-x-574)))) (syntmp-ellipsis?-160 (lambda (syntmp-x-580) (and (syntmp-nonsymbol-id?-114 syntmp-x-580) (syntmp-free-id=?-138 syntmp-x-580 (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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i"))))))))) (syntmp-chi-void-159 (lambda () (list (quote void)))) (syntmp-eval-local-transformer-158 (lambda (syntmp-expanded-581) (let ((syntmp-p-582 (syntmp-local-eval-hook-91 syntmp-expanded-581))) (if (procedure? syntmp-p-582) syntmp-p-582 (syntax-error syntmp-p-582 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-157 (lambda (syntmp-rec?-583 syntmp-e-584 syntmp-r-585 syntmp-w-586 syntmp-s-587 syntmp-k-588) ((lambda (syntmp-tmp-589) ((lambda (syntmp-tmp-590) (if syntmp-tmp-590 (apply (lambda (syntmp-_-591 syntmp-id-592 syntmp-val-593 syntmp-e1-594 syntmp-e2-595) (let ((syntmp-ids-596 syntmp-id-592)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-596)) (syntax-error syntmp-e-584 "duplicate bound keyword in") (let ((syntmp-labels-598 (syntmp-gen-labels-121 syntmp-ids-596))) (let ((syntmp-new-w-599 (syntmp-make-binding-wrap-132 syntmp-ids-596 syntmp-labels-598 syntmp-w-586))) (syntmp-k-588 (cons syntmp-e1-594 syntmp-e2-595) (syntmp-extend-env-109 syntmp-labels-598 (let ((syntmp-w-601 (if syntmp-rec?-583 syntmp-new-w-599 syntmp-w-586)) (syntmp-trans-r-602 (syntmp-macros-only-env-111 syntmp-r-585))) (map (lambda (syntmp-x-603) (cons (quote macro) (syntmp-eval-local-transformer-158 (syntmp-chi-151 syntmp-x-603 syntmp-trans-r-602 syntmp-w-601)))) syntmp-val-593)) syntmp-r-585) syntmp-new-w-599 syntmp-s-587)))))) syntmp-tmp-590) ((lambda (syntmp-_-605) (syntax-error (syntmp-source-wrap-144 syntmp-e-584 syntmp-w-586 syntmp-s-587))) syntmp-tmp-589))) (syntax-dispatch syntmp-tmp-589 (quote (any #(each (any any)) any . each-any))))) syntmp-e-584))) (syntmp-chi-lambda-clause-156 (lambda (syntmp-e-606 syntmp-c-607 syntmp-r-608 syntmp-w-609 syntmp-k-610) ((lambda (syntmp-tmp-611) ((lambda (syntmp-tmp-612) (if syntmp-tmp-612 (apply (lambda (syntmp-id-613 syntmp-e1-614 syntmp-e2-615) (let ((syntmp-ids-616 syntmp-id-613)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-616)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-618 (syntmp-gen-labels-121 syntmp-ids-616)) (syntmp-new-vars-619 (map syntmp-gen-var-163 syntmp-ids-616))) (syntmp-k-610 syntmp-new-vars-619 (syntmp-chi-body-155 (cons syntmp-e1-614 syntmp-e2-615) syntmp-e-606 (syntmp-extend-var-env-110 syntmp-labels-618 syntmp-new-vars-619 syntmp-r-608) (syntmp-make-binding-wrap-132 syntmp-ids-616 syntmp-labels-618 syntmp-w-609))))))) syntmp-tmp-612) ((lambda (syntmp-tmp-621) (if syntmp-tmp-621 (apply (lambda (syntmp-ids-622 syntmp-e1-623 syntmp-e2-624) (let ((syntmp-old-ids-625 (syntmp-lambda-var-list-164 syntmp-ids-622))) (if (not (syntmp-valid-bound-ids?-140 syntmp-old-ids-625)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-626 (syntmp-gen-labels-121 syntmp-old-ids-625)) (syntmp-new-vars-627 (map syntmp-gen-var-163 syntmp-old-ids-625))) (syntmp-k-610 (let syntmp-f-628 ((syntmp-ls1-629 (cdr syntmp-new-vars-627)) (syntmp-ls2-630 (car syntmp-new-vars-627))) (if (null? syntmp-ls1-629) syntmp-ls2-630 (syntmp-f-628 (cdr syntmp-ls1-629) (cons (car syntmp-ls1-629) syntmp-ls2-630)))) (syntmp-chi-body-155 (cons syntmp-e1-623 syntmp-e2-624) syntmp-e-606 (syntmp-extend-var-env-110 syntmp-labels-626 syntmp-new-vars-627 syntmp-r-608) (syntmp-make-binding-wrap-132 syntmp-old-ids-625 syntmp-labels-626 syntmp-w-609))))))) syntmp-tmp-621) ((lambda (syntmp-_-632) (syntax-error syntmp-e-606)) syntmp-tmp-611))) (syntax-dispatch syntmp-tmp-611 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-611 (quote (each-any any . each-any))))) syntmp-c-607))) (syntmp-chi-body-155 (lambda (syntmp-body-633 syntmp-outer-form-634 syntmp-r-635 syntmp-w-636) (let ((syntmp-r-637 (cons (quote ("placeholder" placeholder)) syntmp-r-635))) (let ((syntmp-ribcage-638 (syntmp-make-ribcage-122 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-639 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w-636) (cons syntmp-ribcage-638 (syntmp-wrap-subst-119 syntmp-w-636))))) (let syntmp-parse-640 ((syntmp-body-641 (map (lambda (syntmp-x-647) (cons syntmp-r-637 (syntmp-wrap-143 syntmp-x-647 syntmp-w-639))) syntmp-body-633)) (syntmp-ids-642 (quote ())) (syntmp-labels-643 (quote ())) (syntmp-vars-644 (quote ())) (syntmp-vals-645 (quote ())) (syntmp-bindings-646 (quote ()))) (if (null? syntmp-body-641) (syntax-error syntmp-outer-form-634 "no expressions in body") (let ((syntmp-e-648 (cdar syntmp-body-641)) (syntmp-er-649 (caar syntmp-body-641))) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-648 syntmp-er-649 (quote (())) #f syntmp-ribcage-638)) (lambda (syntmp-type-650 syntmp-value-651 syntmp-e-652 syntmp-w-653 syntmp-s-654) (let ((syntmp-t-655 syntmp-type-650)) (if (memv syntmp-t-655 (quote (define-form))) (let ((syntmp-id-656 (syntmp-wrap-143 syntmp-value-651 syntmp-w-653)) (syntmp-label-657 (syntmp-gen-label-120))) (let ((syntmp-var-658 (syntmp-gen-var-163 syntmp-id-656))) (begin (syntmp-extend-ribcage!-131 syntmp-ribcage-638 syntmp-id-656 syntmp-label-657) (syntmp-parse-640 (cdr syntmp-body-641) (cons syntmp-id-656 syntmp-ids-642) (cons syntmp-label-657 syntmp-labels-643) (cons syntmp-var-658 syntmp-vars-644) (cons (cons syntmp-er-649 (syntmp-wrap-143 syntmp-e-652 syntmp-w-653)) syntmp-vals-645) (cons (cons (quote lexical) syntmp-var-658) syntmp-bindings-646))))) (if (memv syntmp-t-655 (quote (define-syntax-form))) (let ((syntmp-id-659 (syntmp-wrap-143 syntmp-value-651 syntmp-w-653)) (syntmp-label-660 (syntmp-gen-label-120))) (begin (syntmp-extend-ribcage!-131 syntmp-ribcage-638 syntmp-id-659 syntmp-label-660) (syntmp-parse-640 (cdr syntmp-body-641) (cons syntmp-id-659 syntmp-ids-642) (cons syntmp-label-660 syntmp-labels-643) syntmp-vars-644 syntmp-vals-645 (cons (cons (quote macro) (cons syntmp-er-649 (syntmp-wrap-143 syntmp-e-652 syntmp-w-653))) syntmp-bindings-646)))) (if (memv syntmp-t-655 (quote (begin-form))) ((lambda (syntmp-tmp-661) ((lambda (syntmp-tmp-662) (if syntmp-tmp-662 (apply (lambda (syntmp-_-663 syntmp-e1-664) (syntmp-parse-640 (let syntmp-f-665 ((syntmp-forms-666 syntmp-e1-664)) (if (null? syntmp-forms-666) (cdr syntmp-body-641) (cons (cons syntmp-er-649 (syntmp-wrap-143 (car syntmp-forms-666) syntmp-w-653)) (syntmp-f-665 (cdr syntmp-forms-666))))) syntmp-ids-642 syntmp-labels-643 syntmp-vars-644 syntmp-vals-645 syntmp-bindings-646)) syntmp-tmp-662) (syntax-error syntmp-tmp-661))) (syntax-dispatch syntmp-tmp-661 (quote (any . each-any))))) syntmp-e-652) (if (memv syntmp-t-655 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-651 syntmp-e-652 syntmp-er-649 syntmp-w-653 syntmp-s-654 (lambda (syntmp-forms-668 syntmp-er-669 syntmp-w-670 syntmp-s-671) (syntmp-parse-640 (let syntmp-f-672 ((syntmp-forms-673 syntmp-forms-668)) (if (null? syntmp-forms-673) (cdr syntmp-body-641) (cons (cons syntmp-er-669 (syntmp-wrap-143 (car syntmp-forms-673) syntmp-w-670)) (syntmp-f-672 (cdr syntmp-forms-673))))) syntmp-ids-642 syntmp-labels-643 syntmp-vars-644 syntmp-vals-645 syntmp-bindings-646))) (if (null? syntmp-ids-642) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-674) (syntmp-chi-151 (cdr syntmp-x-674) (car syntmp-x-674) (quote (())))) (cons (cons syntmp-er-649 (syntmp-source-wrap-144 syntmp-e-652 syntmp-w-653 syntmp-s-654)) (cdr syntmp-body-641)))) (begin (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-642)) (syntax-error syntmp-outer-form-634 "invalid or duplicate identifier in definition")) (let syntmp-loop-675 ((syntmp-bs-676 syntmp-bindings-646) (syntmp-er-cache-677 #f) (syntmp-r-cache-678 #f)) (if (not (null? syntmp-bs-676)) (let ((syntmp-b-679 (car syntmp-bs-676))) (if (eq? (car syntmp-b-679) (quote macro)) (let ((syntmp-er-680 (cadr syntmp-b-679))) (let ((syntmp-r-cache-681 (if (eq? syntmp-er-680 syntmp-er-cache-677) syntmp-r-cache-678 (syntmp-macros-only-env-111 syntmp-er-680)))) (begin (set-cdr! syntmp-b-679 (syntmp-eval-local-transformer-158 (syntmp-chi-151 (cddr syntmp-b-679) syntmp-r-cache-681 (quote (()))))) (syntmp-loop-675 (cdr syntmp-bs-676) syntmp-er-680 syntmp-r-cache-681)))) (syntmp-loop-675 (cdr syntmp-bs-676) syntmp-er-cache-677 syntmp-r-cache-678))))) (set-cdr! syntmp-r-637 (syntmp-extend-env-109 syntmp-labels-643 syntmp-bindings-646 (cdr syntmp-r-637))) (syntmp-build-letrec-99 #f syntmp-vars-644 (map (lambda (syntmp-x-682) (syntmp-chi-151 (cdr syntmp-x-682) (car syntmp-x-682) (quote (())))) syntmp-vals-645) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-683) (syntmp-chi-151 (cdr syntmp-x-683) (car syntmp-x-683) (quote (())))) (cons (cons syntmp-er-649 (syntmp-source-wrap-144 syntmp-e-652 syntmp-w-653 syntmp-s-654)) (cdr syntmp-body-641)))))))))))))))))))))) (syntmp-chi-macro-154 (lambda (syntmp-p-684 syntmp-e-685 syntmp-r-686 syntmp-w-687 syntmp-rib-688) (letrec ((syntmp-rebuild-macro-output-689 (lambda (syntmp-x-690 syntmp-m-691) (cond ((pair? syntmp-x-690) (cons (syntmp-rebuild-macro-output-689 (car syntmp-x-690) syntmp-m-691) (syntmp-rebuild-macro-output-689 (cdr syntmp-x-690) syntmp-m-691))) ((syntmp-syntax-object?-101 syntmp-x-690) (let ((syntmp-w-692 (syntmp-syntax-object-wrap-103 syntmp-x-690))) (let ((syntmp-ms-693 (syntmp-wrap-marks-118 syntmp-w-692)) (syntmp-s-694 (syntmp-wrap-subst-119 syntmp-w-692))) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-690) (if (and (pair? syntmp-ms-693) (eq? (car syntmp-ms-693) #f)) (syntmp-make-wrap-117 (cdr syntmp-ms-693) (if syntmp-rib-688 (cons syntmp-rib-688 (cdr syntmp-s-694)) (cdr syntmp-s-694))) (syntmp-make-wrap-117 (cons syntmp-m-691 syntmp-ms-693) (if syntmp-rib-688 (cons syntmp-rib-688 (cons (quote shift) syntmp-s-694)) (cons (quote shift) syntmp-s-694)))))))) ((vector? syntmp-x-690) (let ((syntmp-n-695 (vector-length syntmp-x-690))) (let ((syntmp-v-696 (make-vector syntmp-n-695))) (let syntmp-doloop-697 ((syntmp-i-698 0)) (if (syntmp-fx=-87 syntmp-i-698 syntmp-n-695) syntmp-v-696 (begin (vector-set! syntmp-v-696 syntmp-i-698 (syntmp-rebuild-macro-output-689 (vector-ref syntmp-x-690 syntmp-i-698) syntmp-m-691)) (syntmp-doloop-697 (syntmp-fx+-85 syntmp-i-698 1)))))))) ((symbol? syntmp-x-690) (syntax-error syntmp-x-690 "encountered raw symbol in macro output")) (else syntmp-x-690))))) (syntmp-rebuild-macro-output-689 (syntmp-p-684 (syntmp-wrap-143 syntmp-e-685 (syntmp-anti-mark-130 syntmp-w-687))) (string #\m))))) (syntmp-chi-application-153 (lambda (syntmp-x-699 syntmp-e-700 syntmp-r-701 syntmp-w-702 syntmp-s-703) ((lambda (syntmp-tmp-704) ((lambda (syntmp-tmp-705) (if syntmp-tmp-705 (apply (lambda (syntmp-e0-706 syntmp-e1-707) (cons syntmp-x-699 (map (lambda (syntmp-e-708) (syntmp-chi-151 syntmp-e-708 syntmp-r-701 syntmp-w-702)) syntmp-e1-707))) syntmp-tmp-705) (syntax-error syntmp-tmp-704))) (syntax-dispatch syntmp-tmp-704 (quote (any . each-any))))) syntmp-e-700))) (syntmp-chi-expr-152 (lambda (syntmp-type-710 syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (let ((syntmp-t-716 syntmp-type-710)) (if (memv syntmp-t-716 (quote (lexical))) syntmp-value-711 (if (memv syntmp-t-716 (quote (core external-macro))) (syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (if (memv syntmp-t-716 (quote (lexical-call))) (syntmp-chi-application-153 syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (if (memv syntmp-t-716 (quote (global-call))) (syntmp-chi-application-153 syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (if (memv syntmp-t-716 (quote (constant))) (syntmp-build-data-95 syntmp-s-715 (syntmp-strip-162 (syntmp-source-wrap-144 syntmp-e-712 syntmp-w-714 syntmp-s-715) (quote (())))) (if (memv syntmp-t-716 (quote (global))) syntmp-value-711 (if (memv syntmp-t-716 (quote (call))) (syntmp-chi-application-153 (syntmp-chi-151 (car syntmp-e-712) syntmp-r-713 syntmp-w-714) syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (if (memv syntmp-t-716 (quote (begin-form))) ((lambda (syntmp-tmp-717) ((lambda (syntmp-tmp-718) (if syntmp-tmp-718 (apply (lambda (syntmp-_-719 syntmp-e1-720 syntmp-e2-721) (syntmp-chi-sequence-145 (cons syntmp-e1-720 syntmp-e2-721) syntmp-r-713 syntmp-w-714 syntmp-s-715)) syntmp-tmp-718) (syntax-error syntmp-tmp-717))) (syntax-dispatch syntmp-tmp-717 (quote (any any . each-any))))) syntmp-e-712) (if (memv syntmp-t-716 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715 syntmp-chi-sequence-145) (if (memv syntmp-t-716 (quote (eval-when-form))) ((lambda (syntmp-tmp-723) ((lambda (syntmp-tmp-724) (if syntmp-tmp-724 (apply (lambda (syntmp-_-725 syntmp-x-726 syntmp-e1-727 syntmp-e2-728) (let ((syntmp-when-list-729 (syntmp-chi-when-list-148 syntmp-e-712 syntmp-x-726 syntmp-w-714))) (if (memq (quote eval) syntmp-when-list-729) (syntmp-chi-sequence-145 (cons syntmp-e1-727 syntmp-e2-728) syntmp-r-713 syntmp-w-714 syntmp-s-715) (syntmp-chi-void-159)))) syntmp-tmp-724) (syntax-error syntmp-tmp-723))) (syntax-dispatch syntmp-tmp-723 (quote (any each-any any . each-any))))) syntmp-e-712) (if (memv syntmp-t-716 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-143 syntmp-value-711 syntmp-w-714) "invalid context for definition of") (if (memv syntmp-t-716 (quote (syntax))) (syntax-error (syntmp-source-wrap-144 syntmp-e-712 syntmp-w-714 syntmp-s-715) "reference to pattern variable outside syntax form") (if (memv syntmp-t-716 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-144 syntmp-e-712 syntmp-w-714 syntmp-s-715) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-144 syntmp-e-712 syntmp-w-714 syntmp-s-715)))))))))))))))))) (syntmp-chi-151 (lambda (syntmp-e-732 syntmp-r-733 syntmp-w-734) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-732 syntmp-r-733 syntmp-w-734 #f #f)) (lambda (syntmp-type-735 syntmp-value-736 syntmp-e-737 syntmp-w-738 syntmp-s-739) (syntmp-chi-expr-152 syntmp-type-735 syntmp-value-736 syntmp-e-737 syntmp-r-733 syntmp-w-738 syntmp-s-739))))) (syntmp-chi-top-150 (lambda (syntmp-e-740 syntmp-r-741 syntmp-w-742 syntmp-m-743 syntmp-esew-744) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-740 syntmp-r-741 syntmp-w-742 #f #f)) (lambda (syntmp-type-757 syntmp-value-758 syntmp-e-759 syntmp-w-760 syntmp-s-761) (let ((syntmp-t-762 syntmp-type-757)) (if (memv syntmp-t-762 (quote (begin-form))) ((lambda (syntmp-tmp-763) ((lambda (syntmp-tmp-764) (if syntmp-tmp-764 (apply (lambda (syntmp-_-765) (syntmp-chi-void-159)) syntmp-tmp-764) ((lambda (syntmp-tmp-766) (if syntmp-tmp-766 (apply (lambda (syntmp-_-767 syntmp-e1-768 syntmp-e2-769) (syntmp-chi-top-sequence-146 (cons syntmp-e1-768 syntmp-e2-769) syntmp-r-741 syntmp-w-760 syntmp-s-761 syntmp-m-743 syntmp-esew-744)) syntmp-tmp-766) (syntax-error syntmp-tmp-763))) (syntax-dispatch syntmp-tmp-763 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-763 (quote (any))))) syntmp-e-759) (if (memv syntmp-t-762 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-758 syntmp-e-759 syntmp-r-741 syntmp-w-760 syntmp-s-761 (lambda (syntmp-body-771 syntmp-r-772 syntmp-w-773 syntmp-s-774) (syntmp-chi-top-sequence-146 syntmp-body-771 syntmp-r-772 syntmp-w-773 syntmp-s-774 syntmp-m-743 syntmp-esew-744))) (if (memv syntmp-t-762 (quote (eval-when-form))) ((lambda (syntmp-tmp-775) ((lambda (syntmp-tmp-776) (if syntmp-tmp-776 (apply (lambda (syntmp-_-777 syntmp-x-778 syntmp-e1-779 syntmp-e2-780) (let ((syntmp-when-list-781 (syntmp-chi-when-list-148 syntmp-e-759 syntmp-x-778 syntmp-w-760)) (syntmp-body-782 (cons syntmp-e1-779 syntmp-e2-780))) (cond ((eq? syntmp-m-743 (quote e)) (if (memq (quote eval) syntmp-when-list-781) (syntmp-chi-top-sequence-146 syntmp-body-782 syntmp-r-741 syntmp-w-760 syntmp-s-761 (quote e) (quote (eval))) (syntmp-chi-void-159))) ((memq (quote load) syntmp-when-list-781) (if (or (memq (quote compile) syntmp-when-list-781) (and (eq? syntmp-m-743 (quote c&e)) (memq (quote eval) syntmp-when-list-781))) (syntmp-chi-top-sequence-146 syntmp-body-782 syntmp-r-741 syntmp-w-760 syntmp-s-761 (quote c&e) (quote (compile load))) (if (memq syntmp-m-743 (quote (c c&e))) (syntmp-chi-top-sequence-146 syntmp-body-782 syntmp-r-741 syntmp-w-760 syntmp-s-761 (quote c) (quote (load))) (syntmp-chi-void-159)))) ((or (memq (quote compile) syntmp-when-list-781) (and (eq? syntmp-m-743 (quote c&e)) (memq (quote eval) syntmp-when-list-781))) (syntmp-top-level-eval-hook-90 (syntmp-chi-top-sequence-146 syntmp-body-782 syntmp-r-741 syntmp-w-760 syntmp-s-761 (quote e) (quote (eval)))) (syntmp-chi-void-159)) (else (syntmp-chi-void-159))))) syntmp-tmp-776) (syntax-error syntmp-tmp-775))) (syntax-dispatch syntmp-tmp-775 (quote (any each-any any . each-any))))) syntmp-e-759) (if (memv syntmp-t-762 (quote (define-syntax-form))) (let ((syntmp-n-785 (syntmp-id-var-name-137 syntmp-value-758 syntmp-w-760)) (syntmp-r-786 (syntmp-macros-only-env-111 syntmp-r-741))) (let ((syntmp-t-787 syntmp-m-743)) (if (memv syntmp-t-787 (quote (c))) (if (memq (quote compile) syntmp-esew-744) (let ((syntmp-e-788 (syntmp-chi-install-global-147 syntmp-n-785 (syntmp-chi-151 syntmp-e-759 syntmp-r-786 syntmp-w-760)))) (begin (syntmp-top-level-eval-hook-90 syntmp-e-788) (if (memq (quote load) syntmp-esew-744) syntmp-e-788 (syntmp-chi-void-159)))) (if (memq (quote load) syntmp-esew-744) (syntmp-chi-install-global-147 syntmp-n-785 (syntmp-chi-151 syntmp-e-759 syntmp-r-786 syntmp-w-760)) (syntmp-chi-void-159))) (if (memv syntmp-t-787 (quote (c&e))) (let ((syntmp-e-789 (syntmp-chi-install-global-147 syntmp-n-785 (syntmp-chi-151 syntmp-e-759 syntmp-r-786 syntmp-w-760)))) (begin (syntmp-top-level-eval-hook-90 syntmp-e-789) syntmp-e-789)) (begin (if (memq (quote eval) syntmp-esew-744) (syntmp-top-level-eval-hook-90 (syntmp-chi-install-global-147 syntmp-n-785 (syntmp-chi-151 syntmp-e-759 syntmp-r-786 syntmp-w-760)))) (syntmp-chi-void-159)))))) (if (memv syntmp-t-762 (quote (define-form))) (let ((syntmp-n-790 (syntmp-id-var-name-137 syntmp-value-758 syntmp-w-760))) (let ((syntmp-type-791 (syntmp-binding-type-107 (syntmp-lookup-112 syntmp-n-790 syntmp-r-741)))) (let ((syntmp-t-792 syntmp-type-791)) (if (memv syntmp-t-792 (quote (global))) (let ((syntmp-x-793 (list (quote define) syntmp-n-790 (syntmp-chi-151 syntmp-e-759 syntmp-r-741 syntmp-w-760)))) (begin (if (eq? syntmp-m-743 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-793)) syntmp-x-793)) (if (memv syntmp-t-792 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-143 syntmp-value-758 syntmp-w-760) "identifier out of context") (if (eq? syntmp-type-791 (quote external-macro)) (let ((syntmp-x-794 (list (quote define) syntmp-n-790 (syntmp-chi-151 syntmp-e-759 syntmp-r-741 syntmp-w-760)))) (begin (if (eq? syntmp-m-743 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-794)) syntmp-x-794)) (syntax-error (syntmp-wrap-143 syntmp-value-758 syntmp-w-760) "cannot define keyword at top level"))))))) (let ((syntmp-x-795 (syntmp-chi-expr-152 syntmp-type-757 syntmp-value-758 syntmp-e-759 syntmp-r-741 syntmp-w-760 syntmp-s-761))) (begin (if (eq? syntmp-m-743 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-795)) syntmp-x-795)))))))))))) (syntmp-syntax-type-149 (lambda (syntmp-e-796 syntmp-r-797 syntmp-w-798 syntmp-s-799 syntmp-rib-800) (cond ((symbol? syntmp-e-796) (let ((syntmp-n-801 (syntmp-id-var-name-137 syntmp-e-796 syntmp-w-798))) (let ((syntmp-b-802 (syntmp-lookup-112 syntmp-n-801 syntmp-r-797))) (let ((syntmp-type-803 (syntmp-binding-type-107 syntmp-b-802))) (let ((syntmp-t-804 syntmp-type-803)) (if (memv syntmp-t-804 (quote (lexical))) (values syntmp-type-803 (syntmp-binding-value-108 syntmp-b-802) syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-804 (quote (global))) (values syntmp-type-803 syntmp-n-801 syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-804 (quote (macro))) (syntmp-syntax-type-149 (syntmp-chi-macro-154 (syntmp-binding-value-108 syntmp-b-802) syntmp-e-796 syntmp-r-797 syntmp-w-798 syntmp-rib-800) syntmp-r-797 (quote (())) syntmp-s-799 syntmp-rib-800) (values syntmp-type-803 (syntmp-binding-value-108 syntmp-b-802) syntmp-e-796 syntmp-w-798 syntmp-s-799))))))))) ((pair? syntmp-e-796) (let ((syntmp-first-805 (car syntmp-e-796))) (if (syntmp-id?-115 syntmp-first-805) (let ((syntmp-n-806 (syntmp-id-var-name-137 syntmp-first-805 syntmp-w-798))) (let ((syntmp-b-807 (syntmp-lookup-112 syntmp-n-806 syntmp-r-797))) (let ((syntmp-type-808 (syntmp-binding-type-107 syntmp-b-807))) (let ((syntmp-t-809 syntmp-type-808)) (if (memv syntmp-t-809 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-108 syntmp-b-807) syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (global))) (values (quote global-call) syntmp-n-806 syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (macro))) (syntmp-syntax-type-149 (syntmp-chi-macro-154 (syntmp-binding-value-108 syntmp-b-807) syntmp-e-796 syntmp-r-797 syntmp-w-798 syntmp-rib-800) syntmp-r-797 (quote (())) syntmp-s-799 syntmp-rib-800) (if (memv syntmp-t-809 (quote (core external-macro))) (values syntmp-type-808 (syntmp-binding-value-108 syntmp-b-807) syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-108 syntmp-b-807) syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (begin))) (values (quote begin-form) #f syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (define))) ((lambda (syntmp-tmp-810) ((lambda (syntmp-tmp-811) (if (if syntmp-tmp-811 (apply (lambda (syntmp-_-812 syntmp-name-813 syntmp-val-814) (syntmp-id?-115 syntmp-name-813)) syntmp-tmp-811) #f) (apply (lambda (syntmp-_-815 syntmp-name-816 syntmp-val-817) (values (quote define-form) syntmp-name-816 syntmp-val-817 syntmp-w-798 syntmp-s-799)) syntmp-tmp-811) ((lambda (syntmp-tmp-818) (if (if syntmp-tmp-818 (apply (lambda (syntmp-_-819 syntmp-name-820 syntmp-args-821 syntmp-e1-822 syntmp-e2-823) (and (syntmp-id?-115 syntmp-name-820) (syntmp-valid-bound-ids?-140 (syntmp-lambda-var-list-164 syntmp-args-821)))) syntmp-tmp-818) #f) (apply (lambda (syntmp-_-824 syntmp-name-825 syntmp-args-826 syntmp-e1-827 syntmp-e2-828) (values (quote define-form) (syntmp-wrap-143 syntmp-name-825 syntmp-w-798) (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) #((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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i"))))) (syntmp-wrap-143 (cons syntmp-args-826 (cons syntmp-e1-827 syntmp-e2-828)) syntmp-w-798)) (quote (())) syntmp-s-799)) syntmp-tmp-818) ((lambda (syntmp-tmp-830) (if (if syntmp-tmp-830 (apply (lambda (syntmp-_-831 syntmp-name-832) (syntmp-id?-115 syntmp-name-832)) syntmp-tmp-830) #f) (apply (lambda (syntmp-_-833 syntmp-name-834) (values (quote define-form) (syntmp-wrap-143 syntmp-name-834 syntmp-w-798) (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) #((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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i")))))) (quote (())) syntmp-s-799)) syntmp-tmp-830) (syntax-error syntmp-tmp-810))) (syntax-dispatch syntmp-tmp-810 (quote (any any)))))) (syntax-dispatch syntmp-tmp-810 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-810 (quote (any any any))))) syntmp-e-796) (if (memv syntmp-t-809 (quote (define-syntax))) ((lambda (syntmp-tmp-835) ((lambda (syntmp-tmp-836) (if (if syntmp-tmp-836 (apply (lambda (syntmp-_-837 syntmp-name-838 syntmp-val-839) (syntmp-id?-115 syntmp-name-838)) syntmp-tmp-836) #f) (apply (lambda (syntmp-_-840 syntmp-name-841 syntmp-val-842) (values (quote define-syntax-form) syntmp-name-841 syntmp-val-842 syntmp-w-798 syntmp-s-799)) syntmp-tmp-836) (syntax-error syntmp-tmp-835))) (syntax-dispatch syntmp-tmp-835 (quote (any any any))))) syntmp-e-796) (values (quote call) #f syntmp-e-796 syntmp-w-798 syntmp-s-799)))))))))))))) (values (quote call) #f syntmp-e-796 syntmp-w-798 syntmp-s-799)))) ((syntmp-syntax-object?-101 syntmp-e-796) (syntmp-syntax-type-149 (syntmp-syntax-object-expression-102 syntmp-e-796) syntmp-r-797 (syntmp-join-wraps-134 syntmp-w-798 (syntmp-syntax-object-wrap-103 syntmp-e-796)) #f syntmp-rib-800)) ((syntmp-annotation?-89 syntmp-e-796) (syntmp-syntax-type-149 (annotation-expression syntmp-e-796) syntmp-r-797 syntmp-w-798 (annotation-source syntmp-e-796) syntmp-rib-800)) ((let ((syntmp-x-843 syntmp-e-796)) (or (boolean? syntmp-x-843) (number? syntmp-x-843) (string? syntmp-x-843) (char? syntmp-x-843) (keyword? syntmp-x-843))) (values (quote constant) #f syntmp-e-796 syntmp-w-798 syntmp-s-799)) (else (values (quote other) #f syntmp-e-796 syntmp-w-798 syntmp-s-799))))) (syntmp-chi-when-list-148 (lambda (syntmp-e-844 syntmp-when-list-845 syntmp-w-846) (let syntmp-f-847 ((syntmp-when-list-848 syntmp-when-list-845) (syntmp-situations-849 (quote ()))) (if (null? syntmp-when-list-848) syntmp-situations-849 (syntmp-f-847 (cdr syntmp-when-list-848) (cons (let ((syntmp-x-850 (car syntmp-when-list-848))) (cond ((syntmp-free-id=?-138 syntmp-x-850 (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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i")))))) (quote compile)) ((syntmp-free-id=?-138 syntmp-x-850 (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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i")))))) (quote load)) ((syntmp-free-id=?-138 syntmp-x-850 (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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i")))))) (quote eval)) (else (syntax-error (syntmp-wrap-143 syntmp-x-850 syntmp-w-846) "invalid eval-when situation")))) syntmp-situations-849)))))) (syntmp-chi-install-global-147 (lambda (syntmp-name-851 syntmp-e-852) (list (quote install-global-transformer) (syntmp-build-data-95 #f syntmp-name-851) syntmp-e-852))) (syntmp-chi-top-sequence-146 (lambda (syntmp-body-853 syntmp-r-854 syntmp-w-855 syntmp-s-856 syntmp-m-857 syntmp-esew-858) (syntmp-build-sequence-96 syntmp-s-856 (let syntmp-dobody-859 ((syntmp-body-860 syntmp-body-853) (syntmp-r-861 syntmp-r-854) (syntmp-w-862 syntmp-w-855) (syntmp-m-863 syntmp-m-857) (syntmp-esew-864 syntmp-esew-858)) (if (null? syntmp-body-860) (quote ()) (let ((syntmp-first-865 (syntmp-chi-top-150 (car syntmp-body-860) syntmp-r-861 syntmp-w-862 syntmp-m-863 syntmp-esew-864))) (cons syntmp-first-865 (syntmp-dobody-859 (cdr syntmp-body-860) syntmp-r-861 syntmp-w-862 syntmp-m-863 syntmp-esew-864)))))))) (syntmp-chi-sequence-145 (lambda (syntmp-body-866 syntmp-r-867 syntmp-w-868 syntmp-s-869) (syntmp-build-sequence-96 syntmp-s-869 (let syntmp-dobody-870 ((syntmp-body-871 syntmp-body-866) (syntmp-r-872 syntmp-r-867) (syntmp-w-873 syntmp-w-868)) (if (null? syntmp-body-871) (quote ()) (let ((syntmp-first-874 (syntmp-chi-151 (car syntmp-body-871) syntmp-r-872 syntmp-w-873))) (cons syntmp-first-874 (syntmp-dobody-870 (cdr syntmp-body-871) syntmp-r-872 syntmp-w-873)))))))) (syntmp-source-wrap-144 (lambda (syntmp-x-875 syntmp-w-876 syntmp-s-877) (syntmp-wrap-143 (if syntmp-s-877 (make-annotation syntmp-x-875 syntmp-s-877 #f) syntmp-x-875) syntmp-w-876))) (syntmp-wrap-143 (lambda (syntmp-x-878 syntmp-w-879) (cond ((and (null? (syntmp-wrap-marks-118 syntmp-w-879)) (null? (syntmp-wrap-subst-119 syntmp-w-879))) syntmp-x-878) ((syntmp-syntax-object?-101 syntmp-x-878) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-878) (syntmp-join-wraps-134 syntmp-w-879 (syntmp-syntax-object-wrap-103 syntmp-x-878)))) ((null? syntmp-x-878) syntmp-x-878) (else (syntmp-make-syntax-object-100 syntmp-x-878 syntmp-w-879))))) (syntmp-bound-id-member?-142 (lambda (syntmp-x-880 syntmp-list-881) (and (not (null? syntmp-list-881)) (or (syntmp-bound-id=?-139 syntmp-x-880 (car syntmp-list-881)) (syntmp-bound-id-member?-142 syntmp-x-880 (cdr syntmp-list-881)))))) (syntmp-distinct-bound-ids?-141 (lambda (syntmp-ids-882) (let syntmp-distinct?-883 ((syntmp-ids-884 syntmp-ids-882)) (or (null? syntmp-ids-884) (and (not (syntmp-bound-id-member?-142 (car syntmp-ids-884) (cdr syntmp-ids-884))) (syntmp-distinct?-883 (cdr syntmp-ids-884))))))) (syntmp-valid-bound-ids?-140 (lambda (syntmp-ids-885) (and (let syntmp-all-ids?-886 ((syntmp-ids-887 syntmp-ids-885)) (or (null? syntmp-ids-887) (and (syntmp-id?-115 (car syntmp-ids-887)) (syntmp-all-ids?-886 (cdr syntmp-ids-887))))) (syntmp-distinct-bound-ids?-141 syntmp-ids-885)))) (syntmp-bound-id=?-139 (lambda (syntmp-i-888 syntmp-j-889) (if (and (syntmp-syntax-object?-101 syntmp-i-888) (syntmp-syntax-object?-101 syntmp-j-889)) (and (eq? (let ((syntmp-e-890 (syntmp-syntax-object-expression-102 syntmp-i-888))) (if (syntmp-annotation?-89 syntmp-e-890) (annotation-expression syntmp-e-890) syntmp-e-890)) (let ((syntmp-e-891 (syntmp-syntax-object-expression-102 syntmp-j-889))) (if (syntmp-annotation?-89 syntmp-e-891) (annotation-expression syntmp-e-891) syntmp-e-891))) (syntmp-same-marks?-136 (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-i-888)) (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-j-889)))) (eq? (let ((syntmp-e-892 syntmp-i-888)) (if (syntmp-annotation?-89 syntmp-e-892) (annotation-expression syntmp-e-892) syntmp-e-892)) (let ((syntmp-e-893 syntmp-j-889)) (if (syntmp-annotation?-89 syntmp-e-893) (annotation-expression syntmp-e-893) syntmp-e-893)))))) (syntmp-free-id=?-138 (lambda (syntmp-i-894 syntmp-j-895) (and (eq? (let ((syntmp-x-896 syntmp-i-894)) (let ((syntmp-e-897 (if (syntmp-syntax-object?-101 syntmp-x-896) (syntmp-syntax-object-expression-102 syntmp-x-896) syntmp-x-896))) (if (syntmp-annotation?-89 syntmp-e-897) (annotation-expression syntmp-e-897) syntmp-e-897))) (let ((syntmp-x-898 syntmp-j-895)) (let ((syntmp-e-899 (if (syntmp-syntax-object?-101 syntmp-x-898) (syntmp-syntax-object-expression-102 syntmp-x-898) syntmp-x-898))) (if (syntmp-annotation?-89 syntmp-e-899) (annotation-expression syntmp-e-899) syntmp-e-899)))) (eq? (syntmp-id-var-name-137 syntmp-i-894 (quote (()))) (syntmp-id-var-name-137 syntmp-j-895 (quote (()))))))) (syntmp-id-var-name-137 (lambda (syntmp-id-900 syntmp-w-901) (letrec ((syntmp-search-vector-rib-904 (lambda (syntmp-sym-915 syntmp-subst-916 syntmp-marks-917 syntmp-symnames-918 syntmp-ribcage-919) (let ((syntmp-n-920 (vector-length syntmp-symnames-918))) (let syntmp-f-921 ((syntmp-i-922 0)) (cond ((syntmp-fx=-87 syntmp-i-922 syntmp-n-920) (syntmp-search-902 syntmp-sym-915 (cdr syntmp-subst-916) syntmp-marks-917)) ((and (eq? (vector-ref syntmp-symnames-918 syntmp-i-922) syntmp-sym-915) (syntmp-same-marks?-136 syntmp-marks-917 (vector-ref (syntmp-ribcage-marks-125 syntmp-ribcage-919) syntmp-i-922))) (values (vector-ref (syntmp-ribcage-labels-126 syntmp-ribcage-919) syntmp-i-922) syntmp-marks-917)) (else (syntmp-f-921 (syntmp-fx+-85 syntmp-i-922 1)))))))) (syntmp-search-list-rib-903 (lambda (syntmp-sym-923 syntmp-subst-924 syntmp-marks-925 syntmp-symnames-926 syntmp-ribcage-927) (let syntmp-f-928 ((syntmp-symnames-929 syntmp-symnames-926) (syntmp-i-930 0)) (cond ((null? syntmp-symnames-929) (syntmp-search-902 syntmp-sym-923 (cdr syntmp-subst-924) syntmp-marks-925)) ((and (eq? (car syntmp-symnames-929) syntmp-sym-923) (syntmp-same-marks?-136 syntmp-marks-925 (list-ref (syntmp-ribcage-marks-125 syntmp-ribcage-927) syntmp-i-930))) (values (list-ref (syntmp-ribcage-labels-126 syntmp-ribcage-927) syntmp-i-930) syntmp-marks-925)) (else (syntmp-f-928 (cdr syntmp-symnames-929) (syntmp-fx+-85 syntmp-i-930 1))))))) (syntmp-search-902 (lambda (syntmp-sym-931 syntmp-subst-932 syntmp-marks-933) (if (null? syntmp-subst-932) (values #f syntmp-marks-933) (let ((syntmp-fst-934 (car syntmp-subst-932))) (if (eq? syntmp-fst-934 (quote shift)) (syntmp-search-902 syntmp-sym-931 (cdr syntmp-subst-932) (cdr syntmp-marks-933)) (let ((syntmp-symnames-935 (syntmp-ribcage-symnames-124 syntmp-fst-934))) (if (vector? syntmp-symnames-935) (syntmp-search-vector-rib-904 syntmp-sym-931 syntmp-subst-932 syntmp-marks-933 syntmp-symnames-935 syntmp-fst-934) (syntmp-search-list-rib-903 syntmp-sym-931 syntmp-subst-932 syntmp-marks-933 syntmp-symnames-935 syntmp-fst-934))))))))) (cond ((symbol? syntmp-id-900) (or (call-with-values (lambda () (syntmp-search-902 syntmp-id-900 (syntmp-wrap-subst-119 syntmp-w-901) (syntmp-wrap-marks-118 syntmp-w-901))) (lambda (syntmp-x-937 . syntmp-ignore-936) syntmp-x-937)) syntmp-id-900)) ((syntmp-syntax-object?-101 syntmp-id-900) (let ((syntmp-id-938 (let ((syntmp-e-940 (syntmp-syntax-object-expression-102 syntmp-id-900))) (if (syntmp-annotation?-89 syntmp-e-940) (annotation-expression syntmp-e-940) syntmp-e-940))) (syntmp-w1-939 (syntmp-syntax-object-wrap-103 syntmp-id-900))) (let ((syntmp-marks-941 (syntmp-join-marks-135 (syntmp-wrap-marks-118 syntmp-w-901) (syntmp-wrap-marks-118 syntmp-w1-939)))) (call-with-values (lambda () (syntmp-search-902 syntmp-id-938 (syntmp-wrap-subst-119 syntmp-w-901) syntmp-marks-941)) (lambda (syntmp-new-id-942 syntmp-marks-943) (or syntmp-new-id-942 (call-with-values (lambda () (syntmp-search-902 syntmp-id-938 (syntmp-wrap-subst-119 syntmp-w1-939) syntmp-marks-943)) (lambda (syntmp-x-945 . syntmp-ignore-944) syntmp-x-945)) syntmp-id-938)))))) ((syntmp-annotation?-89 syntmp-id-900) (let ((syntmp-id-946 (let ((syntmp-e-947 syntmp-id-900)) (if (syntmp-annotation?-89 syntmp-e-947) (annotation-expression syntmp-e-947) syntmp-e-947)))) (or (call-with-values (lambda () (syntmp-search-902 syntmp-id-946 (syntmp-wrap-subst-119 syntmp-w-901) (syntmp-wrap-marks-118 syntmp-w-901))) (lambda (syntmp-x-949 . syntmp-ignore-948) syntmp-x-949)) syntmp-id-946))) (else (syntmp-error-hook-92 (quote id-var-name) "invalid id" syntmp-id-900)))))) (syntmp-same-marks?-136 (lambda (syntmp-x-950 syntmp-y-951) (or (eq? syntmp-x-950 syntmp-y-951) (and (not (null? syntmp-x-950)) (not (null? syntmp-y-951)) (eq? (car syntmp-x-950) (car syntmp-y-951)) (syntmp-same-marks?-136 (cdr syntmp-x-950) (cdr syntmp-y-951)))))) (syntmp-join-marks-135 (lambda (syntmp-m1-952 syntmp-m2-953) (syntmp-smart-append-133 syntmp-m1-952 syntmp-m2-953))) (syntmp-join-wraps-134 (lambda (syntmp-w1-954 syntmp-w2-955) (let ((syntmp-m1-956 (syntmp-wrap-marks-118 syntmp-w1-954)) (syntmp-s1-957 (syntmp-wrap-subst-119 syntmp-w1-954))) (if (null? syntmp-m1-956) (if (null? syntmp-s1-957) syntmp-w2-955 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w2-955) (syntmp-smart-append-133 syntmp-s1-957 (syntmp-wrap-subst-119 syntmp-w2-955)))) (syntmp-make-wrap-117 (syntmp-smart-append-133 syntmp-m1-956 (syntmp-wrap-marks-118 syntmp-w2-955)) (syntmp-smart-append-133 syntmp-s1-957 (syntmp-wrap-subst-119 syntmp-w2-955))))))) (syntmp-smart-append-133 (lambda (syntmp-m1-958 syntmp-m2-959) (if (null? syntmp-m2-959) syntmp-m1-958 (append syntmp-m1-958 syntmp-m2-959)))) (syntmp-make-binding-wrap-132 (lambda (syntmp-ids-960 syntmp-labels-961 syntmp-w-962) (if (null? syntmp-ids-960) syntmp-w-962 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w-962) (cons (let ((syntmp-labelvec-963 (list->vector syntmp-labels-961))) (let ((syntmp-n-964 (vector-length syntmp-labelvec-963))) (let ((syntmp-symnamevec-965 (make-vector syntmp-n-964)) (syntmp-marksvec-966 (make-vector syntmp-n-964))) (begin (let syntmp-f-967 ((syntmp-ids-968 syntmp-ids-960) (syntmp-i-969 0)) (if (not (null? syntmp-ids-968)) (call-with-values (lambda () (syntmp-id-sym-name&marks-116 (car syntmp-ids-968) syntmp-w-962)) (lambda (syntmp-symname-970 syntmp-marks-971) (begin (vector-set! syntmp-symnamevec-965 syntmp-i-969 syntmp-symname-970) (vector-set! syntmp-marksvec-966 syntmp-i-969 syntmp-marks-971) (syntmp-f-967 (cdr syntmp-ids-968) (syntmp-fx+-85 syntmp-i-969 1))))))) (syntmp-make-ribcage-122 syntmp-symnamevec-965 syntmp-marksvec-966 syntmp-labelvec-963))))) (syntmp-wrap-subst-119 syntmp-w-962)))))) (syntmp-extend-ribcage!-131 (lambda (syntmp-ribcage-972 syntmp-id-973 syntmp-label-974) (begin (syntmp-set-ribcage-symnames!-127 syntmp-ribcage-972 (cons (let ((syntmp-e-975 (syntmp-syntax-object-expression-102 syntmp-id-973))) (if (syntmp-annotation?-89 syntmp-e-975) (annotation-expression syntmp-e-975) syntmp-e-975)) (syntmp-ribcage-symnames-124 syntmp-ribcage-972))) (syntmp-set-ribcage-marks!-128 syntmp-ribcage-972 (cons (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-id-973)) (syntmp-ribcage-marks-125 syntmp-ribcage-972))) (syntmp-set-ribcage-labels!-129 syntmp-ribcage-972 (cons syntmp-label-974 (syntmp-ribcage-labels-126 syntmp-ribcage-972)))))) (syntmp-anti-mark-130 (lambda (syntmp-w-976) (syntmp-make-wrap-117 (cons #f (syntmp-wrap-marks-118 syntmp-w-976)) (cons (quote shift) (syntmp-wrap-subst-119 syntmp-w-976))))) (syntmp-set-ribcage-labels!-129 (lambda (syntmp-x-977 syntmp-update-978) (vector-set! syntmp-x-977 3 syntmp-update-978))) (syntmp-set-ribcage-marks!-128 (lambda (syntmp-x-979 syntmp-update-980) (vector-set! syntmp-x-979 2 syntmp-update-980))) (syntmp-set-ribcage-symnames!-127 (lambda (syntmp-x-981 syntmp-update-982) (vector-set! syntmp-x-981 1 syntmp-update-982))) (syntmp-ribcage-labels-126 (lambda (syntmp-x-983) (vector-ref syntmp-x-983 3))) (syntmp-ribcage-marks-125 (lambda (syntmp-x-984) (vector-ref syntmp-x-984 2))) (syntmp-ribcage-symnames-124 (lambda (syntmp-x-985) (vector-ref syntmp-x-985 1))) (syntmp-ribcage?-123 (lambda (syntmp-x-986) (and (vector? syntmp-x-986) (= (vector-length syntmp-x-986) 4) (eq? (vector-ref syntmp-x-986 0) (quote ribcage))))) (syntmp-make-ribcage-122 (lambda (syntmp-symnames-987 syntmp-marks-988 syntmp-labels-989) (vector (quote ribcage) syntmp-symnames-987 syntmp-marks-988 syntmp-labels-989))) (syntmp-gen-labels-121 (lambda (syntmp-ls-990) (if (null? syntmp-ls-990) (quote ()) (cons (syntmp-gen-label-120) (syntmp-gen-labels-121 (cdr syntmp-ls-990)))))) (syntmp-gen-label-120 (lambda () (string #\i))) (syntmp-wrap-subst-119 cdr) (syntmp-wrap-marks-118 car) (syntmp-make-wrap-117 cons) (syntmp-id-sym-name&marks-116 (lambda (syntmp-x-991 syntmp-w-992) (if (syntmp-syntax-object?-101 syntmp-x-991) (values (let ((syntmp-e-993 (syntmp-syntax-object-expression-102 syntmp-x-991))) (if (syntmp-annotation?-89 syntmp-e-993) (annotation-expression syntmp-e-993) syntmp-e-993)) (syntmp-join-marks-135 (syntmp-wrap-marks-118 syntmp-w-992) (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-x-991)))) (values (let ((syntmp-e-994 syntmp-x-991)) (if (syntmp-annotation?-89 syntmp-e-994) (annotation-expression syntmp-e-994) syntmp-e-994)) (syntmp-wrap-marks-118 syntmp-w-992))))) (syntmp-id?-115 (lambda (syntmp-x-995) (cond ((symbol? syntmp-x-995) #t) ((syntmp-syntax-object?-101 syntmp-x-995) (symbol? (let ((syntmp-e-996 (syntmp-syntax-object-expression-102 syntmp-x-995))) (if (syntmp-annotation?-89 syntmp-e-996) (annotation-expression syntmp-e-996) syntmp-e-996)))) ((syntmp-annotation?-89 syntmp-x-995) (symbol? (annotation-expression syntmp-x-995))) (else #f)))) (syntmp-nonsymbol-id?-114 (lambda (syntmp-x-997) (and (syntmp-syntax-object?-101 syntmp-x-997) (symbol? (let ((syntmp-e-998 (syntmp-syntax-object-expression-102 syntmp-x-997))) (if (syntmp-annotation?-89 syntmp-e-998) (annotation-expression syntmp-e-998) syntmp-e-998)))))) (syntmp-global-extend-113 (lambda (syntmp-type-999 syntmp-sym-1000 syntmp-val-1001) (syntmp-put-global-definition-hook-93 syntmp-sym-1000 (cons syntmp-type-999 syntmp-val-1001)))) (syntmp-lookup-112 (lambda (syntmp-x-1002 syntmp-r-1003) (cond ((assq syntmp-x-1002 syntmp-r-1003) => cdr) ((symbol? syntmp-x-1002) (or (syntmp-get-global-definition-hook-94 syntmp-x-1002) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-111 (lambda (syntmp-r-1004) (if (null? syntmp-r-1004) (quote ()) (let ((syntmp-a-1005 (car syntmp-r-1004))) (if (eq? (cadr syntmp-a-1005) (quote macro)) (cons syntmp-a-1005 (syntmp-macros-only-env-111 (cdr syntmp-r-1004))) (syntmp-macros-only-env-111 (cdr syntmp-r-1004))))))) (syntmp-extend-var-env-110 (lambda (syntmp-labels-1006 syntmp-vars-1007 syntmp-r-1008) (if (null? syntmp-labels-1006) syntmp-r-1008 (syntmp-extend-var-env-110 (cdr syntmp-labels-1006) (cdr syntmp-vars-1007) (cons (cons (car syntmp-labels-1006) (cons (quote lexical) (car syntmp-vars-1007))) syntmp-r-1008))))) (syntmp-extend-env-109 (lambda (syntmp-labels-1009 syntmp-bindings-1010 syntmp-r-1011) (if (null? syntmp-labels-1009) syntmp-r-1011 (syntmp-extend-env-109 (cdr syntmp-labels-1009) (cdr syntmp-bindings-1010) (cons (cons (car syntmp-labels-1009) (car syntmp-bindings-1010)) syntmp-r-1011))))) (syntmp-binding-value-108 cdr) (syntmp-binding-type-107 car) (syntmp-source-annotation-106 (lambda (syntmp-x-1012) (cond ((syntmp-annotation?-89 syntmp-x-1012) (annotation-source syntmp-x-1012)) ((syntmp-syntax-object?-101 syntmp-x-1012) (syntmp-source-annotation-106 (syntmp-syntax-object-expression-102 syntmp-x-1012))) (else #f)))) (syntmp-set-syntax-object-wrap!-105 (lambda (syntmp-x-1013 syntmp-update-1014) (vector-set! syntmp-x-1013 2 syntmp-update-1014))) (syntmp-set-syntax-object-expression!-104 (lambda (syntmp-x-1015 syntmp-update-1016) (vector-set! syntmp-x-1015 1 syntmp-update-1016))) (syntmp-syntax-object-wrap-103 (lambda (syntmp-x-1017) (vector-ref syntmp-x-1017 2))) (syntmp-syntax-object-expression-102 (lambda (syntmp-x-1018) (vector-ref syntmp-x-1018 1))) (syntmp-syntax-object?-101 (lambda (syntmp-x-1019) (and (vector? syntmp-x-1019) (= (vector-length syntmp-x-1019) 3) (eq? (vector-ref syntmp-x-1019 0) (quote syntax-object))))) (syntmp-make-syntax-object-100 (lambda (syntmp-expression-1020 syntmp-wrap-1021) (vector (quote syntax-object) syntmp-expression-1020 syntmp-wrap-1021))) (syntmp-build-letrec-99 (lambda (syntmp-src-1022 syntmp-vars-1023 syntmp-val-exps-1024 syntmp-body-exp-1025) (if (null? syntmp-vars-1023) syntmp-body-exp-1025 (list (quote letrec) (map list syntmp-vars-1023 syntmp-val-exps-1024) syntmp-body-exp-1025)))) (syntmp-build-named-let-98 (lambda (syntmp-src-1026 syntmp-vars-1027 syntmp-val-exps-1028 syntmp-body-exp-1029) (if (null? syntmp-vars-1027) syntmp-body-exp-1029 (list (quote let) (car syntmp-vars-1027) (map list (cdr syntmp-vars-1027) syntmp-val-exps-1028) syntmp-body-exp-1029)))) (syntmp-build-let-97 (lambda (syntmp-src-1030 syntmp-vars-1031 syntmp-val-exps-1032 syntmp-body-exp-1033) (if (null? syntmp-vars-1031) syntmp-body-exp-1033 (list (quote let) (map list syntmp-vars-1031 syntmp-val-exps-1032) syntmp-body-exp-1033)))) (syntmp-build-sequence-96 (lambda (syntmp-src-1034 syntmp-exps-1035) (if (null? (cdr syntmp-exps-1035)) (car syntmp-exps-1035) (cons (quote begin) syntmp-exps-1035)))) (syntmp-build-data-95 (lambda (syntmp-src-1036 syntmp-exp-1037) (if (let ((syntmp-x-1038 syntmp-exp-1037)) (or (boolean? syntmp-x-1038) (number? syntmp-x-1038) (string? syntmp-x-1038) (char? syntmp-x-1038) (keyword? syntmp-x-1038))) syntmp-exp-1037 (list (quote quote) syntmp-exp-1037)))) (syntmp-get-global-definition-hook-94 (lambda (syntmp-symbol-1039) (getprop syntmp-symbol-1039 (quote *sc-expander*)))) (syntmp-put-global-definition-hook-93 (lambda (syntmp-symbol-1040 syntmp-binding-1041) (putprop syntmp-symbol-1040 (quote *sc-expander*) syntmp-binding-1041))) (syntmp-error-hook-92 (lambda (syntmp-who-1042 syntmp-why-1043 syntmp-what-1044) (error syntmp-who-1042 "~a ~s" syntmp-why-1043 syntmp-what-1044))) (syntmp-local-eval-hook-91 (lambda (syntmp-x-1045) (eval (list syntmp-noexpand-84 syntmp-x-1045) (interaction-environment)))) (syntmp-top-level-eval-hook-90 (lambda (syntmp-x-1046) (eval (list syntmp-noexpand-84 syntmp-x-1046) (interaction-environment)))) (syntmp-annotation?-89 (lambda (syntmp-x-1047) #f)) (syntmp-fx<-88 <) (syntmp-fx=-87 =) (syntmp-fx--86 -) (syntmp-fx+-85 +) (syntmp-noexpand-84 "noexpand")) (begin (syntmp-global-extend-113 (quote local-syntax) (quote letrec-syntax) #t) (syntmp-global-extend-113 (quote local-syntax) (quote let-syntax) #f) (syntmp-global-extend-113 (quote core) (quote fluid-let-syntax) (lambda (syntmp-e-1048 syntmp-r-1049 syntmp-w-1050 syntmp-s-1051) ((lambda (syntmp-tmp-1052) ((lambda (syntmp-tmp-1053) (if (if syntmp-tmp-1053 (apply (lambda (syntmp-_-1054 syntmp-var-1055 syntmp-val-1056 syntmp-e1-1057 syntmp-e2-1058) (syntmp-valid-bound-ids?-140 syntmp-var-1055)) syntmp-tmp-1053) #f) (apply (lambda (syntmp-_-1060 syntmp-var-1061 syntmp-val-1062 syntmp-e1-1063 syntmp-e2-1064) (let ((syntmp-names-1065 (map (lambda (syntmp-x-1066) (syntmp-id-var-name-137 syntmp-x-1066 syntmp-w-1050)) syntmp-var-1061))) (begin (for-each (lambda (syntmp-id-1068 syntmp-n-1069) (let ((syntmp-t-1070 (syntmp-binding-type-107 (syntmp-lookup-112 syntmp-n-1069 syntmp-r-1049)))) (if (memv syntmp-t-1070 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-144 syntmp-id-1068 syntmp-w-1050 syntmp-s-1051) "identifier out of context")))) syntmp-var-1061 syntmp-names-1065) (syntmp-chi-body-155 (cons syntmp-e1-1063 syntmp-e2-1064) (syntmp-source-wrap-144 syntmp-e-1048 syntmp-w-1050 syntmp-s-1051) (syntmp-extend-env-109 syntmp-names-1065 (let ((syntmp-trans-r-1073 (syntmp-macros-only-env-111 syntmp-r-1049))) (map (lambda (syntmp-x-1074) (cons (quote macro) (syntmp-eval-local-transformer-158 (syntmp-chi-151 syntmp-x-1074 syntmp-trans-r-1073 syntmp-w-1050)))) syntmp-val-1062)) syntmp-r-1049) syntmp-w-1050)))) syntmp-tmp-1053) ((lambda (syntmp-_-1076) (syntax-error (syntmp-source-wrap-144 syntmp-e-1048 syntmp-w-1050 syntmp-s-1051))) syntmp-tmp-1052))) (syntax-dispatch syntmp-tmp-1052 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1048))) (syntmp-global-extend-113 (quote core) (quote quote) (lambda (syntmp-e-1077 syntmp-r-1078 syntmp-w-1079 syntmp-s-1080) ((lambda (syntmp-tmp-1081) ((lambda (syntmp-tmp-1082) (if syntmp-tmp-1082 (apply (lambda (syntmp-_-1083 syntmp-e-1084) (syntmp-build-data-95 syntmp-s-1080 (syntmp-strip-162 syntmp-e-1084 syntmp-w-1079))) syntmp-tmp-1082) ((lambda (syntmp-_-1085) (syntax-error (syntmp-source-wrap-144 syntmp-e-1077 syntmp-w-1079 syntmp-s-1080))) syntmp-tmp-1081))) (syntax-dispatch syntmp-tmp-1081 (quote (any any))))) syntmp-e-1077))) (syntmp-global-extend-113 (quote core) (quote syntax) (letrec ((syntmp-regen-1093 (lambda (syntmp-x-1094) (let ((syntmp-t-1095 (car syntmp-x-1094))) (if (memv syntmp-t-1095 (quote (ref))) (cadr syntmp-x-1094) (if (memv syntmp-t-1095 (quote (primitive))) (cadr syntmp-x-1094) (if (memv syntmp-t-1095 (quote (quote))) (syntmp-build-data-95 #f (cadr syntmp-x-1094)) (if (memv syntmp-t-1095 (quote (lambda))) (list (quote lambda) (cadr syntmp-x-1094) (syntmp-regen-1093 (caddr syntmp-x-1094))) (if (memv syntmp-t-1095 (quote (map))) (let ((syntmp-ls-1096 (map syntmp-regen-1093 (cdr syntmp-x-1094)))) (cons (if (syntmp-fx=-87 (length syntmp-ls-1096) 2) (quote map) (quote map)) syntmp-ls-1096)) (cons (car syntmp-x-1094) (map syntmp-regen-1093 (cdr syntmp-x-1094))))))))))) (syntmp-gen-vector-1092 (lambda (syntmp-x-1097) (cond ((eq? (car syntmp-x-1097) (quote list)) (cons (quote vector) (cdr syntmp-x-1097))) ((eq? (car syntmp-x-1097) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1097)))) (else (list (quote list->vector) syntmp-x-1097))))) (syntmp-gen-append-1091 (lambda (syntmp-x-1098 syntmp-y-1099) (if (equal? syntmp-y-1099 (quote (quote ()))) syntmp-x-1098 (list (quote append) syntmp-x-1098 syntmp-y-1099)))) (syntmp-gen-cons-1090 (lambda (syntmp-x-1100 syntmp-y-1101) (let ((syntmp-t-1102 (car syntmp-y-1101))) (if (memv syntmp-t-1102 (quote (quote))) (if (eq? (car syntmp-x-1100) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1100) (cadr syntmp-y-1101))) (if (eq? (cadr syntmp-y-1101) (quote ())) (list (quote list) syntmp-x-1100) (list (quote cons) syntmp-x-1100 syntmp-y-1101))) (if (memv syntmp-t-1102 (quote (list))) (cons (quote list) (cons syntmp-x-1100 (cdr syntmp-y-1101))) (list (quote cons) syntmp-x-1100 syntmp-y-1101)))))) (syntmp-gen-map-1089 (lambda (syntmp-e-1103 syntmp-map-env-1104) (let ((syntmp-formals-1105 (map cdr syntmp-map-env-1104)) (syntmp-actuals-1106 (map (lambda (syntmp-x-1107) (list (quote ref) (car syntmp-x-1107))) syntmp-map-env-1104))) (cond ((eq? (car syntmp-e-1103) (quote ref)) (car syntmp-actuals-1106)) ((andmap (lambda (syntmp-x-1108) (and (eq? (car syntmp-x-1108) (quote ref)) (memq (cadr syntmp-x-1108) syntmp-formals-1105))) (cdr syntmp-e-1103)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1103)) (map (let ((syntmp-r-1109 (map cons syntmp-formals-1105 syntmp-actuals-1106))) (lambda (syntmp-x-1110) (cdr (assq (cadr syntmp-x-1110) syntmp-r-1109)))) (cdr syntmp-e-1103))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1105 syntmp-e-1103) syntmp-actuals-1106))))))) (syntmp-gen-mappend-1088 (lambda (syntmp-e-1111 syntmp-map-env-1112) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1089 syntmp-e-1111 syntmp-map-env-1112)))) (syntmp-gen-ref-1087 (lambda (syntmp-src-1113 syntmp-var-1114 syntmp-level-1115 syntmp-maps-1116) (if (syntmp-fx=-87 syntmp-level-1115 0) (values syntmp-var-1114 syntmp-maps-1116) (if (null? syntmp-maps-1116) (syntax-error syntmp-src-1113 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1087 syntmp-src-1113 syntmp-var-1114 (syntmp-fx--86 syntmp-level-1115 1) (cdr syntmp-maps-1116))) (lambda (syntmp-outer-var-1117 syntmp-outer-maps-1118) (let ((syntmp-b-1119 (assq syntmp-outer-var-1117 (car syntmp-maps-1116)))) (if syntmp-b-1119 (values (cdr syntmp-b-1119) syntmp-maps-1116) (let ((syntmp-inner-var-1120 (syntmp-gen-var-163 (quote tmp)))) (values syntmp-inner-var-1120 (cons (cons (cons syntmp-outer-var-1117 syntmp-inner-var-1120) (car syntmp-maps-1116)) syntmp-outer-maps-1118))))))))))) (syntmp-gen-syntax-1086 (lambda (syntmp-src-1121 syntmp-e-1122 syntmp-r-1123 syntmp-maps-1124 syntmp-ellipsis?-1125) (if (syntmp-id?-115 syntmp-e-1122) (let ((syntmp-label-1126 (syntmp-id-var-name-137 syntmp-e-1122 (quote (()))))) (let ((syntmp-b-1127 (syntmp-lookup-112 syntmp-label-1126 syntmp-r-1123))) (if (eq? (syntmp-binding-type-107 syntmp-b-1127) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1128 (syntmp-binding-value-108 syntmp-b-1127))) (syntmp-gen-ref-1087 syntmp-src-1121 (car syntmp-var.lev-1128) (cdr syntmp-var.lev-1128) syntmp-maps-1124))) (lambda (syntmp-var-1129 syntmp-maps-1130) (values (list (quote ref) syntmp-var-1129) syntmp-maps-1130))) (if (syntmp-ellipsis?-1125 syntmp-e-1122) (syntax-error syntmp-src-1121 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1122) syntmp-maps-1124))))) ((lambda (syntmp-tmp-1131) ((lambda (syntmp-tmp-1132) (if (if syntmp-tmp-1132 (apply (lambda (syntmp-dots-1133 syntmp-e-1134) (syntmp-ellipsis?-1125 syntmp-dots-1133)) syntmp-tmp-1132) #f) (apply (lambda (syntmp-dots-1135 syntmp-e-1136) (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-e-1136 syntmp-r-1123 syntmp-maps-1124 (lambda (syntmp-x-1137) #f))) syntmp-tmp-1132) ((lambda (syntmp-tmp-1138) (if (if syntmp-tmp-1138 (apply (lambda (syntmp-x-1139 syntmp-dots-1140 syntmp-y-1141) (syntmp-ellipsis?-1125 syntmp-dots-1140)) syntmp-tmp-1138) #f) (apply (lambda (syntmp-x-1142 syntmp-dots-1143 syntmp-y-1144) (let syntmp-f-1145 ((syntmp-y-1146 syntmp-y-1144) (syntmp-k-1147 (lambda (syntmp-maps-1148) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-x-1142 syntmp-r-1123 (cons (quote ()) syntmp-maps-1148) syntmp-ellipsis?-1125)) (lambda (syntmp-x-1149 syntmp-maps-1150) (if (null? (car syntmp-maps-1150)) (syntax-error syntmp-src-1121 "extra ellipsis in syntax form") (values (syntmp-gen-map-1089 syntmp-x-1149 (car syntmp-maps-1150)) (cdr syntmp-maps-1150)))))))) ((lambda (syntmp-tmp-1151) ((lambda (syntmp-tmp-1152) (if (if syntmp-tmp-1152 (apply (lambda (syntmp-dots-1153 syntmp-y-1154) (syntmp-ellipsis?-1125 syntmp-dots-1153)) syntmp-tmp-1152) #f) (apply (lambda (syntmp-dots-1155 syntmp-y-1156) (syntmp-f-1145 syntmp-y-1156 (lambda (syntmp-maps-1157) (call-with-values (lambda () (syntmp-k-1147 (cons (quote ()) syntmp-maps-1157))) (lambda (syntmp-x-1158 syntmp-maps-1159) (if (null? (car syntmp-maps-1159)) (syntax-error syntmp-src-1121 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1088 syntmp-x-1158 (car syntmp-maps-1159)) (cdr syntmp-maps-1159)))))))) syntmp-tmp-1152) ((lambda (syntmp-_-1160) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-y-1146 syntmp-r-1123 syntmp-maps-1124 syntmp-ellipsis?-1125)) (lambda (syntmp-y-1161 syntmp-maps-1162) (call-with-values (lambda () (syntmp-k-1147 syntmp-maps-1162)) (lambda (syntmp-x-1163 syntmp-maps-1164) (values (syntmp-gen-append-1091 syntmp-x-1163 syntmp-y-1161) syntmp-maps-1164)))))) syntmp-tmp-1151))) (syntax-dispatch syntmp-tmp-1151 (quote (any . any))))) syntmp-y-1146))) syntmp-tmp-1138) ((lambda (syntmp-tmp-1165) (if syntmp-tmp-1165 (apply (lambda (syntmp-x-1166 syntmp-y-1167) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-x-1166 syntmp-r-1123 syntmp-maps-1124 syntmp-ellipsis?-1125)) (lambda (syntmp-x-1168 syntmp-maps-1169) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-y-1167 syntmp-r-1123 syntmp-maps-1169 syntmp-ellipsis?-1125)) (lambda (syntmp-y-1170 syntmp-maps-1171) (values (syntmp-gen-cons-1090 syntmp-x-1168 syntmp-y-1170) syntmp-maps-1171)))))) syntmp-tmp-1165) ((lambda (syntmp-tmp-1172) (if syntmp-tmp-1172 (apply (lambda (syntmp-e1-1173 syntmp-e2-1174) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 (cons syntmp-e1-1173 syntmp-e2-1174) syntmp-r-1123 syntmp-maps-1124 syntmp-ellipsis?-1125)) (lambda (syntmp-e-1176 syntmp-maps-1177) (values (syntmp-gen-vector-1092 syntmp-e-1176) syntmp-maps-1177)))) syntmp-tmp-1172) ((lambda (syntmp-_-1178) (values (list (quote quote) syntmp-e-1122) syntmp-maps-1124)) syntmp-tmp-1131))) (syntax-dispatch syntmp-tmp-1131 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1131 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1131 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1131 (quote (any any))))) syntmp-e-1122))))) (lambda (syntmp-e-1179 syntmp-r-1180 syntmp-w-1181 syntmp-s-1182) (let ((syntmp-e-1183 (syntmp-source-wrap-144 syntmp-e-1179 syntmp-w-1181 syntmp-s-1182))) ((lambda (syntmp-tmp-1184) ((lambda (syntmp-tmp-1185) (if syntmp-tmp-1185 (apply (lambda (syntmp-_-1186 syntmp-x-1187) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-e-1183 syntmp-x-1187 syntmp-r-1180 (quote ()) syntmp-ellipsis?-160)) (lambda (syntmp-e-1188 syntmp-maps-1189) (syntmp-regen-1093 syntmp-e-1188)))) syntmp-tmp-1185) ((lambda (syntmp-_-1190) (syntax-error syntmp-e-1183)) syntmp-tmp-1184))) (syntax-dispatch syntmp-tmp-1184 (quote (any any))))) syntmp-e-1183))))) (syntmp-global-extend-113 (quote core) (quote lambda) (lambda (syntmp-e-1191 syntmp-r-1192 syntmp-w-1193 syntmp-s-1194) ((lambda (syntmp-tmp-1195) ((lambda (syntmp-tmp-1196) (if syntmp-tmp-1196 (apply (lambda (syntmp-_-1197 syntmp-c-1198) (syntmp-chi-lambda-clause-156 (syntmp-source-wrap-144 syntmp-e-1191 syntmp-w-1193 syntmp-s-1194) syntmp-c-1198 syntmp-r-1192 syntmp-w-1193 (lambda (syntmp-vars-1199 syntmp-body-1200) (list (quote lambda) syntmp-vars-1199 syntmp-body-1200)))) syntmp-tmp-1196) (syntax-error syntmp-tmp-1195))) (syntax-dispatch syntmp-tmp-1195 (quote (any . any))))) syntmp-e-1191))) (syntmp-global-extend-113 (quote core) (quote let) (letrec ((syntmp-chi-let-1201 (lambda (syntmp-e-1202 syntmp-r-1203 syntmp-w-1204 syntmp-s-1205 syntmp-constructor-1206 syntmp-ids-1207 syntmp-vals-1208 syntmp-exps-1209) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-1207)) (syntax-error syntmp-e-1202 "duplicate bound variable in") (let ((syntmp-labels-1210 (syntmp-gen-labels-121 syntmp-ids-1207)) (syntmp-new-vars-1211 (map syntmp-gen-var-163 syntmp-ids-1207))) (let ((syntmp-nw-1212 (syntmp-make-binding-wrap-132 syntmp-ids-1207 syntmp-labels-1210 syntmp-w-1204)) (syntmp-nr-1213 (syntmp-extend-var-env-110 syntmp-labels-1210 syntmp-new-vars-1211 syntmp-r-1203))) (syntmp-constructor-1206 syntmp-s-1205 syntmp-new-vars-1211 (map (lambda (syntmp-x-1214) (syntmp-chi-151 syntmp-x-1214 syntmp-r-1203 syntmp-w-1204)) syntmp-vals-1208) (syntmp-chi-body-155 syntmp-exps-1209 (syntmp-source-wrap-144 syntmp-e-1202 syntmp-nw-1212 syntmp-s-1205) syntmp-nr-1213 syntmp-nw-1212)))))))) (lambda (syntmp-e-1215 syntmp-r-1216 syntmp-w-1217 syntmp-s-1218) ((lambda (syntmp-tmp-1219) ((lambda (syntmp-tmp-1220) (if syntmp-tmp-1220 (apply (lambda (syntmp-_-1221 syntmp-id-1222 syntmp-val-1223 syntmp-e1-1224 syntmp-e2-1225) (syntmp-chi-let-1201 syntmp-e-1215 syntmp-r-1216 syntmp-w-1217 syntmp-s-1218 syntmp-build-let-97 syntmp-id-1222 syntmp-val-1223 (cons syntmp-e1-1224 syntmp-e2-1225))) syntmp-tmp-1220) ((lambda (syntmp-tmp-1229) (if (if syntmp-tmp-1229 (apply (lambda (syntmp-_-1230 syntmp-f-1231 syntmp-id-1232 syntmp-val-1233 syntmp-e1-1234 syntmp-e2-1235) (syntmp-id?-115 syntmp-f-1231)) syntmp-tmp-1229) #f) (apply (lambda (syntmp-_-1236 syntmp-f-1237 syntmp-id-1238 syntmp-val-1239 syntmp-e1-1240 syntmp-e2-1241) (syntmp-chi-let-1201 syntmp-e-1215 syntmp-r-1216 syntmp-w-1217 syntmp-s-1218 syntmp-build-named-let-98 (cons syntmp-f-1237 syntmp-id-1238) syntmp-val-1239 (cons syntmp-e1-1240 syntmp-e2-1241))) syntmp-tmp-1229) ((lambda (syntmp-_-1245) (syntax-error (syntmp-source-wrap-144 syntmp-e-1215 syntmp-w-1217 syntmp-s-1218))) syntmp-tmp-1219))) (syntax-dispatch syntmp-tmp-1219 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1219 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1215)))) (syntmp-global-extend-113 (quote core) (quote letrec) (lambda (syntmp-e-1246 syntmp-r-1247 syntmp-w-1248 syntmp-s-1249) ((lambda (syntmp-tmp-1250) ((lambda (syntmp-tmp-1251) (if syntmp-tmp-1251 (apply (lambda (syntmp-_-1252 syntmp-id-1253 syntmp-val-1254 syntmp-e1-1255 syntmp-e2-1256) (let ((syntmp-ids-1257 syntmp-id-1253)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-1257)) (syntax-error syntmp-e-1246 "duplicate bound variable in") (let ((syntmp-labels-1259 (syntmp-gen-labels-121 syntmp-ids-1257)) (syntmp-new-vars-1260 (map syntmp-gen-var-163 syntmp-ids-1257))) (let ((syntmp-w-1261 (syntmp-make-binding-wrap-132 syntmp-ids-1257 syntmp-labels-1259 syntmp-w-1248)) (syntmp-r-1262 (syntmp-extend-var-env-110 syntmp-labels-1259 syntmp-new-vars-1260 syntmp-r-1247))) (syntmp-build-letrec-99 syntmp-s-1249 syntmp-new-vars-1260 (map (lambda (syntmp-x-1263) (syntmp-chi-151 syntmp-x-1263 syntmp-r-1262 syntmp-w-1261)) syntmp-val-1254) (syntmp-chi-body-155 (cons syntmp-e1-1255 syntmp-e2-1256) (syntmp-source-wrap-144 syntmp-e-1246 syntmp-w-1261 syntmp-s-1249) syntmp-r-1262 syntmp-w-1261))))))) syntmp-tmp-1251) ((lambda (syntmp-_-1266) (syntax-error (syntmp-source-wrap-144 syntmp-e-1246 syntmp-w-1248 syntmp-s-1249))) syntmp-tmp-1250))) (syntax-dispatch syntmp-tmp-1250 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1246))) (syntmp-global-extend-113 (quote core) (quote set!) (lambda (syntmp-e-1267 syntmp-r-1268 syntmp-w-1269 syntmp-s-1270) ((lambda (syntmp-tmp-1271) ((lambda (syntmp-tmp-1272) (if (if syntmp-tmp-1272 (apply (lambda (syntmp-_-1273 syntmp-id-1274 syntmp-val-1275) (syntmp-id?-115 syntmp-id-1274)) syntmp-tmp-1272) #f) (apply (lambda (syntmp-_-1276 syntmp-id-1277 syntmp-val-1278) (let ((syntmp-val-1279 (syntmp-chi-151 syntmp-val-1278 syntmp-r-1268 syntmp-w-1269)) (syntmp-n-1280 (syntmp-id-var-name-137 syntmp-id-1277 syntmp-w-1269))) (let ((syntmp-b-1281 (syntmp-lookup-112 syntmp-n-1280 syntmp-r-1268))) (let ((syntmp-t-1282 (syntmp-binding-type-107 syntmp-b-1281))) (if (memv syntmp-t-1282 (quote (lexical))) (list (quote set!) (syntmp-binding-value-108 syntmp-b-1281) syntmp-val-1279) (if (memv syntmp-t-1282 (quote (global))) (list (quote set!) syntmp-n-1280 syntmp-val-1279) (if (memv syntmp-t-1282 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-143 syntmp-id-1277 syntmp-w-1269) "identifier out of context") (syntax-error (syntmp-source-wrap-144 syntmp-e-1267 syntmp-w-1269 syntmp-s-1270))))))))) syntmp-tmp-1272) ((lambda (syntmp-tmp-1283) (if syntmp-tmp-1283 (apply (lambda (syntmp-_-1284 syntmp-getter-1285 syntmp-arg-1286 syntmp-val-1287) (cons (syntmp-chi-151 (list (quote #(syntax-object setter ((top) #(ribcage #(_ getter arg val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s) #((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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i"))))) syntmp-getter-1285) syntmp-r-1268 syntmp-w-1269) (map (lambda (syntmp-e-1288) (syntmp-chi-151 syntmp-e-1288 syntmp-r-1268 syntmp-w-1269)) (append syntmp-arg-1286 (list syntmp-val-1287))))) syntmp-tmp-1283) ((lambda (syntmp-_-1290) (syntax-error (syntmp-source-wrap-144 syntmp-e-1267 syntmp-w-1269 syntmp-s-1270))) syntmp-tmp-1271))) (syntax-dispatch syntmp-tmp-1271 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1271 (quote (any any any))))) syntmp-e-1267))) (syntmp-global-extend-113 (quote begin) (quote begin) (quote ())) (syntmp-global-extend-113 (quote define) (quote define) (quote ())) (syntmp-global-extend-113 (quote define-syntax) (quote define-syntax) (quote ())) (syntmp-global-extend-113 (quote eval-when) (quote eval-when) (quote ())) (syntmp-global-extend-113 (quote core) (quote syntax-case) (letrec ((syntmp-gen-syntax-case-1294 (lambda (syntmp-x-1295 syntmp-keys-1296 syntmp-clauses-1297 syntmp-r-1298) (if (null? syntmp-clauses-1297) (list (quote syntax-error) syntmp-x-1295) ((lambda (syntmp-tmp-1299) ((lambda (syntmp-tmp-1300) (if syntmp-tmp-1300 (apply (lambda (syntmp-pat-1301 syntmp-exp-1302) (if (and (syntmp-id?-115 syntmp-pat-1301) (andmap (lambda (syntmp-x-1303) (not (syntmp-free-id=?-138 syntmp-pat-1301 syntmp-x-1303))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r) #((top) (top) (top) (top)) #("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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i"))))) syntmp-keys-1296))) (let ((syntmp-labels-1304 (list (syntmp-gen-label-120))) (syntmp-var-1305 (syntmp-gen-var-163 syntmp-pat-1301))) (list (list (quote lambda) (list syntmp-var-1305) (syntmp-chi-151 syntmp-exp-1302 (syntmp-extend-env-109 syntmp-labels-1304 (list (cons (quote syntax) (cons syntmp-var-1305 0))) syntmp-r-1298) (syntmp-make-binding-wrap-132 (list syntmp-pat-1301) syntmp-labels-1304 (quote (()))))) syntmp-x-1295)) (syntmp-gen-clause-1293 syntmp-x-1295 syntmp-keys-1296 (cdr syntmp-clauses-1297) syntmp-r-1298 syntmp-pat-1301 #t syntmp-exp-1302))) syntmp-tmp-1300) ((lambda (syntmp-tmp-1306) (if syntmp-tmp-1306 (apply (lambda (syntmp-pat-1307 syntmp-fender-1308 syntmp-exp-1309) (syntmp-gen-clause-1293 syntmp-x-1295 syntmp-keys-1296 (cdr syntmp-clauses-1297) syntmp-r-1298 syntmp-pat-1307 syntmp-fender-1308 syntmp-exp-1309)) syntmp-tmp-1306) ((lambda (syntmp-_-1310) (syntax-error (car syntmp-clauses-1297) "invalid syntax-case clause")) syntmp-tmp-1299))) (syntax-dispatch syntmp-tmp-1299 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1299 (quote (any any))))) (car syntmp-clauses-1297))))) (syntmp-gen-clause-1293 (lambda (syntmp-x-1311 syntmp-keys-1312 syntmp-clauses-1313 syntmp-r-1314 syntmp-pat-1315 syntmp-fender-1316 syntmp-exp-1317) (call-with-values (lambda () (syntmp-convert-pattern-1291 syntmp-pat-1315 syntmp-keys-1312)) (lambda (syntmp-p-1318 syntmp-pvars-1319) (cond ((not (syntmp-distinct-bound-ids?-141 (map car syntmp-pvars-1319))) (syntax-error syntmp-pat-1315 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1320) (not (syntmp-ellipsis?-160 (car syntmp-x-1320)))) syntmp-pvars-1319)) (syntax-error syntmp-pat-1315 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1321 (syntmp-gen-var-163 (quote tmp)))) (list (list (quote lambda) (list syntmp-y-1321) (let ((syntmp-y-1322 syntmp-y-1321)) (list (quote if) ((lambda (syntmp-tmp-1323) ((lambda (syntmp-tmp-1324) (if syntmp-tmp-1324 (apply (lambda () syntmp-y-1322) syntmp-tmp-1324) ((lambda (syntmp-_-1325) (list (quote if) syntmp-y-1322 (syntmp-build-dispatch-call-1292 syntmp-pvars-1319 syntmp-fender-1316 syntmp-y-1322 syntmp-r-1314) (syntmp-build-data-95 #f #f))) syntmp-tmp-1323))) (syntax-dispatch syntmp-tmp-1323 (quote #(atom #t))))) syntmp-fender-1316) (syntmp-build-dispatch-call-1292 syntmp-pvars-1319 syntmp-exp-1317 syntmp-y-1322 syntmp-r-1314) (syntmp-gen-syntax-case-1294 syntmp-x-1311 syntmp-keys-1312 syntmp-clauses-1313 syntmp-r-1314)))) (if (eq? syntmp-p-1318 (quote any)) (list (quote list) syntmp-x-1311) (list (quote syntax-dispatch) syntmp-x-1311 (syntmp-build-data-95 #f syntmp-p-1318))))))))))) (syntmp-build-dispatch-call-1292 (lambda (syntmp-pvars-1326 syntmp-exp-1327 syntmp-y-1328 syntmp-r-1329) (let ((syntmp-ids-1330 (map car syntmp-pvars-1326)) (syntmp-levels-1331 (map cdr syntmp-pvars-1326))) (let ((syntmp-labels-1332 (syntmp-gen-labels-121 syntmp-ids-1330)) (syntmp-new-vars-1333 (map syntmp-gen-var-163 syntmp-ids-1330))) (list (quote apply) (list (quote lambda) syntmp-new-vars-1333 (syntmp-chi-151 syntmp-exp-1327 (syntmp-extend-env-109 syntmp-labels-1332 (map (lambda (syntmp-var-1334 syntmp-level-1335) (cons (quote syntax) (cons syntmp-var-1334 syntmp-level-1335))) syntmp-new-vars-1333 (map cdr syntmp-pvars-1326)) syntmp-r-1329) (syntmp-make-binding-wrap-132 syntmp-ids-1330 syntmp-labels-1332 (quote (()))))) syntmp-y-1328))))) (syntmp-convert-pattern-1291 (lambda (syntmp-pattern-1336 syntmp-keys-1337) (let syntmp-cvt-1338 ((syntmp-p-1339 syntmp-pattern-1336) (syntmp-n-1340 0) (syntmp-ids-1341 (quote ()))) (if (syntmp-id?-115 syntmp-p-1339) (if (syntmp-bound-id-member?-142 syntmp-p-1339 syntmp-keys-1337) (values (vector (quote free-id) syntmp-p-1339) syntmp-ids-1341) (values (quote any) (cons (cons syntmp-p-1339 syntmp-n-1340) syntmp-ids-1341))) ((lambda (syntmp-tmp-1342) ((lambda (syntmp-tmp-1343) (if (if syntmp-tmp-1343 (apply (lambda (syntmp-x-1344 syntmp-dots-1345) (syntmp-ellipsis?-160 syntmp-dots-1345)) syntmp-tmp-1343) #f) (apply (lambda (syntmp-x-1346 syntmp-dots-1347) (call-with-values (lambda () (syntmp-cvt-1338 syntmp-x-1346 (syntmp-fx+-85 syntmp-n-1340 1) syntmp-ids-1341)) (lambda (syntmp-p-1348 syntmp-ids-1349) (values (if (eq? syntmp-p-1348 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1348)) syntmp-ids-1349)))) syntmp-tmp-1343) ((lambda (syntmp-tmp-1350) (if syntmp-tmp-1350 (apply (lambda (syntmp-x-1351 syntmp-y-1352) (call-with-values (lambda () (syntmp-cvt-1338 syntmp-y-1352 syntmp-n-1340 syntmp-ids-1341)) (lambda (syntmp-y-1353 syntmp-ids-1354) (call-with-values (lambda () (syntmp-cvt-1338 syntmp-x-1351 syntmp-n-1340 syntmp-ids-1354)) (lambda (syntmp-x-1355 syntmp-ids-1356) (values (cons syntmp-x-1355 syntmp-y-1353) syntmp-ids-1356)))))) syntmp-tmp-1350) ((lambda (syntmp-tmp-1357) (if syntmp-tmp-1357 (apply (lambda () (values (quote ()) syntmp-ids-1341)) syntmp-tmp-1357) ((lambda (syntmp-tmp-1358) (if syntmp-tmp-1358 (apply (lambda (syntmp-x-1359) (call-with-values (lambda () (syntmp-cvt-1338 syntmp-x-1359 syntmp-n-1340 syntmp-ids-1341)) (lambda (syntmp-p-1361 syntmp-ids-1362) (values (vector (quote vector) syntmp-p-1361) syntmp-ids-1362)))) syntmp-tmp-1358) ((lambda (syntmp-x-1363) (values (vector (quote atom) (syntmp-strip-162 syntmp-p-1339 (quote (())))) syntmp-ids-1341)) syntmp-tmp-1342))) (syntax-dispatch syntmp-tmp-1342 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1342 (quote ()))))) (syntax-dispatch syntmp-tmp-1342 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1342 (quote (any any))))) syntmp-p-1339)))))) (lambda (syntmp-e-1364 syntmp-r-1365 syntmp-w-1366 syntmp-s-1367) (let ((syntmp-e-1368 (syntmp-source-wrap-144 syntmp-e-1364 syntmp-w-1366 syntmp-s-1367))) ((lambda (syntmp-tmp-1369) ((lambda (syntmp-tmp-1370) (if syntmp-tmp-1370 (apply (lambda (syntmp-_-1371 syntmp-val-1372 syntmp-key-1373 syntmp-m-1374) (if (andmap (lambda (syntmp-x-1375) (and (syntmp-id?-115 syntmp-x-1375) (not (syntmp-ellipsis?-160 syntmp-x-1375)))) syntmp-key-1373) (let ((syntmp-x-1377 (syntmp-gen-var-163 (quote tmp)))) (list (list (quote lambda) (list syntmp-x-1377) (syntmp-gen-syntax-case-1294 syntmp-x-1377 syntmp-key-1373 syntmp-m-1374 syntmp-r-1365)) (syntmp-chi-151 syntmp-val-1372 syntmp-r-1365 (quote (()))))) (syntax-error syntmp-e-1368 "invalid literals list in"))) syntmp-tmp-1370) (syntax-error syntmp-tmp-1369))) (syntax-dispatch syntmp-tmp-1369 (quote (any any each-any . each-any))))) syntmp-e-1368))))) (set! sc-expand (let ((syntmp-m-1380 (quote e)) (syntmp-esew-1381 (quote (eval)))) (lambda (syntmp-x-1382) (if (and (pair? syntmp-x-1382) (equal? (car syntmp-x-1382) syntmp-noexpand-84)) (cadr syntmp-x-1382) (syntmp-chi-top-150 syntmp-x-1382 (quote ()) (quote ((top))) syntmp-m-1380 syntmp-esew-1381))))) (set! sc-expand3 (let ((syntmp-m-1383 (quote e)) (syntmp-esew-1384 (quote (eval)))) (lambda (syntmp-x-1386 . syntmp-rest-1385) (if (and (pair? syntmp-x-1386) (equal? (car syntmp-x-1386) syntmp-noexpand-84)) (cadr syntmp-x-1386) (syntmp-chi-top-150 syntmp-x-1386 (quote ()) (quote ((top))) (if (null? syntmp-rest-1385) syntmp-m-1383 (car syntmp-rest-1385)) (if (or (null? syntmp-rest-1385) (null? (cdr syntmp-rest-1385))) syntmp-esew-1384 (cadr syntmp-rest-1385))))))) (set! identifier? (lambda (syntmp-x-1387) (syntmp-nonsymbol-id?-114 syntmp-x-1387))) (set! datum->syntax-object (lambda (syntmp-id-1388 syntmp-datum-1389) (syntmp-make-syntax-object-100 syntmp-datum-1389 (syntmp-syntax-object-wrap-103 syntmp-id-1388)))) (set! syntax-object->datum (lambda (syntmp-x-1390) (syntmp-strip-162 syntmp-x-1390 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1391) (begin (let ((syntmp-x-1392 syntmp-ls-1391)) (if (not (list? syntmp-x-1392)) (syntmp-error-hook-92 (quote generate-temporaries) "invalid argument" syntmp-x-1392))) (map (lambda (syntmp-x-1393) (syntmp-wrap-143 (gensym) (quote ((top))))) syntmp-ls-1391)))) (set! free-identifier=? (lambda (syntmp-x-1394 syntmp-y-1395) (begin (let ((syntmp-x-1396 syntmp-x-1394)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1396)) (syntmp-error-hook-92 (quote free-identifier=?) "invalid argument" syntmp-x-1396))) (let ((syntmp-x-1397 syntmp-y-1395)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1397)) (syntmp-error-hook-92 (quote free-identifier=?) "invalid argument" syntmp-x-1397))) (syntmp-free-id=?-138 syntmp-x-1394 syntmp-y-1395)))) (set! bound-identifier=? (lambda (syntmp-x-1398 syntmp-y-1399) (begin (let ((syntmp-x-1400 syntmp-x-1398)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1400)) (syntmp-error-hook-92 (quote bound-identifier=?) "invalid argument" syntmp-x-1400))) (let ((syntmp-x-1401 syntmp-y-1399)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1401)) (syntmp-error-hook-92 (quote bound-identifier=?) "invalid argument" syntmp-x-1401))) (syntmp-bound-id=?-139 syntmp-x-1398 syntmp-y-1399)))) (set! syntax-error (lambda (syntmp-object-1403 . syntmp-messages-1402) (begin (for-each (lambda (syntmp-x-1404) (let ((syntmp-x-1405 syntmp-x-1404)) (if (not (string? syntmp-x-1405)) (syntmp-error-hook-92 (quote syntax-error) "invalid argument" syntmp-x-1405)))) syntmp-messages-1402) (let ((syntmp-message-1406 (if (null? syntmp-messages-1402) "invalid syntax" (apply string-append syntmp-messages-1402)))) (syntmp-error-hook-92 #f syntmp-message-1406 (syntmp-strip-162 syntmp-object-1403 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1407 syntmp-v-1408) (begin (let ((syntmp-x-1409 syntmp-sym-1407)) (if (not (symbol? syntmp-x-1409)) (syntmp-error-hook-92 (quote define-syntax) "invalid argument" syntmp-x-1409))) (let ((syntmp-x-1410 syntmp-v-1408)) (if (not (procedure? syntmp-x-1410)) (syntmp-error-hook-92 (quote define-syntax) "invalid argument" syntmp-x-1410))) (syntmp-global-extend-113 (quote macro) syntmp-sym-1407 syntmp-v-1408)))) (letrec ((syntmp-match-1415 (lambda (syntmp-e-1416 syntmp-p-1417 syntmp-w-1418 syntmp-r-1419) (cond ((not syntmp-r-1419) #f) ((eq? syntmp-p-1417 (quote any)) (cons (syntmp-wrap-143 syntmp-e-1416 syntmp-w-1418) syntmp-r-1419)) ((syntmp-syntax-object?-101 syntmp-e-1416) (syntmp-match*-1414 (let ((syntmp-e-1420 (syntmp-syntax-object-expression-102 syntmp-e-1416))) (if (syntmp-annotation?-89 syntmp-e-1420) (annotation-expression syntmp-e-1420) syntmp-e-1420)) syntmp-p-1417 (syntmp-join-wraps-134 syntmp-w-1418 (syntmp-syntax-object-wrap-103 syntmp-e-1416)) syntmp-r-1419)) (else (syntmp-match*-1414 (let ((syntmp-e-1421 syntmp-e-1416)) (if (syntmp-annotation?-89 syntmp-e-1421) (annotation-expression syntmp-e-1421) syntmp-e-1421)) syntmp-p-1417 syntmp-w-1418 syntmp-r-1419))))) (syntmp-match*-1414 (lambda (syntmp-e-1422 syntmp-p-1423 syntmp-w-1424 syntmp-r-1425) (cond ((null? syntmp-p-1423) (and (null? syntmp-e-1422) syntmp-r-1425)) ((pair? syntmp-p-1423) (and (pair? syntmp-e-1422) (syntmp-match-1415 (car syntmp-e-1422) (car syntmp-p-1423) syntmp-w-1424 (syntmp-match-1415 (cdr syntmp-e-1422) (cdr syntmp-p-1423) syntmp-w-1424 syntmp-r-1425)))) ((eq? syntmp-p-1423 (quote each-any)) (let ((syntmp-l-1426 (syntmp-match-each-any-1412 syntmp-e-1422 syntmp-w-1424))) (and syntmp-l-1426 (cons syntmp-l-1426 syntmp-r-1425)))) (else (let ((syntmp-t-1427 (vector-ref syntmp-p-1423 0))) (if (memv syntmp-t-1427 (quote (each))) (if (null? syntmp-e-1422) (syntmp-match-empty-1413 (vector-ref syntmp-p-1423 1) syntmp-r-1425) (let ((syntmp-l-1428 (syntmp-match-each-1411 syntmp-e-1422 (vector-ref syntmp-p-1423 1) syntmp-w-1424))) (and syntmp-l-1428 (let syntmp-collect-1429 ((syntmp-l-1430 syntmp-l-1428)) (if (null? (car syntmp-l-1430)) syntmp-r-1425 (cons (map car syntmp-l-1430) (syntmp-collect-1429 (map cdr syntmp-l-1430)))))))) (if (memv syntmp-t-1427 (quote (free-id))) (and (syntmp-id?-115 syntmp-e-1422) (syntmp-free-id=?-138 (syntmp-wrap-143 syntmp-e-1422 syntmp-w-1424) (vector-ref syntmp-p-1423 1)) syntmp-r-1425) (if (memv syntmp-t-1427 (quote (atom))) (and (equal? (vector-ref syntmp-p-1423 1) (syntmp-strip-162 syntmp-e-1422 syntmp-w-1424)) syntmp-r-1425) (if (memv syntmp-t-1427 (quote (vector))) (and (vector? syntmp-e-1422) (syntmp-match-1415 (vector->list syntmp-e-1422) (vector-ref syntmp-p-1423 1) syntmp-w-1424 syntmp-r-1425))))))))))) (syntmp-match-empty-1413 (lambda (syntmp-p-1431 syntmp-r-1432) (cond ((null? syntmp-p-1431) syntmp-r-1432) ((eq? syntmp-p-1431 (quote any)) (cons (quote ()) syntmp-r-1432)) ((pair? syntmp-p-1431) (syntmp-match-empty-1413 (car syntmp-p-1431) (syntmp-match-empty-1413 (cdr syntmp-p-1431) syntmp-r-1432))) ((eq? syntmp-p-1431 (quote each-any)) (cons (quote ()) syntmp-r-1432)) (else (let ((syntmp-t-1433 (vector-ref syntmp-p-1431 0))) (if (memv syntmp-t-1433 (quote (each))) (syntmp-match-empty-1413 (vector-ref syntmp-p-1431 1) syntmp-r-1432) (if (memv syntmp-t-1433 (quote (free-id atom))) syntmp-r-1432 (if (memv syntmp-t-1433 (quote (vector))) (syntmp-match-empty-1413 (vector-ref syntmp-p-1431 1) syntmp-r-1432))))))))) (syntmp-match-each-any-1412 (lambda (syntmp-e-1434 syntmp-w-1435) (cond ((syntmp-annotation?-89 syntmp-e-1434) (syntmp-match-each-any-1412 (annotation-expression syntmp-e-1434) syntmp-w-1435)) ((pair? syntmp-e-1434) (let ((syntmp-l-1436 (syntmp-match-each-any-1412 (cdr syntmp-e-1434) syntmp-w-1435))) (and syntmp-l-1436 (cons (syntmp-wrap-143 (car syntmp-e-1434) syntmp-w-1435) syntmp-l-1436)))) ((null? syntmp-e-1434) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1434) (syntmp-match-each-any-1412 (syntmp-syntax-object-expression-102 syntmp-e-1434) (syntmp-join-wraps-134 syntmp-w-1435 (syntmp-syntax-object-wrap-103 syntmp-e-1434)))) (else #f)))) (syntmp-match-each-1411 (lambda (syntmp-e-1437 syntmp-p-1438 syntmp-w-1439) (cond ((syntmp-annotation?-89 syntmp-e-1437) (syntmp-match-each-1411 (annotation-expression syntmp-e-1437) syntmp-p-1438 syntmp-w-1439)) ((pair? syntmp-e-1437) (let ((syntmp-first-1440 (syntmp-match-1415 (car syntmp-e-1437) syntmp-p-1438 syntmp-w-1439 (quote ())))) (and syntmp-first-1440 (let ((syntmp-rest-1441 (syntmp-match-each-1411 (cdr syntmp-e-1437) syntmp-p-1438 syntmp-w-1439))) (and syntmp-rest-1441 (cons syntmp-first-1440 syntmp-rest-1441)))))) ((null? syntmp-e-1437) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1437) (syntmp-match-each-1411 (syntmp-syntax-object-expression-102 syntmp-e-1437) syntmp-p-1438 (syntmp-join-wraps-134 syntmp-w-1439 (syntmp-syntax-object-wrap-103 syntmp-e-1437)))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1442 syntmp-p-1443) (cond ((eq? syntmp-p-1443 (quote any)) (list syntmp-e-1442)) ((syntmp-syntax-object?-101 syntmp-e-1442) (syntmp-match*-1414 (let ((syntmp-e-1444 (syntmp-syntax-object-expression-102 syntmp-e-1442))) (if (syntmp-annotation?-89 syntmp-e-1444) (annotation-expression syntmp-e-1444) syntmp-e-1444)) syntmp-p-1443 (syntmp-syntax-object-wrap-103 syntmp-e-1442) (quote ()))) (else (syntmp-match*-1414 (let ((syntmp-e-1445 syntmp-e-1442)) (if (syntmp-annotation?-89 syntmp-e-1445) (annotation-expression syntmp-e-1445) syntmp-e-1445)) syntmp-p-1443 (quote (())) (quote ())))))) (set! sc-chi syntmp-chi-151)))))
+(letrec ((syntmp-lambda-var-list-164 (lambda (syntmp-vars-559) (let syntmp-lvl-560 ((syntmp-vars-561 syntmp-vars-559) (syntmp-ls-562 (quote ())) (syntmp-w-563 (quote (())))) (cond ((pair? syntmp-vars-561) (syntmp-lvl-560 (cdr syntmp-vars-561) (cons (syntmp-wrap-143 (car syntmp-vars-561) syntmp-w-563) syntmp-ls-562) syntmp-w-563)) ((syntmp-id?-115 syntmp-vars-561) (cons (syntmp-wrap-143 syntmp-vars-561 syntmp-w-563) syntmp-ls-562)) ((null? syntmp-vars-561) syntmp-ls-562) ((syntmp-syntax-object?-101 syntmp-vars-561) (syntmp-lvl-560 (syntmp-syntax-object-expression-102 syntmp-vars-561) syntmp-ls-562 (syntmp-join-wraps-134 syntmp-w-563 (syntmp-syntax-object-wrap-103 syntmp-vars-561)))) ((syntmp-annotation?-89 syntmp-vars-561) (syntmp-lvl-560 (annotation-expression syntmp-vars-561) syntmp-ls-562 syntmp-w-563)) (else (cons syntmp-vars-561 syntmp-ls-562)))))) (syntmp-gen-var-163 (lambda (syntmp-id-564) (let ((syntmp-id-565 (if (syntmp-syntax-object?-101 syntmp-id-564) (syntmp-syntax-object-expression-102 syntmp-id-564) syntmp-id-564))) (if (syntmp-annotation?-89 syntmp-id-565) (gensym (symbol->string (annotation-expression syntmp-id-565))) (gensym (symbol->string syntmp-id-565)))))) (syntmp-strip-162 (lambda (syntmp-x-566 syntmp-w-567) (if (memq (quote top) (syntmp-wrap-marks-118 syntmp-w-567)) (if (or (syntmp-annotation?-89 syntmp-x-566) (and (pair? syntmp-x-566) (syntmp-annotation?-89 (car syntmp-x-566)))) (syntmp-strip-annotation-161 syntmp-x-566 #f) syntmp-x-566) (let syntmp-f-568 ((syntmp-x-569 syntmp-x-566)) (cond ((syntmp-syntax-object?-101 syntmp-x-569) (syntmp-strip-162 (syntmp-syntax-object-expression-102 syntmp-x-569) (syntmp-syntax-object-wrap-103 syntmp-x-569))) ((pair? syntmp-x-569) (let ((syntmp-a-570 (syntmp-f-568 (car syntmp-x-569))) (syntmp-d-571 (syntmp-f-568 (cdr syntmp-x-569)))) (if (and (eq? syntmp-a-570 (car syntmp-x-569)) (eq? syntmp-d-571 (cdr syntmp-x-569))) syntmp-x-569 (cons syntmp-a-570 syntmp-d-571)))) ((vector? syntmp-x-569) (let ((syntmp-old-572 (vector->list syntmp-x-569))) (let ((syntmp-new-573 (map syntmp-f-568 syntmp-old-572))) (if (andmap eq? syntmp-old-572 syntmp-new-573) syntmp-x-569 (list->vector syntmp-new-573))))) (else syntmp-x-569)))))) (syntmp-strip-annotation-161 (lambda (syntmp-x-574 syntmp-parent-575) (cond ((pair? syntmp-x-574) (let ((syntmp-new-576 (cons #f #f))) (begin (when syntmp-parent-575 (set-annotation-stripped! syntmp-parent-575 syntmp-new-576)) (set-car! syntmp-new-576 (syntmp-strip-annotation-161 (car syntmp-x-574) #f)) (set-cdr! syntmp-new-576 (syntmp-strip-annotation-161 (cdr syntmp-x-574) #f)) syntmp-new-576))) ((syntmp-annotation?-89 syntmp-x-574) (or (annotation-stripped syntmp-x-574) (syntmp-strip-annotation-161 (annotation-expression syntmp-x-574) syntmp-x-574))) ((vector? syntmp-x-574) (let ((syntmp-new-577 (make-vector (vector-length syntmp-x-574)))) (begin (when syntmp-parent-575 (set-annotation-stripped! syntmp-parent-575 syntmp-new-577)) (let syntmp-loop-578 ((syntmp-i-579 (- (vector-length syntmp-x-574) 1))) (unless (syntmp-fx<-88 syntmp-i-579 0) (vector-set! syntmp-new-577 syntmp-i-579 (syntmp-strip-annotation-161 (vector-ref syntmp-x-574 syntmp-i-579) #f)) (syntmp-loop-578 (syntmp-fx--86 syntmp-i-579 1)))) syntmp-new-577))) (else syntmp-x-574)))) (syntmp-ellipsis?-160 (lambda (syntmp-x-580) (and (syntmp-nonsymbol-id?-114 syntmp-x-580) (syntmp-free-id=?-138 syntmp-x-580 (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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i"))))))))) (syntmp-chi-void-159 (lambda () (list (quote void)))) (syntmp-eval-local-transformer-158 (lambda (syntmp-expanded-581) (let ((syntmp-p-582 (syntmp-local-eval-hook-91 syntmp-expanded-581))) (if (procedure? syntmp-p-582) syntmp-p-582 (syntax-error syntmp-p-582 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-157 (lambda (syntmp-rec?-583 syntmp-e-584 syntmp-r-585 syntmp-w-586 syntmp-s-587 syntmp-k-588) ((lambda (syntmp-tmp-589) ((lambda (syntmp-tmp-590) (if syntmp-tmp-590 (apply (lambda (syntmp-_-591 syntmp-id-592 syntmp-val-593 syntmp-e1-594 syntmp-e2-595) (let ((syntmp-ids-596 syntmp-id-592)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-596)) (syntax-error syntmp-e-584 "duplicate bound keyword in") (let ((syntmp-labels-598 (syntmp-gen-labels-121 syntmp-ids-596))) (let ((syntmp-new-w-599 (syntmp-make-binding-wrap-132 syntmp-ids-596 syntmp-labels-598 syntmp-w-586))) (syntmp-k-588 (cons syntmp-e1-594 syntmp-e2-595) (syntmp-extend-env-109 syntmp-labels-598 (let ((syntmp-w-601 (if syntmp-rec?-583 syntmp-new-w-599 syntmp-w-586)) (syntmp-trans-r-602 (syntmp-macros-only-env-111 syntmp-r-585))) (map (lambda (syntmp-x-603) (cons (quote macro) (syntmp-eval-local-transformer-158 (syntmp-chi-151 syntmp-x-603 syntmp-trans-r-602 syntmp-w-601)))) syntmp-val-593)) syntmp-r-585) syntmp-new-w-599 syntmp-s-587)))))) syntmp-tmp-590) ((lambda (syntmp-_-605) (syntax-error (syntmp-source-wrap-144 syntmp-e-584 syntmp-w-586 syntmp-s-587))) syntmp-tmp-589))) (syntax-dispatch syntmp-tmp-589 (quote (any #(each (any any)) any . each-any))))) syntmp-e-584))) (syntmp-chi-lambda-clause-156 (lambda (syntmp-e-606 syntmp-c-607 syntmp-r-608 syntmp-w-609 syntmp-k-610) ((lambda (syntmp-tmp-611) ((lambda (syntmp-tmp-612) (if syntmp-tmp-612 (apply (lambda (syntmp-id-613 syntmp-e1-614 syntmp-e2-615) (let ((syntmp-ids-616 syntmp-id-613)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-616)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-618 (syntmp-gen-labels-121 syntmp-ids-616)) (syntmp-new-vars-619 (map syntmp-gen-var-163 syntmp-ids-616))) (syntmp-k-610 syntmp-new-vars-619 (syntmp-chi-body-155 (cons syntmp-e1-614 syntmp-e2-615) syntmp-e-606 (syntmp-extend-var-env-110 syntmp-labels-618 syntmp-new-vars-619 syntmp-r-608) (syntmp-make-binding-wrap-132 syntmp-ids-616 syntmp-labels-618 syntmp-w-609))))))) syntmp-tmp-612) ((lambda (syntmp-tmp-621) (if syntmp-tmp-621 (apply (lambda (syntmp-ids-622 syntmp-e1-623 syntmp-e2-624) (let ((syntmp-old-ids-625 (syntmp-lambda-var-list-164 syntmp-ids-622))) (if (not (syntmp-valid-bound-ids?-140 syntmp-old-ids-625)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-626 (syntmp-gen-labels-121 syntmp-old-ids-625)) (syntmp-new-vars-627 (map syntmp-gen-var-163 syntmp-old-ids-625))) (syntmp-k-610 (let syntmp-f-628 ((syntmp-ls1-629 (cdr syntmp-new-vars-627)) (syntmp-ls2-630 (car syntmp-new-vars-627))) (if (null? syntmp-ls1-629) syntmp-ls2-630 (syntmp-f-628 (cdr syntmp-ls1-629) (cons (car syntmp-ls1-629) syntmp-ls2-630)))) (syntmp-chi-body-155 (cons syntmp-e1-623 syntmp-e2-624) syntmp-e-606 (syntmp-extend-var-env-110 syntmp-labels-626 syntmp-new-vars-627 syntmp-r-608) (syntmp-make-binding-wrap-132 syntmp-old-ids-625 syntmp-labels-626 syntmp-w-609))))))) syntmp-tmp-621) ((lambda (syntmp-_-632) (syntax-error syntmp-e-606)) syntmp-tmp-611))) (syntax-dispatch syntmp-tmp-611 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-611 (quote (each-any any . each-any))))) syntmp-c-607))) (syntmp-chi-body-155 (lambda (syntmp-body-633 syntmp-outer-form-634 syntmp-r-635 syntmp-w-636) (let ((syntmp-r-637 (cons (quote ("placeholder" placeholder)) syntmp-r-635))) (let ((syntmp-ribcage-638 (syntmp-make-ribcage-122 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-639 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w-636) (cons syntmp-ribcage-638 (syntmp-wrap-subst-119 syntmp-w-636))))) (let syntmp-parse-640 ((syntmp-body-641 (map (lambda (syntmp-x-647) (cons syntmp-r-637 (syntmp-wrap-143 syntmp-x-647 syntmp-w-639))) syntmp-body-633)) (syntmp-ids-642 (quote ())) (syntmp-labels-643 (quote ())) (syntmp-vars-644 (quote ())) (syntmp-vals-645 (quote ())) (syntmp-bindings-646 (quote ()))) (if (null? syntmp-body-641) (syntax-error syntmp-outer-form-634 "no expressions in body") (let ((syntmp-e-648 (cdar syntmp-body-641)) (syntmp-er-649 (caar syntmp-body-641))) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-648 syntmp-er-649 (quote (())) #f syntmp-ribcage-638)) (lambda (syntmp-type-650 syntmp-value-651 syntmp-e-652 syntmp-w-653 syntmp-s-654) (let ((syntmp-t-655 syntmp-type-650)) (if (memv syntmp-t-655 (quote (define-form))) (let ((syntmp-id-656 (syntmp-wrap-143 syntmp-value-651 syntmp-w-653)) (syntmp-label-657 (syntmp-gen-label-120))) (let ((syntmp-var-658 (syntmp-gen-var-163 syntmp-id-656))) (begin (syntmp-extend-ribcage!-131 syntmp-ribcage-638 syntmp-id-656 syntmp-label-657) (syntmp-parse-640 (cdr syntmp-body-641) (cons syntmp-id-656 syntmp-ids-642) (cons syntmp-label-657 syntmp-labels-643) (cons syntmp-var-658 syntmp-vars-644) (cons (cons syntmp-er-649 (syntmp-wrap-143 syntmp-e-652 syntmp-w-653)) syntmp-vals-645) (cons (cons (quote lexical) syntmp-var-658) syntmp-bindings-646))))) (if (memv syntmp-t-655 (quote (define-syntax-form))) (let ((syntmp-id-659 (syntmp-wrap-143 syntmp-value-651 syntmp-w-653)) (syntmp-label-660 (syntmp-gen-label-120))) (begin (syntmp-extend-ribcage!-131 syntmp-ribcage-638 syntmp-id-659 syntmp-label-660) (syntmp-parse-640 (cdr syntmp-body-641) (cons syntmp-id-659 syntmp-ids-642) (cons syntmp-label-660 syntmp-labels-643) syntmp-vars-644 syntmp-vals-645 (cons (cons (quote macro) (cons syntmp-er-649 (syntmp-wrap-143 syntmp-e-652 syntmp-w-653))) syntmp-bindings-646)))) (if (memv syntmp-t-655 (quote (begin-form))) ((lambda (syntmp-tmp-661) ((lambda (syntmp-tmp-662) (if syntmp-tmp-662 (apply (lambda (syntmp-_-663 syntmp-e1-664) (syntmp-parse-640 (let syntmp-f-665 ((syntmp-forms-666 syntmp-e1-664)) (if (null? syntmp-forms-666) (cdr syntmp-body-641) (cons (cons syntmp-er-649 (syntmp-wrap-143 (car syntmp-forms-666) syntmp-w-653)) (syntmp-f-665 (cdr syntmp-forms-666))))) syntmp-ids-642 syntmp-labels-643 syntmp-vars-644 syntmp-vals-645 syntmp-bindings-646)) syntmp-tmp-662) (syntax-error syntmp-tmp-661))) (syntax-dispatch syntmp-tmp-661 (quote (any . each-any))))) syntmp-e-652) (if (memv syntmp-t-655 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-651 syntmp-e-652 syntmp-er-649 syntmp-w-653 syntmp-s-654 (lambda (syntmp-forms-668 syntmp-er-669 syntmp-w-670 syntmp-s-671) (syntmp-parse-640 (let syntmp-f-672 ((syntmp-forms-673 syntmp-forms-668)) (if (null? syntmp-forms-673) (cdr syntmp-body-641) (cons (cons syntmp-er-669 (syntmp-wrap-143 (car syntmp-forms-673) syntmp-w-670)) (syntmp-f-672 (cdr syntmp-forms-673))))) syntmp-ids-642 syntmp-labels-643 syntmp-vars-644 syntmp-vals-645 syntmp-bindings-646))) (if (null? syntmp-ids-642) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-674) (syntmp-chi-151 (cdr syntmp-x-674) (car syntmp-x-674) (quote (())))) (cons (cons syntmp-er-649 (syntmp-source-wrap-144 syntmp-e-652 syntmp-w-653 syntmp-s-654)) (cdr syntmp-body-641)))) (begin (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-642)) (syntax-error syntmp-outer-form-634 "invalid or duplicate identifier in definition")) (let syntmp-loop-675 ((syntmp-bs-676 syntmp-bindings-646) (syntmp-er-cache-677 #f) (syntmp-r-cache-678 #f)) (if (not (null? syntmp-bs-676)) (let ((syntmp-b-679 (car syntmp-bs-676))) (if (eq? (car syntmp-b-679) (quote macro)) (let ((syntmp-er-680 (cadr syntmp-b-679))) (let ((syntmp-r-cache-681 (if (eq? syntmp-er-680 syntmp-er-cache-677) syntmp-r-cache-678 (syntmp-macros-only-env-111 syntmp-er-680)))) (begin (set-cdr! syntmp-b-679 (syntmp-eval-local-transformer-158 (syntmp-chi-151 (cddr syntmp-b-679) syntmp-r-cache-681 (quote (()))))) (syntmp-loop-675 (cdr syntmp-bs-676) syntmp-er-680 syntmp-r-cache-681)))) (syntmp-loop-675 (cdr syntmp-bs-676) syntmp-er-cache-677 syntmp-r-cache-678))))) (set-cdr! syntmp-r-637 (syntmp-extend-env-109 syntmp-labels-643 syntmp-bindings-646 (cdr syntmp-r-637))) (syntmp-build-letrec-99 #f syntmp-vars-644 (map (lambda (syntmp-x-682) (syntmp-chi-151 (cdr syntmp-x-682) (car syntmp-x-682) (quote (())))) syntmp-vals-645) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-683) (syntmp-chi-151 (cdr syntmp-x-683) (car syntmp-x-683) (quote (())))) (cons (cons syntmp-er-649 (syntmp-source-wrap-144 syntmp-e-652 syntmp-w-653 syntmp-s-654)) (cdr syntmp-body-641)))))))))))))))))))))) (syntmp-chi-macro-154 (lambda (syntmp-p-684 syntmp-e-685 syntmp-r-686 syntmp-w-687 syntmp-rib-688) (letrec ((syntmp-rebuild-macro-output-689 (lambda (syntmp-x-690 syntmp-m-691) (cond ((pair? syntmp-x-690) (cons (syntmp-rebuild-macro-output-689 (car syntmp-x-690) syntmp-m-691) (syntmp-rebuild-macro-output-689 (cdr syntmp-x-690) syntmp-m-691))) ((syntmp-syntax-object?-101 syntmp-x-690) (let ((syntmp-w-692 (syntmp-syntax-object-wrap-103 syntmp-x-690))) (let ((syntmp-ms-693 (syntmp-wrap-marks-118 syntmp-w-692)) (syntmp-s-694 (syntmp-wrap-subst-119 syntmp-w-692))) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-690) (if (and (pair? syntmp-ms-693) (eq? (car syntmp-ms-693) #f)) (syntmp-make-wrap-117 (cdr syntmp-ms-693) (if syntmp-rib-688 (cons syntmp-rib-688 (cdr syntmp-s-694)) (cdr syntmp-s-694))) (syntmp-make-wrap-117 (cons syntmp-m-691 syntmp-ms-693) (if syntmp-rib-688 (cons syntmp-rib-688 (cons (quote shift) syntmp-s-694)) (cons (quote shift) syntmp-s-694)))))))) ((vector? syntmp-x-690) (let ((syntmp-n-695 (vector-length syntmp-x-690))) (let ((syntmp-v-696 (make-vector syntmp-n-695))) (let syntmp-doloop-697 ((syntmp-i-698 0)) (if (syntmp-fx=-87 syntmp-i-698 syntmp-n-695) syntmp-v-696 (begin (vector-set! syntmp-v-696 syntmp-i-698 (syntmp-rebuild-macro-output-689 (vector-ref syntmp-x-690 syntmp-i-698) syntmp-m-691)) (syntmp-doloop-697 (syntmp-fx+-85 syntmp-i-698 1)))))))) ((symbol? syntmp-x-690) (syntax-error syntmp-x-690 "encountered raw symbol in macro output")) (else syntmp-x-690))))) (syntmp-rebuild-macro-output-689 (syntmp-p-684 (syntmp-wrap-143 syntmp-e-685 (syntmp-anti-mark-130 syntmp-w-687))) (string #\m))))) (syntmp-chi-application-153 (lambda (syntmp-x-699 syntmp-e-700 syntmp-r-701 syntmp-w-702 syntmp-s-703) ((lambda (syntmp-tmp-704) ((lambda (syntmp-tmp-705) (if syntmp-tmp-705 (apply (lambda (syntmp-e0-706 syntmp-e1-707) (cons syntmp-x-699 (map (lambda (syntmp-e-708) (syntmp-chi-151 syntmp-e-708 syntmp-r-701 syntmp-w-702)) syntmp-e1-707))) syntmp-tmp-705) (syntax-error syntmp-tmp-704))) (syntax-dispatch syntmp-tmp-704 (quote (any . each-any))))) syntmp-e-700))) (syntmp-chi-expr-152 (lambda (syntmp-type-710 syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (let ((syntmp-t-716 syntmp-type-710)) (if (memv syntmp-t-716 (quote (lexical))) syntmp-value-711 (if (memv syntmp-t-716 (quote (core external-macro))) (syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (if (memv syntmp-t-716 (quote (lexical-call))) (syntmp-chi-application-153 syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (if (memv syntmp-t-716 (quote (global-call))) (syntmp-chi-application-153 syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (if (memv syntmp-t-716 (quote (constant))) (syntmp-build-data-95 syntmp-s-715 (syntmp-strip-162 (syntmp-source-wrap-144 syntmp-e-712 syntmp-w-714 syntmp-s-715) (quote (())))) (if (memv syntmp-t-716 (quote (global))) syntmp-value-711 (if (memv syntmp-t-716 (quote (call))) (syntmp-chi-application-153 (syntmp-chi-151 (car syntmp-e-712) syntmp-r-713 syntmp-w-714) syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715) (if (memv syntmp-t-716 (quote (begin-form))) ((lambda (syntmp-tmp-717) ((lambda (syntmp-tmp-718) (if syntmp-tmp-718 (apply (lambda (syntmp-_-719 syntmp-e1-720 syntmp-e2-721) (syntmp-chi-sequence-145 (cons syntmp-e1-720 syntmp-e2-721) syntmp-r-713 syntmp-w-714 syntmp-s-715)) syntmp-tmp-718) (syntax-error syntmp-tmp-717))) (syntax-dispatch syntmp-tmp-717 (quote (any any . each-any))))) syntmp-e-712) (if (memv syntmp-t-716 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-711 syntmp-e-712 syntmp-r-713 syntmp-w-714 syntmp-s-715 syntmp-chi-sequence-145) (if (memv syntmp-t-716 (quote (eval-when-form))) ((lambda (syntmp-tmp-723) ((lambda (syntmp-tmp-724) (if syntmp-tmp-724 (apply (lambda (syntmp-_-725 syntmp-x-726 syntmp-e1-727 syntmp-e2-728) (let ((syntmp-when-list-729 (syntmp-chi-when-list-148 syntmp-e-712 syntmp-x-726 syntmp-w-714))) (if (memq (quote eval) syntmp-when-list-729) (syntmp-chi-sequence-145 (cons syntmp-e1-727 syntmp-e2-728) syntmp-r-713 syntmp-w-714 syntmp-s-715) (syntmp-chi-void-159)))) syntmp-tmp-724) (syntax-error syntmp-tmp-723))) (syntax-dispatch syntmp-tmp-723 (quote (any each-any any . each-any))))) syntmp-e-712) (if (memv syntmp-t-716 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-143 syntmp-value-711 syntmp-w-714) "invalid context for definition of") (if (memv syntmp-t-716 (quote (syntax))) (syntax-error (syntmp-source-wrap-144 syntmp-e-712 syntmp-w-714 syntmp-s-715) "reference to pattern variable outside syntax form") (if (memv syntmp-t-716 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-144 syntmp-e-712 syntmp-w-714 syntmp-s-715) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-144 syntmp-e-712 syntmp-w-714 syntmp-s-715)))))))))))))))))) (syntmp-chi-151 (lambda (syntmp-e-732 syntmp-r-733 syntmp-w-734) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-732 syntmp-r-733 syntmp-w-734 #f #f)) (lambda (syntmp-type-735 syntmp-value-736 syntmp-e-737 syntmp-w-738 syntmp-s-739) (syntmp-chi-expr-152 syntmp-type-735 syntmp-value-736 syntmp-e-737 syntmp-r-733 syntmp-w-738 syntmp-s-739))))) (syntmp-chi-top-150 (lambda (syntmp-e-740 syntmp-r-741 syntmp-w-742 syntmp-m-743 syntmp-esew-744) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-740 syntmp-r-741 syntmp-w-742 #f #f)) (lambda (syntmp-type-757 syntmp-value-758 syntmp-e-759 syntmp-w-760 syntmp-s-761) (let ((syntmp-t-762 syntmp-type-757)) (if (memv syntmp-t-762 (quote (begin-form))) ((lambda (syntmp-tmp-763) ((lambda (syntmp-tmp-764) (if syntmp-tmp-764 (apply (lambda (syntmp-_-765) (syntmp-chi-void-159)) syntmp-tmp-764) ((lambda (syntmp-tmp-766) (if syntmp-tmp-766 (apply (lambda (syntmp-_-767 syntmp-e1-768 syntmp-e2-769) (syntmp-chi-top-sequence-146 (cons syntmp-e1-768 syntmp-e2-769) syntmp-r-741 syntmp-w-760 syntmp-s-761 syntmp-m-743 syntmp-esew-744)) syntmp-tmp-766) (syntax-error syntmp-tmp-763))) (syntax-dispatch syntmp-tmp-763 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-763 (quote (any))))) syntmp-e-759) (if (memv syntmp-t-762 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-758 syntmp-e-759 syntmp-r-741 syntmp-w-760 syntmp-s-761 (lambda (syntmp-body-771 syntmp-r-772 syntmp-w-773 syntmp-s-774) (syntmp-chi-top-sequence-146 syntmp-body-771 syntmp-r-772 syntmp-w-773 syntmp-s-774 syntmp-m-743 syntmp-esew-744))) (if (memv syntmp-t-762 (quote (eval-when-form))) ((lambda (syntmp-tmp-775) ((lambda (syntmp-tmp-776) (if syntmp-tmp-776 (apply (lambda (syntmp-_-777 syntmp-x-778 syntmp-e1-779 syntmp-e2-780) (let ((syntmp-when-list-781 (syntmp-chi-when-list-148 syntmp-e-759 syntmp-x-778 syntmp-w-760)) (syntmp-body-782 (cons syntmp-e1-779 syntmp-e2-780))) (cond ((eq? syntmp-m-743 (quote e)) (if (memq (quote eval) syntmp-when-list-781) (syntmp-chi-top-sequence-146 syntmp-body-782 syntmp-r-741 syntmp-w-760 syntmp-s-761 (quote e) (quote (eval))) (syntmp-chi-void-159))) ((memq (quote load) syntmp-when-list-781) (if (or (memq (quote compile) syntmp-when-list-781) (and (eq? syntmp-m-743 (quote c&e)) (memq (quote eval) syntmp-when-list-781))) (syntmp-chi-top-sequence-146 syntmp-body-782 syntmp-r-741 syntmp-w-760 syntmp-s-761 (quote c&e) (quote (compile load))) (if (memq syntmp-m-743 (quote (c c&e))) (syntmp-chi-top-sequence-146 syntmp-body-782 syntmp-r-741 syntmp-w-760 syntmp-s-761 (quote c) (quote (load))) (syntmp-chi-void-159)))) ((or (memq (quote compile) syntmp-when-list-781) (and (eq? syntmp-m-743 (quote c&e)) (memq (quote eval) syntmp-when-list-781))) (syntmp-top-level-eval-hook-90 (syntmp-chi-top-sequence-146 syntmp-body-782 syntmp-r-741 syntmp-w-760 syntmp-s-761 (quote e) (quote (eval)))) (syntmp-chi-void-159)) (else (syntmp-chi-void-159))))) syntmp-tmp-776) (syntax-error syntmp-tmp-775))) (syntax-dispatch syntmp-tmp-775 (quote (any each-any any . each-any))))) syntmp-e-759) (if (memv syntmp-t-762 (quote (define-syntax-form))) (let ((syntmp-n-785 (syntmp-id-var-name-137 syntmp-value-758 syntmp-w-760)) (syntmp-r-786 (syntmp-macros-only-env-111 syntmp-r-741))) (let ((syntmp-t-787 syntmp-m-743)) (if (memv syntmp-t-787 (quote (c))) (if (memq (quote compile) syntmp-esew-744) (let ((syntmp-e-788 (syntmp-chi-install-global-147 syntmp-n-785 (syntmp-chi-151 syntmp-e-759 syntmp-r-786 syntmp-w-760)))) (begin (syntmp-top-level-eval-hook-90 syntmp-e-788) (if (memq (quote load) syntmp-esew-744) syntmp-e-788 (syntmp-chi-void-159)))) (if (memq (quote load) syntmp-esew-744) (syntmp-chi-install-global-147 syntmp-n-785 (syntmp-chi-151 syntmp-e-759 syntmp-r-786 syntmp-w-760)) (syntmp-chi-void-159))) (if (memv syntmp-t-787 (quote (c&e))) (let ((syntmp-e-789 (syntmp-chi-install-global-147 syntmp-n-785 (syntmp-chi-151 syntmp-e-759 syntmp-r-786 syntmp-w-760)))) (begin (syntmp-top-level-eval-hook-90 syntmp-e-789) syntmp-e-789)) (begin (if (memq (quote eval) syntmp-esew-744) (syntmp-top-level-eval-hook-90 (syntmp-chi-install-global-147 syntmp-n-785 (syntmp-chi-151 syntmp-e-759 syntmp-r-786 syntmp-w-760)))) (syntmp-chi-void-159)))))) (if (memv syntmp-t-762 (quote (define-form))) (let ((syntmp-n-790 (syntmp-id-var-name-137 syntmp-value-758 syntmp-w-760))) (let ((syntmp-type-791 (syntmp-binding-type-107 (syntmp-lookup-112 syntmp-n-790 syntmp-r-741)))) (let ((syntmp-t-792 syntmp-type-791)) (if (memv syntmp-t-792 (quote (global))) (let ((syntmp-x-793 (list (quote define) syntmp-n-790 (syntmp-chi-151 syntmp-e-759 syntmp-r-741 syntmp-w-760)))) (begin (if (eq? syntmp-m-743 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-793)) syntmp-x-793)) (if (memv syntmp-t-792 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-143 syntmp-value-758 syntmp-w-760) "identifier out of context") (if (eq? syntmp-type-791 (quote external-macro)) (let ((syntmp-x-794 (list (quote define) syntmp-n-790 (syntmp-chi-151 syntmp-e-759 syntmp-r-741 syntmp-w-760)))) (begin (if (eq? syntmp-m-743 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-794)) syntmp-x-794)) (syntax-error (syntmp-wrap-143 syntmp-value-758 syntmp-w-760) "cannot define keyword at top level"))))))) (let ((syntmp-x-795 (syntmp-chi-expr-152 syntmp-type-757 syntmp-value-758 syntmp-e-759 syntmp-r-741 syntmp-w-760 syntmp-s-761))) (begin (if (eq? syntmp-m-743 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-795)) syntmp-x-795)))))))))))) (syntmp-syntax-type-149 (lambda (syntmp-e-796 syntmp-r-797 syntmp-w-798 syntmp-s-799 syntmp-rib-800) (cond ((symbol? syntmp-e-796) (let ((syntmp-n-801 (syntmp-id-var-name-137 syntmp-e-796 syntmp-w-798))) (let ((syntmp-b-802 (syntmp-lookup-112 syntmp-n-801 syntmp-r-797))) (let ((syntmp-type-803 (syntmp-binding-type-107 syntmp-b-802))) (let ((syntmp-t-804 syntmp-type-803)) (if (memv syntmp-t-804 (quote (lexical))) (values syntmp-type-803 (syntmp-binding-value-108 syntmp-b-802) syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-804 (quote (global))) (values syntmp-type-803 syntmp-n-801 syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-804 (quote (macro))) (syntmp-syntax-type-149 (syntmp-chi-macro-154 (syntmp-binding-value-108 syntmp-b-802) syntmp-e-796 syntmp-r-797 syntmp-w-798 syntmp-rib-800) syntmp-r-797 (quote (())) syntmp-s-799 syntmp-rib-800) (values syntmp-type-803 (syntmp-binding-value-108 syntmp-b-802) syntmp-e-796 syntmp-w-798 syntmp-s-799))))))))) ((pair? syntmp-e-796) (let ((syntmp-first-805 (car syntmp-e-796))) (if (syntmp-id?-115 syntmp-first-805) (let ((syntmp-n-806 (syntmp-id-var-name-137 syntmp-first-805 syntmp-w-798))) (let ((syntmp-b-807 (syntmp-lookup-112 syntmp-n-806 syntmp-r-797))) (let ((syntmp-type-808 (syntmp-binding-type-107 syntmp-b-807))) (let ((syntmp-t-809 syntmp-type-808)) (if (memv syntmp-t-809 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-108 syntmp-b-807) syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (global))) (values (quote global-call) syntmp-n-806 syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (macro))) (syntmp-syntax-type-149 (syntmp-chi-macro-154 (syntmp-binding-value-108 syntmp-b-807) syntmp-e-796 syntmp-r-797 syntmp-w-798 syntmp-rib-800) syntmp-r-797 (quote (())) syntmp-s-799 syntmp-rib-800) (if (memv syntmp-t-809 (quote (core external-macro))) (values syntmp-type-808 (syntmp-binding-value-108 syntmp-b-807) syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-108 syntmp-b-807) syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (begin))) (values (quote begin-form) #f syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-796 syntmp-w-798 syntmp-s-799) (if (memv syntmp-t-809 (quote (define))) ((lambda (syntmp-tmp-810) ((lambda (syntmp-tmp-811) (if (if syntmp-tmp-811 (apply (lambda (syntmp-_-812 syntmp-name-813 syntmp-val-814) (syntmp-id?-115 syntmp-name-813)) syntmp-tmp-811) #f) (apply (lambda (syntmp-_-815 syntmp-name-816 syntmp-val-817) (values (quote define-form) syntmp-name-816 syntmp-val-817 syntmp-w-798 syntmp-s-799)) syntmp-tmp-811) ((lambda (syntmp-tmp-818) (if (if syntmp-tmp-818 (apply (lambda (syntmp-_-819 syntmp-name-820 syntmp-args-821 syntmp-e1-822 syntmp-e2-823) (and (syntmp-id?-115 syntmp-name-820) (syntmp-valid-bound-ids?-140 (syntmp-lambda-var-list-164 syntmp-args-821)))) syntmp-tmp-818) #f) (apply (lambda (syntmp-_-824 syntmp-name-825 syntmp-args-826 syntmp-e1-827 syntmp-e2-828) (values (quote define-form) (syntmp-wrap-143 syntmp-name-825 syntmp-w-798) (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) #((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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i"))))) (syntmp-wrap-143 (cons syntmp-args-826 (cons syntmp-e1-827 syntmp-e2-828)) syntmp-w-798)) (quote (())) syntmp-s-799)) syntmp-tmp-818) ((lambda (syntmp-tmp-830) (if (if syntmp-tmp-830 (apply (lambda (syntmp-_-831 syntmp-name-832) (syntmp-id?-115 syntmp-name-832)) syntmp-tmp-830) #f) (apply (lambda (syntmp-_-833 syntmp-name-834) (values (quote define-form) (syntmp-wrap-143 syntmp-name-834 syntmp-w-798) (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) #((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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i")))))) (quote (())) syntmp-s-799)) syntmp-tmp-830) (syntax-error syntmp-tmp-810))) (syntax-dispatch syntmp-tmp-810 (quote (any any)))))) (syntax-dispatch syntmp-tmp-810 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-810 (quote (any any any))))) syntmp-e-796) (if (memv syntmp-t-809 (quote (define-syntax))) ((lambda (syntmp-tmp-835) ((lambda (syntmp-tmp-836) (if (if syntmp-tmp-836 (apply (lambda (syntmp-_-837 syntmp-name-838 syntmp-val-839) (syntmp-id?-115 syntmp-name-838)) syntmp-tmp-836) #f) (apply (lambda (syntmp-_-840 syntmp-name-841 syntmp-val-842) (values (quote define-syntax-form) syntmp-name-841 syntmp-val-842 syntmp-w-798 syntmp-s-799)) syntmp-tmp-836) (syntax-error syntmp-tmp-835))) (syntax-dispatch syntmp-tmp-835 (quote (any any any))))) syntmp-e-796) (values (quote call) #f syntmp-e-796 syntmp-w-798 syntmp-s-799)))))))))))))) (values (quote call) #f syntmp-e-796 syntmp-w-798 syntmp-s-799)))) ((syntmp-syntax-object?-101 syntmp-e-796) (syntmp-syntax-type-149 (syntmp-syntax-object-expression-102 syntmp-e-796) syntmp-r-797 (syntmp-join-wraps-134 syntmp-w-798 (syntmp-syntax-object-wrap-103 syntmp-e-796)) #f syntmp-rib-800)) ((syntmp-annotation?-89 syntmp-e-796) (syntmp-syntax-type-149 (annotation-expression syntmp-e-796) syntmp-r-797 syntmp-w-798 (annotation-source syntmp-e-796) syntmp-rib-800)) ((let ((syntmp-x-843 syntmp-e-796)) (or (boolean? syntmp-x-843) (number? syntmp-x-843) (string? syntmp-x-843) (char? syntmp-x-843) (keyword? syntmp-x-843) (procedure? syntmp-x-843))) (values (quote constant) #f syntmp-e-796 syntmp-w-798 syntmp-s-799)) (else (values (quote other) #f syntmp-e-796 syntmp-w-798 syntmp-s-799))))) (syntmp-chi-when-list-148 (lambda (syntmp-e-844 syntmp-when-list-845 syntmp-w-846) (let syntmp-f-847 ((syntmp-when-list-848 syntmp-when-list-845) (syntmp-situations-849 (quote ()))) (if (null? syntmp-when-list-848) syntmp-situations-849 (syntmp-f-847 (cdr syntmp-when-list-848) (cons (let ((syntmp-x-850 (car syntmp-when-list-848))) (cond ((syntmp-free-id=?-138 syntmp-x-850 (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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i")))))) (quote compile)) ((syntmp-free-id=?-138 syntmp-x-850 (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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i")))))) (quote load)) ((syntmp-free-id=?-138 syntmp-x-850 (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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i")))))) (quote eval)) (else (syntax-error (syntmp-wrap-143 syntmp-x-850 syntmp-w-846) "invalid eval-when situation")))) syntmp-situations-849)))))) (syntmp-chi-install-global-147 (lambda (syntmp-name-851 syntmp-e-852) (list (quote install-global-transformer) (syntmp-build-data-95 #f syntmp-name-851) syntmp-e-852))) (syntmp-chi-top-sequence-146 (lambda (syntmp-body-853 syntmp-r-854 syntmp-w-855 syntmp-s-856 syntmp-m-857 syntmp-esew-858) (syntmp-build-sequence-96 syntmp-s-856 (let syntmp-dobody-859 ((syntmp-body-860 syntmp-body-853) (syntmp-r-861 syntmp-r-854) (syntmp-w-862 syntmp-w-855) (syntmp-m-863 syntmp-m-857) (syntmp-esew-864 syntmp-esew-858)) (if (null? syntmp-body-860) (quote ()) (let ((syntmp-first-865 (syntmp-chi-top-150 (car syntmp-body-860) syntmp-r-861 syntmp-w-862 syntmp-m-863 syntmp-esew-864))) (cons syntmp-first-865 (syntmp-dobody-859 (cdr syntmp-body-860) syntmp-r-861 syntmp-w-862 syntmp-m-863 syntmp-esew-864)))))))) (syntmp-chi-sequence-145 (lambda (syntmp-body-866 syntmp-r-867 syntmp-w-868 syntmp-s-869) (syntmp-build-sequence-96 syntmp-s-869 (let syntmp-dobody-870 ((syntmp-body-871 syntmp-body-866) (syntmp-r-872 syntmp-r-867) (syntmp-w-873 syntmp-w-868)) (if (null? syntmp-body-871) (quote ()) (let ((syntmp-first-874 (syntmp-chi-151 (car syntmp-body-871) syntmp-r-872 syntmp-w-873))) (cons syntmp-first-874 (syntmp-dobody-870 (cdr syntmp-body-871) syntmp-r-872 syntmp-w-873)))))))) (syntmp-source-wrap-144 (lambda (syntmp-x-875 syntmp-w-876 syntmp-s-877) (syntmp-wrap-143 (if syntmp-s-877 (make-annotation syntmp-x-875 syntmp-s-877 #f) syntmp-x-875) syntmp-w-876))) (syntmp-wrap-143 (lambda (syntmp-x-878 syntmp-w-879) (cond ((and (null? (syntmp-wrap-marks-118 syntmp-w-879)) (null? (syntmp-wrap-subst-119 syntmp-w-879))) syntmp-x-878) ((syntmp-syntax-object?-101 syntmp-x-878) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-878) (syntmp-join-wraps-134 syntmp-w-879 (syntmp-syntax-object-wrap-103 syntmp-x-878)))) ((null? syntmp-x-878) syntmp-x-878) (else (syntmp-make-syntax-object-100 syntmp-x-878 syntmp-w-879))))) (syntmp-bound-id-member?-142 (lambda (syntmp-x-880 syntmp-list-881) (and (not (null? syntmp-list-881)) (or (syntmp-bound-id=?-139 syntmp-x-880 (car syntmp-list-881)) (syntmp-bound-id-member?-142 syntmp-x-880 (cdr syntmp-list-881)))))) (syntmp-distinct-bound-ids?-141 (lambda (syntmp-ids-882) (let syntmp-distinct?-883 ((syntmp-ids-884 syntmp-ids-882)) (or (null? syntmp-ids-884) (and (not (syntmp-bound-id-member?-142 (car syntmp-ids-884) (cdr syntmp-ids-884))) (syntmp-distinct?-883 (cdr syntmp-ids-884))))))) (syntmp-valid-bound-ids?-140 (lambda (syntmp-ids-885) (and (let syntmp-all-ids?-886 ((syntmp-ids-887 syntmp-ids-885)) (or (null? syntmp-ids-887) (and (syntmp-id?-115 (car syntmp-ids-887)) (syntmp-all-ids?-886 (cdr syntmp-ids-887))))) (syntmp-distinct-bound-ids?-141 syntmp-ids-885)))) (syntmp-bound-id=?-139 (lambda (syntmp-i-888 syntmp-j-889) (if (and (syntmp-syntax-object?-101 syntmp-i-888) (syntmp-syntax-object?-101 syntmp-j-889)) (and (eq? (let ((syntmp-e-890 (syntmp-syntax-object-expression-102 syntmp-i-888))) (if (syntmp-annotation?-89 syntmp-e-890) (annotation-expression syntmp-e-890) syntmp-e-890)) (let ((syntmp-e-891 (syntmp-syntax-object-expression-102 syntmp-j-889))) (if (syntmp-annotation?-89 syntmp-e-891) (annotation-expression syntmp-e-891) syntmp-e-891))) (syntmp-same-marks?-136 (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-i-888)) (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-j-889)))) (eq? (let ((syntmp-e-892 syntmp-i-888)) (if (syntmp-annotation?-89 syntmp-e-892) (annotation-expression syntmp-e-892) syntmp-e-892)) (let ((syntmp-e-893 syntmp-j-889)) (if (syntmp-annotation?-89 syntmp-e-893) (annotation-expression syntmp-e-893) syntmp-e-893)))))) (syntmp-free-id=?-138 (lambda (syntmp-i-894 syntmp-j-895) (and (eq? (let ((syntmp-x-896 syntmp-i-894)) (let ((syntmp-e-897 (if (syntmp-syntax-object?-101 syntmp-x-896) (syntmp-syntax-object-expression-102 syntmp-x-896) syntmp-x-896))) (if (syntmp-annotation?-89 syntmp-e-897) (annotation-expression syntmp-e-897) syntmp-e-897))) (let ((syntmp-x-898 syntmp-j-895)) (let ((syntmp-e-899 (if (syntmp-syntax-object?-101 syntmp-x-898) (syntmp-syntax-object-expression-102 syntmp-x-898) syntmp-x-898))) (if (syntmp-annotation?-89 syntmp-e-899) (annotation-expression syntmp-e-899) syntmp-e-899)))) (eq? (syntmp-id-var-name-137 syntmp-i-894 (quote (()))) (syntmp-id-var-name-137 syntmp-j-895 (quote (()))))))) (syntmp-id-var-name-137 (lambda (syntmp-id-900 syntmp-w-901) (letrec ((syntmp-search-vector-rib-904 (lambda (syntmp-sym-915 syntmp-subst-916 syntmp-marks-917 syntmp-symnames-918 syntmp-ribcage-919) (let ((syntmp-n-920 (vector-length syntmp-symnames-918))) (let syntmp-f-921 ((syntmp-i-922 0)) (cond ((syntmp-fx=-87 syntmp-i-922 syntmp-n-920) (syntmp-search-902 syntmp-sym-915 (cdr syntmp-subst-916) syntmp-marks-917)) ((and (eq? (vector-ref syntmp-symnames-918 syntmp-i-922) syntmp-sym-915) (syntmp-same-marks?-136 syntmp-marks-917 (vector-ref (syntmp-ribcage-marks-125 syntmp-ribcage-919) syntmp-i-922))) (values (vector-ref (syntmp-ribcage-labels-126 syntmp-ribcage-919) syntmp-i-922) syntmp-marks-917)) (else (syntmp-f-921 (syntmp-fx+-85 syntmp-i-922 1)))))))) (syntmp-search-list-rib-903 (lambda (syntmp-sym-923 syntmp-subst-924 syntmp-marks-925 syntmp-symnames-926 syntmp-ribcage-927) (let syntmp-f-928 ((syntmp-symnames-929 syntmp-symnames-926) (syntmp-i-930 0)) (cond ((null? syntmp-symnames-929) (syntmp-search-902 syntmp-sym-923 (cdr syntmp-subst-924) syntmp-marks-925)) ((and (eq? (car syntmp-symnames-929) syntmp-sym-923) (syntmp-same-marks?-136 syntmp-marks-925 (list-ref (syntmp-ribcage-marks-125 syntmp-ribcage-927) syntmp-i-930))) (values (list-ref (syntmp-ribcage-labels-126 syntmp-ribcage-927) syntmp-i-930) syntmp-marks-925)) (else (syntmp-f-928 (cdr syntmp-symnames-929) (syntmp-fx+-85 syntmp-i-930 1))))))) (syntmp-search-902 (lambda (syntmp-sym-931 syntmp-subst-932 syntmp-marks-933) (if (null? syntmp-subst-932) (values #f syntmp-marks-933) (let ((syntmp-fst-934 (car syntmp-subst-932))) (if (eq? syntmp-fst-934 (quote shift)) (syntmp-search-902 syntmp-sym-931 (cdr syntmp-subst-932) (cdr syntmp-marks-933)) (let ((syntmp-symnames-935 (syntmp-ribcage-symnames-124 syntmp-fst-934))) (if (vector? syntmp-symnames-935) (syntmp-search-vector-rib-904 syntmp-sym-931 syntmp-subst-932 syntmp-marks-933 syntmp-symnames-935 syntmp-fst-934) (syntmp-search-list-rib-903 syntmp-sym-931 syntmp-subst-932 syntmp-marks-933 syntmp-symnames-935 syntmp-fst-934))))))))) (cond ((symbol? syntmp-id-900) (or (call-with-values (lambda () (syntmp-search-902 syntmp-id-900 (syntmp-wrap-subst-119 syntmp-w-901) (syntmp-wrap-marks-118 syntmp-w-901))) (lambda (syntmp-x-937 . syntmp-ignore-936) syntmp-x-937)) syntmp-id-900)) ((syntmp-syntax-object?-101 syntmp-id-900) (let ((syntmp-id-938 (let ((syntmp-e-940 (syntmp-syntax-object-expression-102 syntmp-id-900))) (if (syntmp-annotation?-89 syntmp-e-940) (annotation-expression syntmp-e-940) syntmp-e-940))) (syntmp-w1-939 (syntmp-syntax-object-wrap-103 syntmp-id-900))) (let ((syntmp-marks-941 (syntmp-join-marks-135 (syntmp-wrap-marks-118 syntmp-w-901) (syntmp-wrap-marks-118 syntmp-w1-939)))) (call-with-values (lambda () (syntmp-search-902 syntmp-id-938 (syntmp-wrap-subst-119 syntmp-w-901) syntmp-marks-941)) (lambda (syntmp-new-id-942 syntmp-marks-943) (or syntmp-new-id-942 (call-with-values (lambda () (syntmp-search-902 syntmp-id-938 (syntmp-wrap-subst-119 syntmp-w1-939) syntmp-marks-943)) (lambda (syntmp-x-945 . syntmp-ignore-944) syntmp-x-945)) syntmp-id-938)))))) ((syntmp-annotation?-89 syntmp-id-900) (let ((syntmp-id-946 (let ((syntmp-e-947 syntmp-id-900)) (if (syntmp-annotation?-89 syntmp-e-947) (annotation-expression syntmp-e-947) syntmp-e-947)))) (or (call-with-values (lambda () (syntmp-search-902 syntmp-id-946 (syntmp-wrap-subst-119 syntmp-w-901) (syntmp-wrap-marks-118 syntmp-w-901))) (lambda (syntmp-x-949 . syntmp-ignore-948) syntmp-x-949)) syntmp-id-946))) (else (syntmp-error-hook-92 (quote id-var-name) "invalid id" syntmp-id-900)))))) (syntmp-same-marks?-136 (lambda (syntmp-x-950 syntmp-y-951) (or (eq? syntmp-x-950 syntmp-y-951) (and (not (null? syntmp-x-950)) (not (null? syntmp-y-951)) (eq? (car syntmp-x-950) (car syntmp-y-951)) (syntmp-same-marks?-136 (cdr syntmp-x-950) (cdr syntmp-y-951)))))) (syntmp-join-marks-135 (lambda (syntmp-m1-952 syntmp-m2-953) (syntmp-smart-append-133 syntmp-m1-952 syntmp-m2-953))) (syntmp-join-wraps-134 (lambda (syntmp-w1-954 syntmp-w2-955) (let ((syntmp-m1-956 (syntmp-wrap-marks-118 syntmp-w1-954)) (syntmp-s1-957 (syntmp-wrap-subst-119 syntmp-w1-954))) (if (null? syntmp-m1-956) (if (null? syntmp-s1-957) syntmp-w2-955 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w2-955) (syntmp-smart-append-133 syntmp-s1-957 (syntmp-wrap-subst-119 syntmp-w2-955)))) (syntmp-make-wrap-117 (syntmp-smart-append-133 syntmp-m1-956 (syntmp-wrap-marks-118 syntmp-w2-955)) (syntmp-smart-append-133 syntmp-s1-957 (syntmp-wrap-subst-119 syntmp-w2-955))))))) (syntmp-smart-append-133 (lambda (syntmp-m1-958 syntmp-m2-959) (if (null? syntmp-m2-959) syntmp-m1-958 (append syntmp-m1-958 syntmp-m2-959)))) (syntmp-make-binding-wrap-132 (lambda (syntmp-ids-960 syntmp-labels-961 syntmp-w-962) (if (null? syntmp-ids-960) syntmp-w-962 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w-962) (cons (let ((syntmp-labelvec-963 (list->vector syntmp-labels-961))) (let ((syntmp-n-964 (vector-length syntmp-labelvec-963))) (let ((syntmp-symnamevec-965 (make-vector syntmp-n-964)) (syntmp-marksvec-966 (make-vector syntmp-n-964))) (begin (let syntmp-f-967 ((syntmp-ids-968 syntmp-ids-960) (syntmp-i-969 0)) (if (not (null? syntmp-ids-968)) (call-with-values (lambda () (syntmp-id-sym-name&marks-116 (car syntmp-ids-968) syntmp-w-962)) (lambda (syntmp-symname-970 syntmp-marks-971) (begin (vector-set! syntmp-symnamevec-965 syntmp-i-969 syntmp-symname-970) (vector-set! syntmp-marksvec-966 syntmp-i-969 syntmp-marks-971) (syntmp-f-967 (cdr syntmp-ids-968) (syntmp-fx+-85 syntmp-i-969 1))))))) (syntmp-make-ribcage-122 syntmp-symnamevec-965 syntmp-marksvec-966 syntmp-labelvec-963))))) (syntmp-wrap-subst-119 syntmp-w-962)))))) (syntmp-extend-ribcage!-131 (lambda (syntmp-ribcage-972 syntmp-id-973 syntmp-label-974) (begin (syntmp-set-ribcage-symnames!-127 syntmp-ribcage-972 (cons (let ((syntmp-e-975 (syntmp-syntax-object-expression-102 syntmp-id-973))) (if (syntmp-annotation?-89 syntmp-e-975) (annotation-expression syntmp-e-975) syntmp-e-975)) (syntmp-ribcage-symnames-124 syntmp-ribcage-972))) (syntmp-set-ribcage-marks!-128 syntmp-ribcage-972 (cons (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-id-973)) (syntmp-ribcage-marks-125 syntmp-ribcage-972))) (syntmp-set-ribcage-labels!-129 syntmp-ribcage-972 (cons syntmp-label-974 (syntmp-ribcage-labels-126 syntmp-ribcage-972)))))) (syntmp-anti-mark-130 (lambda (syntmp-w-976) (syntmp-make-wrap-117 (cons #f (syntmp-wrap-marks-118 syntmp-w-976)) (cons (quote shift) (syntmp-wrap-subst-119 syntmp-w-976))))) (syntmp-set-ribcage-labels!-129 (lambda (syntmp-x-977 syntmp-update-978) (vector-set! syntmp-x-977 3 syntmp-update-978))) (syntmp-set-ribcage-marks!-128 (lambda (syntmp-x-979 syntmp-update-980) (vector-set! syntmp-x-979 2 syntmp-update-980))) (syntmp-set-ribcage-symnames!-127 (lambda (syntmp-x-981 syntmp-update-982) (vector-set! syntmp-x-981 1 syntmp-update-982))) (syntmp-ribcage-labels-126 (lambda (syntmp-x-983) (vector-ref syntmp-x-983 3))) (syntmp-ribcage-marks-125 (lambda (syntmp-x-984) (vector-ref syntmp-x-984 2))) (syntmp-ribcage-symnames-124 (lambda (syntmp-x-985) (vector-ref syntmp-x-985 1))) (syntmp-ribcage?-123 (lambda (syntmp-x-986) (and (vector? syntmp-x-986) (= (vector-length syntmp-x-986) 4) (eq? (vector-ref syntmp-x-986 0) (quote ribcage))))) (syntmp-make-ribcage-122 (lambda (syntmp-symnames-987 syntmp-marks-988 syntmp-labels-989) (vector (quote ribcage) syntmp-symnames-987 syntmp-marks-988 syntmp-labels-989))) (syntmp-gen-labels-121 (lambda (syntmp-ls-990) (if (null? syntmp-ls-990) (quote ()) (cons (syntmp-gen-label-120) (syntmp-gen-labels-121 (cdr syntmp-ls-990)))))) (syntmp-gen-label-120 (lambda () (string #\i))) (syntmp-wrap-subst-119 cdr) (syntmp-wrap-marks-118 car) (syntmp-make-wrap-117 cons) (syntmp-id-sym-name&marks-116 (lambda (syntmp-x-991 syntmp-w-992) (if (syntmp-syntax-object?-101 syntmp-x-991) (values (let ((syntmp-e-993 (syntmp-syntax-object-expression-102 syntmp-x-991))) (if (syntmp-annotation?-89 syntmp-e-993) (annotation-expression syntmp-e-993) syntmp-e-993)) (syntmp-join-marks-135 (syntmp-wrap-marks-118 syntmp-w-992) (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-x-991)))) (values (let ((syntmp-e-994 syntmp-x-991)) (if (syntmp-annotation?-89 syntmp-e-994) (annotation-expression syntmp-e-994) syntmp-e-994)) (syntmp-wrap-marks-118 syntmp-w-992))))) (syntmp-id?-115 (lambda (syntmp-x-995) (cond ((symbol? syntmp-x-995) #t) ((syntmp-syntax-object?-101 syntmp-x-995) (symbol? (let ((syntmp-e-996 (syntmp-syntax-object-expression-102 syntmp-x-995))) (if (syntmp-annotation?-89 syntmp-e-996) (annotation-expression syntmp-e-996) syntmp-e-996)))) ((syntmp-annotation?-89 syntmp-x-995) (symbol? (annotation-expression syntmp-x-995))) (else #f)))) (syntmp-nonsymbol-id?-114 (lambda (syntmp-x-997) (and (syntmp-syntax-object?-101 syntmp-x-997) (symbol? (let ((syntmp-e-998 (syntmp-syntax-object-expression-102 syntmp-x-997))) (if (syntmp-annotation?-89 syntmp-e-998) (annotation-expression syntmp-e-998) syntmp-e-998)))))) (syntmp-global-extend-113 (lambda (syntmp-type-999 syntmp-sym-1000 syntmp-val-1001) (syntmp-put-global-definition-hook-93 syntmp-sym-1000 (cons syntmp-type-999 syntmp-val-1001)))) (syntmp-lookup-112 (lambda (syntmp-x-1002 syntmp-r-1003) (cond ((assq syntmp-x-1002 syntmp-r-1003) => cdr) ((symbol? syntmp-x-1002) (or (syntmp-get-global-definition-hook-94 syntmp-x-1002) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-111 (lambda (syntmp-r-1004) (if (null? syntmp-r-1004) (quote ()) (let ((syntmp-a-1005 (car syntmp-r-1004))) (if (eq? (cadr syntmp-a-1005) (quote macro)) (cons syntmp-a-1005 (syntmp-macros-only-env-111 (cdr syntmp-r-1004))) (syntmp-macros-only-env-111 (cdr syntmp-r-1004))))))) (syntmp-extend-var-env-110 (lambda (syntmp-labels-1006 syntmp-vars-1007 syntmp-r-1008) (if (null? syntmp-labels-1006) syntmp-r-1008 (syntmp-extend-var-env-110 (cdr syntmp-labels-1006) (cdr syntmp-vars-1007) (cons (cons (car syntmp-labels-1006) (cons (quote lexical) (car syntmp-vars-1007))) syntmp-r-1008))))) (syntmp-extend-env-109 (lambda (syntmp-labels-1009 syntmp-bindings-1010 syntmp-r-1011) (if (null? syntmp-labels-1009) syntmp-r-1011 (syntmp-extend-env-109 (cdr syntmp-labels-1009) (cdr syntmp-bindings-1010) (cons (cons (car syntmp-labels-1009) (car syntmp-bindings-1010)) syntmp-r-1011))))) (syntmp-binding-value-108 cdr) (syntmp-binding-type-107 car) (syntmp-source-annotation-106 (lambda (syntmp-x-1012) (cond ((syntmp-annotation?-89 syntmp-x-1012) (annotation-source syntmp-x-1012)) ((syntmp-syntax-object?-101 syntmp-x-1012) (syntmp-source-annotation-106 (syntmp-syntax-object-expression-102 syntmp-x-1012))) (else #f)))) (syntmp-set-syntax-object-wrap!-105 (lambda (syntmp-x-1013 syntmp-update-1014) (vector-set! syntmp-x-1013 2 syntmp-update-1014))) (syntmp-set-syntax-object-expression!-104 (lambda (syntmp-x-1015 syntmp-update-1016) (vector-set! syntmp-x-1015 1 syntmp-update-1016))) (syntmp-syntax-object-wrap-103 (lambda (syntmp-x-1017) (vector-ref syntmp-x-1017 2))) (syntmp-syntax-object-expression-102 (lambda (syntmp-x-1018) (vector-ref syntmp-x-1018 1))) (syntmp-syntax-object?-101 (lambda (syntmp-x-1019) (and (vector? syntmp-x-1019) (= (vector-length syntmp-x-1019) 3) (eq? (vector-ref syntmp-x-1019 0) (quote syntax-object))))) (syntmp-make-syntax-object-100 (lambda (syntmp-expression-1020 syntmp-wrap-1021) (vector (quote syntax-object) syntmp-expression-1020 syntmp-wrap-1021))) (syntmp-build-letrec-99 (lambda (syntmp-src-1022 syntmp-vars-1023 syntmp-val-exps-1024 syntmp-body-exp-1025) (if (null? syntmp-vars-1023) syntmp-body-exp-1025 (list (quote letrec) (map list syntmp-vars-1023 syntmp-val-exps-1024) syntmp-body-exp-1025)))) (syntmp-build-named-let-98 (lambda (syntmp-src-1026 syntmp-vars-1027 syntmp-val-exps-1028 syntmp-body-exp-1029) (if (null? syntmp-vars-1027) syntmp-body-exp-1029 (list (quote let) (car syntmp-vars-1027) (map list (cdr syntmp-vars-1027) syntmp-val-exps-1028) syntmp-body-exp-1029)))) (syntmp-build-let-97 (lambda (syntmp-src-1030 syntmp-vars-1031 syntmp-val-exps-1032 syntmp-body-exp-1033) (if (null? syntmp-vars-1031) syntmp-body-exp-1033 (list (quote let) (map list syntmp-vars-1031 syntmp-val-exps-1032) syntmp-body-exp-1033)))) (syntmp-build-sequence-96 (lambda (syntmp-src-1034 syntmp-exps-1035) (if (null? (cdr syntmp-exps-1035)) (car syntmp-exps-1035) (cons (quote begin) syntmp-exps-1035)))) (syntmp-build-data-95 (lambda (syntmp-src-1036 syntmp-exp-1037) (if (let ((syntmp-x-1038 syntmp-exp-1037)) (or (boolean? syntmp-x-1038) (number? syntmp-x-1038) (string? syntmp-x-1038) (char? syntmp-x-1038) (keyword? syntmp-x-1038) (procedure? syntmp-x-1038))) syntmp-exp-1037 (list (quote quote) syntmp-exp-1037)))) (syntmp-get-global-definition-hook-94 (lambda (syntmp-symbol-1039) (getprop syntmp-symbol-1039 (quote *sc-expander*)))) (syntmp-put-global-definition-hook-93 (lambda (syntmp-symbol-1040 syntmp-binding-1041) (putprop syntmp-symbol-1040 (quote *sc-expander*) syntmp-binding-1041))) (syntmp-error-hook-92 (lambda (syntmp-who-1042 syntmp-why-1043 syntmp-what-1044) (error syntmp-who-1042 "~a ~s" syntmp-why-1043 syntmp-what-1044))) (syntmp-local-eval-hook-91 (lambda (syntmp-x-1045) (eval (list syntmp-noexpand-84 syntmp-x-1045) (interaction-environment)))) (syntmp-top-level-eval-hook-90 (lambda (syntmp-x-1046) (eval (list syntmp-noexpand-84 syntmp-x-1046) (interaction-environment)))) (syntmp-annotation?-89 (lambda (syntmp-x-1047) #f)) (syntmp-fx<-88 <) (syntmp-fx=-87 =) (syntmp-fx--86 -) (syntmp-fx+-85 +) (syntmp-noexpand-84 "noexpand")) (begin (syntmp-global-extend-113 (quote local-syntax) (quote letrec-syntax) #t) (syntmp-global-extend-113 (quote local-syntax) (quote let-syntax) #f) (syntmp-global-extend-113 (quote core) (quote fluid-let-syntax) (lambda (syntmp-e-1048 syntmp-r-1049 syntmp-w-1050 syntmp-s-1051) ((lambda (syntmp-tmp-1052) ((lambda (syntmp-tmp-1053) (if (if syntmp-tmp-1053 (apply (lambda (syntmp-_-1054 syntmp-var-1055 syntmp-val-1056 syntmp-e1-1057 syntmp-e2-1058) (syntmp-valid-bound-ids?-140 syntmp-var-1055)) syntmp-tmp-1053) #f) (apply (lambda (syntmp-_-1060 syntmp-var-1061 syntmp-val-1062 syntmp-e1-1063 syntmp-e2-1064) (let ((syntmp-names-1065 (map (lambda (syntmp-x-1066) (syntmp-id-var-name-137 syntmp-x-1066 syntmp-w-1050)) syntmp-var-1061))) (begin (for-each (lambda (syntmp-id-1068 syntmp-n-1069) (let ((syntmp-t-1070 (syntmp-binding-type-107 (syntmp-lookup-112 syntmp-n-1069 syntmp-r-1049)))) (if (memv syntmp-t-1070 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-144 syntmp-id-1068 syntmp-w-1050 syntmp-s-1051) "identifier out of context")))) syntmp-var-1061 syntmp-names-1065) (syntmp-chi-body-155 (cons syntmp-e1-1063 syntmp-e2-1064) (syntmp-source-wrap-144 syntmp-e-1048 syntmp-w-1050 syntmp-s-1051) (syntmp-extend-env-109 syntmp-names-1065 (let ((syntmp-trans-r-1073 (syntmp-macros-only-env-111 syntmp-r-1049))) (map (lambda (syntmp-x-1074) (cons (quote macro) (syntmp-eval-local-transformer-158 (syntmp-chi-151 syntmp-x-1074 syntmp-trans-r-1073 syntmp-w-1050)))) syntmp-val-1062)) syntmp-r-1049) syntmp-w-1050)))) syntmp-tmp-1053) ((lambda (syntmp-_-1076) (syntax-error (syntmp-source-wrap-144 syntmp-e-1048 syntmp-w-1050 syntmp-s-1051))) syntmp-tmp-1052))) (syntax-dispatch syntmp-tmp-1052 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1048))) (syntmp-global-extend-113 (quote core) (quote quote) (lambda (syntmp-e-1077 syntmp-r-1078 syntmp-w-1079 syntmp-s-1080) ((lambda (syntmp-tmp-1081) ((lambda (syntmp-tmp-1082) (if syntmp-tmp-1082 (apply (lambda (syntmp-_-1083 syntmp-e-1084) (syntmp-build-data-95 syntmp-s-1080 (syntmp-strip-162 syntmp-e-1084 syntmp-w-1079))) syntmp-tmp-1082) ((lambda (syntmp-_-1085) (syntax-error (syntmp-source-wrap-144 syntmp-e-1077 syntmp-w-1079 syntmp-s-1080))) syntmp-tmp-1081))) (syntax-dispatch syntmp-tmp-1081 (quote (any any))))) syntmp-e-1077))) (syntmp-global-extend-113 (quote core) (quote syntax) (letrec ((syntmp-regen-1093 (lambda (syntmp-x-1094) (let ((syntmp-t-1095 (car syntmp-x-1094))) (if (memv syntmp-t-1095 (quote (ref))) (cadr syntmp-x-1094) (if (memv syntmp-t-1095 (quote (primitive))) (cadr syntmp-x-1094) (if (memv syntmp-t-1095 (quote (quote))) (syntmp-build-data-95 #f (cadr syntmp-x-1094)) (if (memv syntmp-t-1095 (quote (lambda))) (list (quote lambda) (cadr syntmp-x-1094) (syntmp-regen-1093 (caddr syntmp-x-1094))) (if (memv syntmp-t-1095 (quote (map))) (let ((syntmp-ls-1096 (map syntmp-regen-1093 (cdr syntmp-x-1094)))) (cons (if (syntmp-fx=-87 (length syntmp-ls-1096) 2) (quote map) (quote map)) syntmp-ls-1096)) (cons (car syntmp-x-1094) (map syntmp-regen-1093 (cdr syntmp-x-1094))))))))))) (syntmp-gen-vector-1092 (lambda (syntmp-x-1097) (cond ((eq? (car syntmp-x-1097) (quote list)) (cons (quote vector) (cdr syntmp-x-1097))) ((eq? (car syntmp-x-1097) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1097)))) (else (list (quote list->vector) syntmp-x-1097))))) (syntmp-gen-append-1091 (lambda (syntmp-x-1098 syntmp-y-1099) (if (equal? syntmp-y-1099 (quote (quote ()))) syntmp-x-1098 (list (quote append) syntmp-x-1098 syntmp-y-1099)))) (syntmp-gen-cons-1090 (lambda (syntmp-x-1100 syntmp-y-1101) (let ((syntmp-t-1102 (car syntmp-y-1101))) (if (memv syntmp-t-1102 (quote (quote))) (if (eq? (car syntmp-x-1100) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1100) (cadr syntmp-y-1101))) (if (eq? (cadr syntmp-y-1101) (quote ())) (list (quote list) syntmp-x-1100) (list (quote cons) syntmp-x-1100 syntmp-y-1101))) (if (memv syntmp-t-1102 (quote (list))) (cons (quote list) (cons syntmp-x-1100 (cdr syntmp-y-1101))) (list (quote cons) syntmp-x-1100 syntmp-y-1101)))))) (syntmp-gen-map-1089 (lambda (syntmp-e-1103 syntmp-map-env-1104) (let ((syntmp-formals-1105 (map cdr syntmp-map-env-1104)) (syntmp-actuals-1106 (map (lambda (syntmp-x-1107) (list (quote ref) (car syntmp-x-1107))) syntmp-map-env-1104))) (cond ((eq? (car syntmp-e-1103) (quote ref)) (car syntmp-actuals-1106)) ((andmap (lambda (syntmp-x-1108) (and (eq? (car syntmp-x-1108) (quote ref)) (memq (cadr syntmp-x-1108) syntmp-formals-1105))) (cdr syntmp-e-1103)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1103)) (map (let ((syntmp-r-1109 (map cons syntmp-formals-1105 syntmp-actuals-1106))) (lambda (syntmp-x-1110) (cdr (assq (cadr syntmp-x-1110) syntmp-r-1109)))) (cdr syntmp-e-1103))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1105 syntmp-e-1103) syntmp-actuals-1106))))))) (syntmp-gen-mappend-1088 (lambda (syntmp-e-1111 syntmp-map-env-1112) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1089 syntmp-e-1111 syntmp-map-env-1112)))) (syntmp-gen-ref-1087 (lambda (syntmp-src-1113 syntmp-var-1114 syntmp-level-1115 syntmp-maps-1116) (if (syntmp-fx=-87 syntmp-level-1115 0) (values syntmp-var-1114 syntmp-maps-1116) (if (null? syntmp-maps-1116) (syntax-error syntmp-src-1113 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1087 syntmp-src-1113 syntmp-var-1114 (syntmp-fx--86 syntmp-level-1115 1) (cdr syntmp-maps-1116))) (lambda (syntmp-outer-var-1117 syntmp-outer-maps-1118) (let ((syntmp-b-1119 (assq syntmp-outer-var-1117 (car syntmp-maps-1116)))) (if syntmp-b-1119 (values (cdr syntmp-b-1119) syntmp-maps-1116) (let ((syntmp-inner-var-1120 (syntmp-gen-var-163 (quote tmp)))) (values syntmp-inner-var-1120 (cons (cons (cons syntmp-outer-var-1117 syntmp-inner-var-1120) (car syntmp-maps-1116)) syntmp-outer-maps-1118))))))))))) (syntmp-gen-syntax-1086 (lambda (syntmp-src-1121 syntmp-e-1122 syntmp-r-1123 syntmp-maps-1124 syntmp-ellipsis?-1125) (if (syntmp-id?-115 syntmp-e-1122) (let ((syntmp-label-1126 (syntmp-id-var-name-137 syntmp-e-1122 (quote (()))))) (let ((syntmp-b-1127 (syntmp-lookup-112 syntmp-label-1126 syntmp-r-1123))) (if (eq? (syntmp-binding-type-107 syntmp-b-1127) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1128 (syntmp-binding-value-108 syntmp-b-1127))) (syntmp-gen-ref-1087 syntmp-src-1121 (car syntmp-var.lev-1128) (cdr syntmp-var.lev-1128) syntmp-maps-1124))) (lambda (syntmp-var-1129 syntmp-maps-1130) (values (list (quote ref) syntmp-var-1129) syntmp-maps-1130))) (if (syntmp-ellipsis?-1125 syntmp-e-1122) (syntax-error syntmp-src-1121 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1122) syntmp-maps-1124))))) ((lambda (syntmp-tmp-1131) ((lambda (syntmp-tmp-1132) (if (if syntmp-tmp-1132 (apply (lambda (syntmp-dots-1133 syntmp-e-1134) (syntmp-ellipsis?-1125 syntmp-dots-1133)) syntmp-tmp-1132) #f) (apply (lambda (syntmp-dots-1135 syntmp-e-1136) (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-e-1136 syntmp-r-1123 syntmp-maps-1124 (lambda (syntmp-x-1137) #f))) syntmp-tmp-1132) ((lambda (syntmp-tmp-1138) (if (if syntmp-tmp-1138 (apply (lambda (syntmp-x-1139 syntmp-dots-1140 syntmp-y-1141) (syntmp-ellipsis?-1125 syntmp-dots-1140)) syntmp-tmp-1138) #f) (apply (lambda (syntmp-x-1142 syntmp-dots-1143 syntmp-y-1144) (let syntmp-f-1145 ((syntmp-y-1146 syntmp-y-1144) (syntmp-k-1147 (lambda (syntmp-maps-1148) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-x-1142 syntmp-r-1123 (cons (quote ()) syntmp-maps-1148) syntmp-ellipsis?-1125)) (lambda (syntmp-x-1149 syntmp-maps-1150) (if (null? (car syntmp-maps-1150)) (syntax-error syntmp-src-1121 "extra ellipsis in syntax form") (values (syntmp-gen-map-1089 syntmp-x-1149 (car syntmp-maps-1150)) (cdr syntmp-maps-1150)))))))) ((lambda (syntmp-tmp-1151) ((lambda (syntmp-tmp-1152) (if (if syntmp-tmp-1152 (apply (lambda (syntmp-dots-1153 syntmp-y-1154) (syntmp-ellipsis?-1125 syntmp-dots-1153)) syntmp-tmp-1152) #f) (apply (lambda (syntmp-dots-1155 syntmp-y-1156) (syntmp-f-1145 syntmp-y-1156 (lambda (syntmp-maps-1157) (call-with-values (lambda () (syntmp-k-1147 (cons (quote ()) syntmp-maps-1157))) (lambda (syntmp-x-1158 syntmp-maps-1159) (if (null? (car syntmp-maps-1159)) (syntax-error syntmp-src-1121 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1088 syntmp-x-1158 (car syntmp-maps-1159)) (cdr syntmp-maps-1159)))))))) syntmp-tmp-1152) ((lambda (syntmp-_-1160) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-y-1146 syntmp-r-1123 syntmp-maps-1124 syntmp-ellipsis?-1125)) (lambda (syntmp-y-1161 syntmp-maps-1162) (call-with-values (lambda () (syntmp-k-1147 syntmp-maps-1162)) (lambda (syntmp-x-1163 syntmp-maps-1164) (values (syntmp-gen-append-1091 syntmp-x-1163 syntmp-y-1161) syntmp-maps-1164)))))) syntmp-tmp-1151))) (syntax-dispatch syntmp-tmp-1151 (quote (any . any))))) syntmp-y-1146))) syntmp-tmp-1138) ((lambda (syntmp-tmp-1165) (if syntmp-tmp-1165 (apply (lambda (syntmp-x-1166 syntmp-y-1167) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-x-1166 syntmp-r-1123 syntmp-maps-1124 syntmp-ellipsis?-1125)) (lambda (syntmp-x-1168 syntmp-maps-1169) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 syntmp-y-1167 syntmp-r-1123 syntmp-maps-1169 syntmp-ellipsis?-1125)) (lambda (syntmp-y-1170 syntmp-maps-1171) (values (syntmp-gen-cons-1090 syntmp-x-1168 syntmp-y-1170) syntmp-maps-1171)))))) syntmp-tmp-1165) ((lambda (syntmp-tmp-1172) (if syntmp-tmp-1172 (apply (lambda (syntmp-e1-1173 syntmp-e2-1174) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-src-1121 (cons syntmp-e1-1173 syntmp-e2-1174) syntmp-r-1123 syntmp-maps-1124 syntmp-ellipsis?-1125)) (lambda (syntmp-e-1176 syntmp-maps-1177) (values (syntmp-gen-vector-1092 syntmp-e-1176) syntmp-maps-1177)))) syntmp-tmp-1172) ((lambda (syntmp-_-1178) (values (list (quote quote) syntmp-e-1122) syntmp-maps-1124)) syntmp-tmp-1131))) (syntax-dispatch syntmp-tmp-1131 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1131 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1131 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1131 (quote (any any))))) syntmp-e-1122))))) (lambda (syntmp-e-1179 syntmp-r-1180 syntmp-w-1181 syntmp-s-1182) (let ((syntmp-e-1183 (syntmp-source-wrap-144 syntmp-e-1179 syntmp-w-1181 syntmp-s-1182))) ((lambda (syntmp-tmp-1184) ((lambda (syntmp-tmp-1185) (if syntmp-tmp-1185 (apply (lambda (syntmp-_-1186 syntmp-x-1187) (call-with-values (lambda () (syntmp-gen-syntax-1086 syntmp-e-1183 syntmp-x-1187 syntmp-r-1180 (quote ()) syntmp-ellipsis?-160)) (lambda (syntmp-e-1188 syntmp-maps-1189) (syntmp-regen-1093 syntmp-e-1188)))) syntmp-tmp-1185) ((lambda (syntmp-_-1190) (syntax-error syntmp-e-1183)) syntmp-tmp-1184))) (syntax-dispatch syntmp-tmp-1184 (quote (any any))))) syntmp-e-1183))))) (syntmp-global-extend-113 (quote core) (quote lambda) (lambda (syntmp-e-1191 syntmp-r-1192 syntmp-w-1193 syntmp-s-1194) ((lambda (syntmp-tmp-1195) ((lambda (syntmp-tmp-1196) (if syntmp-tmp-1196 (apply (lambda (syntmp-_-1197 syntmp-c-1198) (syntmp-chi-lambda-clause-156 (syntmp-source-wrap-144 syntmp-e-1191 syntmp-w-1193 syntmp-s-1194) syntmp-c-1198 syntmp-r-1192 syntmp-w-1193 (lambda (syntmp-vars-1199 syntmp-body-1200) (list (quote lambda) syntmp-vars-1199 syntmp-body-1200)))) syntmp-tmp-1196) (syntax-error syntmp-tmp-1195))) (syntax-dispatch syntmp-tmp-1195 (quote (any . any))))) syntmp-e-1191))) (syntmp-global-extend-113 (quote core) (quote let) (letrec ((syntmp-chi-let-1201 (lambda (syntmp-e-1202 syntmp-r-1203 syntmp-w-1204 syntmp-s-1205 syntmp-constructor-1206 syntmp-ids-1207 syntmp-vals-1208 syntmp-exps-1209) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-1207)) (syntax-error syntmp-e-1202 "duplicate bound variable in") (let ((syntmp-labels-1210 (syntmp-gen-labels-121 syntmp-ids-1207)) (syntmp-new-vars-1211 (map syntmp-gen-var-163 syntmp-ids-1207))) (let ((syntmp-nw-1212 (syntmp-make-binding-wrap-132 syntmp-ids-1207 syntmp-labels-1210 syntmp-w-1204)) (syntmp-nr-1213 (syntmp-extend-var-env-110 syntmp-labels-1210 syntmp-new-vars-1211 syntmp-r-1203))) (syntmp-constructor-1206 syntmp-s-1205 syntmp-new-vars-1211 (map (lambda (syntmp-x-1214) (syntmp-chi-151 syntmp-x-1214 syntmp-r-1203 syntmp-w-1204)) syntmp-vals-1208) (syntmp-chi-body-155 syntmp-exps-1209 (syntmp-source-wrap-144 syntmp-e-1202 syntmp-nw-1212 syntmp-s-1205) syntmp-nr-1213 syntmp-nw-1212)))))))) (lambda (syntmp-e-1215 syntmp-r-1216 syntmp-w-1217 syntmp-s-1218) ((lambda (syntmp-tmp-1219) ((lambda (syntmp-tmp-1220) (if syntmp-tmp-1220 (apply (lambda (syntmp-_-1221 syntmp-id-1222 syntmp-val-1223 syntmp-e1-1224 syntmp-e2-1225) (syntmp-chi-let-1201 syntmp-e-1215 syntmp-r-1216 syntmp-w-1217 syntmp-s-1218 syntmp-build-let-97 syntmp-id-1222 syntmp-val-1223 (cons syntmp-e1-1224 syntmp-e2-1225))) syntmp-tmp-1220) ((lambda (syntmp-tmp-1229) (if (if syntmp-tmp-1229 (apply (lambda (syntmp-_-1230 syntmp-f-1231 syntmp-id-1232 syntmp-val-1233 syntmp-e1-1234 syntmp-e2-1235) (syntmp-id?-115 syntmp-f-1231)) syntmp-tmp-1229) #f) (apply (lambda (syntmp-_-1236 syntmp-f-1237 syntmp-id-1238 syntmp-val-1239 syntmp-e1-1240 syntmp-e2-1241) (syntmp-chi-let-1201 syntmp-e-1215 syntmp-r-1216 syntmp-w-1217 syntmp-s-1218 syntmp-build-named-let-98 (cons syntmp-f-1237 syntmp-id-1238) syntmp-val-1239 (cons syntmp-e1-1240 syntmp-e2-1241))) syntmp-tmp-1229) ((lambda (syntmp-_-1245) (syntax-error (syntmp-source-wrap-144 syntmp-e-1215 syntmp-w-1217 syntmp-s-1218))) syntmp-tmp-1219))) (syntax-dispatch syntmp-tmp-1219 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1219 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1215)))) (syntmp-global-extend-113 (quote core) (quote letrec) (lambda (syntmp-e-1246 syntmp-r-1247 syntmp-w-1248 syntmp-s-1249) ((lambda (syntmp-tmp-1250) ((lambda (syntmp-tmp-1251) (if syntmp-tmp-1251 (apply (lambda (syntmp-_-1252 syntmp-id-1253 syntmp-val-1254 syntmp-e1-1255 syntmp-e2-1256) (let ((syntmp-ids-1257 syntmp-id-1253)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-1257)) (syntax-error syntmp-e-1246 "duplicate bound variable in") (let ((syntmp-labels-1259 (syntmp-gen-labels-121 syntmp-ids-1257)) (syntmp-new-vars-1260 (map syntmp-gen-var-163 syntmp-ids-1257))) (let ((syntmp-w-1261 (syntmp-make-binding-wrap-132 syntmp-ids-1257 syntmp-labels-1259 syntmp-w-1248)) (syntmp-r-1262 (syntmp-extend-var-env-110 syntmp-labels-1259 syntmp-new-vars-1260 syntmp-r-1247))) (syntmp-build-letrec-99 syntmp-s-1249 syntmp-new-vars-1260 (map (lambda (syntmp-x-1263) (syntmp-chi-151 syntmp-x-1263 syntmp-r-1262 syntmp-w-1261)) syntmp-val-1254) (syntmp-chi-body-155 (cons syntmp-e1-1255 syntmp-e2-1256) (syntmp-source-wrap-144 syntmp-e-1246 syntmp-w-1261 syntmp-s-1249) syntmp-r-1262 syntmp-w-1261))))))) syntmp-tmp-1251) ((lambda (syntmp-_-1266) (syntax-error (syntmp-source-wrap-144 syntmp-e-1246 syntmp-w-1248 syntmp-s-1249))) syntmp-tmp-1250))) (syntax-dispatch syntmp-tmp-1250 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1246))) (syntmp-global-extend-113 (quote core) (quote set!) (lambda (syntmp-e-1267 syntmp-r-1268 syntmp-w-1269 syntmp-s-1270) ((lambda (syntmp-tmp-1271) ((lambda (syntmp-tmp-1272) (if (if syntmp-tmp-1272 (apply (lambda (syntmp-_-1273 syntmp-id-1274 syntmp-val-1275) (syntmp-id?-115 syntmp-id-1274)) syntmp-tmp-1272) #f) (apply (lambda (syntmp-_-1276 syntmp-id-1277 syntmp-val-1278) (let ((syntmp-val-1279 (syntmp-chi-151 syntmp-val-1278 syntmp-r-1268 syntmp-w-1269)) (syntmp-n-1280 (syntmp-id-var-name-137 syntmp-id-1277 syntmp-w-1269))) (let ((syntmp-b-1281 (syntmp-lookup-112 syntmp-n-1280 syntmp-r-1268))) (let ((syntmp-t-1282 (syntmp-binding-type-107 syntmp-b-1281))) (if (memv syntmp-t-1282 (quote (lexical))) (list (quote set!) (syntmp-binding-value-108 syntmp-b-1281) syntmp-val-1279) (if (memv syntmp-t-1282 (quote (global))) (list (quote set!) syntmp-n-1280 syntmp-val-1279) (if (memv syntmp-t-1282 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-143 syntmp-id-1277 syntmp-w-1269) "identifier out of context") (syntax-error (syntmp-source-wrap-144 syntmp-e-1267 syntmp-w-1269 syntmp-s-1270))))))))) syntmp-tmp-1272) ((lambda (syntmp-tmp-1283) (if syntmp-tmp-1283 (apply (lambda (syntmp-_-1284 syntmp-getter-1285 syntmp-arg-1286 syntmp-val-1287) (cons (syntmp-chi-151 (list (quote #(syntax-object setter ((top) #(ribcage #(_ getter arg val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s) #((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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i"))))) syntmp-getter-1285) syntmp-r-1268 syntmp-w-1269) (map (lambda (syntmp-e-1288) (syntmp-chi-151 syntmp-e-1288 syntmp-r-1268 syntmp-w-1269)) (append syntmp-arg-1286 (list syntmp-val-1287))))) syntmp-tmp-1283) ((lambda (syntmp-_-1290) (syntax-error (syntmp-source-wrap-144 syntmp-e-1267 syntmp-w-1269 syntmp-s-1270))) syntmp-tmp-1271))) (syntax-dispatch syntmp-tmp-1271 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1271 (quote (any any any))))) syntmp-e-1267))) (syntmp-global-extend-113 (quote begin) (quote begin) (quote ())) (syntmp-global-extend-113 (quote define) (quote define) (quote ())) (syntmp-global-extend-113 (quote define-syntax) (quote define-syntax) (quote ())) (syntmp-global-extend-113 (quote eval-when) (quote eval-when) (quote ())) (syntmp-global-extend-113 (quote core) (quote syntax-case) (letrec ((syntmp-gen-syntax-case-1294 (lambda (syntmp-x-1295 syntmp-keys-1296 syntmp-clauses-1297 syntmp-r-1298) (if (null? syntmp-clauses-1297) (list (quote syntax-error) syntmp-x-1295) ((lambda (syntmp-tmp-1299) ((lambda (syntmp-tmp-1300) (if syntmp-tmp-1300 (apply (lambda (syntmp-pat-1301 syntmp-exp-1302) (if (and (syntmp-id?-115 syntmp-pat-1301) (andmap (lambda (syntmp-x-1303) (not (syntmp-free-id=?-138 syntmp-pat-1301 syntmp-x-1303))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r) #((top) (top) (top) (top)) #("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-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? 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 get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? 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) ((top)) ("i"))))) syntmp-keys-1296))) (let ((syntmp-labels-1304 (list (syntmp-gen-label-120))) (syntmp-var-1305 (syntmp-gen-var-163 syntmp-pat-1301))) (list (list (quote lambda) (list syntmp-var-1305) (syntmp-chi-151 syntmp-exp-1302 (syntmp-extend-env-109 syntmp-labels-1304 (list (cons (quote syntax) (cons syntmp-var-1305 0))) syntmp-r-1298) (syntmp-make-binding-wrap-132 (list syntmp-pat-1301) syntmp-labels-1304 (quote (()))))) syntmp-x-1295)) (syntmp-gen-clause-1293 syntmp-x-1295 syntmp-keys-1296 (cdr syntmp-clauses-1297) syntmp-r-1298 syntmp-pat-1301 #t syntmp-exp-1302))) syntmp-tmp-1300) ((lambda (syntmp-tmp-1306) (if syntmp-tmp-1306 (apply (lambda (syntmp-pat-1307 syntmp-fender-1308 syntmp-exp-1309) (syntmp-gen-clause-1293 syntmp-x-1295 syntmp-keys-1296 (cdr syntmp-clauses-1297) syntmp-r-1298 syntmp-pat-1307 syntmp-fender-1308 syntmp-exp-1309)) syntmp-tmp-1306) ((lambda (syntmp-_-1310) (syntax-error (car syntmp-clauses-1297) "invalid syntax-case clause")) syntmp-tmp-1299))) (syntax-dispatch syntmp-tmp-1299 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1299 (quote (any any))))) (car syntmp-clauses-1297))))) (syntmp-gen-clause-1293 (lambda (syntmp-x-1311 syntmp-keys-1312 syntmp-clauses-1313 syntmp-r-1314 syntmp-pat-1315 syntmp-fender-1316 syntmp-exp-1317) (call-with-values (lambda () (syntmp-convert-pattern-1291 syntmp-pat-1315 syntmp-keys-1312)) (lambda (syntmp-p-1318 syntmp-pvars-1319) (cond ((not (syntmp-distinct-bound-ids?-141 (map car syntmp-pvars-1319))) (syntax-error syntmp-pat-1315 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1320) (not (syntmp-ellipsis?-160 (car syntmp-x-1320)))) syntmp-pvars-1319)) (syntax-error syntmp-pat-1315 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1321 (syntmp-gen-var-163 (quote tmp)))) (list (list (quote lambda) (list syntmp-y-1321) (let ((syntmp-y-1322 syntmp-y-1321)) (list (quote if) ((lambda (syntmp-tmp-1323) ((lambda (syntmp-tmp-1324) (if syntmp-tmp-1324 (apply (lambda () syntmp-y-1322) syntmp-tmp-1324) ((lambda (syntmp-_-1325) (list (quote if) syntmp-y-1322 (syntmp-build-dispatch-call-1292 syntmp-pvars-1319 syntmp-fender-1316 syntmp-y-1322 syntmp-r-1314) (syntmp-build-data-95 #f #f))) syntmp-tmp-1323))) (syntax-dispatch syntmp-tmp-1323 (quote #(atom #t))))) syntmp-fender-1316) (syntmp-build-dispatch-call-1292 syntmp-pvars-1319 syntmp-exp-1317 syntmp-y-1322 syntmp-r-1314) (syntmp-gen-syntax-case-1294 syntmp-x-1311 syntmp-keys-1312 syntmp-clauses-1313 syntmp-r-1314)))) (if (eq? syntmp-p-1318 (quote any)) (list (quote list) syntmp-x-1311) (list (quote syntax-dispatch) syntmp-x-1311 (syntmp-build-data-95 #f syntmp-p-1318))))))))))) (syntmp-build-dispatch-call-1292 (lambda (syntmp-pvars-1326 syntmp-exp-1327 syntmp-y-1328 syntmp-r-1329) (let ((syntmp-ids-1330 (map car syntmp-pvars-1326)) (syntmp-levels-1331 (map cdr syntmp-pvars-1326))) (let ((syntmp-labels-1332 (syntmp-gen-labels-121 syntmp-ids-1330)) (syntmp-new-vars-1333 (map syntmp-gen-var-163 syntmp-ids-1330))) (list (quote apply) (list (quote lambda) syntmp-new-vars-1333 (syntmp-chi-151 syntmp-exp-1327 (syntmp-extend-env-109 syntmp-labels-1332 (map (lambda (syntmp-var-1334 syntmp-level-1335) (cons (quote syntax) (cons syntmp-var-1334 syntmp-level-1335))) syntmp-new-vars-1333 (map cdr syntmp-pvars-1326)) syntmp-r-1329) (syntmp-make-binding-wrap-132 syntmp-ids-1330 syntmp-labels-1332 (quote (()))))) syntmp-y-1328))))) (syntmp-convert-pattern-1291 (lambda (syntmp-pattern-1336 syntmp-keys-1337) (let syntmp-cvt-1338 ((syntmp-p-1339 syntmp-pattern-1336) (syntmp-n-1340 0) (syntmp-ids-1341 (quote ()))) (if (syntmp-id?-115 syntmp-p-1339) (if (syntmp-bound-id-member?-142 syntmp-p-1339 syntmp-keys-1337) (values (vector (quote free-id) syntmp-p-1339) syntmp-ids-1341) (values (quote any) (cons (cons syntmp-p-1339 syntmp-n-1340) syntmp-ids-1341))) ((lambda (syntmp-tmp-1342) ((lambda (syntmp-tmp-1343) (if (if syntmp-tmp-1343 (apply (lambda (syntmp-x-1344 syntmp-dots-1345) (syntmp-ellipsis?-160 syntmp-dots-1345)) syntmp-tmp-1343) #f) (apply (lambda (syntmp-x-1346 syntmp-dots-1347) (call-with-values (lambda () (syntmp-cvt-1338 syntmp-x-1346 (syntmp-fx+-85 syntmp-n-1340 1) syntmp-ids-1341)) (lambda (syntmp-p-1348 syntmp-ids-1349) (values (if (eq? syntmp-p-1348 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1348)) syntmp-ids-1349)))) syntmp-tmp-1343) ((lambda (syntmp-tmp-1350) (if syntmp-tmp-1350 (apply (lambda (syntmp-x-1351 syntmp-y-1352) (call-with-values (lambda () (syntmp-cvt-1338 syntmp-y-1352 syntmp-n-1340 syntmp-ids-1341)) (lambda (syntmp-y-1353 syntmp-ids-1354) (call-with-values (lambda () (syntmp-cvt-1338 syntmp-x-1351 syntmp-n-1340 syntmp-ids-1354)) (lambda (syntmp-x-1355 syntmp-ids-1356) (values (cons syntmp-x-1355 syntmp-y-1353) syntmp-ids-1356)))))) syntmp-tmp-1350) ((lambda (syntmp-tmp-1357) (if syntmp-tmp-1357 (apply (lambda () (values (quote ()) syntmp-ids-1341)) syntmp-tmp-1357) ((lambda (syntmp-tmp-1358) (if syntmp-tmp-1358 (apply (lambda (syntmp-x-1359) (call-with-values (lambda () (syntmp-cvt-1338 syntmp-x-1359 syntmp-n-1340 syntmp-ids-1341)) (lambda (syntmp-p-1361 syntmp-ids-1362) (values (vector (quote vector) syntmp-p-1361) syntmp-ids-1362)))) syntmp-tmp-1358) ((lambda (syntmp-x-1363) (values (vector (quote atom) (syntmp-strip-162 syntmp-p-1339 (quote (())))) syntmp-ids-1341)) syntmp-tmp-1342))) (syntax-dispatch syntmp-tmp-1342 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1342 (quote ()))))) (syntax-dispatch syntmp-tmp-1342 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1342 (quote (any any))))) syntmp-p-1339)))))) (lambda (syntmp-e-1364 syntmp-r-1365 syntmp-w-1366 syntmp-s-1367) (let ((syntmp-e-1368 (syntmp-source-wrap-144 syntmp-e-1364 syntmp-w-1366 syntmp-s-1367))) ((lambda (syntmp-tmp-1369) ((lambda (syntmp-tmp-1370) (if syntmp-tmp-1370 (apply (lambda (syntmp-_-1371 syntmp-val-1372 syntmp-key-1373 syntmp-m-1374) (if (andmap (lambda (syntmp-x-1375) (and (syntmp-id?-115 syntmp-x-1375) (not (syntmp-ellipsis?-160 syntmp-x-1375)))) syntmp-key-1373) (let ((syntmp-x-1377 (syntmp-gen-var-163 (quote tmp)))) (list (list (quote lambda) (list syntmp-x-1377) (syntmp-gen-syntax-case-1294 syntmp-x-1377 syntmp-key-1373 syntmp-m-1374 syntmp-r-1365)) (syntmp-chi-151 syntmp-val-1372 syntmp-r-1365 (quote (()))))) (syntax-error syntmp-e-1368 "invalid literals list in"))) syntmp-tmp-1370) (syntax-error syntmp-tmp-1369))) (syntax-dispatch syntmp-tmp-1369 (quote (any any each-any . each-any))))) syntmp-e-1368))))) (set! sc-expand (let ((syntmp-m-1380 (quote e)) (syntmp-esew-1381 (quote (eval)))) (lambda (syntmp-x-1382) (if (and (pair? syntmp-x-1382) (equal? (car syntmp-x-1382) syntmp-noexpand-84)) (cadr syntmp-x-1382) (syntmp-chi-top-150 syntmp-x-1382 (quote ()) (quote ((top))) syntmp-m-1380 syntmp-esew-1381))))) (set! sc-expand3 (let ((syntmp-m-1383 (quote e)) (syntmp-esew-1384 (quote (eval)))) (lambda (syntmp-x-1386 . syntmp-rest-1385) (if (and (pair? syntmp-x-1386) (equal? (car syntmp-x-1386) syntmp-noexpand-84)) (cadr syntmp-x-1386) (syntmp-chi-top-150 syntmp-x-1386 (quote ()) (quote ((top))) (if (null? syntmp-rest-1385) syntmp-m-1383 (car syntmp-rest-1385)) (if (or (null? syntmp-rest-1385) (null? (cdr syntmp-rest-1385))) syntmp-esew-1384 (cadr syntmp-rest-1385))))))) (set! identifier? (lambda (syntmp-x-1387) (syntmp-nonsymbol-id?-114 syntmp-x-1387))) (set! datum->syntax-object (lambda (syntmp-id-1388 syntmp-datum-1389) (syntmp-make-syntax-object-100 syntmp-datum-1389 (syntmp-syntax-object-wrap-103 syntmp-id-1388)))) (set! syntax-object->datum (lambda (syntmp-x-1390) (syntmp-strip-162 syntmp-x-1390 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1391) (begin (let ((syntmp-x-1392 syntmp-ls-1391)) (if (not (list? syntmp-x-1392)) (syntmp-error-hook-92 (quote generate-temporaries) "invalid argument" syntmp-x-1392))) (map (lambda (syntmp-x-1393) (syntmp-wrap-143 (gensym) (quote ((top))))) syntmp-ls-1391)))) (set! free-identifier=? (lambda (syntmp-x-1394 syntmp-y-1395) (begin (let ((syntmp-x-1396 syntmp-x-1394)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1396)) (syntmp-error-hook-92 (quote free-identifier=?) "invalid argument" syntmp-x-1396))) (let ((syntmp-x-1397 syntmp-y-1395)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1397)) (syntmp-error-hook-92 (quote free-identifier=?) "invalid argument" syntmp-x-1397))) (syntmp-free-id=?-138 syntmp-x-1394 syntmp-y-1395)))) (set! bound-identifier=? (lambda (syntmp-x-1398 syntmp-y-1399) (begin (let ((syntmp-x-1400 syntmp-x-1398)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1400)) (syntmp-error-hook-92 (quote bound-identifier=?) "invalid argument" syntmp-x-1400))) (let ((syntmp-x-1401 syntmp-y-1399)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1401)) (syntmp-error-hook-92 (quote bound-identifier=?) "invalid argument" syntmp-x-1401))) (syntmp-bound-id=?-139 syntmp-x-1398 syntmp-y-1399)))) (set! syntax-error (lambda (syntmp-object-1403 . syntmp-messages-1402) (begin (for-each (lambda (syntmp-x-1404) (let ((syntmp-x-1405 syntmp-x-1404)) (if (not (string? syntmp-x-1405)) (syntmp-error-hook-92 (quote syntax-error) "invalid argument" syntmp-x-1405)))) syntmp-messages-1402) (let ((syntmp-message-1406 (if (null? syntmp-messages-1402) "invalid syntax" (apply string-append syntmp-messages-1402)))) (syntmp-error-hook-92 #f syntmp-message-1406 (syntmp-strip-162 syntmp-object-1403 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1407 syntmp-v-1408) (begin (let ((syntmp-x-1409 syntmp-sym-1407)) (if (not (symbol? syntmp-x-1409)) (syntmp-error-hook-92 (quote define-syntax) "invalid argument" syntmp-x-1409))) (let ((syntmp-x-1410 syntmp-v-1408)) (if (not (procedure? syntmp-x-1410)) (syntmp-error-hook-92 (quote define-syntax) "invalid argument" syntmp-x-1410))) (syntmp-global-extend-113 (quote macro) syntmp-sym-1407 syntmp-v-1408)))) (letrec ((syntmp-match-1415 (lambda (syntmp-e-1416 syntmp-p-1417 syntmp-w-1418 syntmp-r-1419) (cond ((not syntmp-r-1419) #f) ((eq? syntmp-p-1417 (quote any)) (cons (syntmp-wrap-143 syntmp-e-1416 syntmp-w-1418) syntmp-r-1419)) ((syntmp-syntax-object?-101 syntmp-e-1416) (syntmp-match*-1414 (let ((syntmp-e-1420 (syntmp-syntax-object-expression-102 syntmp-e-1416))) (if (syntmp-annotation?-89 syntmp-e-1420) (annotation-expression syntmp-e-1420) syntmp-e-1420)) syntmp-p-1417 (syntmp-join-wraps-134 syntmp-w-1418 (syntmp-syntax-object-wrap-103 syntmp-e-1416)) syntmp-r-1419)) (else (syntmp-match*-1414 (let ((syntmp-e-1421 syntmp-e-1416)) (if (syntmp-annotation?-89 syntmp-e-1421) (annotation-expression syntmp-e-1421) syntmp-e-1421)) syntmp-p-1417 syntmp-w-1418 syntmp-r-1419))))) (syntmp-match*-1414 (lambda (syntmp-e-1422 syntmp-p-1423 syntmp-w-1424 syntmp-r-1425) (cond ((null? syntmp-p-1423) (and (null? syntmp-e-1422) syntmp-r-1425)) ((pair? syntmp-p-1423) (and (pair? syntmp-e-1422) (syntmp-match-1415 (car syntmp-e-1422) (car syntmp-p-1423) syntmp-w-1424 (syntmp-match-1415 (cdr syntmp-e-1422) (cdr syntmp-p-1423) syntmp-w-1424 syntmp-r-1425)))) ((eq? syntmp-p-1423 (quote each-any)) (let ((syntmp-l-1426 (syntmp-match-each-any-1412 syntmp-e-1422 syntmp-w-1424))) (and syntmp-l-1426 (cons syntmp-l-1426 syntmp-r-1425)))) (else (let ((syntmp-t-1427 (vector-ref syntmp-p-1423 0))) (if (memv syntmp-t-1427 (quote (each))) (if (null? syntmp-e-1422) (syntmp-match-empty-1413 (vector-ref syntmp-p-1423 1) syntmp-r-1425) (let ((syntmp-l-1428 (syntmp-match-each-1411 syntmp-e-1422 (vector-ref syntmp-p-1423 1) syntmp-w-1424))) (and syntmp-l-1428 (let syntmp-collect-1429 ((syntmp-l-1430 syntmp-l-1428)) (if (null? (car syntmp-l-1430)) syntmp-r-1425 (cons (map car syntmp-l-1430) (syntmp-collect-1429 (map cdr syntmp-l-1430)))))))) (if (memv syntmp-t-1427 (quote (free-id))) (and (syntmp-id?-115 syntmp-e-1422) (syntmp-free-id=?-138 (syntmp-wrap-143 syntmp-e-1422 syntmp-w-1424) (vector-ref syntmp-p-1423 1)) syntmp-r-1425) (if (memv syntmp-t-1427 (quote (atom))) (and (equal? (vector-ref syntmp-p-1423 1) (syntmp-strip-162 syntmp-e-1422 syntmp-w-1424)) syntmp-r-1425) (if (memv syntmp-t-1427 (quote (vector))) (and (vector? syntmp-e-1422) (syntmp-match-1415 (vector->list syntmp-e-1422) (vector-ref syntmp-p-1423 1) syntmp-w-1424 syntmp-r-1425))))))))))) (syntmp-match-empty-1413 (lambda (syntmp-p-1431 syntmp-r-1432) (cond ((null? syntmp-p-1431) syntmp-r-1432) ((eq? syntmp-p-1431 (quote any)) (cons (quote ()) syntmp-r-1432)) ((pair? syntmp-p-1431) (syntmp-match-empty-1413 (car syntmp-p-1431) (syntmp-match-empty-1413 (cdr syntmp-p-1431) syntmp-r-1432))) ((eq? syntmp-p-1431 (quote each-any)) (cons (quote ()) syntmp-r-1432)) (else (let ((syntmp-t-1433 (vector-ref syntmp-p-1431 0))) (if (memv syntmp-t-1433 (quote (each))) (syntmp-match-empty-1413 (vector-ref syntmp-p-1431 1) syntmp-r-1432) (if (memv syntmp-t-1433 (quote (free-id atom))) syntmp-r-1432 (if (memv syntmp-t-1433 (quote (vector))) (syntmp-match-empty-1413 (vector-ref syntmp-p-1431 1) syntmp-r-1432))))))))) (syntmp-match-each-any-1412 (lambda (syntmp-e-1434 syntmp-w-1435) (cond ((syntmp-annotation?-89 syntmp-e-1434) (syntmp-match-each-any-1412 (annotation-expression syntmp-e-1434) syntmp-w-1435)) ((pair? syntmp-e-1434) (let ((syntmp-l-1436 (syntmp-match-each-any-1412 (cdr syntmp-e-1434) syntmp-w-1435))) (and syntmp-l-1436 (cons (syntmp-wrap-143 (car syntmp-e-1434) syntmp-w-1435) syntmp-l-1436)))) ((null? syntmp-e-1434) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1434) (syntmp-match-each-any-1412 (syntmp-syntax-object-expression-102 syntmp-e-1434) (syntmp-join-wraps-134 syntmp-w-1435 (syntmp-syntax-object-wrap-103 syntmp-e-1434)))) (else #f)))) (syntmp-match-each-1411 (lambda (syntmp-e-1437 syntmp-p-1438 syntmp-w-1439) (cond ((syntmp-annotation?-89 syntmp-e-1437) (syntmp-match-each-1411 (annotation-expression syntmp-e-1437) syntmp-p-1438 syntmp-w-1439)) ((pair? syntmp-e-1437) (let ((syntmp-first-1440 (syntmp-match-1415 (car syntmp-e-1437) syntmp-p-1438 syntmp-w-1439 (quote ())))) (and syntmp-first-1440 (let ((syntmp-rest-1441 (syntmp-match-each-1411 (cdr syntmp-e-1437) syntmp-p-1438 syntmp-w-1439))) (and syntmp-rest-1441 (cons syntmp-first-1440 syntmp-rest-1441)))))) ((null? syntmp-e-1437) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1437) (syntmp-match-each-1411 (syntmp-syntax-object-expression-102 syntmp-e-1437) syntmp-p-1438 (syntmp-join-wraps-134 syntmp-w-1439 (syntmp-syntax-object-wrap-103 syntmp-e-1437)))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1442 syntmp-p-1443) (cond ((eq? syntmp-p-1443 (quote any)) (list syntmp-e-1442)) ((syntmp-syntax-object?-101 syntmp-e-1442) (syntmp-match*-1414 (let ((syntmp-e-1444 (syntmp-syntax-object-expression-102 syntmp-e-1442))) (if (syntmp-annotation?-89 syntmp-e-1444) (annotation-expression syntmp-e-1444) syntmp-e-1444)) syntmp-p-1443 (syntmp-syntax-object-wrap-103 syntmp-e-1442) (quote ()))) (else (syntmp-match*-1414 (let ((syntmp-e-1445 syntmp-e-1442)) (if (syntmp-annotation?-89 syntmp-e-1445) (annotation-expression syntmp-e-1445) syntmp-e-1445)) syntmp-p-1443 (quote (())) (quote ())))))) (set! sc-chi syntmp-chi-151)))))
 (install-global-transformer (quote with-syntax) (lambda (syntmp-x-1446) ((lambda (syntmp-tmp-1447) ((lambda (syntmp-tmp-1448) (if syntmp-tmp-1448 (apply (lambda (syntmp-_-1449 syntmp-e1-1450 syntmp-e2-1451) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1450 syntmp-e2-1451))) syntmp-tmp-1448) ((lambda (syntmp-tmp-1453) (if syntmp-tmp-1453 (apply (lambda (syntmp-_-1454 syntmp-out-1455 syntmp-in-1456 syntmp-e1-1457 syntmp-e2-1458) (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"))))) syntmp-in-1456 (quote ()) (list syntmp-out-1455 (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"))))) (cons syntmp-e1-1457 syntmp-e2-1458))))) syntmp-tmp-1453) ((lambda (syntmp-tmp-1460) (if syntmp-tmp-1460 (apply (lambda (syntmp-_-1461 syntmp-out-1462 syntmp-in-1463 syntmp-e1-1464 syntmp-e2-1465) (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"))))) (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"))))) syntmp-in-1463) (quote ()) (list syntmp-out-1462 (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"))))) (cons syntmp-e1-1464 syntmp-e2-1465))))) syntmp-tmp-1460) (syntax-error syntmp-tmp-1447))) (syntax-dispatch syntmp-tmp-1447 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1447 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1447 (quote (any () any . each-any))))) syntmp-x-1446)))
 (install-global-transformer (quote syntax-rules) (lambda (syntmp-x-1487) ((lambda (syntmp-tmp-1488) ((lambda (syntmp-tmp-1489) (if syntmp-tmp-1489 (apply (lambda (syntmp-_-1490 syntmp-k-1491 syntmp-keyword-1492 syntmp-pattern-1493 syntmp-template-1494) (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"))))) (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")))))) (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"))))) (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"))))) (cons syntmp-k-1491 (map (lambda (syntmp-tmp-1497 syntmp-tmp-1496) (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"))))) syntmp-tmp-1496) (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"))))) syntmp-tmp-1497))) syntmp-template-1494 syntmp-pattern-1493)))))) syntmp-tmp-1489) (syntax-error syntmp-tmp-1488))) (syntax-dispatch syntmp-tmp-1488 (quote (any each-any . #(each ((any . any) any))))))) syntmp-x-1487)))
 (install-global-transformer (quote let*) (lambda (syntmp-x-1508) ((lambda (syntmp-tmp-1509) ((lambda (syntmp-tmp-1510) (if (if syntmp-tmp-1510 (apply (lambda (syntmp-let*-1511 syntmp-x-1512 syntmp-v-1513 syntmp-e1-1514 syntmp-e2-1515) (andmap identifier? syntmp-x-1512)) syntmp-tmp-1510) #f) (apply (lambda (syntmp-let*-1517 syntmp-x-1518 syntmp-v-1519 syntmp-e1-1520 syntmp-e2-1521) (let syntmp-f-1522 ((syntmp-bindings-1523 (map list syntmp-x-1518 syntmp-v-1519))) (if (null? syntmp-bindings-1523) (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"))))) (cons (quote ()) (cons syntmp-e1-1520 syntmp-e2-1521))) ((lambda (syntmp-tmp-1527) ((lambda (syntmp-tmp-1528) (if syntmp-tmp-1528 (apply (lambda (syntmp-body-1529 syntmp-binding-1530) (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"))))) (list syntmp-binding-1530) syntmp-body-1529)) syntmp-tmp-1528) (syntax-error syntmp-tmp-1527))) (syntax-dispatch syntmp-tmp-1527 (quote (any any))))) (list (syntmp-f-1522 (cdr syntmp-bindings-1523)) (car syntmp-bindings-1523)))))) syntmp-tmp-1510) (syntax-error syntmp-tmp-1509))) (syntax-dispatch syntmp-tmp-1509 (quote (any #(each (any any)) any . each-any))))) syntmp-x-1508)))
diff --git a/ice-9/psyntax.ss b/ice-9/psyntax.ss
index ac33ca02e..bea81e85e 100644
--- a/ice-9/psyntax.ss
+++ b/ice-9/psyntax.ss
@@ -455,7 +455,8 @@
   (syntax-rules ()
     ((_ e)
      (let ((x e))
-       (or (boolean? x) (number? x) (string? x) (char? x) (keyword? x))))))
+       (or (boolean? x) (number? x) (string? x) (char? x) (keyword? x)
+	   (procedure? x))))))
 )
 
 (define-structure (syntax-object expression wrap))