diff --git a/module/ice-9/annotate.scm b/module/ice-9/annotate.scm index faa5f859a..24cd6e894 100644 --- a/module/ice-9/annotate.scm +++ b/module/ice-9/annotate.scm @@ -24,7 +24,7 @@ (define (make-vtable "prprpw" (lambda (struct port) - (display "#" port)))) @@ -46,12 +46,15 @@ (struct-set! a 2 #t)) (define (annotate e) - (cond ((and (list? e) (not (null? e))) - (make-annotation (map annotate e) (source-properties e) #f)) - ((pair? e) - (make-annotation (cons (annotate (car e)) (annotate (cdr e))) - (source-properties e) #f)) - (else e))) + (let ((p (if (pair? e) (source-properties e) #f)) + (out (cond ((and (list? e) (not (null? e))) + (map annotate e)) + ((pair? e) + (cons (annotate (car e)) (annotate (cdr e)))) + (else e)))) + (if (pair? p) + (make-annotation out p #f) + out))) (define (deannotate e) (cond ((list? e) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 4abf7bcc9..2bc1a2d4d 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -1,11 +1,11 @@ -(letrec ((syntmp-lambda-var-list-164 (lambda (syntmp-vars-549) (let syntmp-lvl-550 ((syntmp-vars-551 syntmp-vars-549) (syntmp-ls-552 (quote ())) (syntmp-w-553 (quote (())))) (cond ((pair? syntmp-vars-551) (syntmp-lvl-550 (cdr syntmp-vars-551) (cons (syntmp-wrap-143 (car syntmp-vars-551) syntmp-w-553) syntmp-ls-552) syntmp-w-553)) ((syntmp-id?-115 syntmp-vars-551) (cons (syntmp-wrap-143 syntmp-vars-551 syntmp-w-553) syntmp-ls-552)) ((null? syntmp-vars-551) syntmp-ls-552) ((syntmp-syntax-object?-101 syntmp-vars-551) (syntmp-lvl-550 (syntmp-syntax-object-expression-102 syntmp-vars-551) syntmp-ls-552 (syntmp-join-wraps-134 syntmp-w-553 (syntmp-syntax-object-wrap-103 syntmp-vars-551)))) ((syntmp-annotation?-89 syntmp-vars-551) (syntmp-lvl-550 (annotation-expression syntmp-vars-551) syntmp-ls-552 syntmp-w-553)) (else (cons syntmp-vars-551 syntmp-ls-552)))))) (syntmp-gen-var-163 (lambda (syntmp-id-554) (let ((syntmp-id-555 (if (syntmp-syntax-object?-101 syntmp-id-554) (syntmp-syntax-object-expression-102 syntmp-id-554) syntmp-id-554))) (if (syntmp-annotation?-89 syntmp-id-555) (gensym (symbol->string (annotation-expression syntmp-id-555))) (gensym (symbol->string syntmp-id-555)))))) (syntmp-strip-162 (lambda (syntmp-x-556 syntmp-w-557) (if (memq (quote top) (syntmp-wrap-marks-118 syntmp-w-557)) (if (or (syntmp-annotation?-89 syntmp-x-556) (and (pair? syntmp-x-556) (syntmp-annotation?-89 (car syntmp-x-556)))) (syntmp-strip-annotation-161 syntmp-x-556 #f) syntmp-x-556) (let syntmp-f-558 ((syntmp-x-559 syntmp-x-556)) (cond ((syntmp-syntax-object?-101 syntmp-x-559) (syntmp-strip-162 (syntmp-syntax-object-expression-102 syntmp-x-559) (syntmp-syntax-object-wrap-103 syntmp-x-559))) ((pair? syntmp-x-559) (let ((syntmp-a-560 (syntmp-f-558 (car syntmp-x-559))) (syntmp-d-561 (syntmp-f-558 (cdr syntmp-x-559)))) (if (and (eq? syntmp-a-560 (car syntmp-x-559)) (eq? syntmp-d-561 (cdr syntmp-x-559))) syntmp-x-559 (cons syntmp-a-560 syntmp-d-561)))) ((vector? syntmp-x-559) (let ((syntmp-old-562 (vector->list syntmp-x-559))) (let ((syntmp-new-563 (map syntmp-f-558 syntmp-old-562))) (if (andmap eq? syntmp-old-562 syntmp-new-563) syntmp-x-559 (list->vector syntmp-new-563))))) (else syntmp-x-559)))))) (syntmp-strip-annotation-161 (lambda (syntmp-x-564 syntmp-parent-565) (cond ((pair? syntmp-x-564) (let ((syntmp-new-566 (cons #f #f))) (begin (when syntmp-parent-565 (set-annotation-stripped! syntmp-parent-565 syntmp-new-566)) (set-car! syntmp-new-566 (syntmp-strip-annotation-161 (car syntmp-x-564) #f)) (set-cdr! syntmp-new-566 (syntmp-strip-annotation-161 (cdr syntmp-x-564) #f)) syntmp-new-566))) ((syntmp-annotation?-89 syntmp-x-564) (or (annotation-stripped syntmp-x-564) (syntmp-strip-annotation-161 (annotation-expression syntmp-x-564) syntmp-x-564))) ((vector? syntmp-x-564) (let ((syntmp-new-567 (make-vector (vector-length syntmp-x-564)))) (begin (when syntmp-parent-565 (set-annotation-stripped! syntmp-parent-565 syntmp-new-567)) (let syntmp-loop-568 ((syntmp-i-569 (- (vector-length syntmp-x-564) 1))) (unless (syntmp-fx<-88 syntmp-i-569 0) (vector-set! syntmp-new-567 syntmp-i-569 (syntmp-strip-annotation-161 (vector-ref syntmp-x-564 syntmp-i-569) #f)) (syntmp-loop-568 (syntmp-fx--86 syntmp-i-569 1)))) syntmp-new-567))) (else syntmp-x-564)))) (syntmp-ellipsis?-160 (lambda (syntmp-x-570) (and (syntmp-nonsymbol-id?-114 syntmp-x-570) (syntmp-free-id=?-138 syntmp-x-570 (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-571) (let ((syntmp-p-572 (syntmp-local-eval-hook-91 syntmp-expanded-571))) (if (procedure? syntmp-p-572) syntmp-p-572 (syntax-error syntmp-p-572 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-157 (lambda (syntmp-rec?-573 syntmp-e-574 syntmp-r-575 syntmp-w-576 syntmp-s-577 syntmp-k-578) ((lambda (syntmp-tmp-579) ((lambda (syntmp-tmp-580) (if syntmp-tmp-580 (apply (lambda (syntmp-_-581 syntmp-id-582 syntmp-val-583 syntmp-e1-584 syntmp-e2-585) (let ((syntmp-ids-586 syntmp-id-582)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-586)) (syntax-error syntmp-e-574 "duplicate bound keyword in") (let ((syntmp-labels-588 (syntmp-gen-labels-121 syntmp-ids-586))) (let ((syntmp-new-w-589 (syntmp-make-binding-wrap-132 syntmp-ids-586 syntmp-labels-588 syntmp-w-576))) (syntmp-k-578 (cons syntmp-e1-584 syntmp-e2-585) (syntmp-extend-env-109 syntmp-labels-588 (let ((syntmp-w-591 (if syntmp-rec?-573 syntmp-new-w-589 syntmp-w-576)) (syntmp-trans-r-592 (syntmp-macros-only-env-111 syntmp-r-575))) (map (lambda (syntmp-x-593) (cons (quote macro) (syntmp-eval-local-transformer-158 (syntmp-chi-151 syntmp-x-593 syntmp-trans-r-592 syntmp-w-591)))) syntmp-val-583)) syntmp-r-575) syntmp-new-w-589 syntmp-s-577)))))) syntmp-tmp-580) ((lambda (syntmp-_-595) (syntax-error (syntmp-source-wrap-144 syntmp-e-574 syntmp-w-576 syntmp-s-577))) syntmp-tmp-579))) (syntax-dispatch syntmp-tmp-579 (quote (any #(each (any any)) any . each-any))))) syntmp-e-574))) (syntmp-chi-lambda-clause-156 (lambda (syntmp-e-596 syntmp-c-597 syntmp-r-598 syntmp-w-599 syntmp-k-600) ((lambda (syntmp-tmp-601) ((lambda (syntmp-tmp-602) (if syntmp-tmp-602 (apply (lambda (syntmp-id-603 syntmp-e1-604 syntmp-e2-605) (let ((syntmp-ids-606 syntmp-id-603)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-606)) (syntax-error syntmp-e-596 "invalid parameter list in") (let ((syntmp-labels-608 (syntmp-gen-labels-121 syntmp-ids-606)) (syntmp-new-vars-609 (map syntmp-gen-var-163 syntmp-ids-606))) (syntmp-k-600 syntmp-new-vars-609 (syntmp-chi-body-155 (cons syntmp-e1-604 syntmp-e2-605) syntmp-e-596 (syntmp-extend-var-env-110 syntmp-labels-608 syntmp-new-vars-609 syntmp-r-598) (syntmp-make-binding-wrap-132 syntmp-ids-606 syntmp-labels-608 syntmp-w-599))))))) syntmp-tmp-602) ((lambda (syntmp-tmp-611) (if syntmp-tmp-611 (apply (lambda (syntmp-ids-612 syntmp-e1-613 syntmp-e2-614) (let ((syntmp-old-ids-615 (syntmp-lambda-var-list-164 syntmp-ids-612))) (if (not (syntmp-valid-bound-ids?-140 syntmp-old-ids-615)) (syntax-error syntmp-e-596 "invalid parameter list in") (let ((syntmp-labels-616 (syntmp-gen-labels-121 syntmp-old-ids-615)) (syntmp-new-vars-617 (map syntmp-gen-var-163 syntmp-old-ids-615))) (syntmp-k-600 (let syntmp-f-618 ((syntmp-ls1-619 (cdr syntmp-new-vars-617)) (syntmp-ls2-620 (car syntmp-new-vars-617))) (if (null? syntmp-ls1-619) syntmp-ls2-620 (syntmp-f-618 (cdr syntmp-ls1-619) (cons (car syntmp-ls1-619) syntmp-ls2-620)))) (syntmp-chi-body-155 (cons syntmp-e1-613 syntmp-e2-614) syntmp-e-596 (syntmp-extend-var-env-110 syntmp-labels-616 syntmp-new-vars-617 syntmp-r-598) (syntmp-make-binding-wrap-132 syntmp-old-ids-615 syntmp-labels-616 syntmp-w-599))))))) syntmp-tmp-611) ((lambda (syntmp-_-622) (syntax-error syntmp-e-596)) syntmp-tmp-601))) (syntax-dispatch syntmp-tmp-601 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-601 (quote (each-any any . each-any))))) syntmp-c-597))) (syntmp-chi-body-155 (lambda (syntmp-body-623 syntmp-outer-form-624 syntmp-r-625 syntmp-w-626) (let ((syntmp-r-627 (cons (quote ("placeholder" placeholder)) syntmp-r-625))) (let ((syntmp-ribcage-628 (syntmp-make-ribcage-122 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-629 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w-626) (cons syntmp-ribcage-628 (syntmp-wrap-subst-119 syntmp-w-626))))) (let syntmp-parse-630 ((syntmp-body-631 (map (lambda (syntmp-x-637) (cons syntmp-r-627 (syntmp-wrap-143 syntmp-x-637 syntmp-w-629))) syntmp-body-623)) (syntmp-ids-632 (quote ())) (syntmp-labels-633 (quote ())) (syntmp-vars-634 (quote ())) (syntmp-vals-635 (quote ())) (syntmp-bindings-636 (quote ()))) (if (null? syntmp-body-631) (syntax-error syntmp-outer-form-624 "no expressions in body") (let ((syntmp-e-638 (cdar syntmp-body-631)) (syntmp-er-639 (caar syntmp-body-631))) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-638 syntmp-er-639 (quote (())) #f syntmp-ribcage-628)) (lambda (syntmp-type-640 syntmp-value-641 syntmp-e-642 syntmp-w-643 syntmp-s-644) (let ((syntmp-t-645 syntmp-type-640)) (if (memv syntmp-t-645 (quote (define-form))) (let ((syntmp-id-646 (syntmp-wrap-143 syntmp-value-641 syntmp-w-643)) (syntmp-label-647 (syntmp-gen-label-120))) (let ((syntmp-var-648 (syntmp-gen-var-163 syntmp-id-646))) (begin (syntmp-extend-ribcage!-131 syntmp-ribcage-628 syntmp-id-646 syntmp-label-647) (syntmp-parse-630 (cdr syntmp-body-631) (cons syntmp-id-646 syntmp-ids-632) (cons syntmp-label-647 syntmp-labels-633) (cons syntmp-var-648 syntmp-vars-634) (cons (cons syntmp-er-639 (syntmp-wrap-143 syntmp-e-642 syntmp-w-643)) syntmp-vals-635) (cons (cons (quote lexical) syntmp-var-648) syntmp-bindings-636))))) (if (memv syntmp-t-645 (quote (define-syntax-form))) (let ((syntmp-id-649 (syntmp-wrap-143 syntmp-value-641 syntmp-w-643)) (syntmp-label-650 (syntmp-gen-label-120))) (begin (syntmp-extend-ribcage!-131 syntmp-ribcage-628 syntmp-id-649 syntmp-label-650) (syntmp-parse-630 (cdr syntmp-body-631) (cons syntmp-id-649 syntmp-ids-632) (cons syntmp-label-650 syntmp-labels-633) syntmp-vars-634 syntmp-vals-635 (cons (cons (quote macro) (cons syntmp-er-639 (syntmp-wrap-143 syntmp-e-642 syntmp-w-643))) syntmp-bindings-636)))) (if (memv syntmp-t-645 (quote (begin-form))) ((lambda (syntmp-tmp-651) ((lambda (syntmp-tmp-652) (if syntmp-tmp-652 (apply (lambda (syntmp-_-653 syntmp-e1-654) (syntmp-parse-630 (let syntmp-f-655 ((syntmp-forms-656 syntmp-e1-654)) (if (null? syntmp-forms-656) (cdr syntmp-body-631) (cons (cons syntmp-er-639 (syntmp-wrap-143 (car syntmp-forms-656) syntmp-w-643)) (syntmp-f-655 (cdr syntmp-forms-656))))) syntmp-ids-632 syntmp-labels-633 syntmp-vars-634 syntmp-vals-635 syntmp-bindings-636)) syntmp-tmp-652) (syntax-error syntmp-tmp-651))) (syntax-dispatch syntmp-tmp-651 (quote (any . each-any))))) syntmp-e-642) (if (memv syntmp-t-645 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-641 syntmp-e-642 syntmp-er-639 syntmp-w-643 syntmp-s-644 (lambda (syntmp-forms-658 syntmp-er-659 syntmp-w-660 syntmp-s-661) (syntmp-parse-630 (let syntmp-f-662 ((syntmp-forms-663 syntmp-forms-658)) (if (null? syntmp-forms-663) (cdr syntmp-body-631) (cons (cons syntmp-er-659 (syntmp-wrap-143 (car syntmp-forms-663) syntmp-w-660)) (syntmp-f-662 (cdr syntmp-forms-663))))) syntmp-ids-632 syntmp-labels-633 syntmp-vars-634 syntmp-vals-635 syntmp-bindings-636))) (if (null? syntmp-ids-632) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-664) (syntmp-chi-151 (cdr syntmp-x-664) (car syntmp-x-664) (quote (())))) (cons (cons syntmp-er-639 (syntmp-source-wrap-144 syntmp-e-642 syntmp-w-643 syntmp-s-644)) (cdr syntmp-body-631)))) (begin (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-632)) (syntax-error syntmp-outer-form-624 "invalid or duplicate identifier in definition")) (let syntmp-loop-665 ((syntmp-bs-666 syntmp-bindings-636) (syntmp-er-cache-667 #f) (syntmp-r-cache-668 #f)) (if (not (null? syntmp-bs-666)) (let ((syntmp-b-669 (car syntmp-bs-666))) (if (eq? (car syntmp-b-669) (quote macro)) (let ((syntmp-er-670 (cadr syntmp-b-669))) (let ((syntmp-r-cache-671 (if (eq? syntmp-er-670 syntmp-er-cache-667) syntmp-r-cache-668 (syntmp-macros-only-env-111 syntmp-er-670)))) (begin (set-cdr! syntmp-b-669 (syntmp-eval-local-transformer-158 (syntmp-chi-151 (cddr syntmp-b-669) syntmp-r-cache-671 (quote (()))))) (syntmp-loop-665 (cdr syntmp-bs-666) syntmp-er-670 syntmp-r-cache-671)))) (syntmp-loop-665 (cdr syntmp-bs-666) syntmp-er-cache-667 syntmp-r-cache-668))))) (set-cdr! syntmp-r-627 (syntmp-extend-env-109 syntmp-labels-633 syntmp-bindings-636 (cdr syntmp-r-627))) (syntmp-build-letrec-99 #f syntmp-vars-634 (map (lambda (syntmp-x-672) (syntmp-chi-151 (cdr syntmp-x-672) (car syntmp-x-672) (quote (())))) syntmp-vals-635) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-673) (syntmp-chi-151 (cdr syntmp-x-673) (car syntmp-x-673) (quote (())))) (cons (cons syntmp-er-639 (syntmp-source-wrap-144 syntmp-e-642 syntmp-w-643 syntmp-s-644)) (cdr syntmp-body-631)))))))))))))))))))))) (syntmp-chi-macro-154 (lambda (syntmp-p-674 syntmp-e-675 syntmp-r-676 syntmp-w-677 syntmp-rib-678) (letrec ((syntmp-rebuild-macro-output-679 (lambda (syntmp-x-680 syntmp-m-681) (cond ((pair? syntmp-x-680) (cons (syntmp-rebuild-macro-output-679 (car syntmp-x-680) syntmp-m-681) (syntmp-rebuild-macro-output-679 (cdr syntmp-x-680) syntmp-m-681))) ((syntmp-syntax-object?-101 syntmp-x-680) (let ((syntmp-w-682 (syntmp-syntax-object-wrap-103 syntmp-x-680))) (let ((syntmp-ms-683 (syntmp-wrap-marks-118 syntmp-w-682)) (syntmp-s-684 (syntmp-wrap-subst-119 syntmp-w-682))) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-680) (if (and (pair? syntmp-ms-683) (eq? (car syntmp-ms-683) #f)) (syntmp-make-wrap-117 (cdr syntmp-ms-683) (if syntmp-rib-678 (cons syntmp-rib-678 (cdr syntmp-s-684)) (cdr syntmp-s-684))) (syntmp-make-wrap-117 (cons syntmp-m-681 syntmp-ms-683) (if syntmp-rib-678 (cons syntmp-rib-678 (cons (quote shift) syntmp-s-684)) (cons (quote shift) syntmp-s-684)))))))) ((vector? syntmp-x-680) (let ((syntmp-n-685 (vector-length syntmp-x-680))) (let ((syntmp-v-686 (make-vector syntmp-n-685))) (let syntmp-doloop-687 ((syntmp-i-688 0)) (if (syntmp-fx=-87 syntmp-i-688 syntmp-n-685) syntmp-v-686 (begin (vector-set! syntmp-v-686 syntmp-i-688 (syntmp-rebuild-macro-output-679 (vector-ref syntmp-x-680 syntmp-i-688) syntmp-m-681)) (syntmp-doloop-687 (syntmp-fx+-85 syntmp-i-688 1)))))))) ((symbol? syntmp-x-680) (syntax-error syntmp-x-680 "encountered raw symbol in macro output")) (else syntmp-x-680))))) (syntmp-rebuild-macro-output-679 (syntmp-p-674 (syntmp-wrap-143 syntmp-e-675 (syntmp-anti-mark-130 syntmp-w-677))) (string #\m))))) (syntmp-chi-application-153 (lambda (syntmp-x-689 syntmp-e-690 syntmp-r-691 syntmp-w-692 syntmp-s-693) ((lambda (syntmp-tmp-694) ((lambda (syntmp-tmp-695) (if syntmp-tmp-695 (apply (lambda (syntmp-e0-696 syntmp-e1-697) (cons syntmp-x-689 (map (lambda (syntmp-e-698) (syntmp-chi-151 syntmp-e-698 syntmp-r-691 syntmp-w-692)) syntmp-e1-697))) syntmp-tmp-695) (syntax-error syntmp-tmp-694))) (syntax-dispatch syntmp-tmp-694 (quote (any . each-any))))) syntmp-e-690))) (syntmp-chi-expr-152 (lambda (syntmp-type-700 syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (let ((syntmp-t-706 syntmp-type-700)) (if (memv syntmp-t-706 (quote (lexical))) syntmp-value-701 (if (memv syntmp-t-706 (quote (core external-macro))) (syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (if (memv syntmp-t-706 (quote (lexical-call))) (syntmp-chi-application-153 syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (if (memv syntmp-t-706 (quote (global-call))) (syntmp-chi-application-153 syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (if (memv syntmp-t-706 (quote (constant))) (syntmp-build-data-95 syntmp-s-705 (syntmp-strip-162 (syntmp-source-wrap-144 syntmp-e-702 syntmp-w-704 syntmp-s-705) (quote (())))) (if (memv syntmp-t-706 (quote (global))) syntmp-value-701 (if (memv syntmp-t-706 (quote (call))) (syntmp-chi-application-153 (syntmp-chi-151 (car syntmp-e-702) syntmp-r-703 syntmp-w-704) syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (if (memv syntmp-t-706 (quote (begin-form))) ((lambda (syntmp-tmp-707) ((lambda (syntmp-tmp-708) (if syntmp-tmp-708 (apply (lambda (syntmp-_-709 syntmp-e1-710 syntmp-e2-711) (syntmp-chi-sequence-145 (cons syntmp-e1-710 syntmp-e2-711) syntmp-r-703 syntmp-w-704 syntmp-s-705)) syntmp-tmp-708) (syntax-error syntmp-tmp-707))) (syntax-dispatch syntmp-tmp-707 (quote (any any . each-any))))) syntmp-e-702) (if (memv syntmp-t-706 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705 syntmp-chi-sequence-145) (if (memv syntmp-t-706 (quote (eval-when-form))) ((lambda (syntmp-tmp-713) ((lambda (syntmp-tmp-714) (if syntmp-tmp-714 (apply (lambda (syntmp-_-715 syntmp-x-716 syntmp-e1-717 syntmp-e2-718) (let ((syntmp-when-list-719 (syntmp-chi-when-list-148 syntmp-e-702 syntmp-x-716 syntmp-w-704))) (if (memq (quote eval) syntmp-when-list-719) (syntmp-chi-sequence-145 (cons syntmp-e1-717 syntmp-e2-718) syntmp-r-703 syntmp-w-704 syntmp-s-705) (syntmp-chi-void-159)))) syntmp-tmp-714) (syntax-error syntmp-tmp-713))) (syntax-dispatch syntmp-tmp-713 (quote (any each-any any . each-any))))) syntmp-e-702) (if (memv syntmp-t-706 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-143 syntmp-value-701 syntmp-w-704) "invalid context for definition of") (if (memv syntmp-t-706 (quote (syntax))) (syntax-error (syntmp-source-wrap-144 syntmp-e-702 syntmp-w-704 syntmp-s-705) "reference to pattern variable outside syntax form") (if (memv syntmp-t-706 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-144 syntmp-e-702 syntmp-w-704 syntmp-s-705) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-144 syntmp-e-702 syntmp-w-704 syntmp-s-705)))))))))))))))))) (syntmp-chi-151 (lambda (syntmp-e-722 syntmp-r-723 syntmp-w-724) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-722 syntmp-r-723 syntmp-w-724 #f #f)) (lambda (syntmp-type-725 syntmp-value-726 syntmp-e-727 syntmp-w-728 syntmp-s-729) (syntmp-chi-expr-152 syntmp-type-725 syntmp-value-726 syntmp-e-727 syntmp-r-723 syntmp-w-728 syntmp-s-729))))) (syntmp-chi-top-150 (lambda (syntmp-e-730 syntmp-r-731 syntmp-w-732 syntmp-m-733 syntmp-esew-734) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-730 syntmp-r-731 syntmp-w-732 #f #f)) (lambda (syntmp-type-747 syntmp-value-748 syntmp-e-749 syntmp-w-750 syntmp-s-751) (let ((syntmp-t-752 syntmp-type-747)) (if (memv syntmp-t-752 (quote (begin-form))) ((lambda (syntmp-tmp-753) ((lambda (syntmp-tmp-754) (if syntmp-tmp-754 (apply (lambda (syntmp-_-755) (syntmp-chi-void-159)) syntmp-tmp-754) ((lambda (syntmp-tmp-756) (if syntmp-tmp-756 (apply (lambda (syntmp-_-757 syntmp-e1-758 syntmp-e2-759) (syntmp-chi-top-sequence-146 (cons syntmp-e1-758 syntmp-e2-759) syntmp-r-731 syntmp-w-750 syntmp-s-751 syntmp-m-733 syntmp-esew-734)) syntmp-tmp-756) (syntax-error syntmp-tmp-753))) (syntax-dispatch syntmp-tmp-753 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-753 (quote (any))))) syntmp-e-749) (if (memv syntmp-t-752 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-748 syntmp-e-749 syntmp-r-731 syntmp-w-750 syntmp-s-751 (lambda (syntmp-body-761 syntmp-r-762 syntmp-w-763 syntmp-s-764) (syntmp-chi-top-sequence-146 syntmp-body-761 syntmp-r-762 syntmp-w-763 syntmp-s-764 syntmp-m-733 syntmp-esew-734))) (if (memv syntmp-t-752 (quote (eval-when-form))) ((lambda (syntmp-tmp-765) ((lambda (syntmp-tmp-766) (if syntmp-tmp-766 (apply (lambda (syntmp-_-767 syntmp-x-768 syntmp-e1-769 syntmp-e2-770) (let ((syntmp-when-list-771 (syntmp-chi-when-list-148 syntmp-e-749 syntmp-x-768 syntmp-w-750)) (syntmp-body-772 (cons syntmp-e1-769 syntmp-e2-770))) (cond ((eq? syntmp-m-733 (quote e)) (if (memq (quote eval) syntmp-when-list-771) (syntmp-chi-top-sequence-146 syntmp-body-772 syntmp-r-731 syntmp-w-750 syntmp-s-751 (quote e) (quote (eval))) (syntmp-chi-void-159))) ((memq (quote load) syntmp-when-list-771) (if (or (memq (quote compile) syntmp-when-list-771) (and (eq? syntmp-m-733 (quote c&e)) (memq (quote eval) syntmp-when-list-771))) (syntmp-chi-top-sequence-146 syntmp-body-772 syntmp-r-731 syntmp-w-750 syntmp-s-751 (quote c&e) (quote (compile load))) (if (memq syntmp-m-733 (quote (c c&e))) (syntmp-chi-top-sequence-146 syntmp-body-772 syntmp-r-731 syntmp-w-750 syntmp-s-751 (quote c) (quote (load))) (syntmp-chi-void-159)))) ((or (memq (quote compile) syntmp-when-list-771) (and (eq? syntmp-m-733 (quote c&e)) (memq (quote eval) syntmp-when-list-771))) (syntmp-top-level-eval-hook-90 (syntmp-chi-top-sequence-146 syntmp-body-772 syntmp-r-731 syntmp-w-750 syntmp-s-751 (quote e) (quote (eval)))) (syntmp-chi-void-159)) (else (syntmp-chi-void-159))))) syntmp-tmp-766) (syntax-error syntmp-tmp-765))) (syntax-dispatch syntmp-tmp-765 (quote (any each-any any . each-any))))) syntmp-e-749) (if (memv syntmp-t-752 (quote (define-syntax-form))) (let ((syntmp-n-775 (syntmp-id-var-name-137 syntmp-value-748 syntmp-w-750)) (syntmp-r-776 (syntmp-macros-only-env-111 syntmp-r-731))) (let ((syntmp-t-777 syntmp-m-733)) (if (memv syntmp-t-777 (quote (c))) (if (memq (quote compile) syntmp-esew-734) (let ((syntmp-e-778 (syntmp-chi-install-global-147 syntmp-n-775 (syntmp-chi-151 syntmp-e-749 syntmp-r-776 syntmp-w-750)))) (begin (syntmp-top-level-eval-hook-90 syntmp-e-778) (if (memq (quote load) syntmp-esew-734) syntmp-e-778 (syntmp-chi-void-159)))) (if (memq (quote load) syntmp-esew-734) (syntmp-chi-install-global-147 syntmp-n-775 (syntmp-chi-151 syntmp-e-749 syntmp-r-776 syntmp-w-750)) (syntmp-chi-void-159))) (if (memv syntmp-t-777 (quote (c&e))) (let ((syntmp-e-779 (syntmp-chi-install-global-147 syntmp-n-775 (syntmp-chi-151 syntmp-e-749 syntmp-r-776 syntmp-w-750)))) (begin (syntmp-top-level-eval-hook-90 syntmp-e-779) syntmp-e-779)) (begin (if (memq (quote eval) syntmp-esew-734) (syntmp-top-level-eval-hook-90 (syntmp-chi-install-global-147 syntmp-n-775 (syntmp-chi-151 syntmp-e-749 syntmp-r-776 syntmp-w-750)))) (syntmp-chi-void-159)))))) (if (memv syntmp-t-752 (quote (define-form))) (let ((syntmp-n-780 (syntmp-id-var-name-137 syntmp-value-748 syntmp-w-750))) (let ((syntmp-type-781 (syntmp-binding-type-107 (syntmp-lookup-112 syntmp-n-780 syntmp-r-731)))) (let ((syntmp-t-782 syntmp-type-781)) (if (memv syntmp-t-782 (quote (global))) (let ((syntmp-x-783 (list (quote define) syntmp-n-780 (syntmp-chi-151 syntmp-e-749 syntmp-r-731 syntmp-w-750)))) (begin (if (eq? syntmp-m-733 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-783)) syntmp-x-783)) (if (memv syntmp-t-782 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-143 syntmp-value-748 syntmp-w-750) "identifier out of context") (if (eq? syntmp-type-781 (quote external-macro)) (let ((syntmp-x-784 (list (quote define) syntmp-n-780 (syntmp-chi-151 syntmp-e-749 syntmp-r-731 syntmp-w-750)))) (begin (if (eq? syntmp-m-733 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-784)) syntmp-x-784)) (syntax-error (syntmp-wrap-143 syntmp-value-748 syntmp-w-750) "cannot define keyword at top level"))))))) (let ((syntmp-x-785 (syntmp-chi-expr-152 syntmp-type-747 syntmp-value-748 syntmp-e-749 syntmp-r-731 syntmp-w-750 syntmp-s-751))) (begin (if (eq? syntmp-m-733 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-785)) syntmp-x-785)))))))))))) (syntmp-syntax-type-149 (lambda (syntmp-e-786 syntmp-r-787 syntmp-w-788 syntmp-s-789 syntmp-rib-790) (cond ((symbol? syntmp-e-786) (let ((syntmp-n-791 (syntmp-id-var-name-137 syntmp-e-786 syntmp-w-788))) (let ((syntmp-b-792 (syntmp-lookup-112 syntmp-n-791 syntmp-r-787))) (let ((syntmp-type-793 (syntmp-binding-type-107 syntmp-b-792))) (let ((syntmp-t-794 syntmp-type-793)) (if (memv syntmp-t-794 (quote (lexical))) (values syntmp-type-793 (syntmp-binding-value-108 syntmp-b-792) syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-794 (quote (global))) (values syntmp-type-793 syntmp-n-791 syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-794 (quote (macro))) (syntmp-syntax-type-149 (syntmp-chi-macro-154 (syntmp-binding-value-108 syntmp-b-792) syntmp-e-786 syntmp-r-787 syntmp-w-788 syntmp-rib-790) syntmp-r-787 (quote (())) syntmp-s-789 syntmp-rib-790) (values syntmp-type-793 (syntmp-binding-value-108 syntmp-b-792) syntmp-e-786 syntmp-w-788 syntmp-s-789))))))))) ((pair? syntmp-e-786) (let ((syntmp-first-795 (car syntmp-e-786))) (if (syntmp-id?-115 syntmp-first-795) (let ((syntmp-n-796 (syntmp-id-var-name-137 syntmp-first-795 syntmp-w-788))) (let ((syntmp-b-797 (syntmp-lookup-112 syntmp-n-796 syntmp-r-787))) (let ((syntmp-type-798 (syntmp-binding-type-107 syntmp-b-797))) (let ((syntmp-t-799 syntmp-type-798)) (if (memv syntmp-t-799 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-108 syntmp-b-797) syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (global))) (values (quote global-call) syntmp-n-796 syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (macro))) (syntmp-syntax-type-149 (syntmp-chi-macro-154 (syntmp-binding-value-108 syntmp-b-797) syntmp-e-786 syntmp-r-787 syntmp-w-788 syntmp-rib-790) syntmp-r-787 (quote (())) syntmp-s-789 syntmp-rib-790) (if (memv syntmp-t-799 (quote (core external-macro))) (values syntmp-type-798 (syntmp-binding-value-108 syntmp-b-797) syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-108 syntmp-b-797) syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (begin))) (values (quote begin-form) #f syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (define))) ((lambda (syntmp-tmp-800) ((lambda (syntmp-tmp-801) (if (if syntmp-tmp-801 (apply (lambda (syntmp-_-802 syntmp-name-803 syntmp-val-804) (syntmp-id?-115 syntmp-name-803)) syntmp-tmp-801) #f) (apply (lambda (syntmp-_-805 syntmp-name-806 syntmp-val-807) (values (quote define-form) syntmp-name-806 syntmp-val-807 syntmp-w-788 syntmp-s-789)) syntmp-tmp-801) ((lambda (syntmp-tmp-808) (if (if syntmp-tmp-808 (apply (lambda (syntmp-_-809 syntmp-name-810 syntmp-args-811 syntmp-e1-812 syntmp-e2-813) (and (syntmp-id?-115 syntmp-name-810) (syntmp-valid-bound-ids?-140 (syntmp-lambda-var-list-164 syntmp-args-811)))) syntmp-tmp-808) #f) (apply (lambda (syntmp-_-814 syntmp-name-815 syntmp-args-816 syntmp-e1-817 syntmp-e2-818) (values (quote define-form) (syntmp-wrap-143 syntmp-name-815 syntmp-w-788) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-816 (cons syntmp-e1-817 syntmp-e2-818)) syntmp-w-788)) (quote (())) syntmp-s-789)) syntmp-tmp-808) ((lambda (syntmp-tmp-820) (if (if syntmp-tmp-820 (apply (lambda (syntmp-_-821 syntmp-name-822) (syntmp-id?-115 syntmp-name-822)) syntmp-tmp-820) #f) (apply (lambda (syntmp-_-823 syntmp-name-824) (values (quote define-form) (syntmp-wrap-143 syntmp-name-824 syntmp-w-788) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-789)) syntmp-tmp-820) (syntax-error syntmp-tmp-800))) (syntax-dispatch syntmp-tmp-800 (quote (any any)))))) (syntax-dispatch syntmp-tmp-800 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-800 (quote (any any any))))) syntmp-e-786) (if (memv syntmp-t-799 (quote (define-syntax))) ((lambda (syntmp-tmp-825) ((lambda (syntmp-tmp-826) (if (if syntmp-tmp-826 (apply (lambda (syntmp-_-827 syntmp-name-828 syntmp-val-829) (syntmp-id?-115 syntmp-name-828)) syntmp-tmp-826) #f) (apply (lambda (syntmp-_-830 syntmp-name-831 syntmp-val-832) (values (quote define-syntax-form) syntmp-name-831 syntmp-val-832 syntmp-w-788 syntmp-s-789)) syntmp-tmp-826) (syntax-error syntmp-tmp-825))) (syntax-dispatch syntmp-tmp-825 (quote (any any any))))) syntmp-e-786) (values (quote call) #f syntmp-e-786 syntmp-w-788 syntmp-s-789)))))))))))))) (values (quote call) #f syntmp-e-786 syntmp-w-788 syntmp-s-789)))) ((syntmp-syntax-object?-101 syntmp-e-786) (syntmp-syntax-type-149 (syntmp-syntax-object-expression-102 syntmp-e-786) syntmp-r-787 (syntmp-join-wraps-134 syntmp-w-788 (syntmp-syntax-object-wrap-103 syntmp-e-786)) #f syntmp-rib-790)) ((syntmp-annotation?-89 syntmp-e-786) (syntmp-syntax-type-149 (annotation-expression syntmp-e-786) syntmp-r-787 syntmp-w-788 (annotation-source syntmp-e-786) syntmp-rib-790)) ((self-evaluating? syntmp-e-786) (values (quote constant) #f syntmp-e-786 syntmp-w-788 syntmp-s-789)) (else (values (quote other) #f syntmp-e-786 syntmp-w-788 syntmp-s-789))))) (syntmp-chi-when-list-148 (lambda (syntmp-e-833 syntmp-when-list-834 syntmp-w-835) (let syntmp-f-836 ((syntmp-when-list-837 syntmp-when-list-834) (syntmp-situations-838 (quote ()))) (if (null? syntmp-when-list-837) syntmp-situations-838 (syntmp-f-836 (cdr syntmp-when-list-837) (cons (let ((syntmp-x-839 (car syntmp-when-list-837))) (cond ((syntmp-free-id=?-138 syntmp-x-839 (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-839 (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-839 (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-839 syntmp-w-835) "invalid eval-when situation")))) syntmp-situations-838)))))) (syntmp-chi-install-global-147 (lambda (syntmp-name-840 syntmp-e-841) (list (quote install-global-transformer) (syntmp-build-data-95 #f syntmp-name-840) syntmp-e-841))) (syntmp-chi-top-sequence-146 (lambda (syntmp-body-842 syntmp-r-843 syntmp-w-844 syntmp-s-845 syntmp-m-846 syntmp-esew-847) (syntmp-build-sequence-96 syntmp-s-845 (let syntmp-dobody-848 ((syntmp-body-849 syntmp-body-842) (syntmp-r-850 syntmp-r-843) (syntmp-w-851 syntmp-w-844) (syntmp-m-852 syntmp-m-846) (syntmp-esew-853 syntmp-esew-847)) (if (null? syntmp-body-849) (quote ()) (let ((syntmp-first-854 (syntmp-chi-top-150 (car syntmp-body-849) syntmp-r-850 syntmp-w-851 syntmp-m-852 syntmp-esew-853))) (cons syntmp-first-854 (syntmp-dobody-848 (cdr syntmp-body-849) syntmp-r-850 syntmp-w-851 syntmp-m-852 syntmp-esew-853)))))))) (syntmp-chi-sequence-145 (lambda (syntmp-body-855 syntmp-r-856 syntmp-w-857 syntmp-s-858) (syntmp-build-sequence-96 syntmp-s-858 (let syntmp-dobody-859 ((syntmp-body-860 syntmp-body-855) (syntmp-r-861 syntmp-r-856) (syntmp-w-862 syntmp-w-857)) (if (null? syntmp-body-860) (quote ()) (let ((syntmp-first-863 (syntmp-chi-151 (car syntmp-body-860) syntmp-r-861 syntmp-w-862))) (cons syntmp-first-863 (syntmp-dobody-859 (cdr syntmp-body-860) syntmp-r-861 syntmp-w-862)))))))) (syntmp-source-wrap-144 (lambda (syntmp-x-864 syntmp-w-865 syntmp-s-866) (syntmp-wrap-143 (if syntmp-s-866 (make-annotation syntmp-x-864 syntmp-s-866 #f) syntmp-x-864) syntmp-w-865))) (syntmp-wrap-143 (lambda (syntmp-x-867 syntmp-w-868) (cond ((and (null? (syntmp-wrap-marks-118 syntmp-w-868)) (null? (syntmp-wrap-subst-119 syntmp-w-868))) syntmp-x-867) ((syntmp-syntax-object?-101 syntmp-x-867) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-867) (syntmp-join-wraps-134 syntmp-w-868 (syntmp-syntax-object-wrap-103 syntmp-x-867)))) ((null? syntmp-x-867) syntmp-x-867) (else (syntmp-make-syntax-object-100 syntmp-x-867 syntmp-w-868))))) (syntmp-bound-id-member?-142 (lambda (syntmp-x-869 syntmp-list-870) (and (not (null? syntmp-list-870)) (or (syntmp-bound-id=?-139 syntmp-x-869 (car syntmp-list-870)) (syntmp-bound-id-member?-142 syntmp-x-869 (cdr syntmp-list-870)))))) (syntmp-distinct-bound-ids?-141 (lambda (syntmp-ids-871) (let syntmp-distinct?-872 ((syntmp-ids-873 syntmp-ids-871)) (or (null? syntmp-ids-873) (and (not (syntmp-bound-id-member?-142 (car syntmp-ids-873) (cdr syntmp-ids-873))) (syntmp-distinct?-872 (cdr syntmp-ids-873))))))) (syntmp-valid-bound-ids?-140 (lambda (syntmp-ids-874) (and (let syntmp-all-ids?-875 ((syntmp-ids-876 syntmp-ids-874)) (or (null? syntmp-ids-876) (and (syntmp-id?-115 (car syntmp-ids-876)) (syntmp-all-ids?-875 (cdr syntmp-ids-876))))) (syntmp-distinct-bound-ids?-141 syntmp-ids-874)))) (syntmp-bound-id=?-139 (lambda (syntmp-i-877 syntmp-j-878) (if (and (syntmp-syntax-object?-101 syntmp-i-877) (syntmp-syntax-object?-101 syntmp-j-878)) (and (eq? (let ((syntmp-e-879 (syntmp-syntax-object-expression-102 syntmp-i-877))) (if (syntmp-annotation?-89 syntmp-e-879) (annotation-expression syntmp-e-879) syntmp-e-879)) (let ((syntmp-e-880 (syntmp-syntax-object-expression-102 syntmp-j-878))) (if (syntmp-annotation?-89 syntmp-e-880) (annotation-expression syntmp-e-880) syntmp-e-880))) (syntmp-same-marks?-136 (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-i-877)) (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-j-878)))) (eq? (let ((syntmp-e-881 syntmp-i-877)) (if (syntmp-annotation?-89 syntmp-e-881) (annotation-expression syntmp-e-881) syntmp-e-881)) (let ((syntmp-e-882 syntmp-j-878)) (if (syntmp-annotation?-89 syntmp-e-882) (annotation-expression syntmp-e-882) syntmp-e-882)))))) (syntmp-free-id=?-138 (lambda (syntmp-i-883 syntmp-j-884) (and (eq? (let ((syntmp-x-885 syntmp-i-883)) (let ((syntmp-e-886 (if (syntmp-syntax-object?-101 syntmp-x-885) (syntmp-syntax-object-expression-102 syntmp-x-885) syntmp-x-885))) (if (syntmp-annotation?-89 syntmp-e-886) (annotation-expression syntmp-e-886) syntmp-e-886))) (let ((syntmp-x-887 syntmp-j-884)) (let ((syntmp-e-888 (if (syntmp-syntax-object?-101 syntmp-x-887) (syntmp-syntax-object-expression-102 syntmp-x-887) syntmp-x-887))) (if (syntmp-annotation?-89 syntmp-e-888) (annotation-expression syntmp-e-888) syntmp-e-888)))) (eq? (syntmp-id-var-name-137 syntmp-i-883 (quote (()))) (syntmp-id-var-name-137 syntmp-j-884 (quote (()))))))) (syntmp-id-var-name-137 (lambda (syntmp-id-889 syntmp-w-890) (letrec ((syntmp-search-vector-rib-893 (lambda (syntmp-sym-904 syntmp-subst-905 syntmp-marks-906 syntmp-symnames-907 syntmp-ribcage-908) (let ((syntmp-n-909 (vector-length syntmp-symnames-907))) (let syntmp-f-910 ((syntmp-i-911 0)) (cond ((syntmp-fx=-87 syntmp-i-911 syntmp-n-909) (syntmp-search-891 syntmp-sym-904 (cdr syntmp-subst-905) syntmp-marks-906)) ((and (eq? (vector-ref syntmp-symnames-907 syntmp-i-911) syntmp-sym-904) (syntmp-same-marks?-136 syntmp-marks-906 (vector-ref (syntmp-ribcage-marks-125 syntmp-ribcage-908) syntmp-i-911))) (values (vector-ref (syntmp-ribcage-labels-126 syntmp-ribcage-908) syntmp-i-911) syntmp-marks-906)) (else (syntmp-f-910 (syntmp-fx+-85 syntmp-i-911 1)))))))) (syntmp-search-list-rib-892 (lambda (syntmp-sym-912 syntmp-subst-913 syntmp-marks-914 syntmp-symnames-915 syntmp-ribcage-916) (let syntmp-f-917 ((syntmp-symnames-918 syntmp-symnames-915) (syntmp-i-919 0)) (cond ((null? syntmp-symnames-918) (syntmp-search-891 syntmp-sym-912 (cdr syntmp-subst-913) syntmp-marks-914)) ((and (eq? (car syntmp-symnames-918) syntmp-sym-912) (syntmp-same-marks?-136 syntmp-marks-914 (list-ref (syntmp-ribcage-marks-125 syntmp-ribcage-916) syntmp-i-919))) (values (list-ref (syntmp-ribcage-labels-126 syntmp-ribcage-916) syntmp-i-919) syntmp-marks-914)) (else (syntmp-f-917 (cdr syntmp-symnames-918) (syntmp-fx+-85 syntmp-i-919 1))))))) (syntmp-search-891 (lambda (syntmp-sym-920 syntmp-subst-921 syntmp-marks-922) (if (null? syntmp-subst-921) (values #f syntmp-marks-922) (let ((syntmp-fst-923 (car syntmp-subst-921))) (if (eq? syntmp-fst-923 (quote shift)) (syntmp-search-891 syntmp-sym-920 (cdr syntmp-subst-921) (cdr syntmp-marks-922)) (let ((syntmp-symnames-924 (syntmp-ribcage-symnames-124 syntmp-fst-923))) (if (vector? syntmp-symnames-924) (syntmp-search-vector-rib-893 syntmp-sym-920 syntmp-subst-921 syntmp-marks-922 syntmp-symnames-924 syntmp-fst-923) (syntmp-search-list-rib-892 syntmp-sym-920 syntmp-subst-921 syntmp-marks-922 syntmp-symnames-924 syntmp-fst-923))))))))) (cond ((symbol? syntmp-id-889) (or (call-with-values (lambda () (syntmp-search-891 syntmp-id-889 (syntmp-wrap-subst-119 syntmp-w-890) (syntmp-wrap-marks-118 syntmp-w-890))) (lambda (syntmp-x-926 . syntmp-ignore-925) syntmp-x-926)) syntmp-id-889)) ((syntmp-syntax-object?-101 syntmp-id-889) (let ((syntmp-id-927 (let ((syntmp-e-929 (syntmp-syntax-object-expression-102 syntmp-id-889))) (if (syntmp-annotation?-89 syntmp-e-929) (annotation-expression syntmp-e-929) syntmp-e-929))) (syntmp-w1-928 (syntmp-syntax-object-wrap-103 syntmp-id-889))) (let ((syntmp-marks-930 (syntmp-join-marks-135 (syntmp-wrap-marks-118 syntmp-w-890) (syntmp-wrap-marks-118 syntmp-w1-928)))) (call-with-values (lambda () (syntmp-search-891 syntmp-id-927 (syntmp-wrap-subst-119 syntmp-w-890) syntmp-marks-930)) (lambda (syntmp-new-id-931 syntmp-marks-932) (or syntmp-new-id-931 (call-with-values (lambda () (syntmp-search-891 syntmp-id-927 (syntmp-wrap-subst-119 syntmp-w1-928) syntmp-marks-932)) (lambda (syntmp-x-934 . syntmp-ignore-933) syntmp-x-934)) syntmp-id-927)))))) ((syntmp-annotation?-89 syntmp-id-889) (let ((syntmp-id-935 (let ((syntmp-e-936 syntmp-id-889)) (if (syntmp-annotation?-89 syntmp-e-936) (annotation-expression syntmp-e-936) syntmp-e-936)))) (or (call-with-values (lambda () (syntmp-search-891 syntmp-id-935 (syntmp-wrap-subst-119 syntmp-w-890) (syntmp-wrap-marks-118 syntmp-w-890))) (lambda (syntmp-x-938 . syntmp-ignore-937) syntmp-x-938)) syntmp-id-935))) (else (syntmp-error-hook-92 (quote id-var-name) "invalid id" syntmp-id-889)))))) (syntmp-same-marks?-136 (lambda (syntmp-x-939 syntmp-y-940) (or (eq? syntmp-x-939 syntmp-y-940) (and (not (null? syntmp-x-939)) (not (null? syntmp-y-940)) (eq? (car syntmp-x-939) (car syntmp-y-940)) (syntmp-same-marks?-136 (cdr syntmp-x-939) (cdr syntmp-y-940)))))) (syntmp-join-marks-135 (lambda (syntmp-m1-941 syntmp-m2-942) (syntmp-smart-append-133 syntmp-m1-941 syntmp-m2-942))) (syntmp-join-wraps-134 (lambda (syntmp-w1-943 syntmp-w2-944) (let ((syntmp-m1-945 (syntmp-wrap-marks-118 syntmp-w1-943)) (syntmp-s1-946 (syntmp-wrap-subst-119 syntmp-w1-943))) (if (null? syntmp-m1-945) (if (null? syntmp-s1-946) syntmp-w2-944 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w2-944) (syntmp-smart-append-133 syntmp-s1-946 (syntmp-wrap-subst-119 syntmp-w2-944)))) (syntmp-make-wrap-117 (syntmp-smart-append-133 syntmp-m1-945 (syntmp-wrap-marks-118 syntmp-w2-944)) (syntmp-smart-append-133 syntmp-s1-946 (syntmp-wrap-subst-119 syntmp-w2-944))))))) (syntmp-smart-append-133 (lambda (syntmp-m1-947 syntmp-m2-948) (if (null? syntmp-m2-948) syntmp-m1-947 (append syntmp-m1-947 syntmp-m2-948)))) (syntmp-make-binding-wrap-132 (lambda (syntmp-ids-949 syntmp-labels-950 syntmp-w-951) (if (null? syntmp-ids-949) syntmp-w-951 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w-951) (cons (let ((syntmp-labelvec-952 (list->vector syntmp-labels-950))) (let ((syntmp-n-953 (vector-length syntmp-labelvec-952))) (let ((syntmp-symnamevec-954 (make-vector syntmp-n-953)) (syntmp-marksvec-955 (make-vector syntmp-n-953))) (begin (let syntmp-f-956 ((syntmp-ids-957 syntmp-ids-949) (syntmp-i-958 0)) (if (not (null? syntmp-ids-957)) (call-with-values (lambda () (syntmp-id-sym-name&marks-116 (car syntmp-ids-957) syntmp-w-951)) (lambda (syntmp-symname-959 syntmp-marks-960) (begin (vector-set! syntmp-symnamevec-954 syntmp-i-958 syntmp-symname-959) (vector-set! syntmp-marksvec-955 syntmp-i-958 syntmp-marks-960) (syntmp-f-956 (cdr syntmp-ids-957) (syntmp-fx+-85 syntmp-i-958 1))))))) (syntmp-make-ribcage-122 syntmp-symnamevec-954 syntmp-marksvec-955 syntmp-labelvec-952))))) (syntmp-wrap-subst-119 syntmp-w-951)))))) (syntmp-extend-ribcage!-131 (lambda (syntmp-ribcage-961 syntmp-id-962 syntmp-label-963) (begin (syntmp-set-ribcage-symnames!-127 syntmp-ribcage-961 (cons (let ((syntmp-e-964 (syntmp-syntax-object-expression-102 syntmp-id-962))) (if (syntmp-annotation?-89 syntmp-e-964) (annotation-expression syntmp-e-964) syntmp-e-964)) (syntmp-ribcage-symnames-124 syntmp-ribcage-961))) (syntmp-set-ribcage-marks!-128 syntmp-ribcage-961 (cons (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-id-962)) (syntmp-ribcage-marks-125 syntmp-ribcage-961))) (syntmp-set-ribcage-labels!-129 syntmp-ribcage-961 (cons syntmp-label-963 (syntmp-ribcage-labels-126 syntmp-ribcage-961)))))) (syntmp-anti-mark-130 (lambda (syntmp-w-965) (syntmp-make-wrap-117 (cons #f (syntmp-wrap-marks-118 syntmp-w-965)) (cons (quote shift) (syntmp-wrap-subst-119 syntmp-w-965))))) (syntmp-set-ribcage-labels!-129 (lambda (syntmp-x-966 syntmp-update-967) (vector-set! syntmp-x-966 3 syntmp-update-967))) (syntmp-set-ribcage-marks!-128 (lambda (syntmp-x-968 syntmp-update-969) (vector-set! syntmp-x-968 2 syntmp-update-969))) (syntmp-set-ribcage-symnames!-127 (lambda (syntmp-x-970 syntmp-update-971) (vector-set! syntmp-x-970 1 syntmp-update-971))) (syntmp-ribcage-labels-126 (lambda (syntmp-x-972) (vector-ref syntmp-x-972 3))) (syntmp-ribcage-marks-125 (lambda (syntmp-x-973) (vector-ref syntmp-x-973 2))) (syntmp-ribcage-symnames-124 (lambda (syntmp-x-974) (vector-ref syntmp-x-974 1))) (syntmp-ribcage?-123 (lambda (syntmp-x-975) (and (vector? syntmp-x-975) (= (vector-length syntmp-x-975) 4) (eq? (vector-ref syntmp-x-975 0) (quote ribcage))))) (syntmp-make-ribcage-122 (lambda (syntmp-symnames-976 syntmp-marks-977 syntmp-labels-978) (vector (quote ribcage) syntmp-symnames-976 syntmp-marks-977 syntmp-labels-978))) (syntmp-gen-labels-121 (lambda (syntmp-ls-979) (if (null? syntmp-ls-979) (quote ()) (cons (syntmp-gen-label-120) (syntmp-gen-labels-121 (cdr syntmp-ls-979)))))) (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-980 syntmp-w-981) (if (syntmp-syntax-object?-101 syntmp-x-980) (values (let ((syntmp-e-982 (syntmp-syntax-object-expression-102 syntmp-x-980))) (if (syntmp-annotation?-89 syntmp-e-982) (annotation-expression syntmp-e-982) syntmp-e-982)) (syntmp-join-marks-135 (syntmp-wrap-marks-118 syntmp-w-981) (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-x-980)))) (values (let ((syntmp-e-983 syntmp-x-980)) (if (syntmp-annotation?-89 syntmp-e-983) (annotation-expression syntmp-e-983) syntmp-e-983)) (syntmp-wrap-marks-118 syntmp-w-981))))) (syntmp-id?-115 (lambda (syntmp-x-984) (cond ((symbol? syntmp-x-984) #t) ((syntmp-syntax-object?-101 syntmp-x-984) (symbol? (let ((syntmp-e-985 (syntmp-syntax-object-expression-102 syntmp-x-984))) (if (syntmp-annotation?-89 syntmp-e-985) (annotation-expression syntmp-e-985) syntmp-e-985)))) ((syntmp-annotation?-89 syntmp-x-984) (symbol? (annotation-expression syntmp-x-984))) (else #f)))) (syntmp-nonsymbol-id?-114 (lambda (syntmp-x-986) (and (syntmp-syntax-object?-101 syntmp-x-986) (symbol? (let ((syntmp-e-987 (syntmp-syntax-object-expression-102 syntmp-x-986))) (if (syntmp-annotation?-89 syntmp-e-987) (annotation-expression syntmp-e-987) syntmp-e-987)))))) (syntmp-global-extend-113 (lambda (syntmp-type-988 syntmp-sym-989 syntmp-val-990) (syntmp-put-global-definition-hook-93 syntmp-sym-989 (cons syntmp-type-988 syntmp-val-990)))) (syntmp-lookup-112 (lambda (syntmp-x-991 syntmp-r-992) (cond ((assq syntmp-x-991 syntmp-r-992) => cdr) ((symbol? syntmp-x-991) (or (syntmp-get-global-definition-hook-94 syntmp-x-991) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-111 (lambda (syntmp-r-993) (if (null? syntmp-r-993) (quote ()) (let ((syntmp-a-994 (car syntmp-r-993))) (if (eq? (cadr syntmp-a-994) (quote macro)) (cons syntmp-a-994 (syntmp-macros-only-env-111 (cdr syntmp-r-993))) (syntmp-macros-only-env-111 (cdr syntmp-r-993))))))) (syntmp-extend-var-env-110 (lambda (syntmp-labels-995 syntmp-vars-996 syntmp-r-997) (if (null? syntmp-labels-995) syntmp-r-997 (syntmp-extend-var-env-110 (cdr syntmp-labels-995) (cdr syntmp-vars-996) (cons (cons (car syntmp-labels-995) (cons (quote lexical) (car syntmp-vars-996))) syntmp-r-997))))) (syntmp-extend-env-109 (lambda (syntmp-labels-998 syntmp-bindings-999 syntmp-r-1000) (if (null? syntmp-labels-998) syntmp-r-1000 (syntmp-extend-env-109 (cdr syntmp-labels-998) (cdr syntmp-bindings-999) (cons (cons (car syntmp-labels-998) (car syntmp-bindings-999)) syntmp-r-1000))))) (syntmp-binding-value-108 cdr) (syntmp-binding-type-107 car) (syntmp-source-annotation-106 (lambda (syntmp-x-1001) (cond ((syntmp-annotation?-89 syntmp-x-1001) (annotation-source syntmp-x-1001)) ((syntmp-syntax-object?-101 syntmp-x-1001) (syntmp-source-annotation-106 (syntmp-syntax-object-expression-102 syntmp-x-1001))) (else #f)))) (syntmp-set-syntax-object-wrap!-105 (lambda (syntmp-x-1002 syntmp-update-1003) (vector-set! syntmp-x-1002 2 syntmp-update-1003))) (syntmp-set-syntax-object-expression!-104 (lambda (syntmp-x-1004 syntmp-update-1005) (vector-set! syntmp-x-1004 1 syntmp-update-1005))) (syntmp-syntax-object-wrap-103 (lambda (syntmp-x-1006) (vector-ref syntmp-x-1006 2))) (syntmp-syntax-object-expression-102 (lambda (syntmp-x-1007) (vector-ref syntmp-x-1007 1))) (syntmp-syntax-object?-101 (lambda (syntmp-x-1008) (and (vector? syntmp-x-1008) (= (vector-length syntmp-x-1008) 3) (eq? (vector-ref syntmp-x-1008 0) (quote syntax-object))))) (syntmp-make-syntax-object-100 (lambda (syntmp-expression-1009 syntmp-wrap-1010) (vector (quote syntax-object) syntmp-expression-1009 syntmp-wrap-1010))) (syntmp-build-letrec-99 (lambda (syntmp-src-1011 syntmp-vars-1012 syntmp-val-exps-1013 syntmp-body-exp-1014) (if (null? syntmp-vars-1012) syntmp-body-exp-1014 (list (quote letrec) (map list syntmp-vars-1012 syntmp-val-exps-1013) syntmp-body-exp-1014)))) (syntmp-build-named-let-98 (lambda (syntmp-src-1015 syntmp-vars-1016 syntmp-val-exps-1017 syntmp-body-exp-1018) (if (null? syntmp-vars-1016) syntmp-body-exp-1018 (list (quote let) (car syntmp-vars-1016) (map list (cdr syntmp-vars-1016) syntmp-val-exps-1017) syntmp-body-exp-1018)))) (syntmp-build-let-97 (lambda (syntmp-src-1019 syntmp-vars-1020 syntmp-val-exps-1021 syntmp-body-exp-1022) (if (null? syntmp-vars-1020) syntmp-body-exp-1022 (list (quote let) (map list syntmp-vars-1020 syntmp-val-exps-1021) syntmp-body-exp-1022)))) (syntmp-build-sequence-96 (lambda (syntmp-src-1023 syntmp-exps-1024) (if (null? (cdr syntmp-exps-1024)) (car syntmp-exps-1024) (cons (quote begin) syntmp-exps-1024)))) (syntmp-build-data-95 (lambda (syntmp-src-1025 syntmp-exp-1026) (if (and (self-evaluating? syntmp-exp-1026) (not (vector? syntmp-exp-1026))) syntmp-exp-1026 (list (quote quote) syntmp-exp-1026)))) (syntmp-get-global-definition-hook-94 (lambda (syntmp-symbol-1027) (getprop syntmp-symbol-1027 (quote *sc-expander*)))) (syntmp-put-global-definition-hook-93 (lambda (syntmp-symbol-1028 syntmp-binding-1029) (putprop syntmp-symbol-1028 (quote *sc-expander*) syntmp-binding-1029))) (syntmp-error-hook-92 (lambda (syntmp-who-1030 syntmp-why-1031 syntmp-what-1032) (error syntmp-who-1030 "~a ~s" syntmp-why-1031 syntmp-what-1032))) (syntmp-local-eval-hook-91 (lambda (syntmp-x-1033) (eval (list syntmp-noexpand-84 syntmp-x-1033) (interaction-environment)))) (syntmp-top-level-eval-hook-90 (lambda (syntmp-x-1034) (eval (list syntmp-noexpand-84 syntmp-x-1034) (interaction-environment)))) (syntmp-annotation?-89 (lambda (syntmp-x-1035) #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-1036 syntmp-r-1037 syntmp-w-1038 syntmp-s-1039) ((lambda (syntmp-tmp-1040) ((lambda (syntmp-tmp-1041) (if (if syntmp-tmp-1041 (apply (lambda (syntmp-_-1042 syntmp-var-1043 syntmp-val-1044 syntmp-e1-1045 syntmp-e2-1046) (syntmp-valid-bound-ids?-140 syntmp-var-1043)) syntmp-tmp-1041) #f) (apply (lambda (syntmp-_-1048 syntmp-var-1049 syntmp-val-1050 syntmp-e1-1051 syntmp-e2-1052) (let ((syntmp-names-1053 (map (lambda (syntmp-x-1054) (syntmp-id-var-name-137 syntmp-x-1054 syntmp-w-1038)) syntmp-var-1049))) (begin (for-each (lambda (syntmp-id-1056 syntmp-n-1057) (let ((syntmp-t-1058 (syntmp-binding-type-107 (syntmp-lookup-112 syntmp-n-1057 syntmp-r-1037)))) (if (memv syntmp-t-1058 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-144 syntmp-id-1056 syntmp-w-1038 syntmp-s-1039) "identifier out of context")))) syntmp-var-1049 syntmp-names-1053) (syntmp-chi-body-155 (cons syntmp-e1-1051 syntmp-e2-1052) (syntmp-source-wrap-144 syntmp-e-1036 syntmp-w-1038 syntmp-s-1039) (syntmp-extend-env-109 syntmp-names-1053 (let ((syntmp-trans-r-1061 (syntmp-macros-only-env-111 syntmp-r-1037))) (map (lambda (syntmp-x-1062) (cons (quote macro) (syntmp-eval-local-transformer-158 (syntmp-chi-151 syntmp-x-1062 syntmp-trans-r-1061 syntmp-w-1038)))) syntmp-val-1050)) syntmp-r-1037) syntmp-w-1038)))) syntmp-tmp-1041) ((lambda (syntmp-_-1064) (syntax-error (syntmp-source-wrap-144 syntmp-e-1036 syntmp-w-1038 syntmp-s-1039))) syntmp-tmp-1040))) (syntax-dispatch syntmp-tmp-1040 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1036))) (syntmp-global-extend-113 (quote core) (quote quote) (lambda (syntmp-e-1065 syntmp-r-1066 syntmp-w-1067 syntmp-s-1068) ((lambda (syntmp-tmp-1069) ((lambda (syntmp-tmp-1070) (if syntmp-tmp-1070 (apply (lambda (syntmp-_-1071 syntmp-e-1072) (syntmp-build-data-95 syntmp-s-1068 (syntmp-strip-162 syntmp-e-1072 syntmp-w-1067))) syntmp-tmp-1070) ((lambda (syntmp-_-1073) (syntax-error (syntmp-source-wrap-144 syntmp-e-1065 syntmp-w-1067 syntmp-s-1068))) syntmp-tmp-1069))) (syntax-dispatch syntmp-tmp-1069 (quote (any any))))) syntmp-e-1065))) (syntmp-global-extend-113 (quote core) (quote syntax) (letrec ((syntmp-regen-1081 (lambda (syntmp-x-1082) (let ((syntmp-t-1083 (car syntmp-x-1082))) (if (memv syntmp-t-1083 (quote (ref))) (cadr syntmp-x-1082) (if (memv syntmp-t-1083 (quote (primitive))) (cadr syntmp-x-1082) (if (memv syntmp-t-1083 (quote (quote))) (syntmp-build-data-95 #f (cadr syntmp-x-1082)) (if (memv syntmp-t-1083 (quote (lambda))) (list (quote lambda) (cadr syntmp-x-1082) (syntmp-regen-1081 (caddr syntmp-x-1082))) (if (memv syntmp-t-1083 (quote (map))) (let ((syntmp-ls-1084 (map syntmp-regen-1081 (cdr syntmp-x-1082)))) (cons (if (syntmp-fx=-87 (length syntmp-ls-1084) 2) (quote map) (quote map)) syntmp-ls-1084)) (cons (car syntmp-x-1082) (map syntmp-regen-1081 (cdr syntmp-x-1082))))))))))) (syntmp-gen-vector-1080 (lambda (syntmp-x-1085) (cond ((eq? (car syntmp-x-1085) (quote list)) (cons (quote vector) (cdr syntmp-x-1085))) ((eq? (car syntmp-x-1085) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1085)))) (else (list (quote list->vector) syntmp-x-1085))))) (syntmp-gen-append-1079 (lambda (syntmp-x-1086 syntmp-y-1087) (if (equal? syntmp-y-1087 (quote (quote ()))) syntmp-x-1086 (list (quote append) syntmp-x-1086 syntmp-y-1087)))) (syntmp-gen-cons-1078 (lambda (syntmp-x-1088 syntmp-y-1089) (let ((syntmp-t-1090 (car syntmp-y-1089))) (if (memv syntmp-t-1090 (quote (quote))) (if (eq? (car syntmp-x-1088) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1088) (cadr syntmp-y-1089))) (if (eq? (cadr syntmp-y-1089) (quote ())) (list (quote list) syntmp-x-1088) (list (quote cons) syntmp-x-1088 syntmp-y-1089))) (if (memv syntmp-t-1090 (quote (list))) (cons (quote list) (cons syntmp-x-1088 (cdr syntmp-y-1089))) (list (quote cons) syntmp-x-1088 syntmp-y-1089)))))) (syntmp-gen-map-1077 (lambda (syntmp-e-1091 syntmp-map-env-1092) (let ((syntmp-formals-1093 (map cdr syntmp-map-env-1092)) (syntmp-actuals-1094 (map (lambda (syntmp-x-1095) (list (quote ref) (car syntmp-x-1095))) syntmp-map-env-1092))) (cond ((eq? (car syntmp-e-1091) (quote ref)) (car syntmp-actuals-1094)) ((andmap (lambda (syntmp-x-1096) (and (eq? (car syntmp-x-1096) (quote ref)) (memq (cadr syntmp-x-1096) syntmp-formals-1093))) (cdr syntmp-e-1091)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1091)) (map (let ((syntmp-r-1097 (map cons syntmp-formals-1093 syntmp-actuals-1094))) (lambda (syntmp-x-1098) (cdr (assq (cadr syntmp-x-1098) syntmp-r-1097)))) (cdr syntmp-e-1091))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1093 syntmp-e-1091) syntmp-actuals-1094))))))) (syntmp-gen-mappend-1076 (lambda (syntmp-e-1099 syntmp-map-env-1100) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1077 syntmp-e-1099 syntmp-map-env-1100)))) (syntmp-gen-ref-1075 (lambda (syntmp-src-1101 syntmp-var-1102 syntmp-level-1103 syntmp-maps-1104) (if (syntmp-fx=-87 syntmp-level-1103 0) (values syntmp-var-1102 syntmp-maps-1104) (if (null? syntmp-maps-1104) (syntax-error syntmp-src-1101 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1075 syntmp-src-1101 syntmp-var-1102 (syntmp-fx--86 syntmp-level-1103 1) (cdr syntmp-maps-1104))) (lambda (syntmp-outer-var-1105 syntmp-outer-maps-1106) (let ((syntmp-b-1107 (assq syntmp-outer-var-1105 (car syntmp-maps-1104)))) (if syntmp-b-1107 (values (cdr syntmp-b-1107) syntmp-maps-1104) (let ((syntmp-inner-var-1108 (syntmp-gen-var-163 (quote tmp)))) (values syntmp-inner-var-1108 (cons (cons (cons syntmp-outer-var-1105 syntmp-inner-var-1108) (car syntmp-maps-1104)) syntmp-outer-maps-1106))))))))))) (syntmp-gen-syntax-1074 (lambda (syntmp-src-1109 syntmp-e-1110 syntmp-r-1111 syntmp-maps-1112 syntmp-ellipsis?-1113) (if (syntmp-id?-115 syntmp-e-1110) (let ((syntmp-label-1114 (syntmp-id-var-name-137 syntmp-e-1110 (quote (()))))) (let ((syntmp-b-1115 (syntmp-lookup-112 syntmp-label-1114 syntmp-r-1111))) (if (eq? (syntmp-binding-type-107 syntmp-b-1115) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1116 (syntmp-binding-value-108 syntmp-b-1115))) (syntmp-gen-ref-1075 syntmp-src-1109 (car syntmp-var.lev-1116) (cdr syntmp-var.lev-1116) syntmp-maps-1112))) (lambda (syntmp-var-1117 syntmp-maps-1118) (values (list (quote ref) syntmp-var-1117) syntmp-maps-1118))) (if (syntmp-ellipsis?-1113 syntmp-e-1110) (syntax-error syntmp-src-1109 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1110) syntmp-maps-1112))))) ((lambda (syntmp-tmp-1119) ((lambda (syntmp-tmp-1120) (if (if syntmp-tmp-1120 (apply (lambda (syntmp-dots-1121 syntmp-e-1122) (syntmp-ellipsis?-1113 syntmp-dots-1121)) syntmp-tmp-1120) #f) (apply (lambda (syntmp-dots-1123 syntmp-e-1124) (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-e-1124 syntmp-r-1111 syntmp-maps-1112 (lambda (syntmp-x-1125) #f))) syntmp-tmp-1120) ((lambda (syntmp-tmp-1126) (if (if syntmp-tmp-1126 (apply (lambda (syntmp-x-1127 syntmp-dots-1128 syntmp-y-1129) (syntmp-ellipsis?-1113 syntmp-dots-1128)) syntmp-tmp-1126) #f) (apply (lambda (syntmp-x-1130 syntmp-dots-1131 syntmp-y-1132) (let syntmp-f-1133 ((syntmp-y-1134 syntmp-y-1132) (syntmp-k-1135 (lambda (syntmp-maps-1136) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-x-1130 syntmp-r-1111 (cons (quote ()) syntmp-maps-1136) syntmp-ellipsis?-1113)) (lambda (syntmp-x-1137 syntmp-maps-1138) (if (null? (car syntmp-maps-1138)) (syntax-error syntmp-src-1109 "extra ellipsis in syntax form") (values (syntmp-gen-map-1077 syntmp-x-1137 (car syntmp-maps-1138)) (cdr syntmp-maps-1138)))))))) ((lambda (syntmp-tmp-1139) ((lambda (syntmp-tmp-1140) (if (if syntmp-tmp-1140 (apply (lambda (syntmp-dots-1141 syntmp-y-1142) (syntmp-ellipsis?-1113 syntmp-dots-1141)) syntmp-tmp-1140) #f) (apply (lambda (syntmp-dots-1143 syntmp-y-1144) (syntmp-f-1133 syntmp-y-1144 (lambda (syntmp-maps-1145) (call-with-values (lambda () (syntmp-k-1135 (cons (quote ()) syntmp-maps-1145))) (lambda (syntmp-x-1146 syntmp-maps-1147) (if (null? (car syntmp-maps-1147)) (syntax-error syntmp-src-1109 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1076 syntmp-x-1146 (car syntmp-maps-1147)) (cdr syntmp-maps-1147)))))))) syntmp-tmp-1140) ((lambda (syntmp-_-1148) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-y-1134 syntmp-r-1111 syntmp-maps-1112 syntmp-ellipsis?-1113)) (lambda (syntmp-y-1149 syntmp-maps-1150) (call-with-values (lambda () (syntmp-k-1135 syntmp-maps-1150)) (lambda (syntmp-x-1151 syntmp-maps-1152) (values (syntmp-gen-append-1079 syntmp-x-1151 syntmp-y-1149) syntmp-maps-1152)))))) syntmp-tmp-1139))) (syntax-dispatch syntmp-tmp-1139 (quote (any . any))))) syntmp-y-1134))) syntmp-tmp-1126) ((lambda (syntmp-tmp-1153) (if syntmp-tmp-1153 (apply (lambda (syntmp-x-1154 syntmp-y-1155) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-x-1154 syntmp-r-1111 syntmp-maps-1112 syntmp-ellipsis?-1113)) (lambda (syntmp-x-1156 syntmp-maps-1157) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-y-1155 syntmp-r-1111 syntmp-maps-1157 syntmp-ellipsis?-1113)) (lambda (syntmp-y-1158 syntmp-maps-1159) (values (syntmp-gen-cons-1078 syntmp-x-1156 syntmp-y-1158) syntmp-maps-1159)))))) syntmp-tmp-1153) ((lambda (syntmp-tmp-1160) (if syntmp-tmp-1160 (apply (lambda (syntmp-e1-1161 syntmp-e2-1162) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 (cons syntmp-e1-1161 syntmp-e2-1162) syntmp-r-1111 syntmp-maps-1112 syntmp-ellipsis?-1113)) (lambda (syntmp-e-1164 syntmp-maps-1165) (values (syntmp-gen-vector-1080 syntmp-e-1164) syntmp-maps-1165)))) syntmp-tmp-1160) ((lambda (syntmp-_-1166) (values (list (quote quote) syntmp-e-1110) syntmp-maps-1112)) syntmp-tmp-1119))) (syntax-dispatch syntmp-tmp-1119 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1119 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1119 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1119 (quote (any any))))) syntmp-e-1110))))) (lambda (syntmp-e-1167 syntmp-r-1168 syntmp-w-1169 syntmp-s-1170) (let ((syntmp-e-1171 (syntmp-source-wrap-144 syntmp-e-1167 syntmp-w-1169 syntmp-s-1170))) ((lambda (syntmp-tmp-1172) ((lambda (syntmp-tmp-1173) (if syntmp-tmp-1173 (apply (lambda (syntmp-_-1174 syntmp-x-1175) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-e-1171 syntmp-x-1175 syntmp-r-1168 (quote ()) syntmp-ellipsis?-160)) (lambda (syntmp-e-1176 syntmp-maps-1177) (syntmp-regen-1081 syntmp-e-1176)))) syntmp-tmp-1173) ((lambda (syntmp-_-1178) (syntax-error syntmp-e-1171)) syntmp-tmp-1172))) (syntax-dispatch syntmp-tmp-1172 (quote (any any))))) syntmp-e-1171))))) (syntmp-global-extend-113 (quote core) (quote lambda) (lambda (syntmp-e-1179 syntmp-r-1180 syntmp-w-1181 syntmp-s-1182) ((lambda (syntmp-tmp-1183) ((lambda (syntmp-tmp-1184) (if syntmp-tmp-1184 (apply (lambda (syntmp-_-1185 syntmp-c-1186) (syntmp-chi-lambda-clause-156 (syntmp-source-wrap-144 syntmp-e-1179 syntmp-w-1181 syntmp-s-1182) syntmp-c-1186 syntmp-r-1180 syntmp-w-1181 (lambda (syntmp-vars-1187 syntmp-body-1188) (list (quote lambda) syntmp-vars-1187 syntmp-body-1188)))) syntmp-tmp-1184) (syntax-error syntmp-tmp-1183))) (syntax-dispatch syntmp-tmp-1183 (quote (any . any))))) syntmp-e-1179))) (syntmp-global-extend-113 (quote core) (quote let) (letrec ((syntmp-chi-let-1189 (lambda (syntmp-e-1190 syntmp-r-1191 syntmp-w-1192 syntmp-s-1193 syntmp-constructor-1194 syntmp-ids-1195 syntmp-vals-1196 syntmp-exps-1197) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-1195)) (syntax-error syntmp-e-1190 "duplicate bound variable in") (let ((syntmp-labels-1198 (syntmp-gen-labels-121 syntmp-ids-1195)) (syntmp-new-vars-1199 (map syntmp-gen-var-163 syntmp-ids-1195))) (let ((syntmp-nw-1200 (syntmp-make-binding-wrap-132 syntmp-ids-1195 syntmp-labels-1198 syntmp-w-1192)) (syntmp-nr-1201 (syntmp-extend-var-env-110 syntmp-labels-1198 syntmp-new-vars-1199 syntmp-r-1191))) (syntmp-constructor-1194 syntmp-s-1193 syntmp-new-vars-1199 (map (lambda (syntmp-x-1202) (syntmp-chi-151 syntmp-x-1202 syntmp-r-1191 syntmp-w-1192)) syntmp-vals-1196) (syntmp-chi-body-155 syntmp-exps-1197 (syntmp-source-wrap-144 syntmp-e-1190 syntmp-nw-1200 syntmp-s-1193) syntmp-nr-1201 syntmp-nw-1200)))))))) (lambda (syntmp-e-1203 syntmp-r-1204 syntmp-w-1205 syntmp-s-1206) ((lambda (syntmp-tmp-1207) ((lambda (syntmp-tmp-1208) (if syntmp-tmp-1208 (apply (lambda (syntmp-_-1209 syntmp-id-1210 syntmp-val-1211 syntmp-e1-1212 syntmp-e2-1213) (syntmp-chi-let-1189 syntmp-e-1203 syntmp-r-1204 syntmp-w-1205 syntmp-s-1206 syntmp-build-let-97 syntmp-id-1210 syntmp-val-1211 (cons syntmp-e1-1212 syntmp-e2-1213))) syntmp-tmp-1208) ((lambda (syntmp-tmp-1217) (if (if syntmp-tmp-1217 (apply (lambda (syntmp-_-1218 syntmp-f-1219 syntmp-id-1220 syntmp-val-1221 syntmp-e1-1222 syntmp-e2-1223) (syntmp-id?-115 syntmp-f-1219)) syntmp-tmp-1217) #f) (apply (lambda (syntmp-_-1224 syntmp-f-1225 syntmp-id-1226 syntmp-val-1227 syntmp-e1-1228 syntmp-e2-1229) (syntmp-chi-let-1189 syntmp-e-1203 syntmp-r-1204 syntmp-w-1205 syntmp-s-1206 syntmp-build-named-let-98 (cons syntmp-f-1225 syntmp-id-1226) syntmp-val-1227 (cons syntmp-e1-1228 syntmp-e2-1229))) syntmp-tmp-1217) ((lambda (syntmp-_-1233) (syntax-error (syntmp-source-wrap-144 syntmp-e-1203 syntmp-w-1205 syntmp-s-1206))) syntmp-tmp-1207))) (syntax-dispatch syntmp-tmp-1207 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1207 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1203)))) (syntmp-global-extend-113 (quote core) (quote letrec) (lambda (syntmp-e-1234 syntmp-r-1235 syntmp-w-1236 syntmp-s-1237) ((lambda (syntmp-tmp-1238) ((lambda (syntmp-tmp-1239) (if syntmp-tmp-1239 (apply (lambda (syntmp-_-1240 syntmp-id-1241 syntmp-val-1242 syntmp-e1-1243 syntmp-e2-1244) (let ((syntmp-ids-1245 syntmp-id-1241)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-1245)) (syntax-error syntmp-e-1234 "duplicate bound variable in") (let ((syntmp-labels-1247 (syntmp-gen-labels-121 syntmp-ids-1245)) (syntmp-new-vars-1248 (map syntmp-gen-var-163 syntmp-ids-1245))) (let ((syntmp-w-1249 (syntmp-make-binding-wrap-132 syntmp-ids-1245 syntmp-labels-1247 syntmp-w-1236)) (syntmp-r-1250 (syntmp-extend-var-env-110 syntmp-labels-1247 syntmp-new-vars-1248 syntmp-r-1235))) (syntmp-build-letrec-99 syntmp-s-1237 syntmp-new-vars-1248 (map (lambda (syntmp-x-1251) (syntmp-chi-151 syntmp-x-1251 syntmp-r-1250 syntmp-w-1249)) syntmp-val-1242) (syntmp-chi-body-155 (cons syntmp-e1-1243 syntmp-e2-1244) (syntmp-source-wrap-144 syntmp-e-1234 syntmp-w-1249 syntmp-s-1237) syntmp-r-1250 syntmp-w-1249))))))) syntmp-tmp-1239) ((lambda (syntmp-_-1254) (syntax-error (syntmp-source-wrap-144 syntmp-e-1234 syntmp-w-1236 syntmp-s-1237))) syntmp-tmp-1238))) (syntax-dispatch syntmp-tmp-1238 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1234))) (syntmp-global-extend-113 (quote core) (quote set!) (lambda (syntmp-e-1255 syntmp-r-1256 syntmp-w-1257 syntmp-s-1258) ((lambda (syntmp-tmp-1259) ((lambda (syntmp-tmp-1260) (if (if syntmp-tmp-1260 (apply (lambda (syntmp-_-1261 syntmp-id-1262 syntmp-val-1263) (syntmp-id?-115 syntmp-id-1262)) syntmp-tmp-1260) #f) (apply (lambda (syntmp-_-1264 syntmp-id-1265 syntmp-val-1266) (let ((syntmp-val-1267 (syntmp-chi-151 syntmp-val-1266 syntmp-r-1256 syntmp-w-1257)) (syntmp-n-1268 (syntmp-id-var-name-137 syntmp-id-1265 syntmp-w-1257))) (let ((syntmp-b-1269 (syntmp-lookup-112 syntmp-n-1268 syntmp-r-1256))) (let ((syntmp-t-1270 (syntmp-binding-type-107 syntmp-b-1269))) (if (memv syntmp-t-1270 (quote (lexical))) (list (quote set!) (syntmp-binding-value-108 syntmp-b-1269) syntmp-val-1267) (if (memv syntmp-t-1270 (quote (global))) (list (quote set!) syntmp-n-1268 syntmp-val-1267) (if (memv syntmp-t-1270 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-143 syntmp-id-1265 syntmp-w-1257) "identifier out of context") (syntax-error (syntmp-source-wrap-144 syntmp-e-1255 syntmp-w-1257 syntmp-s-1258))))))))) syntmp-tmp-1260) ((lambda (syntmp-tmp-1271) (if syntmp-tmp-1271 (apply (lambda (syntmp-_-1272 syntmp-getter-1273 syntmp-arg-1274 syntmp-val-1275) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-1273) syntmp-r-1256 syntmp-w-1257) (map (lambda (syntmp-e-1276) (syntmp-chi-151 syntmp-e-1276 syntmp-r-1256 syntmp-w-1257)) (append syntmp-arg-1274 (list syntmp-val-1275))))) syntmp-tmp-1271) ((lambda (syntmp-_-1278) (syntax-error (syntmp-source-wrap-144 syntmp-e-1255 syntmp-w-1257 syntmp-s-1258))) syntmp-tmp-1259))) (syntax-dispatch syntmp-tmp-1259 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1259 (quote (any any any))))) syntmp-e-1255))) (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-1282 (lambda (syntmp-x-1283 syntmp-keys-1284 syntmp-clauses-1285 syntmp-r-1286) (if (null? syntmp-clauses-1285) (list (quote syntax-error) syntmp-x-1283) ((lambda (syntmp-tmp-1287) ((lambda (syntmp-tmp-1288) (if syntmp-tmp-1288 (apply (lambda (syntmp-pat-1289 syntmp-exp-1290) (if (and (syntmp-id?-115 syntmp-pat-1289) (andmap (lambda (syntmp-x-1291) (not (syntmp-free-id=?-138 syntmp-pat-1289 syntmp-x-1291))) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-1284))) (let ((syntmp-labels-1292 (list (syntmp-gen-label-120))) (syntmp-var-1293 (syntmp-gen-var-163 syntmp-pat-1289))) (list (list (quote lambda) (list syntmp-var-1293) (syntmp-chi-151 syntmp-exp-1290 (syntmp-extend-env-109 syntmp-labels-1292 (list (cons (quote syntax) (cons syntmp-var-1293 0))) syntmp-r-1286) (syntmp-make-binding-wrap-132 (list syntmp-pat-1289) syntmp-labels-1292 (quote (()))))) syntmp-x-1283)) (syntmp-gen-clause-1281 syntmp-x-1283 syntmp-keys-1284 (cdr syntmp-clauses-1285) syntmp-r-1286 syntmp-pat-1289 #t syntmp-exp-1290))) syntmp-tmp-1288) ((lambda (syntmp-tmp-1294) (if syntmp-tmp-1294 (apply (lambda (syntmp-pat-1295 syntmp-fender-1296 syntmp-exp-1297) (syntmp-gen-clause-1281 syntmp-x-1283 syntmp-keys-1284 (cdr syntmp-clauses-1285) syntmp-r-1286 syntmp-pat-1295 syntmp-fender-1296 syntmp-exp-1297)) syntmp-tmp-1294) ((lambda (syntmp-_-1298) (syntax-error (car syntmp-clauses-1285) "invalid syntax-case clause")) syntmp-tmp-1287))) (syntax-dispatch syntmp-tmp-1287 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1287 (quote (any any))))) (car syntmp-clauses-1285))))) (syntmp-gen-clause-1281 (lambda (syntmp-x-1299 syntmp-keys-1300 syntmp-clauses-1301 syntmp-r-1302 syntmp-pat-1303 syntmp-fender-1304 syntmp-exp-1305) (call-with-values (lambda () (syntmp-convert-pattern-1279 syntmp-pat-1303 syntmp-keys-1300)) (lambda (syntmp-p-1306 syntmp-pvars-1307) (cond ((not (syntmp-distinct-bound-ids?-141 (map car syntmp-pvars-1307))) (syntax-error syntmp-pat-1303 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1308) (not (syntmp-ellipsis?-160 (car syntmp-x-1308)))) syntmp-pvars-1307)) (syntax-error syntmp-pat-1303 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1309 (syntmp-gen-var-163 (quote tmp)))) (list (list (quote lambda) (list syntmp-y-1309) (let ((syntmp-y-1310 syntmp-y-1309)) (list (quote if) ((lambda (syntmp-tmp-1311) ((lambda (syntmp-tmp-1312) (if syntmp-tmp-1312 (apply (lambda () syntmp-y-1310) syntmp-tmp-1312) ((lambda (syntmp-_-1313) (list (quote if) syntmp-y-1310 (syntmp-build-dispatch-call-1280 syntmp-pvars-1307 syntmp-fender-1304 syntmp-y-1310 syntmp-r-1302) (syntmp-build-data-95 #f #f))) syntmp-tmp-1311))) (syntax-dispatch syntmp-tmp-1311 (quote #(atom #t))))) syntmp-fender-1304) (syntmp-build-dispatch-call-1280 syntmp-pvars-1307 syntmp-exp-1305 syntmp-y-1310 syntmp-r-1302) (syntmp-gen-syntax-case-1282 syntmp-x-1299 syntmp-keys-1300 syntmp-clauses-1301 syntmp-r-1302)))) (if (eq? syntmp-p-1306 (quote any)) (list (quote list) syntmp-x-1299) (list (quote syntax-dispatch) syntmp-x-1299 (syntmp-build-data-95 #f syntmp-p-1306))))))))))) (syntmp-build-dispatch-call-1280 (lambda (syntmp-pvars-1314 syntmp-exp-1315 syntmp-y-1316 syntmp-r-1317) (let ((syntmp-ids-1318 (map car syntmp-pvars-1314)) (syntmp-levels-1319 (map cdr syntmp-pvars-1314))) (let ((syntmp-labels-1320 (syntmp-gen-labels-121 syntmp-ids-1318)) (syntmp-new-vars-1321 (map syntmp-gen-var-163 syntmp-ids-1318))) (list (quote apply) (list (quote lambda) syntmp-new-vars-1321 (syntmp-chi-151 syntmp-exp-1315 (syntmp-extend-env-109 syntmp-labels-1320 (map (lambda (syntmp-var-1322 syntmp-level-1323) (cons (quote syntax) (cons syntmp-var-1322 syntmp-level-1323))) syntmp-new-vars-1321 (map cdr syntmp-pvars-1314)) syntmp-r-1317) (syntmp-make-binding-wrap-132 syntmp-ids-1318 syntmp-labels-1320 (quote (()))))) syntmp-y-1316))))) (syntmp-convert-pattern-1279 (lambda (syntmp-pattern-1324 syntmp-keys-1325) (let syntmp-cvt-1326 ((syntmp-p-1327 syntmp-pattern-1324) (syntmp-n-1328 0) (syntmp-ids-1329 (quote ()))) (if (syntmp-id?-115 syntmp-p-1327) (if (syntmp-bound-id-member?-142 syntmp-p-1327 syntmp-keys-1325) (values (vector (quote free-id) syntmp-p-1327) syntmp-ids-1329) (values (quote any) (cons (cons syntmp-p-1327 syntmp-n-1328) syntmp-ids-1329))) ((lambda (syntmp-tmp-1330) ((lambda (syntmp-tmp-1331) (if (if syntmp-tmp-1331 (apply (lambda (syntmp-x-1332 syntmp-dots-1333) (syntmp-ellipsis?-160 syntmp-dots-1333)) syntmp-tmp-1331) #f) (apply (lambda (syntmp-x-1334 syntmp-dots-1335) (call-with-values (lambda () (syntmp-cvt-1326 syntmp-x-1334 (syntmp-fx+-85 syntmp-n-1328 1) syntmp-ids-1329)) (lambda (syntmp-p-1336 syntmp-ids-1337) (values (if (eq? syntmp-p-1336 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1336)) syntmp-ids-1337)))) syntmp-tmp-1331) ((lambda (syntmp-tmp-1338) (if syntmp-tmp-1338 (apply (lambda (syntmp-x-1339 syntmp-y-1340) (call-with-values (lambda () (syntmp-cvt-1326 syntmp-y-1340 syntmp-n-1328 syntmp-ids-1329)) (lambda (syntmp-y-1341 syntmp-ids-1342) (call-with-values (lambda () (syntmp-cvt-1326 syntmp-x-1339 syntmp-n-1328 syntmp-ids-1342)) (lambda (syntmp-x-1343 syntmp-ids-1344) (values (cons syntmp-x-1343 syntmp-y-1341) syntmp-ids-1344)))))) syntmp-tmp-1338) ((lambda (syntmp-tmp-1345) (if syntmp-tmp-1345 (apply (lambda () (values (quote ()) syntmp-ids-1329)) syntmp-tmp-1345) ((lambda (syntmp-tmp-1346) (if syntmp-tmp-1346 (apply (lambda (syntmp-x-1347) (call-with-values (lambda () (syntmp-cvt-1326 syntmp-x-1347 syntmp-n-1328 syntmp-ids-1329)) (lambda (syntmp-p-1349 syntmp-ids-1350) (values (vector (quote vector) syntmp-p-1349) syntmp-ids-1350)))) syntmp-tmp-1346) ((lambda (syntmp-x-1351) (values (vector (quote atom) (syntmp-strip-162 syntmp-p-1327 (quote (())))) syntmp-ids-1329)) syntmp-tmp-1330))) (syntax-dispatch syntmp-tmp-1330 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1330 (quote ()))))) (syntax-dispatch syntmp-tmp-1330 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1330 (quote (any any))))) syntmp-p-1327)))))) (lambda (syntmp-e-1352 syntmp-r-1353 syntmp-w-1354 syntmp-s-1355) (let ((syntmp-e-1356 (syntmp-source-wrap-144 syntmp-e-1352 syntmp-w-1354 syntmp-s-1355))) ((lambda (syntmp-tmp-1357) ((lambda (syntmp-tmp-1358) (if syntmp-tmp-1358 (apply (lambda (syntmp-_-1359 syntmp-val-1360 syntmp-key-1361 syntmp-m-1362) (if (andmap (lambda (syntmp-x-1363) (and (syntmp-id?-115 syntmp-x-1363) (not (syntmp-ellipsis?-160 syntmp-x-1363)))) syntmp-key-1361) (let ((syntmp-x-1365 (syntmp-gen-var-163 (quote tmp)))) (list (list (quote lambda) (list syntmp-x-1365) (syntmp-gen-syntax-case-1282 syntmp-x-1365 syntmp-key-1361 syntmp-m-1362 syntmp-r-1353)) (syntmp-chi-151 syntmp-val-1360 syntmp-r-1353 (quote (()))))) (syntax-error syntmp-e-1356 "invalid literals list in"))) syntmp-tmp-1358) (syntax-error syntmp-tmp-1357))) (syntax-dispatch syntmp-tmp-1357 (quote (any any each-any . each-any))))) syntmp-e-1356))))) (set! sc-expand (let ((syntmp-m-1368 (quote e)) (syntmp-esew-1369 (quote (eval)))) (lambda (syntmp-x-1370) (if (and (pair? syntmp-x-1370) (equal? (car syntmp-x-1370) syntmp-noexpand-84)) (cadr syntmp-x-1370) (syntmp-chi-top-150 syntmp-x-1370 (quote ()) (quote ((top))) syntmp-m-1368 syntmp-esew-1369))))) (set! sc-expand3 (let ((syntmp-m-1371 (quote e)) (syntmp-esew-1372 (quote (eval)))) (lambda (syntmp-x-1374 . syntmp-rest-1373) (if (and (pair? syntmp-x-1374) (equal? (car syntmp-x-1374) syntmp-noexpand-84)) (cadr syntmp-x-1374) (syntmp-chi-top-150 syntmp-x-1374 (quote ()) (quote ((top))) (if (null? syntmp-rest-1373) syntmp-m-1371 (car syntmp-rest-1373)) (if (or (null? syntmp-rest-1373) (null? (cdr syntmp-rest-1373))) syntmp-esew-1372 (cadr syntmp-rest-1373))))))) (set! identifier? (lambda (syntmp-x-1375) (syntmp-nonsymbol-id?-114 syntmp-x-1375))) (set! datum->syntax-object (lambda (syntmp-id-1376 syntmp-datum-1377) (syntmp-make-syntax-object-100 syntmp-datum-1377 (syntmp-syntax-object-wrap-103 syntmp-id-1376)))) (set! syntax-object->datum (lambda (syntmp-x-1378) (syntmp-strip-162 syntmp-x-1378 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1379) (begin (let ((syntmp-x-1380 syntmp-ls-1379)) (if (not (list? syntmp-x-1380)) (syntmp-error-hook-92 (quote generate-temporaries) "invalid argument" syntmp-x-1380))) (map (lambda (syntmp-x-1381) (syntmp-wrap-143 (gensym) (quote ((top))))) syntmp-ls-1379)))) (set! free-identifier=? (lambda (syntmp-x-1382 syntmp-y-1383) (begin (let ((syntmp-x-1384 syntmp-x-1382)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1384)) (syntmp-error-hook-92 (quote free-identifier=?) "invalid argument" syntmp-x-1384))) (let ((syntmp-x-1385 syntmp-y-1383)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1385)) (syntmp-error-hook-92 (quote free-identifier=?) "invalid argument" syntmp-x-1385))) (syntmp-free-id=?-138 syntmp-x-1382 syntmp-y-1383)))) (set! bound-identifier=? (lambda (syntmp-x-1386 syntmp-y-1387) (begin (let ((syntmp-x-1388 syntmp-x-1386)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1388)) (syntmp-error-hook-92 (quote bound-identifier=?) "invalid argument" syntmp-x-1388))) (let ((syntmp-x-1389 syntmp-y-1387)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1389)) (syntmp-error-hook-92 (quote bound-identifier=?) "invalid argument" syntmp-x-1389))) (syntmp-bound-id=?-139 syntmp-x-1386 syntmp-y-1387)))) (set! syntax-error (lambda (syntmp-object-1391 . syntmp-messages-1390) (begin (for-each (lambda (syntmp-x-1392) (let ((syntmp-x-1393 syntmp-x-1392)) (if (not (string? syntmp-x-1393)) (syntmp-error-hook-92 (quote syntax-error) "invalid argument" syntmp-x-1393)))) syntmp-messages-1390) (let ((syntmp-message-1394 (if (null? syntmp-messages-1390) "invalid syntax" (apply string-append syntmp-messages-1390)))) (syntmp-error-hook-92 #f syntmp-message-1394 (syntmp-strip-162 syntmp-object-1391 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1395 syntmp-v-1396) (begin (let ((syntmp-x-1397 syntmp-sym-1395)) (if (not (symbol? syntmp-x-1397)) (syntmp-error-hook-92 (quote define-syntax) "invalid argument" syntmp-x-1397))) (let ((syntmp-x-1398 syntmp-v-1396)) (if (not (procedure? syntmp-x-1398)) (syntmp-error-hook-92 (quote define-syntax) "invalid argument" syntmp-x-1398))) (syntmp-global-extend-113 (quote macro) syntmp-sym-1395 syntmp-v-1396)))) (letrec ((syntmp-match-1403 (lambda (syntmp-e-1404 syntmp-p-1405 syntmp-w-1406 syntmp-r-1407) (cond ((not syntmp-r-1407) #f) ((eq? syntmp-p-1405 (quote any)) (cons (syntmp-wrap-143 syntmp-e-1404 syntmp-w-1406) syntmp-r-1407)) ((syntmp-syntax-object?-101 syntmp-e-1404) (syntmp-match*-1402 (let ((syntmp-e-1408 (syntmp-syntax-object-expression-102 syntmp-e-1404))) (if (syntmp-annotation?-89 syntmp-e-1408) (annotation-expression syntmp-e-1408) syntmp-e-1408)) syntmp-p-1405 (syntmp-join-wraps-134 syntmp-w-1406 (syntmp-syntax-object-wrap-103 syntmp-e-1404)) syntmp-r-1407)) (else (syntmp-match*-1402 (let ((syntmp-e-1409 syntmp-e-1404)) (if (syntmp-annotation?-89 syntmp-e-1409) (annotation-expression syntmp-e-1409) syntmp-e-1409)) syntmp-p-1405 syntmp-w-1406 syntmp-r-1407))))) (syntmp-match*-1402 (lambda (syntmp-e-1410 syntmp-p-1411 syntmp-w-1412 syntmp-r-1413) (cond ((null? syntmp-p-1411) (and (null? syntmp-e-1410) syntmp-r-1413)) ((pair? syntmp-p-1411) (and (pair? syntmp-e-1410) (syntmp-match-1403 (car syntmp-e-1410) (car syntmp-p-1411) syntmp-w-1412 (syntmp-match-1403 (cdr syntmp-e-1410) (cdr syntmp-p-1411) syntmp-w-1412 syntmp-r-1413)))) ((eq? syntmp-p-1411 (quote each-any)) (let ((syntmp-l-1414 (syntmp-match-each-any-1400 syntmp-e-1410 syntmp-w-1412))) (and syntmp-l-1414 (cons syntmp-l-1414 syntmp-r-1413)))) (else (let ((syntmp-t-1415 (vector-ref syntmp-p-1411 0))) (if (memv syntmp-t-1415 (quote (each))) (if (null? syntmp-e-1410) (syntmp-match-empty-1401 (vector-ref syntmp-p-1411 1) syntmp-r-1413) (let ((syntmp-l-1416 (syntmp-match-each-1399 syntmp-e-1410 (vector-ref syntmp-p-1411 1) syntmp-w-1412))) (and syntmp-l-1416 (let syntmp-collect-1417 ((syntmp-l-1418 syntmp-l-1416)) (if (null? (car syntmp-l-1418)) syntmp-r-1413 (cons (map car syntmp-l-1418) (syntmp-collect-1417 (map cdr syntmp-l-1418)))))))) (if (memv syntmp-t-1415 (quote (free-id))) (and (syntmp-id?-115 syntmp-e-1410) (syntmp-free-id=?-138 (syntmp-wrap-143 syntmp-e-1410 syntmp-w-1412) (vector-ref syntmp-p-1411 1)) syntmp-r-1413) (if (memv syntmp-t-1415 (quote (atom))) (and (equal? (vector-ref syntmp-p-1411 1) (syntmp-strip-162 syntmp-e-1410 syntmp-w-1412)) syntmp-r-1413) (if (memv syntmp-t-1415 (quote (vector))) (and (vector? syntmp-e-1410) (syntmp-match-1403 (vector->list syntmp-e-1410) (vector-ref syntmp-p-1411 1) syntmp-w-1412 syntmp-r-1413))))))))))) (syntmp-match-empty-1401 (lambda (syntmp-p-1419 syntmp-r-1420) (cond ((null? syntmp-p-1419) syntmp-r-1420) ((eq? syntmp-p-1419 (quote any)) (cons (quote ()) syntmp-r-1420)) ((pair? syntmp-p-1419) (syntmp-match-empty-1401 (car syntmp-p-1419) (syntmp-match-empty-1401 (cdr syntmp-p-1419) syntmp-r-1420))) ((eq? syntmp-p-1419 (quote each-any)) (cons (quote ()) syntmp-r-1420)) (else (let ((syntmp-t-1421 (vector-ref syntmp-p-1419 0))) (if (memv syntmp-t-1421 (quote (each))) (syntmp-match-empty-1401 (vector-ref syntmp-p-1419 1) syntmp-r-1420) (if (memv syntmp-t-1421 (quote (free-id atom))) syntmp-r-1420 (if (memv syntmp-t-1421 (quote (vector))) (syntmp-match-empty-1401 (vector-ref syntmp-p-1419 1) syntmp-r-1420))))))))) (syntmp-match-each-any-1400 (lambda (syntmp-e-1422 syntmp-w-1423) (cond ((syntmp-annotation?-89 syntmp-e-1422) (syntmp-match-each-any-1400 (annotation-expression syntmp-e-1422) syntmp-w-1423)) ((pair? syntmp-e-1422) (let ((syntmp-l-1424 (syntmp-match-each-any-1400 (cdr syntmp-e-1422) syntmp-w-1423))) (and syntmp-l-1424 (cons (syntmp-wrap-143 (car syntmp-e-1422) syntmp-w-1423) syntmp-l-1424)))) ((null? syntmp-e-1422) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1422) (syntmp-match-each-any-1400 (syntmp-syntax-object-expression-102 syntmp-e-1422) (syntmp-join-wraps-134 syntmp-w-1423 (syntmp-syntax-object-wrap-103 syntmp-e-1422)))) (else #f)))) (syntmp-match-each-1399 (lambda (syntmp-e-1425 syntmp-p-1426 syntmp-w-1427) (cond ((syntmp-annotation?-89 syntmp-e-1425) (syntmp-match-each-1399 (annotation-expression syntmp-e-1425) syntmp-p-1426 syntmp-w-1427)) ((pair? syntmp-e-1425) (let ((syntmp-first-1428 (syntmp-match-1403 (car syntmp-e-1425) syntmp-p-1426 syntmp-w-1427 (quote ())))) (and syntmp-first-1428 (let ((syntmp-rest-1429 (syntmp-match-each-1399 (cdr syntmp-e-1425) syntmp-p-1426 syntmp-w-1427))) (and syntmp-rest-1429 (cons syntmp-first-1428 syntmp-rest-1429)))))) ((null? syntmp-e-1425) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1425) (syntmp-match-each-1399 (syntmp-syntax-object-expression-102 syntmp-e-1425) syntmp-p-1426 (syntmp-join-wraps-134 syntmp-w-1427 (syntmp-syntax-object-wrap-103 syntmp-e-1425)))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1430 syntmp-p-1431) (cond ((eq? syntmp-p-1431 (quote any)) (list syntmp-e-1430)) ((syntmp-syntax-object?-101 syntmp-e-1430) (syntmp-match*-1402 (let ((syntmp-e-1432 (syntmp-syntax-object-expression-102 syntmp-e-1430))) (if (syntmp-annotation?-89 syntmp-e-1432) (annotation-expression syntmp-e-1432) syntmp-e-1432)) syntmp-p-1431 (syntmp-syntax-object-wrap-103 syntmp-e-1430) (quote ()))) (else (syntmp-match*-1402 (let ((syntmp-e-1433 syntmp-e-1430)) (if (syntmp-annotation?-89 syntmp-e-1433) (annotation-expression syntmp-e-1433) syntmp-e-1433)) syntmp-p-1431 (quote (())) (quote ())))))) (set! sc-chi syntmp-chi-151))))) -(install-global-transformer (quote with-syntax) (lambda (syntmp-x-1434) ((lambda (syntmp-tmp-1435) ((lambda (syntmp-tmp-1436) (if syntmp-tmp-1436 (apply (lambda (syntmp-_-1437 syntmp-e1-1438 syntmp-e2-1439) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1438 syntmp-e2-1439))) syntmp-tmp-1436) ((lambda (syntmp-tmp-1441) (if syntmp-tmp-1441 (apply (lambda (syntmp-_-1442 syntmp-out-1443 syntmp-in-1444 syntmp-e1-1445 syntmp-e2-1446) (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-1444 (quote ()) (list syntmp-out-1443 (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-1445 syntmp-e2-1446))))) syntmp-tmp-1441) ((lambda (syntmp-tmp-1448) (if syntmp-tmp-1448 (apply (lambda (syntmp-_-1449 syntmp-out-1450 syntmp-in-1451 syntmp-e1-1452 syntmp-e2-1453) (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-1451) (quote ()) (list syntmp-out-1450 (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-1452 syntmp-e2-1453))))) syntmp-tmp-1448) (syntax-error syntmp-tmp-1435))) (syntax-dispatch syntmp-tmp-1435 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1435 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1435 (quote (any () any . each-any))))) syntmp-x-1434))) -(install-global-transformer (quote syntax-rules) (lambda (syntmp-x-1475) ((lambda (syntmp-tmp-1476) ((lambda (syntmp-tmp-1477) (if syntmp-tmp-1477 (apply (lambda (syntmp-_-1478 syntmp-k-1479 syntmp-keyword-1480 syntmp-pattern-1481 syntmp-template-1482) (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-1479 (map (lambda (syntmp-tmp-1485 syntmp-tmp-1484) (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-1484) (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-1485))) syntmp-template-1482 syntmp-pattern-1481)))))) syntmp-tmp-1477) (syntax-error syntmp-tmp-1476))) (syntax-dispatch syntmp-tmp-1476 (quote (any each-any . #(each ((any . any) any))))))) syntmp-x-1475))) -(install-global-transformer (quote let*) (lambda (syntmp-x-1496) ((lambda (syntmp-tmp-1497) ((lambda (syntmp-tmp-1498) (if (if syntmp-tmp-1498 (apply (lambda (syntmp-let*-1499 syntmp-x-1500 syntmp-v-1501 syntmp-e1-1502 syntmp-e2-1503) (andmap identifier? syntmp-x-1500)) syntmp-tmp-1498) #f) (apply (lambda (syntmp-let*-1505 syntmp-x-1506 syntmp-v-1507 syntmp-e1-1508 syntmp-e2-1509) (let syntmp-f-1510 ((syntmp-bindings-1511 (map list syntmp-x-1506 syntmp-v-1507))) (if (null? syntmp-bindings-1511) (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-1508 syntmp-e2-1509))) ((lambda (syntmp-tmp-1515) ((lambda (syntmp-tmp-1516) (if syntmp-tmp-1516 (apply (lambda (syntmp-body-1517 syntmp-binding-1518) (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-1518) syntmp-body-1517)) syntmp-tmp-1516) (syntax-error syntmp-tmp-1515))) (syntax-dispatch syntmp-tmp-1515 (quote (any any))))) (list (syntmp-f-1510 (cdr syntmp-bindings-1511)) (car syntmp-bindings-1511)))))) syntmp-tmp-1498) (syntax-error syntmp-tmp-1497))) (syntax-dispatch syntmp-tmp-1497 (quote (any #(each (any any)) any . each-any))))) syntmp-x-1496))) -(install-global-transformer (quote do) (lambda (syntmp-orig-x-1538) ((lambda (syntmp-tmp-1539) ((lambda (syntmp-tmp-1540) (if syntmp-tmp-1540 (apply (lambda (syntmp-_-1541 syntmp-var-1542 syntmp-init-1543 syntmp-step-1544 syntmp-e0-1545 syntmp-e1-1546 syntmp-c-1547) ((lambda (syntmp-tmp-1548) ((lambda (syntmp-tmp-1549) (if syntmp-tmp-1549 (apply (lambda (syntmp-step-1550) ((lambda (syntmp-tmp-1551) ((lambda (syntmp-tmp-1552) (if syntmp-tmp-1552 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (map list syntmp-var-1542 syntmp-init-1543) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-e0-1545) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (append syntmp-c-1547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-step-1550))))))) syntmp-tmp-1552) ((lambda (syntmp-tmp-1557) (if syntmp-tmp-1557 (apply (lambda (syntmp-e1-1558 syntmp-e2-1559) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (map list syntmp-var-1542 syntmp-init-1543) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-e0-1545 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (cons syntmp-e1-1558 syntmp-e2-1559)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (append syntmp-c-1547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-step-1550))))))) syntmp-tmp-1557) (syntax-error syntmp-tmp-1551))) (syntax-dispatch syntmp-tmp-1551 (quote (any . each-any)))))) (syntax-dispatch syntmp-tmp-1551 (quote ())))) syntmp-e1-1546)) syntmp-tmp-1549) (syntax-error syntmp-tmp-1548))) (syntax-dispatch syntmp-tmp-1548 (quote each-any)))) (map (lambda (syntmp-v-1566 syntmp-s-1567) ((lambda (syntmp-tmp-1568) ((lambda (syntmp-tmp-1569) (if syntmp-tmp-1569 (apply (lambda () syntmp-v-1566) syntmp-tmp-1569) ((lambda (syntmp-tmp-1570) (if syntmp-tmp-1570 (apply (lambda (syntmp-e-1571) syntmp-e-1571) syntmp-tmp-1570) ((lambda (syntmp-_-1572) (syntax-error syntmp-orig-x-1538)) syntmp-tmp-1568))) (syntax-dispatch syntmp-tmp-1568 (quote (any)))))) (syntax-dispatch syntmp-tmp-1568 (quote ())))) syntmp-s-1567)) syntmp-var-1542 syntmp-step-1544))) syntmp-tmp-1540) (syntax-error syntmp-tmp-1539))) (syntax-dispatch syntmp-tmp-1539 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) syntmp-orig-x-1538))) -(install-global-transformer (quote quasiquote) (letrec ((syntmp-quasicons-1600 (lambda (syntmp-x-1604 syntmp-y-1605) ((lambda (syntmp-tmp-1606) ((lambda (syntmp-tmp-1607) (if syntmp-tmp-1607 (apply (lambda (syntmp-x-1608 syntmp-y-1609) ((lambda (syntmp-tmp-1610) ((lambda (syntmp-tmp-1611) (if syntmp-tmp-1611 (apply (lambda (syntmp-dy-1612) ((lambda (syntmp-tmp-1613) ((lambda (syntmp-tmp-1614) (if syntmp-tmp-1614 (apply (lambda (syntmp-dx-1615) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons syntmp-dx-1615 syntmp-dy-1612))) syntmp-tmp-1614) ((lambda (syntmp-_-1616) (if (null? syntmp-dy-1612) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1608) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1608 syntmp-y-1609))) syntmp-tmp-1613))) (syntax-dispatch syntmp-tmp-1613 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-x-1608)) syntmp-tmp-1611) ((lambda (syntmp-tmp-1617) (if syntmp-tmp-1617 (apply (lambda (syntmp-stuff-1618) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons syntmp-x-1608 syntmp-stuff-1618))) syntmp-tmp-1617) ((lambda (syntmp-else-1619) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1608 syntmp-y-1609)) syntmp-tmp-1610))) (syntax-dispatch syntmp-tmp-1610 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . any)))))) (syntax-dispatch syntmp-tmp-1610 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-y-1609)) syntmp-tmp-1607) (syntax-error syntmp-tmp-1606))) (syntax-dispatch syntmp-tmp-1606 (quote (any any))))) (list syntmp-x-1604 syntmp-y-1605)))) (syntmp-quasiappend-1601 (lambda (syntmp-x-1620 syntmp-y-1621) ((lambda (syntmp-tmp-1622) ((lambda (syntmp-tmp-1623) (if syntmp-tmp-1623 (apply (lambda (syntmp-x-1624 syntmp-y-1625) ((lambda (syntmp-tmp-1626) ((lambda (syntmp-tmp-1627) (if syntmp-tmp-1627 (apply (lambda () syntmp-x-1624) syntmp-tmp-1627) ((lambda (syntmp-_-1628) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1624 syntmp-y-1625)) syntmp-tmp-1626))) (syntax-dispatch syntmp-tmp-1626 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) ()))))) syntmp-y-1625)) syntmp-tmp-1623) (syntax-error syntmp-tmp-1622))) (syntax-dispatch syntmp-tmp-1622 (quote (any any))))) (list syntmp-x-1620 syntmp-y-1621)))) (syntmp-quasivector-1602 (lambda (syntmp-x-1629) ((lambda (syntmp-tmp-1630) ((lambda (syntmp-x-1631) ((lambda (syntmp-tmp-1632) ((lambda (syntmp-tmp-1633) (if syntmp-tmp-1633 (apply (lambda (syntmp-x-1634) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (list->vector syntmp-x-1634))) syntmp-tmp-1633) ((lambda (syntmp-tmp-1636) (if syntmp-tmp-1636 (apply (lambda (syntmp-x-1637) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1637)) syntmp-tmp-1636) ((lambda (syntmp-_-1639) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1631)) syntmp-tmp-1632))) (syntax-dispatch syntmp-tmp-1632 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . each-any)))))) (syntax-dispatch syntmp-tmp-1632 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) each-any))))) syntmp-x-1631)) syntmp-tmp-1630)) syntmp-x-1629))) (syntmp-quasi-1603 (lambda (syntmp-p-1640 syntmp-lev-1641) ((lambda (syntmp-tmp-1642) ((lambda (syntmp-tmp-1643) (if syntmp-tmp-1643 (apply (lambda (syntmp-p-1644) (if (= syntmp-lev-1641 0) syntmp-p-1644 (syntmp-quasicons-1600 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1603 (list syntmp-p-1644) (- syntmp-lev-1641 1))))) syntmp-tmp-1643) ((lambda (syntmp-tmp-1645) (if syntmp-tmp-1645 (apply (lambda (syntmp-p-1646 syntmp-q-1647) (if (= syntmp-lev-1641 0) (syntmp-quasiappend-1601 syntmp-p-1646 (syntmp-quasi-1603 syntmp-q-1647 syntmp-lev-1641)) (syntmp-quasicons-1600 (syntmp-quasicons-1600 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1603 (list syntmp-p-1646) (- syntmp-lev-1641 1))) (syntmp-quasi-1603 syntmp-q-1647 syntmp-lev-1641)))) syntmp-tmp-1645) ((lambda (syntmp-tmp-1648) (if syntmp-tmp-1648 (apply (lambda (syntmp-p-1649) (syntmp-quasicons-1600 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1603 (list syntmp-p-1649) (+ syntmp-lev-1641 1)))) syntmp-tmp-1648) ((lambda (syntmp-tmp-1650) (if syntmp-tmp-1650 (apply (lambda (syntmp-p-1651 syntmp-q-1652) (syntmp-quasicons-1600 (syntmp-quasi-1603 syntmp-p-1651 syntmp-lev-1641) (syntmp-quasi-1603 syntmp-q-1652 syntmp-lev-1641))) syntmp-tmp-1650) ((lambda (syntmp-tmp-1653) (if syntmp-tmp-1653 (apply (lambda (syntmp-x-1654) (syntmp-quasivector-1602 (syntmp-quasi-1603 syntmp-x-1654 syntmp-lev-1641))) syntmp-tmp-1653) ((lambda (syntmp-p-1656) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-p-1656)) syntmp-tmp-1642))) (syntax-dispatch syntmp-tmp-1642 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1642 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1642 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any)))))) (syntax-dispatch syntmp-tmp-1642 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any) . any)))))) (syntax-dispatch syntmp-tmp-1642 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-p-1640)))) (lambda (syntmp-x-1657) ((lambda (syntmp-tmp-1658) ((lambda (syntmp-tmp-1659) (if syntmp-tmp-1659 (apply (lambda (syntmp-_-1660 syntmp-e-1661) (syntmp-quasi-1603 syntmp-e-1661 0)) syntmp-tmp-1659) (syntax-error syntmp-tmp-1658))) (syntax-dispatch syntmp-tmp-1658 (quote (any any))))) syntmp-x-1657)))) -(install-global-transformer (quote include) (lambda (syntmp-x-1721) (letrec ((syntmp-read-file-1722 (lambda (syntmp-fn-1723 syntmp-k-1724) (let ((syntmp-p-1725 (open-input-file syntmp-fn-1723))) (let syntmp-f-1726 ((syntmp-x-1727 (read syntmp-p-1725))) (if (eof-object? syntmp-x-1727) (begin (close-input-port syntmp-p-1725) (quote ())) (cons (datum->syntax-object syntmp-k-1724 syntmp-x-1727) (syntmp-f-1726 (read syntmp-p-1725))))))))) ((lambda (syntmp-tmp-1728) ((lambda (syntmp-tmp-1729) (if syntmp-tmp-1729 (apply (lambda (syntmp-k-1730 syntmp-filename-1731) (let ((syntmp-fn-1732 (syntax-object->datum syntmp-filename-1731))) ((lambda (syntmp-tmp-1733) ((lambda (syntmp-tmp-1734) (if syntmp-tmp-1734 (apply (lambda (syntmp-exp-1735) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))))) syntmp-exp-1735)) syntmp-tmp-1734) (syntax-error syntmp-tmp-1733))) (syntax-dispatch syntmp-tmp-1733 (quote each-any)))) (syntmp-read-file-1722 syntmp-fn-1732 syntmp-k-1730)))) syntmp-tmp-1729) (syntax-error syntmp-tmp-1728))) (syntax-dispatch syntmp-tmp-1728 (quote (any any))))) syntmp-x-1721)))) -(install-global-transformer (quote unquote) (lambda (syntmp-x-1752) ((lambda (syntmp-tmp-1753) ((lambda (syntmp-tmp-1754) (if syntmp-tmp-1754 (apply (lambda (syntmp-_-1755 syntmp-e-1756) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1756))) syntmp-tmp-1754) (syntax-error syntmp-tmp-1753))) (syntax-dispatch syntmp-tmp-1753 (quote (any any))))) syntmp-x-1752))) -(install-global-transformer (quote unquote-splicing) (lambda (syntmp-x-1762) ((lambda (syntmp-tmp-1763) ((lambda (syntmp-tmp-1764) (if syntmp-tmp-1764 (apply (lambda (syntmp-_-1765 syntmp-e-1766) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1766))) syntmp-tmp-1764) (syntax-error syntmp-tmp-1763))) (syntax-dispatch syntmp-tmp-1763 (quote (any any))))) syntmp-x-1762))) -(install-global-transformer (quote case) (lambda (syntmp-x-1772) ((lambda (syntmp-tmp-1773) ((lambda (syntmp-tmp-1774) (if syntmp-tmp-1774 (apply (lambda (syntmp-_-1775 syntmp-e-1776 syntmp-m1-1777 syntmp-m2-1778) ((lambda (syntmp-tmp-1779) ((lambda (syntmp-body-1780) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-e-1776)) syntmp-body-1780)) syntmp-tmp-1779)) (let syntmp-f-1781 ((syntmp-clause-1782 syntmp-m1-1777) (syntmp-clauses-1783 syntmp-m2-1778)) (if (null? syntmp-clauses-1783) ((lambda (syntmp-tmp-1785) ((lambda (syntmp-tmp-1786) (if syntmp-tmp-1786 (apply (lambda (syntmp-e1-1787 syntmp-e2-1788) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1787 syntmp-e2-1788))) syntmp-tmp-1786) ((lambda (syntmp-tmp-1790) (if syntmp-tmp-1790 (apply (lambda (syntmp-k-1791 syntmp-e1-1792 syntmp-e2-1793) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-k-1791)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1792 syntmp-e2-1793)))) syntmp-tmp-1790) ((lambda (syntmp-_-1796) (syntax-error syntmp-x-1772)) syntmp-tmp-1785))) (syntax-dispatch syntmp-tmp-1785 (quote (each-any any . each-any)))))) (syntax-dispatch syntmp-tmp-1785 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) any . each-any))))) syntmp-clause-1782) ((lambda (syntmp-tmp-1797) ((lambda (syntmp-rest-1798) ((lambda (syntmp-tmp-1799) ((lambda (syntmp-tmp-1800) (if syntmp-tmp-1800 (apply (lambda (syntmp-k-1801 syntmp-e1-1802 syntmp-e2-1803) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-k-1801)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1802 syntmp-e2-1803)) syntmp-rest-1798)) syntmp-tmp-1800) ((lambda (syntmp-_-1806) (syntax-error syntmp-x-1772)) syntmp-tmp-1799))) (syntax-dispatch syntmp-tmp-1799 (quote (each-any any . each-any))))) syntmp-clause-1782)) syntmp-tmp-1797)) (syntmp-f-1781 (car syntmp-clauses-1783) (cdr syntmp-clauses-1783))))))) syntmp-tmp-1774) (syntax-error syntmp-tmp-1773))) (syntax-dispatch syntmp-tmp-1773 (quote (any any any . each-any))))) syntmp-x-1772))) -(install-global-transformer (quote identifier-syntax) (lambda (syntmp-x-1836) ((lambda (syntmp-tmp-1837) ((lambda (syntmp-tmp-1838) (if syntmp-tmp-1838 (apply (lambda (syntmp-_-1839 syntmp-e-1840) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-e-1840)) (list (cons syntmp-_-1839 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e-1840 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))))))))) syntmp-tmp-1838) (syntax-error syntmp-tmp-1837))) (syntax-dispatch syntmp-tmp-1837 (quote (any any))))) syntmp-x-1836))) +(letrec ((syntmp-lambda-var-list-163 (lambda (syntmp-vars-548) (let syntmp-lvl-549 ((syntmp-vars-550 syntmp-vars-548) (syntmp-ls-551 (quote ())) (syntmp-w-552 (quote (())))) (cond ((pair? syntmp-vars-550) (syntmp-lvl-549 (cdr syntmp-vars-550) (cons (syntmp-wrap-142 (car syntmp-vars-550) syntmp-w-552) syntmp-ls-551) syntmp-w-552)) ((syntmp-id?-114 syntmp-vars-550) (cons (syntmp-wrap-142 syntmp-vars-550 syntmp-w-552) syntmp-ls-551)) ((null? syntmp-vars-550) syntmp-ls-551) ((syntmp-syntax-object?-100 syntmp-vars-550) (syntmp-lvl-549 (syntmp-syntax-object-expression-101 syntmp-vars-550) syntmp-ls-551 (syntmp-join-wraps-133 syntmp-w-552 (syntmp-syntax-object-wrap-102 syntmp-vars-550)))) ((annotation? syntmp-vars-550) (syntmp-lvl-549 (annotation-expression syntmp-vars-550) syntmp-ls-551 syntmp-w-552)) (else (cons syntmp-vars-550 syntmp-ls-551)))))) (syntmp-gen-var-162 (lambda (syntmp-id-553) (let ((syntmp-id-554 (if (syntmp-syntax-object?-100 syntmp-id-553) (syntmp-syntax-object-expression-101 syntmp-id-553) syntmp-id-553))) (if (annotation? syntmp-id-554) (gensym (symbol->string (annotation-expression syntmp-id-554))) (gensym (symbol->string syntmp-id-554)))))) (syntmp-strip-161 (lambda (syntmp-x-555 syntmp-w-556) (if (memq (quote top) (syntmp-wrap-marks-117 syntmp-w-556)) (if (or (annotation? syntmp-x-555) (and (pair? syntmp-x-555) (annotation? (car syntmp-x-555)))) (syntmp-strip-annotation-160 syntmp-x-555 #f) syntmp-x-555) (let syntmp-f-557 ((syntmp-x-558 syntmp-x-555)) (cond ((syntmp-syntax-object?-100 syntmp-x-558) (syntmp-strip-161 (syntmp-syntax-object-expression-101 syntmp-x-558) (syntmp-syntax-object-wrap-102 syntmp-x-558))) ((pair? syntmp-x-558) (let ((syntmp-a-559 (syntmp-f-557 (car syntmp-x-558))) (syntmp-d-560 (syntmp-f-557 (cdr syntmp-x-558)))) (if (and (eq? syntmp-a-559 (car syntmp-x-558)) (eq? syntmp-d-560 (cdr syntmp-x-558))) syntmp-x-558 (cons syntmp-a-559 syntmp-d-560)))) ((vector? syntmp-x-558) (let ((syntmp-old-561 (vector->list syntmp-x-558))) (let ((syntmp-new-562 (map syntmp-f-557 syntmp-old-561))) (if (andmap eq? syntmp-old-561 syntmp-new-562) syntmp-x-558 (list->vector syntmp-new-562))))) (else syntmp-x-558)))))) (syntmp-strip-annotation-160 (lambda (syntmp-x-563 syntmp-parent-564) (cond ((pair? syntmp-x-563) (let ((syntmp-new-565 (cons #f #f))) (begin (when syntmp-parent-564 (set-annotation-stripped! syntmp-parent-564 syntmp-new-565)) (set-car! syntmp-new-565 (syntmp-strip-annotation-160 (car syntmp-x-563) #f)) (set-cdr! syntmp-new-565 (syntmp-strip-annotation-160 (cdr syntmp-x-563) #f)) syntmp-new-565))) ((annotation? syntmp-x-563) (or (annotation-stripped syntmp-x-563) (syntmp-strip-annotation-160 (annotation-expression syntmp-x-563) syntmp-x-563))) ((vector? syntmp-x-563) (let ((syntmp-new-566 (make-vector (vector-length syntmp-x-563)))) (begin (when syntmp-parent-564 (set-annotation-stripped! syntmp-parent-564 syntmp-new-566)) (let syntmp-loop-567 ((syntmp-i-568 (- (vector-length syntmp-x-563) 1))) (unless (syntmp-fx<-88 syntmp-i-568 0) (vector-set! syntmp-new-566 syntmp-i-568 (syntmp-strip-annotation-160 (vector-ref syntmp-x-563 syntmp-i-568) #f)) (syntmp-loop-567 (syntmp-fx--86 syntmp-i-568 1)))) syntmp-new-566))) (else syntmp-x-563)))) (syntmp-ellipsis?-159 (lambda (syntmp-x-569) (and (syntmp-nonsymbol-id?-113 syntmp-x-569) (syntmp-free-id=?-137 syntmp-x-569 (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 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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-158 (lambda () (list (quote void)))) (syntmp-eval-local-transformer-157 (lambda (syntmp-expanded-570) (let ((syntmp-p-571 (syntmp-local-eval-hook-90 syntmp-expanded-570))) (if (procedure? syntmp-p-571) syntmp-p-571 (syntax-error syntmp-p-571 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-156 (lambda (syntmp-rec?-572 syntmp-e-573 syntmp-r-574 syntmp-w-575 syntmp-s-576 syntmp-k-577) ((lambda (syntmp-tmp-578) ((lambda (syntmp-tmp-579) (if syntmp-tmp-579 (apply (lambda (syntmp-_-580 syntmp-id-581 syntmp-val-582 syntmp-e1-583 syntmp-e2-584) (let ((syntmp-ids-585 syntmp-id-581)) (if (not (syntmp-valid-bound-ids?-139 syntmp-ids-585)) (syntax-error syntmp-e-573 "duplicate bound keyword in") (let ((syntmp-labels-587 (syntmp-gen-labels-120 syntmp-ids-585))) (let ((syntmp-new-w-588 (syntmp-make-binding-wrap-131 syntmp-ids-585 syntmp-labels-587 syntmp-w-575))) (syntmp-k-577 (cons syntmp-e1-583 syntmp-e2-584) (syntmp-extend-env-108 syntmp-labels-587 (let ((syntmp-w-590 (if syntmp-rec?-572 syntmp-new-w-588 syntmp-w-575)) (syntmp-trans-r-591 (syntmp-macros-only-env-110 syntmp-r-574))) (map (lambda (syntmp-x-592) (cons (quote macro) (syntmp-eval-local-transformer-157 (syntmp-chi-150 syntmp-x-592 syntmp-trans-r-591 syntmp-w-590)))) syntmp-val-582)) syntmp-r-574) syntmp-new-w-588 syntmp-s-576)))))) syntmp-tmp-579) ((lambda (syntmp-_-594) (syntax-error (syntmp-source-wrap-143 syntmp-e-573 syntmp-w-575 syntmp-s-576))) syntmp-tmp-578))) (syntax-dispatch syntmp-tmp-578 (quote (any #(each (any any)) any . each-any))))) syntmp-e-573))) (syntmp-chi-lambda-clause-155 (lambda (syntmp-e-595 syntmp-c-596 syntmp-r-597 syntmp-w-598 syntmp-k-599) ((lambda (syntmp-tmp-600) ((lambda (syntmp-tmp-601) (if syntmp-tmp-601 (apply (lambda (syntmp-id-602 syntmp-e1-603 syntmp-e2-604) (let ((syntmp-ids-605 syntmp-id-602)) (if (not (syntmp-valid-bound-ids?-139 syntmp-ids-605)) (syntax-error syntmp-e-595 "invalid parameter list in") (let ((syntmp-labels-607 (syntmp-gen-labels-120 syntmp-ids-605)) (syntmp-new-vars-608 (map syntmp-gen-var-162 syntmp-ids-605))) (syntmp-k-599 syntmp-new-vars-608 (syntmp-chi-body-154 (cons syntmp-e1-603 syntmp-e2-604) syntmp-e-595 (syntmp-extend-var-env-109 syntmp-labels-607 syntmp-new-vars-608 syntmp-r-597) (syntmp-make-binding-wrap-131 syntmp-ids-605 syntmp-labels-607 syntmp-w-598))))))) syntmp-tmp-601) ((lambda (syntmp-tmp-610) (if syntmp-tmp-610 (apply (lambda (syntmp-ids-611 syntmp-e1-612 syntmp-e2-613) (let ((syntmp-old-ids-614 (syntmp-lambda-var-list-163 syntmp-ids-611))) (if (not (syntmp-valid-bound-ids?-139 syntmp-old-ids-614)) (syntax-error syntmp-e-595 "invalid parameter list in") (let ((syntmp-labels-615 (syntmp-gen-labels-120 syntmp-old-ids-614)) (syntmp-new-vars-616 (map syntmp-gen-var-162 syntmp-old-ids-614))) (syntmp-k-599 (let syntmp-f-617 ((syntmp-ls1-618 (cdr syntmp-new-vars-616)) (syntmp-ls2-619 (car syntmp-new-vars-616))) (if (null? syntmp-ls1-618) syntmp-ls2-619 (syntmp-f-617 (cdr syntmp-ls1-618) (cons (car syntmp-ls1-618) syntmp-ls2-619)))) (syntmp-chi-body-154 (cons syntmp-e1-612 syntmp-e2-613) syntmp-e-595 (syntmp-extend-var-env-109 syntmp-labels-615 syntmp-new-vars-616 syntmp-r-597) (syntmp-make-binding-wrap-131 syntmp-old-ids-614 syntmp-labels-615 syntmp-w-598))))))) syntmp-tmp-610) ((lambda (syntmp-_-621) (syntax-error syntmp-e-595)) syntmp-tmp-600))) (syntax-dispatch syntmp-tmp-600 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-600 (quote (each-any any . each-any))))) syntmp-c-596))) (syntmp-chi-body-154 (lambda (syntmp-body-622 syntmp-outer-form-623 syntmp-r-624 syntmp-w-625) (let ((syntmp-r-626 (cons (quote ("placeholder" placeholder)) syntmp-r-624))) (let ((syntmp-ribcage-627 (syntmp-make-ribcage-121 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-628 (syntmp-make-wrap-116 (syntmp-wrap-marks-117 syntmp-w-625) (cons syntmp-ribcage-627 (syntmp-wrap-subst-118 syntmp-w-625))))) (let syntmp-parse-629 ((syntmp-body-630 (map (lambda (syntmp-x-636) (cons syntmp-r-626 (syntmp-wrap-142 syntmp-x-636 syntmp-w-628))) syntmp-body-622)) (syntmp-ids-631 (quote ())) (syntmp-labels-632 (quote ())) (syntmp-vars-633 (quote ())) (syntmp-vals-634 (quote ())) (syntmp-bindings-635 (quote ()))) (if (null? syntmp-body-630) (syntax-error syntmp-outer-form-623 "no expressions in body") (let ((syntmp-e-637 (cdar syntmp-body-630)) (syntmp-er-638 (caar syntmp-body-630))) (call-with-values (lambda () (syntmp-syntax-type-148 syntmp-e-637 syntmp-er-638 (quote (())) #f syntmp-ribcage-627)) (lambda (syntmp-type-639 syntmp-value-640 syntmp-e-641 syntmp-w-642 syntmp-s-643) (let ((syntmp-t-644 syntmp-type-639)) (if (memv syntmp-t-644 (quote (define-form))) (let ((syntmp-id-645 (syntmp-wrap-142 syntmp-value-640 syntmp-w-642)) (syntmp-label-646 (syntmp-gen-label-119))) (let ((syntmp-var-647 (syntmp-gen-var-162 syntmp-id-645))) (begin (syntmp-extend-ribcage!-130 syntmp-ribcage-627 syntmp-id-645 syntmp-label-646) (syntmp-parse-629 (cdr syntmp-body-630) (cons syntmp-id-645 syntmp-ids-631) (cons syntmp-label-646 syntmp-labels-632) (cons syntmp-var-647 syntmp-vars-633) (cons (cons syntmp-er-638 (syntmp-wrap-142 syntmp-e-641 syntmp-w-642)) syntmp-vals-634) (cons (cons (quote lexical) syntmp-var-647) syntmp-bindings-635))))) (if (memv syntmp-t-644 (quote (define-syntax-form))) (let ((syntmp-id-648 (syntmp-wrap-142 syntmp-value-640 syntmp-w-642)) (syntmp-label-649 (syntmp-gen-label-119))) (begin (syntmp-extend-ribcage!-130 syntmp-ribcage-627 syntmp-id-648 syntmp-label-649) (syntmp-parse-629 (cdr syntmp-body-630) (cons syntmp-id-648 syntmp-ids-631) (cons syntmp-label-649 syntmp-labels-632) syntmp-vars-633 syntmp-vals-634 (cons (cons (quote macro) (cons syntmp-er-638 (syntmp-wrap-142 syntmp-e-641 syntmp-w-642))) syntmp-bindings-635)))) (if (memv syntmp-t-644 (quote (begin-form))) ((lambda (syntmp-tmp-650) ((lambda (syntmp-tmp-651) (if syntmp-tmp-651 (apply (lambda (syntmp-_-652 syntmp-e1-653) (syntmp-parse-629 (let syntmp-f-654 ((syntmp-forms-655 syntmp-e1-653)) (if (null? syntmp-forms-655) (cdr syntmp-body-630) (cons (cons syntmp-er-638 (syntmp-wrap-142 (car syntmp-forms-655) syntmp-w-642)) (syntmp-f-654 (cdr syntmp-forms-655))))) syntmp-ids-631 syntmp-labels-632 syntmp-vars-633 syntmp-vals-634 syntmp-bindings-635)) syntmp-tmp-651) (syntax-error syntmp-tmp-650))) (syntax-dispatch syntmp-tmp-650 (quote (any . each-any))))) syntmp-e-641) (if (memv syntmp-t-644 (quote (local-syntax-form))) (syntmp-chi-local-syntax-156 syntmp-value-640 syntmp-e-641 syntmp-er-638 syntmp-w-642 syntmp-s-643 (lambda (syntmp-forms-657 syntmp-er-658 syntmp-w-659 syntmp-s-660) (syntmp-parse-629 (let syntmp-f-661 ((syntmp-forms-662 syntmp-forms-657)) (if (null? syntmp-forms-662) (cdr syntmp-body-630) (cons (cons syntmp-er-658 (syntmp-wrap-142 (car syntmp-forms-662) syntmp-w-659)) (syntmp-f-661 (cdr syntmp-forms-662))))) syntmp-ids-631 syntmp-labels-632 syntmp-vars-633 syntmp-vals-634 syntmp-bindings-635))) (if (null? syntmp-ids-631) (syntmp-build-sequence-95 #f (map (lambda (syntmp-x-663) (syntmp-chi-150 (cdr syntmp-x-663) (car syntmp-x-663) (quote (())))) (cons (cons syntmp-er-638 (syntmp-source-wrap-143 syntmp-e-641 syntmp-w-642 syntmp-s-643)) (cdr syntmp-body-630)))) (begin (if (not (syntmp-valid-bound-ids?-139 syntmp-ids-631)) (syntax-error syntmp-outer-form-623 "invalid or duplicate identifier in definition")) (let syntmp-loop-664 ((syntmp-bs-665 syntmp-bindings-635) (syntmp-er-cache-666 #f) (syntmp-r-cache-667 #f)) (if (not (null? syntmp-bs-665)) (let ((syntmp-b-668 (car syntmp-bs-665))) (if (eq? (car syntmp-b-668) (quote macro)) (let ((syntmp-er-669 (cadr syntmp-b-668))) (let ((syntmp-r-cache-670 (if (eq? syntmp-er-669 syntmp-er-cache-666) syntmp-r-cache-667 (syntmp-macros-only-env-110 syntmp-er-669)))) (begin (set-cdr! syntmp-b-668 (syntmp-eval-local-transformer-157 (syntmp-chi-150 (cddr syntmp-b-668) syntmp-r-cache-670 (quote (()))))) (syntmp-loop-664 (cdr syntmp-bs-665) syntmp-er-669 syntmp-r-cache-670)))) (syntmp-loop-664 (cdr syntmp-bs-665) syntmp-er-cache-666 syntmp-r-cache-667))))) (set-cdr! syntmp-r-626 (syntmp-extend-env-108 syntmp-labels-632 syntmp-bindings-635 (cdr syntmp-r-626))) (syntmp-build-letrec-98 #f syntmp-vars-633 (map (lambda (syntmp-x-671) (syntmp-chi-150 (cdr syntmp-x-671) (car syntmp-x-671) (quote (())))) syntmp-vals-634) (syntmp-build-sequence-95 #f (map (lambda (syntmp-x-672) (syntmp-chi-150 (cdr syntmp-x-672) (car syntmp-x-672) (quote (())))) (cons (cons syntmp-er-638 (syntmp-source-wrap-143 syntmp-e-641 syntmp-w-642 syntmp-s-643)) (cdr syntmp-body-630)))))))))))))))))))))) (syntmp-chi-macro-153 (lambda (syntmp-p-673 syntmp-e-674 syntmp-r-675 syntmp-w-676 syntmp-rib-677) (letrec ((syntmp-rebuild-macro-output-678 (lambda (syntmp-x-679 syntmp-m-680) (cond ((pair? syntmp-x-679) (cons (syntmp-rebuild-macro-output-678 (car syntmp-x-679) syntmp-m-680) (syntmp-rebuild-macro-output-678 (cdr syntmp-x-679) syntmp-m-680))) ((syntmp-syntax-object?-100 syntmp-x-679) (let ((syntmp-w-681 (syntmp-syntax-object-wrap-102 syntmp-x-679))) (let ((syntmp-ms-682 (syntmp-wrap-marks-117 syntmp-w-681)) (syntmp-s-683 (syntmp-wrap-subst-118 syntmp-w-681))) (syntmp-make-syntax-object-99 (syntmp-syntax-object-expression-101 syntmp-x-679) (if (and (pair? syntmp-ms-682) (eq? (car syntmp-ms-682) #f)) (syntmp-make-wrap-116 (cdr syntmp-ms-682) (if syntmp-rib-677 (cons syntmp-rib-677 (cdr syntmp-s-683)) (cdr syntmp-s-683))) (syntmp-make-wrap-116 (cons syntmp-m-680 syntmp-ms-682) (if syntmp-rib-677 (cons syntmp-rib-677 (cons (quote shift) syntmp-s-683)) (cons (quote shift) syntmp-s-683)))))))) ((vector? syntmp-x-679) (let ((syntmp-n-684 (vector-length syntmp-x-679))) (let ((syntmp-v-685 (make-vector syntmp-n-684))) (let syntmp-doloop-686 ((syntmp-i-687 0)) (if (syntmp-fx=-87 syntmp-i-687 syntmp-n-684) syntmp-v-685 (begin (vector-set! syntmp-v-685 syntmp-i-687 (syntmp-rebuild-macro-output-678 (vector-ref syntmp-x-679 syntmp-i-687) syntmp-m-680)) (syntmp-doloop-686 (syntmp-fx+-85 syntmp-i-687 1)))))))) ((symbol? syntmp-x-679) (syntax-error syntmp-x-679 "encountered raw symbol in macro output")) (else syntmp-x-679))))) (syntmp-rebuild-macro-output-678 (syntmp-p-673 (syntmp-wrap-142 syntmp-e-674 (syntmp-anti-mark-129 syntmp-w-676))) (string #\m))))) (syntmp-chi-application-152 (lambda (syntmp-x-688 syntmp-e-689 syntmp-r-690 syntmp-w-691 syntmp-s-692) ((lambda (syntmp-tmp-693) ((lambda (syntmp-tmp-694) (if syntmp-tmp-694 (apply (lambda (syntmp-e0-695 syntmp-e1-696) (cons syntmp-x-688 (map (lambda (syntmp-e-697) (syntmp-chi-150 syntmp-e-697 syntmp-r-690 syntmp-w-691)) syntmp-e1-696))) syntmp-tmp-694) (syntax-error syntmp-tmp-693))) (syntax-dispatch syntmp-tmp-693 (quote (any . each-any))))) syntmp-e-689))) (syntmp-chi-expr-151 (lambda (syntmp-type-699 syntmp-value-700 syntmp-e-701 syntmp-r-702 syntmp-w-703 syntmp-s-704) (let ((syntmp-t-705 syntmp-type-699)) (if (memv syntmp-t-705 (quote (lexical))) syntmp-value-700 (if (memv syntmp-t-705 (quote (core external-macro))) (syntmp-value-700 syntmp-e-701 syntmp-r-702 syntmp-w-703 syntmp-s-704) (if (memv syntmp-t-705 (quote (lexical-call))) (syntmp-chi-application-152 syntmp-value-700 syntmp-e-701 syntmp-r-702 syntmp-w-703 syntmp-s-704) (if (memv syntmp-t-705 (quote (global-call))) (syntmp-chi-application-152 syntmp-value-700 syntmp-e-701 syntmp-r-702 syntmp-w-703 syntmp-s-704) (if (memv syntmp-t-705 (quote (constant))) (syntmp-build-data-94 syntmp-s-704 (syntmp-strip-161 (syntmp-source-wrap-143 syntmp-e-701 syntmp-w-703 syntmp-s-704) (quote (())))) (if (memv syntmp-t-705 (quote (global))) syntmp-value-700 (if (memv syntmp-t-705 (quote (call))) (syntmp-chi-application-152 (syntmp-chi-150 (car syntmp-e-701) syntmp-r-702 syntmp-w-703) syntmp-e-701 syntmp-r-702 syntmp-w-703 syntmp-s-704) (if (memv syntmp-t-705 (quote (begin-form))) ((lambda (syntmp-tmp-706) ((lambda (syntmp-tmp-707) (if syntmp-tmp-707 (apply (lambda (syntmp-_-708 syntmp-e1-709 syntmp-e2-710) (syntmp-chi-sequence-144 (cons syntmp-e1-709 syntmp-e2-710) syntmp-r-702 syntmp-w-703 syntmp-s-704)) syntmp-tmp-707) (syntax-error syntmp-tmp-706))) (syntax-dispatch syntmp-tmp-706 (quote (any any . each-any))))) syntmp-e-701) (if (memv syntmp-t-705 (quote (local-syntax-form))) (syntmp-chi-local-syntax-156 syntmp-value-700 syntmp-e-701 syntmp-r-702 syntmp-w-703 syntmp-s-704 syntmp-chi-sequence-144) (if (memv syntmp-t-705 (quote (eval-when-form))) ((lambda (syntmp-tmp-712) ((lambda (syntmp-tmp-713) (if syntmp-tmp-713 (apply (lambda (syntmp-_-714 syntmp-x-715 syntmp-e1-716 syntmp-e2-717) (let ((syntmp-when-list-718 (syntmp-chi-when-list-147 syntmp-e-701 syntmp-x-715 syntmp-w-703))) (if (memq (quote eval) syntmp-when-list-718) (syntmp-chi-sequence-144 (cons syntmp-e1-716 syntmp-e2-717) syntmp-r-702 syntmp-w-703 syntmp-s-704) (syntmp-chi-void-158)))) syntmp-tmp-713) (syntax-error syntmp-tmp-712))) (syntax-dispatch syntmp-tmp-712 (quote (any each-any any . each-any))))) syntmp-e-701) (if (memv syntmp-t-705 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-142 syntmp-value-700 syntmp-w-703) "invalid context for definition of") (if (memv syntmp-t-705 (quote (syntax))) (syntax-error (syntmp-source-wrap-143 syntmp-e-701 syntmp-w-703 syntmp-s-704) "reference to pattern variable outside syntax form") (if (memv syntmp-t-705 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-143 syntmp-e-701 syntmp-w-703 syntmp-s-704) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-143 syntmp-e-701 syntmp-w-703 syntmp-s-704)))))))))))))))))) (syntmp-chi-150 (lambda (syntmp-e-721 syntmp-r-722 syntmp-w-723) (call-with-values (lambda () (syntmp-syntax-type-148 syntmp-e-721 syntmp-r-722 syntmp-w-723 #f #f)) (lambda (syntmp-type-724 syntmp-value-725 syntmp-e-726 syntmp-w-727 syntmp-s-728) (syntmp-chi-expr-151 syntmp-type-724 syntmp-value-725 syntmp-e-726 syntmp-r-722 syntmp-w-727 syntmp-s-728))))) (syntmp-chi-top-149 (lambda (syntmp-e-729 syntmp-r-730 syntmp-w-731 syntmp-m-732 syntmp-esew-733) (call-with-values (lambda () (syntmp-syntax-type-148 syntmp-e-729 syntmp-r-730 syntmp-w-731 #f #f)) (lambda (syntmp-type-746 syntmp-value-747 syntmp-e-748 syntmp-w-749 syntmp-s-750) (let ((syntmp-t-751 syntmp-type-746)) (if (memv syntmp-t-751 (quote (begin-form))) ((lambda (syntmp-tmp-752) ((lambda (syntmp-tmp-753) (if syntmp-tmp-753 (apply (lambda (syntmp-_-754) (syntmp-chi-void-158)) syntmp-tmp-753) ((lambda (syntmp-tmp-755) (if syntmp-tmp-755 (apply (lambda (syntmp-_-756 syntmp-e1-757 syntmp-e2-758) (syntmp-chi-top-sequence-145 (cons syntmp-e1-757 syntmp-e2-758) syntmp-r-730 syntmp-w-749 syntmp-s-750 syntmp-m-732 syntmp-esew-733)) syntmp-tmp-755) (syntax-error syntmp-tmp-752))) (syntax-dispatch syntmp-tmp-752 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-752 (quote (any))))) syntmp-e-748) (if (memv syntmp-t-751 (quote (local-syntax-form))) (syntmp-chi-local-syntax-156 syntmp-value-747 syntmp-e-748 syntmp-r-730 syntmp-w-749 syntmp-s-750 (lambda (syntmp-body-760 syntmp-r-761 syntmp-w-762 syntmp-s-763) (syntmp-chi-top-sequence-145 syntmp-body-760 syntmp-r-761 syntmp-w-762 syntmp-s-763 syntmp-m-732 syntmp-esew-733))) (if (memv syntmp-t-751 (quote (eval-when-form))) ((lambda (syntmp-tmp-764) ((lambda (syntmp-tmp-765) (if syntmp-tmp-765 (apply (lambda (syntmp-_-766 syntmp-x-767 syntmp-e1-768 syntmp-e2-769) (let ((syntmp-when-list-770 (syntmp-chi-when-list-147 syntmp-e-748 syntmp-x-767 syntmp-w-749)) (syntmp-body-771 (cons syntmp-e1-768 syntmp-e2-769))) (cond ((eq? syntmp-m-732 (quote e)) (if (memq (quote eval) syntmp-when-list-770) (syntmp-chi-top-sequence-145 syntmp-body-771 syntmp-r-730 syntmp-w-749 syntmp-s-750 (quote e) (quote (eval))) (syntmp-chi-void-158))) ((memq (quote load) syntmp-when-list-770) (if (or (memq (quote compile) syntmp-when-list-770) (and (eq? syntmp-m-732 (quote c&e)) (memq (quote eval) syntmp-when-list-770))) (syntmp-chi-top-sequence-145 syntmp-body-771 syntmp-r-730 syntmp-w-749 syntmp-s-750 (quote c&e) (quote (compile load))) (if (memq syntmp-m-732 (quote (c c&e))) (syntmp-chi-top-sequence-145 syntmp-body-771 syntmp-r-730 syntmp-w-749 syntmp-s-750 (quote c) (quote (load))) (syntmp-chi-void-158)))) ((or (memq (quote compile) syntmp-when-list-770) (and (eq? syntmp-m-732 (quote c&e)) (memq (quote eval) syntmp-when-list-770))) (syntmp-top-level-eval-hook-89 (syntmp-chi-top-sequence-145 syntmp-body-771 syntmp-r-730 syntmp-w-749 syntmp-s-750 (quote e) (quote (eval)))) (syntmp-chi-void-158)) (else (syntmp-chi-void-158))))) syntmp-tmp-765) (syntax-error syntmp-tmp-764))) (syntax-dispatch syntmp-tmp-764 (quote (any each-any any . each-any))))) syntmp-e-748) (if (memv syntmp-t-751 (quote (define-syntax-form))) (let ((syntmp-n-774 (syntmp-id-var-name-136 syntmp-value-747 syntmp-w-749)) (syntmp-r-775 (syntmp-macros-only-env-110 syntmp-r-730))) (let ((syntmp-t-776 syntmp-m-732)) (if (memv syntmp-t-776 (quote (c))) (if (memq (quote compile) syntmp-esew-733) (let ((syntmp-e-777 (syntmp-chi-install-global-146 syntmp-n-774 (syntmp-chi-150 syntmp-e-748 syntmp-r-775 syntmp-w-749)))) (begin (syntmp-top-level-eval-hook-89 syntmp-e-777) (if (memq (quote load) syntmp-esew-733) syntmp-e-777 (syntmp-chi-void-158)))) (if (memq (quote load) syntmp-esew-733) (syntmp-chi-install-global-146 syntmp-n-774 (syntmp-chi-150 syntmp-e-748 syntmp-r-775 syntmp-w-749)) (syntmp-chi-void-158))) (if (memv syntmp-t-776 (quote (c&e))) (let ((syntmp-e-778 (syntmp-chi-install-global-146 syntmp-n-774 (syntmp-chi-150 syntmp-e-748 syntmp-r-775 syntmp-w-749)))) (begin (syntmp-top-level-eval-hook-89 syntmp-e-778) syntmp-e-778)) (begin (if (memq (quote eval) syntmp-esew-733) (syntmp-top-level-eval-hook-89 (syntmp-chi-install-global-146 syntmp-n-774 (syntmp-chi-150 syntmp-e-748 syntmp-r-775 syntmp-w-749)))) (syntmp-chi-void-158)))))) (if (memv syntmp-t-751 (quote (define-form))) (let ((syntmp-n-779 (syntmp-id-var-name-136 syntmp-value-747 syntmp-w-749))) (let ((syntmp-type-780 (syntmp-binding-type-106 (syntmp-lookup-111 syntmp-n-779 syntmp-r-730)))) (let ((syntmp-t-781 syntmp-type-780)) (if (memv syntmp-t-781 (quote (global))) (let ((syntmp-x-782 (list (quote define) syntmp-n-779 (syntmp-chi-150 syntmp-e-748 syntmp-r-730 syntmp-w-749)))) (begin (if (eq? syntmp-m-732 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-782)) syntmp-x-782)) (if (memv syntmp-t-781 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-142 syntmp-value-747 syntmp-w-749) "identifier out of context") (if (eq? syntmp-type-780 (quote external-macro)) (let ((syntmp-x-783 (list (quote define) syntmp-n-779 (syntmp-chi-150 syntmp-e-748 syntmp-r-730 syntmp-w-749)))) (begin (if (eq? syntmp-m-732 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-783)) syntmp-x-783)) (syntax-error (syntmp-wrap-142 syntmp-value-747 syntmp-w-749) "cannot define keyword at top level"))))))) (let ((syntmp-x-784 (syntmp-chi-expr-151 syntmp-type-746 syntmp-value-747 syntmp-e-748 syntmp-r-730 syntmp-w-749 syntmp-s-750))) (begin (if (eq? syntmp-m-732 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-784)) syntmp-x-784)))))))))))) (syntmp-syntax-type-148 (lambda (syntmp-e-785 syntmp-r-786 syntmp-w-787 syntmp-s-788 syntmp-rib-789) (cond ((symbol? syntmp-e-785) (let ((syntmp-n-790 (syntmp-id-var-name-136 syntmp-e-785 syntmp-w-787))) (let ((syntmp-b-791 (syntmp-lookup-111 syntmp-n-790 syntmp-r-786))) (let ((syntmp-type-792 (syntmp-binding-type-106 syntmp-b-791))) (let ((syntmp-t-793 syntmp-type-792)) (if (memv syntmp-t-793 (quote (lexical))) (values syntmp-type-792 (syntmp-binding-value-107 syntmp-b-791) syntmp-e-785 syntmp-w-787 syntmp-s-788) (if (memv syntmp-t-793 (quote (global))) (values syntmp-type-792 syntmp-n-790 syntmp-e-785 syntmp-w-787 syntmp-s-788) (if (memv syntmp-t-793 (quote (macro))) (syntmp-syntax-type-148 (syntmp-chi-macro-153 (syntmp-binding-value-107 syntmp-b-791) syntmp-e-785 syntmp-r-786 syntmp-w-787 syntmp-rib-789) syntmp-r-786 (quote (())) syntmp-s-788 syntmp-rib-789) (values syntmp-type-792 (syntmp-binding-value-107 syntmp-b-791) syntmp-e-785 syntmp-w-787 syntmp-s-788))))))))) ((pair? syntmp-e-785) (let ((syntmp-first-794 (car syntmp-e-785))) (if (syntmp-id?-114 syntmp-first-794) (let ((syntmp-n-795 (syntmp-id-var-name-136 syntmp-first-794 syntmp-w-787))) (let ((syntmp-b-796 (syntmp-lookup-111 syntmp-n-795 syntmp-r-786))) (let ((syntmp-type-797 (syntmp-binding-type-106 syntmp-b-796))) (let ((syntmp-t-798 syntmp-type-797)) (if (memv syntmp-t-798 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-107 syntmp-b-796) syntmp-e-785 syntmp-w-787 syntmp-s-788) (if (memv syntmp-t-798 (quote (global))) (values (quote global-call) syntmp-n-795 syntmp-e-785 syntmp-w-787 syntmp-s-788) (if (memv syntmp-t-798 (quote (macro))) (syntmp-syntax-type-148 (syntmp-chi-macro-153 (syntmp-binding-value-107 syntmp-b-796) syntmp-e-785 syntmp-r-786 syntmp-w-787 syntmp-rib-789) syntmp-r-786 (quote (())) syntmp-s-788 syntmp-rib-789) (if (memv syntmp-t-798 (quote (core external-macro))) (values syntmp-type-797 (syntmp-binding-value-107 syntmp-b-796) syntmp-e-785 syntmp-w-787 syntmp-s-788) (if (memv syntmp-t-798 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-107 syntmp-b-796) syntmp-e-785 syntmp-w-787 syntmp-s-788) (if (memv syntmp-t-798 (quote (begin))) (values (quote begin-form) #f syntmp-e-785 syntmp-w-787 syntmp-s-788) (if (memv syntmp-t-798 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-785 syntmp-w-787 syntmp-s-788) (if (memv syntmp-t-798 (quote (define))) ((lambda (syntmp-tmp-799) ((lambda (syntmp-tmp-800) (if (if syntmp-tmp-800 (apply (lambda (syntmp-_-801 syntmp-name-802 syntmp-val-803) (syntmp-id?-114 syntmp-name-802)) syntmp-tmp-800) #f) (apply (lambda (syntmp-_-804 syntmp-name-805 syntmp-val-806) (values (quote define-form) syntmp-name-805 syntmp-val-806 syntmp-w-787 syntmp-s-788)) syntmp-tmp-800) ((lambda (syntmp-tmp-807) (if (if syntmp-tmp-807 (apply (lambda (syntmp-_-808 syntmp-name-809 syntmp-args-810 syntmp-e1-811 syntmp-e2-812) (and (syntmp-id?-114 syntmp-name-809) (syntmp-valid-bound-ids?-139 (syntmp-lambda-var-list-163 syntmp-args-810)))) syntmp-tmp-807) #f) (apply (lambda (syntmp-_-813 syntmp-name-814 syntmp-args-815 syntmp-e1-816 syntmp-e2-817) (values (quote define-form) (syntmp-wrap-142 syntmp-name-814 syntmp-w-787) (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 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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-142 (cons syntmp-args-815 (cons syntmp-e1-816 syntmp-e2-817)) syntmp-w-787)) (quote (())) syntmp-s-788)) syntmp-tmp-807) ((lambda (syntmp-tmp-819) (if (if syntmp-tmp-819 (apply (lambda (syntmp-_-820 syntmp-name-821) (syntmp-id?-114 syntmp-name-821)) syntmp-tmp-819) #f) (apply (lambda (syntmp-_-822 syntmp-name-823) (values (quote define-form) (syntmp-wrap-142 syntmp-name-823 syntmp-w-787) (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 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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-788)) syntmp-tmp-819) (syntax-error syntmp-tmp-799))) (syntax-dispatch syntmp-tmp-799 (quote (any any)))))) (syntax-dispatch syntmp-tmp-799 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-799 (quote (any any any))))) syntmp-e-785) (if (memv syntmp-t-798 (quote (define-syntax))) ((lambda (syntmp-tmp-824) ((lambda (syntmp-tmp-825) (if (if syntmp-tmp-825 (apply (lambda (syntmp-_-826 syntmp-name-827 syntmp-val-828) (syntmp-id?-114 syntmp-name-827)) syntmp-tmp-825) #f) (apply (lambda (syntmp-_-829 syntmp-name-830 syntmp-val-831) (values (quote define-syntax-form) syntmp-name-830 syntmp-val-831 syntmp-w-787 syntmp-s-788)) syntmp-tmp-825) (syntax-error syntmp-tmp-824))) (syntax-dispatch syntmp-tmp-824 (quote (any any any))))) syntmp-e-785) (values (quote call) #f syntmp-e-785 syntmp-w-787 syntmp-s-788)))))))))))))) (values (quote call) #f syntmp-e-785 syntmp-w-787 syntmp-s-788)))) ((syntmp-syntax-object?-100 syntmp-e-785) (syntmp-syntax-type-148 (syntmp-syntax-object-expression-101 syntmp-e-785) syntmp-r-786 (syntmp-join-wraps-133 syntmp-w-787 (syntmp-syntax-object-wrap-102 syntmp-e-785)) #f syntmp-rib-789)) ((annotation? syntmp-e-785) (syntmp-syntax-type-148 (annotation-expression syntmp-e-785) syntmp-r-786 syntmp-w-787 (annotation-source syntmp-e-785) syntmp-rib-789)) ((self-evaluating? syntmp-e-785) (values (quote constant) #f syntmp-e-785 syntmp-w-787 syntmp-s-788)) (else (values (quote other) #f syntmp-e-785 syntmp-w-787 syntmp-s-788))))) (syntmp-chi-when-list-147 (lambda (syntmp-e-832 syntmp-when-list-833 syntmp-w-834) (let syntmp-f-835 ((syntmp-when-list-836 syntmp-when-list-833) (syntmp-situations-837 (quote ()))) (if (null? syntmp-when-list-836) syntmp-situations-837 (syntmp-f-835 (cdr syntmp-when-list-836) (cons (let ((syntmp-x-838 (car syntmp-when-list-836))) (cond ((syntmp-free-id=?-137 syntmp-x-838 (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 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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?-137 syntmp-x-838 (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 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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?-137 syntmp-x-838 (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 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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-142 syntmp-x-838 syntmp-w-834) "invalid eval-when situation")))) syntmp-situations-837)))))) (syntmp-chi-install-global-146 (lambda (syntmp-name-839 syntmp-e-840) (list (quote install-global-transformer) (syntmp-build-data-94 #f syntmp-name-839) syntmp-e-840))) (syntmp-chi-top-sequence-145 (lambda (syntmp-body-841 syntmp-r-842 syntmp-w-843 syntmp-s-844 syntmp-m-845 syntmp-esew-846) (syntmp-build-sequence-95 syntmp-s-844 (let syntmp-dobody-847 ((syntmp-body-848 syntmp-body-841) (syntmp-r-849 syntmp-r-842) (syntmp-w-850 syntmp-w-843) (syntmp-m-851 syntmp-m-845) (syntmp-esew-852 syntmp-esew-846)) (if (null? syntmp-body-848) (quote ()) (let ((syntmp-first-853 (syntmp-chi-top-149 (car syntmp-body-848) syntmp-r-849 syntmp-w-850 syntmp-m-851 syntmp-esew-852))) (cons syntmp-first-853 (syntmp-dobody-847 (cdr syntmp-body-848) syntmp-r-849 syntmp-w-850 syntmp-m-851 syntmp-esew-852)))))))) (syntmp-chi-sequence-144 (lambda (syntmp-body-854 syntmp-r-855 syntmp-w-856 syntmp-s-857) (syntmp-build-sequence-95 syntmp-s-857 (let syntmp-dobody-858 ((syntmp-body-859 syntmp-body-854) (syntmp-r-860 syntmp-r-855) (syntmp-w-861 syntmp-w-856)) (if (null? syntmp-body-859) (quote ()) (let ((syntmp-first-862 (syntmp-chi-150 (car syntmp-body-859) syntmp-r-860 syntmp-w-861))) (cons syntmp-first-862 (syntmp-dobody-858 (cdr syntmp-body-859) syntmp-r-860 syntmp-w-861)))))))) (syntmp-source-wrap-143 (lambda (syntmp-x-863 syntmp-w-864 syntmp-s-865) (syntmp-wrap-142 (if syntmp-s-865 (make-annotation syntmp-x-863 syntmp-s-865 #f) syntmp-x-863) syntmp-w-864))) (syntmp-wrap-142 (lambda (syntmp-x-866 syntmp-w-867) (cond ((and (null? (syntmp-wrap-marks-117 syntmp-w-867)) (null? (syntmp-wrap-subst-118 syntmp-w-867))) syntmp-x-866) ((syntmp-syntax-object?-100 syntmp-x-866) (syntmp-make-syntax-object-99 (syntmp-syntax-object-expression-101 syntmp-x-866) (syntmp-join-wraps-133 syntmp-w-867 (syntmp-syntax-object-wrap-102 syntmp-x-866)))) ((null? syntmp-x-866) syntmp-x-866) (else (syntmp-make-syntax-object-99 syntmp-x-866 syntmp-w-867))))) (syntmp-bound-id-member?-141 (lambda (syntmp-x-868 syntmp-list-869) (and (not (null? syntmp-list-869)) (or (syntmp-bound-id=?-138 syntmp-x-868 (car syntmp-list-869)) (syntmp-bound-id-member?-141 syntmp-x-868 (cdr syntmp-list-869)))))) (syntmp-distinct-bound-ids?-140 (lambda (syntmp-ids-870) (let syntmp-distinct?-871 ((syntmp-ids-872 syntmp-ids-870)) (or (null? syntmp-ids-872) (and (not (syntmp-bound-id-member?-141 (car syntmp-ids-872) (cdr syntmp-ids-872))) (syntmp-distinct?-871 (cdr syntmp-ids-872))))))) (syntmp-valid-bound-ids?-139 (lambda (syntmp-ids-873) (and (let syntmp-all-ids?-874 ((syntmp-ids-875 syntmp-ids-873)) (or (null? syntmp-ids-875) (and (syntmp-id?-114 (car syntmp-ids-875)) (syntmp-all-ids?-874 (cdr syntmp-ids-875))))) (syntmp-distinct-bound-ids?-140 syntmp-ids-873)))) (syntmp-bound-id=?-138 (lambda (syntmp-i-876 syntmp-j-877) (if (and (syntmp-syntax-object?-100 syntmp-i-876) (syntmp-syntax-object?-100 syntmp-j-877)) (and (eq? (let ((syntmp-e-878 (syntmp-syntax-object-expression-101 syntmp-i-876))) (if (annotation? syntmp-e-878) (annotation-expression syntmp-e-878) syntmp-e-878)) (let ((syntmp-e-879 (syntmp-syntax-object-expression-101 syntmp-j-877))) (if (annotation? syntmp-e-879) (annotation-expression syntmp-e-879) syntmp-e-879))) (syntmp-same-marks?-135 (syntmp-wrap-marks-117 (syntmp-syntax-object-wrap-102 syntmp-i-876)) (syntmp-wrap-marks-117 (syntmp-syntax-object-wrap-102 syntmp-j-877)))) (eq? (let ((syntmp-e-880 syntmp-i-876)) (if (annotation? syntmp-e-880) (annotation-expression syntmp-e-880) syntmp-e-880)) (let ((syntmp-e-881 syntmp-j-877)) (if (annotation? syntmp-e-881) (annotation-expression syntmp-e-881) syntmp-e-881)))))) (syntmp-free-id=?-137 (lambda (syntmp-i-882 syntmp-j-883) (and (eq? (let ((syntmp-x-884 syntmp-i-882)) (let ((syntmp-e-885 (if (syntmp-syntax-object?-100 syntmp-x-884) (syntmp-syntax-object-expression-101 syntmp-x-884) syntmp-x-884))) (if (annotation? syntmp-e-885) (annotation-expression syntmp-e-885) syntmp-e-885))) (let ((syntmp-x-886 syntmp-j-883)) (let ((syntmp-e-887 (if (syntmp-syntax-object?-100 syntmp-x-886) (syntmp-syntax-object-expression-101 syntmp-x-886) syntmp-x-886))) (if (annotation? syntmp-e-887) (annotation-expression syntmp-e-887) syntmp-e-887)))) (eq? (syntmp-id-var-name-136 syntmp-i-882 (quote (()))) (syntmp-id-var-name-136 syntmp-j-883 (quote (()))))))) (syntmp-id-var-name-136 (lambda (syntmp-id-888 syntmp-w-889) (letrec ((syntmp-search-vector-rib-892 (lambda (syntmp-sym-903 syntmp-subst-904 syntmp-marks-905 syntmp-symnames-906 syntmp-ribcage-907) (let ((syntmp-n-908 (vector-length syntmp-symnames-906))) (let syntmp-f-909 ((syntmp-i-910 0)) (cond ((syntmp-fx=-87 syntmp-i-910 syntmp-n-908) (syntmp-search-890 syntmp-sym-903 (cdr syntmp-subst-904) syntmp-marks-905)) ((and (eq? (vector-ref syntmp-symnames-906 syntmp-i-910) syntmp-sym-903) (syntmp-same-marks?-135 syntmp-marks-905 (vector-ref (syntmp-ribcage-marks-124 syntmp-ribcage-907) syntmp-i-910))) (values (vector-ref (syntmp-ribcage-labels-125 syntmp-ribcage-907) syntmp-i-910) syntmp-marks-905)) (else (syntmp-f-909 (syntmp-fx+-85 syntmp-i-910 1)))))))) (syntmp-search-list-rib-891 (lambda (syntmp-sym-911 syntmp-subst-912 syntmp-marks-913 syntmp-symnames-914 syntmp-ribcage-915) (let syntmp-f-916 ((syntmp-symnames-917 syntmp-symnames-914) (syntmp-i-918 0)) (cond ((null? syntmp-symnames-917) (syntmp-search-890 syntmp-sym-911 (cdr syntmp-subst-912) syntmp-marks-913)) ((and (eq? (car syntmp-symnames-917) syntmp-sym-911) (syntmp-same-marks?-135 syntmp-marks-913 (list-ref (syntmp-ribcage-marks-124 syntmp-ribcage-915) syntmp-i-918))) (values (list-ref (syntmp-ribcage-labels-125 syntmp-ribcage-915) syntmp-i-918) syntmp-marks-913)) (else (syntmp-f-916 (cdr syntmp-symnames-917) (syntmp-fx+-85 syntmp-i-918 1))))))) (syntmp-search-890 (lambda (syntmp-sym-919 syntmp-subst-920 syntmp-marks-921) (if (null? syntmp-subst-920) (values #f syntmp-marks-921) (let ((syntmp-fst-922 (car syntmp-subst-920))) (if (eq? syntmp-fst-922 (quote shift)) (syntmp-search-890 syntmp-sym-919 (cdr syntmp-subst-920) (cdr syntmp-marks-921)) (let ((syntmp-symnames-923 (syntmp-ribcage-symnames-123 syntmp-fst-922))) (if (vector? syntmp-symnames-923) (syntmp-search-vector-rib-892 syntmp-sym-919 syntmp-subst-920 syntmp-marks-921 syntmp-symnames-923 syntmp-fst-922) (syntmp-search-list-rib-891 syntmp-sym-919 syntmp-subst-920 syntmp-marks-921 syntmp-symnames-923 syntmp-fst-922))))))))) (cond ((symbol? syntmp-id-888) (or (call-with-values (lambda () (syntmp-search-890 syntmp-id-888 (syntmp-wrap-subst-118 syntmp-w-889) (syntmp-wrap-marks-117 syntmp-w-889))) (lambda (syntmp-x-925 . syntmp-ignore-924) syntmp-x-925)) syntmp-id-888)) ((syntmp-syntax-object?-100 syntmp-id-888) (let ((syntmp-id-926 (let ((syntmp-e-928 (syntmp-syntax-object-expression-101 syntmp-id-888))) (if (annotation? syntmp-e-928) (annotation-expression syntmp-e-928) syntmp-e-928))) (syntmp-w1-927 (syntmp-syntax-object-wrap-102 syntmp-id-888))) (let ((syntmp-marks-929 (syntmp-join-marks-134 (syntmp-wrap-marks-117 syntmp-w-889) (syntmp-wrap-marks-117 syntmp-w1-927)))) (call-with-values (lambda () (syntmp-search-890 syntmp-id-926 (syntmp-wrap-subst-118 syntmp-w-889) syntmp-marks-929)) (lambda (syntmp-new-id-930 syntmp-marks-931) (or syntmp-new-id-930 (call-with-values (lambda () (syntmp-search-890 syntmp-id-926 (syntmp-wrap-subst-118 syntmp-w1-927) syntmp-marks-931)) (lambda (syntmp-x-933 . syntmp-ignore-932) syntmp-x-933)) syntmp-id-926)))))) ((annotation? syntmp-id-888) (let ((syntmp-id-934 (let ((syntmp-e-935 syntmp-id-888)) (if (annotation? syntmp-e-935) (annotation-expression syntmp-e-935) syntmp-e-935)))) (or (call-with-values (lambda () (syntmp-search-890 syntmp-id-934 (syntmp-wrap-subst-118 syntmp-w-889) (syntmp-wrap-marks-117 syntmp-w-889))) (lambda (syntmp-x-937 . syntmp-ignore-936) syntmp-x-937)) syntmp-id-934))) (else (syntmp-error-hook-91 (quote id-var-name) "invalid id" syntmp-id-888)))))) (syntmp-same-marks?-135 (lambda (syntmp-x-938 syntmp-y-939) (or (eq? syntmp-x-938 syntmp-y-939) (and (not (null? syntmp-x-938)) (not (null? syntmp-y-939)) (eq? (car syntmp-x-938) (car syntmp-y-939)) (syntmp-same-marks?-135 (cdr syntmp-x-938) (cdr syntmp-y-939)))))) (syntmp-join-marks-134 (lambda (syntmp-m1-940 syntmp-m2-941) (syntmp-smart-append-132 syntmp-m1-940 syntmp-m2-941))) (syntmp-join-wraps-133 (lambda (syntmp-w1-942 syntmp-w2-943) (let ((syntmp-m1-944 (syntmp-wrap-marks-117 syntmp-w1-942)) (syntmp-s1-945 (syntmp-wrap-subst-118 syntmp-w1-942))) (if (null? syntmp-m1-944) (if (null? syntmp-s1-945) syntmp-w2-943 (syntmp-make-wrap-116 (syntmp-wrap-marks-117 syntmp-w2-943) (syntmp-smart-append-132 syntmp-s1-945 (syntmp-wrap-subst-118 syntmp-w2-943)))) (syntmp-make-wrap-116 (syntmp-smart-append-132 syntmp-m1-944 (syntmp-wrap-marks-117 syntmp-w2-943)) (syntmp-smart-append-132 syntmp-s1-945 (syntmp-wrap-subst-118 syntmp-w2-943))))))) (syntmp-smart-append-132 (lambda (syntmp-m1-946 syntmp-m2-947) (if (null? syntmp-m2-947) syntmp-m1-946 (append syntmp-m1-946 syntmp-m2-947)))) (syntmp-make-binding-wrap-131 (lambda (syntmp-ids-948 syntmp-labels-949 syntmp-w-950) (if (null? syntmp-ids-948) syntmp-w-950 (syntmp-make-wrap-116 (syntmp-wrap-marks-117 syntmp-w-950) (cons (let ((syntmp-labelvec-951 (list->vector syntmp-labels-949))) (let ((syntmp-n-952 (vector-length syntmp-labelvec-951))) (let ((syntmp-symnamevec-953 (make-vector syntmp-n-952)) (syntmp-marksvec-954 (make-vector syntmp-n-952))) (begin (let syntmp-f-955 ((syntmp-ids-956 syntmp-ids-948) (syntmp-i-957 0)) (if (not (null? syntmp-ids-956)) (call-with-values (lambda () (syntmp-id-sym-name&marks-115 (car syntmp-ids-956) syntmp-w-950)) (lambda (syntmp-symname-958 syntmp-marks-959) (begin (vector-set! syntmp-symnamevec-953 syntmp-i-957 syntmp-symname-958) (vector-set! syntmp-marksvec-954 syntmp-i-957 syntmp-marks-959) (syntmp-f-955 (cdr syntmp-ids-956) (syntmp-fx+-85 syntmp-i-957 1))))))) (syntmp-make-ribcage-121 syntmp-symnamevec-953 syntmp-marksvec-954 syntmp-labelvec-951))))) (syntmp-wrap-subst-118 syntmp-w-950)))))) (syntmp-extend-ribcage!-130 (lambda (syntmp-ribcage-960 syntmp-id-961 syntmp-label-962) (begin (syntmp-set-ribcage-symnames!-126 syntmp-ribcage-960 (cons (let ((syntmp-e-963 (syntmp-syntax-object-expression-101 syntmp-id-961))) (if (annotation? syntmp-e-963) (annotation-expression syntmp-e-963) syntmp-e-963)) (syntmp-ribcage-symnames-123 syntmp-ribcage-960))) (syntmp-set-ribcage-marks!-127 syntmp-ribcage-960 (cons (syntmp-wrap-marks-117 (syntmp-syntax-object-wrap-102 syntmp-id-961)) (syntmp-ribcage-marks-124 syntmp-ribcage-960))) (syntmp-set-ribcage-labels!-128 syntmp-ribcage-960 (cons syntmp-label-962 (syntmp-ribcage-labels-125 syntmp-ribcage-960)))))) (syntmp-anti-mark-129 (lambda (syntmp-w-964) (syntmp-make-wrap-116 (cons #f (syntmp-wrap-marks-117 syntmp-w-964)) (cons (quote shift) (syntmp-wrap-subst-118 syntmp-w-964))))) (syntmp-set-ribcage-labels!-128 (lambda (syntmp-x-965 syntmp-update-966) (vector-set! syntmp-x-965 3 syntmp-update-966))) (syntmp-set-ribcage-marks!-127 (lambda (syntmp-x-967 syntmp-update-968) (vector-set! syntmp-x-967 2 syntmp-update-968))) (syntmp-set-ribcage-symnames!-126 (lambda (syntmp-x-969 syntmp-update-970) (vector-set! syntmp-x-969 1 syntmp-update-970))) (syntmp-ribcage-labels-125 (lambda (syntmp-x-971) (vector-ref syntmp-x-971 3))) (syntmp-ribcage-marks-124 (lambda (syntmp-x-972) (vector-ref syntmp-x-972 2))) (syntmp-ribcage-symnames-123 (lambda (syntmp-x-973) (vector-ref syntmp-x-973 1))) (syntmp-ribcage?-122 (lambda (syntmp-x-974) (and (vector? syntmp-x-974) (= (vector-length syntmp-x-974) 4) (eq? (vector-ref syntmp-x-974 0) (quote ribcage))))) (syntmp-make-ribcage-121 (lambda (syntmp-symnames-975 syntmp-marks-976 syntmp-labels-977) (vector (quote ribcage) syntmp-symnames-975 syntmp-marks-976 syntmp-labels-977))) (syntmp-gen-labels-120 (lambda (syntmp-ls-978) (if (null? syntmp-ls-978) (quote ()) (cons (syntmp-gen-label-119) (syntmp-gen-labels-120 (cdr syntmp-ls-978)))))) (syntmp-gen-label-119 (lambda () (string #\i))) (syntmp-wrap-subst-118 cdr) (syntmp-wrap-marks-117 car) (syntmp-make-wrap-116 cons) (syntmp-id-sym-name&marks-115 (lambda (syntmp-x-979 syntmp-w-980) (if (syntmp-syntax-object?-100 syntmp-x-979) (values (let ((syntmp-e-981 (syntmp-syntax-object-expression-101 syntmp-x-979))) (if (annotation? syntmp-e-981) (annotation-expression syntmp-e-981) syntmp-e-981)) (syntmp-join-marks-134 (syntmp-wrap-marks-117 syntmp-w-980) (syntmp-wrap-marks-117 (syntmp-syntax-object-wrap-102 syntmp-x-979)))) (values (let ((syntmp-e-982 syntmp-x-979)) (if (annotation? syntmp-e-982) (annotation-expression syntmp-e-982) syntmp-e-982)) (syntmp-wrap-marks-117 syntmp-w-980))))) (syntmp-id?-114 (lambda (syntmp-x-983) (cond ((symbol? syntmp-x-983) #t) ((syntmp-syntax-object?-100 syntmp-x-983) (symbol? (let ((syntmp-e-984 (syntmp-syntax-object-expression-101 syntmp-x-983))) (if (annotation? syntmp-e-984) (annotation-expression syntmp-e-984) syntmp-e-984)))) ((annotation? syntmp-x-983) (symbol? (annotation-expression syntmp-x-983))) (else #f)))) (syntmp-nonsymbol-id?-113 (lambda (syntmp-x-985) (and (syntmp-syntax-object?-100 syntmp-x-985) (symbol? (let ((syntmp-e-986 (syntmp-syntax-object-expression-101 syntmp-x-985))) (if (annotation? syntmp-e-986) (annotation-expression syntmp-e-986) syntmp-e-986)))))) (syntmp-global-extend-112 (lambda (syntmp-type-987 syntmp-sym-988 syntmp-val-989) (syntmp-put-global-definition-hook-92 syntmp-sym-988 (cons syntmp-type-987 syntmp-val-989)))) (syntmp-lookup-111 (lambda (syntmp-x-990 syntmp-r-991) (cond ((assq syntmp-x-990 syntmp-r-991) => cdr) ((symbol? syntmp-x-990) (or (syntmp-get-global-definition-hook-93 syntmp-x-990) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-110 (lambda (syntmp-r-992) (if (null? syntmp-r-992) (quote ()) (let ((syntmp-a-993 (car syntmp-r-992))) (if (eq? (cadr syntmp-a-993) (quote macro)) (cons syntmp-a-993 (syntmp-macros-only-env-110 (cdr syntmp-r-992))) (syntmp-macros-only-env-110 (cdr syntmp-r-992))))))) (syntmp-extend-var-env-109 (lambda (syntmp-labels-994 syntmp-vars-995 syntmp-r-996) (if (null? syntmp-labels-994) syntmp-r-996 (syntmp-extend-var-env-109 (cdr syntmp-labels-994) (cdr syntmp-vars-995) (cons (cons (car syntmp-labels-994) (cons (quote lexical) (car syntmp-vars-995))) syntmp-r-996))))) (syntmp-extend-env-108 (lambda (syntmp-labels-997 syntmp-bindings-998 syntmp-r-999) (if (null? syntmp-labels-997) syntmp-r-999 (syntmp-extend-env-108 (cdr syntmp-labels-997) (cdr syntmp-bindings-998) (cons (cons (car syntmp-labels-997) (car syntmp-bindings-998)) syntmp-r-999))))) (syntmp-binding-value-107 cdr) (syntmp-binding-type-106 car) (syntmp-source-annotation-105 (lambda (syntmp-x-1000) (cond ((annotation? syntmp-x-1000) (annotation-source syntmp-x-1000)) ((syntmp-syntax-object?-100 syntmp-x-1000) (syntmp-source-annotation-105 (syntmp-syntax-object-expression-101 syntmp-x-1000))) (else #f)))) (syntmp-set-syntax-object-wrap!-104 (lambda (syntmp-x-1001 syntmp-update-1002) (vector-set! syntmp-x-1001 2 syntmp-update-1002))) (syntmp-set-syntax-object-expression!-103 (lambda (syntmp-x-1003 syntmp-update-1004) (vector-set! syntmp-x-1003 1 syntmp-update-1004))) (syntmp-syntax-object-wrap-102 (lambda (syntmp-x-1005) (vector-ref syntmp-x-1005 2))) (syntmp-syntax-object-expression-101 (lambda (syntmp-x-1006) (vector-ref syntmp-x-1006 1))) (syntmp-syntax-object?-100 (lambda (syntmp-x-1007) (and (vector? syntmp-x-1007) (= (vector-length syntmp-x-1007) 3) (eq? (vector-ref syntmp-x-1007 0) (quote syntax-object))))) (syntmp-make-syntax-object-99 (lambda (syntmp-expression-1008 syntmp-wrap-1009) (vector (quote syntax-object) syntmp-expression-1008 syntmp-wrap-1009))) (syntmp-build-letrec-98 (lambda (syntmp-src-1010 syntmp-vars-1011 syntmp-val-exps-1012 syntmp-body-exp-1013) (if (null? syntmp-vars-1011) syntmp-body-exp-1013 (list (quote letrec) (map list syntmp-vars-1011 syntmp-val-exps-1012) syntmp-body-exp-1013)))) (syntmp-build-named-let-97 (lambda (syntmp-src-1014 syntmp-vars-1015 syntmp-val-exps-1016 syntmp-body-exp-1017) (if (null? syntmp-vars-1015) syntmp-body-exp-1017 (list (quote let) (car syntmp-vars-1015) (map list (cdr syntmp-vars-1015) syntmp-val-exps-1016) syntmp-body-exp-1017)))) (syntmp-build-let-96 (lambda (syntmp-src-1018 syntmp-vars-1019 syntmp-val-exps-1020 syntmp-body-exp-1021) (if (null? syntmp-vars-1019) syntmp-body-exp-1021 (list (quote let) (map list syntmp-vars-1019 syntmp-val-exps-1020) syntmp-body-exp-1021)))) (syntmp-build-sequence-95 (lambda (syntmp-src-1022 syntmp-exps-1023) (if (null? (cdr syntmp-exps-1023)) (car syntmp-exps-1023) (cons (quote begin) syntmp-exps-1023)))) (syntmp-build-data-94 (lambda (syntmp-src-1024 syntmp-exp-1025) (if (and (self-evaluating? syntmp-exp-1025) (not (vector? syntmp-exp-1025))) syntmp-exp-1025 (list (quote quote) syntmp-exp-1025)))) (syntmp-get-global-definition-hook-93 (lambda (syntmp-symbol-1026) (getprop syntmp-symbol-1026 (quote *sc-expander*)))) (syntmp-put-global-definition-hook-92 (lambda (syntmp-symbol-1027 syntmp-binding-1028) (putprop syntmp-symbol-1027 (quote *sc-expander*) syntmp-binding-1028))) (syntmp-error-hook-91 (lambda (syntmp-who-1029 syntmp-why-1030 syntmp-what-1031) (error syntmp-who-1029 "~a ~s" syntmp-why-1030 syntmp-what-1031))) (syntmp-local-eval-hook-90 (lambda (syntmp-x-1032) (eval (list syntmp-noexpand-84 syntmp-x-1032) (interaction-environment)))) (syntmp-top-level-eval-hook-89 (lambda (syntmp-x-1033) (eval (list syntmp-noexpand-84 syntmp-x-1033) (interaction-environment)))) (syntmp-fx<-88 <) (syntmp-fx=-87 =) (syntmp-fx--86 -) (syntmp-fx+-85 +) (syntmp-noexpand-84 "noexpand")) (begin (syntmp-global-extend-112 (quote local-syntax) (quote letrec-syntax) #t) (syntmp-global-extend-112 (quote local-syntax) (quote let-syntax) #f) (syntmp-global-extend-112 (quote core) (quote fluid-let-syntax) (lambda (syntmp-e-1034 syntmp-r-1035 syntmp-w-1036 syntmp-s-1037) ((lambda (syntmp-tmp-1038) ((lambda (syntmp-tmp-1039) (if (if syntmp-tmp-1039 (apply (lambda (syntmp-_-1040 syntmp-var-1041 syntmp-val-1042 syntmp-e1-1043 syntmp-e2-1044) (syntmp-valid-bound-ids?-139 syntmp-var-1041)) syntmp-tmp-1039) #f) (apply (lambda (syntmp-_-1046 syntmp-var-1047 syntmp-val-1048 syntmp-e1-1049 syntmp-e2-1050) (let ((syntmp-names-1051 (map (lambda (syntmp-x-1052) (syntmp-id-var-name-136 syntmp-x-1052 syntmp-w-1036)) syntmp-var-1047))) (begin (for-each (lambda (syntmp-id-1054 syntmp-n-1055) (let ((syntmp-t-1056 (syntmp-binding-type-106 (syntmp-lookup-111 syntmp-n-1055 syntmp-r-1035)))) (if (memv syntmp-t-1056 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-143 syntmp-id-1054 syntmp-w-1036 syntmp-s-1037) "identifier out of context")))) syntmp-var-1047 syntmp-names-1051) (syntmp-chi-body-154 (cons syntmp-e1-1049 syntmp-e2-1050) (syntmp-source-wrap-143 syntmp-e-1034 syntmp-w-1036 syntmp-s-1037) (syntmp-extend-env-108 syntmp-names-1051 (let ((syntmp-trans-r-1059 (syntmp-macros-only-env-110 syntmp-r-1035))) (map (lambda (syntmp-x-1060) (cons (quote macro) (syntmp-eval-local-transformer-157 (syntmp-chi-150 syntmp-x-1060 syntmp-trans-r-1059 syntmp-w-1036)))) syntmp-val-1048)) syntmp-r-1035) syntmp-w-1036)))) syntmp-tmp-1039) ((lambda (syntmp-_-1062) (syntax-error (syntmp-source-wrap-143 syntmp-e-1034 syntmp-w-1036 syntmp-s-1037))) syntmp-tmp-1038))) (syntax-dispatch syntmp-tmp-1038 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1034))) (syntmp-global-extend-112 (quote core) (quote quote) (lambda (syntmp-e-1063 syntmp-r-1064 syntmp-w-1065 syntmp-s-1066) ((lambda (syntmp-tmp-1067) ((lambda (syntmp-tmp-1068) (if syntmp-tmp-1068 (apply (lambda (syntmp-_-1069 syntmp-e-1070) (syntmp-build-data-94 syntmp-s-1066 (syntmp-strip-161 syntmp-e-1070 syntmp-w-1065))) syntmp-tmp-1068) ((lambda (syntmp-_-1071) (syntax-error (syntmp-source-wrap-143 syntmp-e-1063 syntmp-w-1065 syntmp-s-1066))) syntmp-tmp-1067))) (syntax-dispatch syntmp-tmp-1067 (quote (any any))))) syntmp-e-1063))) (syntmp-global-extend-112 (quote core) (quote syntax) (letrec ((syntmp-regen-1079 (lambda (syntmp-x-1080) (let ((syntmp-t-1081 (car syntmp-x-1080))) (if (memv syntmp-t-1081 (quote (ref))) (cadr syntmp-x-1080) (if (memv syntmp-t-1081 (quote (primitive))) (cadr syntmp-x-1080) (if (memv syntmp-t-1081 (quote (quote))) (syntmp-build-data-94 #f (cadr syntmp-x-1080)) (if (memv syntmp-t-1081 (quote (lambda))) (list (quote lambda) (cadr syntmp-x-1080) (syntmp-regen-1079 (caddr syntmp-x-1080))) (if (memv syntmp-t-1081 (quote (map))) (let ((syntmp-ls-1082 (map syntmp-regen-1079 (cdr syntmp-x-1080)))) (cons (if (syntmp-fx=-87 (length syntmp-ls-1082) 2) (quote map) (quote map)) syntmp-ls-1082)) (cons (car syntmp-x-1080) (map syntmp-regen-1079 (cdr syntmp-x-1080))))))))))) (syntmp-gen-vector-1078 (lambda (syntmp-x-1083) (cond ((eq? (car syntmp-x-1083) (quote list)) (cons (quote vector) (cdr syntmp-x-1083))) ((eq? (car syntmp-x-1083) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1083)))) (else (list (quote list->vector) syntmp-x-1083))))) (syntmp-gen-append-1077 (lambda (syntmp-x-1084 syntmp-y-1085) (if (equal? syntmp-y-1085 (quote (quote ()))) syntmp-x-1084 (list (quote append) syntmp-x-1084 syntmp-y-1085)))) (syntmp-gen-cons-1076 (lambda (syntmp-x-1086 syntmp-y-1087) (let ((syntmp-t-1088 (car syntmp-y-1087))) (if (memv syntmp-t-1088 (quote (quote))) (if (eq? (car syntmp-x-1086) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1086) (cadr syntmp-y-1087))) (if (eq? (cadr syntmp-y-1087) (quote ())) (list (quote list) syntmp-x-1086) (list (quote cons) syntmp-x-1086 syntmp-y-1087))) (if (memv syntmp-t-1088 (quote (list))) (cons (quote list) (cons syntmp-x-1086 (cdr syntmp-y-1087))) (list (quote cons) syntmp-x-1086 syntmp-y-1087)))))) (syntmp-gen-map-1075 (lambda (syntmp-e-1089 syntmp-map-env-1090) (let ((syntmp-formals-1091 (map cdr syntmp-map-env-1090)) (syntmp-actuals-1092 (map (lambda (syntmp-x-1093) (list (quote ref) (car syntmp-x-1093))) syntmp-map-env-1090))) (cond ((eq? (car syntmp-e-1089) (quote ref)) (car syntmp-actuals-1092)) ((andmap (lambda (syntmp-x-1094) (and (eq? (car syntmp-x-1094) (quote ref)) (memq (cadr syntmp-x-1094) syntmp-formals-1091))) (cdr syntmp-e-1089)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1089)) (map (let ((syntmp-r-1095 (map cons syntmp-formals-1091 syntmp-actuals-1092))) (lambda (syntmp-x-1096) (cdr (assq (cadr syntmp-x-1096) syntmp-r-1095)))) (cdr syntmp-e-1089))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1091 syntmp-e-1089) syntmp-actuals-1092))))))) (syntmp-gen-mappend-1074 (lambda (syntmp-e-1097 syntmp-map-env-1098) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1075 syntmp-e-1097 syntmp-map-env-1098)))) (syntmp-gen-ref-1073 (lambda (syntmp-src-1099 syntmp-var-1100 syntmp-level-1101 syntmp-maps-1102) (if (syntmp-fx=-87 syntmp-level-1101 0) (values syntmp-var-1100 syntmp-maps-1102) (if (null? syntmp-maps-1102) (syntax-error syntmp-src-1099 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1073 syntmp-src-1099 syntmp-var-1100 (syntmp-fx--86 syntmp-level-1101 1) (cdr syntmp-maps-1102))) (lambda (syntmp-outer-var-1103 syntmp-outer-maps-1104) (let ((syntmp-b-1105 (assq syntmp-outer-var-1103 (car syntmp-maps-1102)))) (if syntmp-b-1105 (values (cdr syntmp-b-1105) syntmp-maps-1102) (let ((syntmp-inner-var-1106 (syntmp-gen-var-162 (quote tmp)))) (values syntmp-inner-var-1106 (cons (cons (cons syntmp-outer-var-1103 syntmp-inner-var-1106) (car syntmp-maps-1102)) syntmp-outer-maps-1104))))))))))) (syntmp-gen-syntax-1072 (lambda (syntmp-src-1107 syntmp-e-1108 syntmp-r-1109 syntmp-maps-1110 syntmp-ellipsis?-1111) (if (syntmp-id?-114 syntmp-e-1108) (let ((syntmp-label-1112 (syntmp-id-var-name-136 syntmp-e-1108 (quote (()))))) (let ((syntmp-b-1113 (syntmp-lookup-111 syntmp-label-1112 syntmp-r-1109))) (if (eq? (syntmp-binding-type-106 syntmp-b-1113) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1114 (syntmp-binding-value-107 syntmp-b-1113))) (syntmp-gen-ref-1073 syntmp-src-1107 (car syntmp-var.lev-1114) (cdr syntmp-var.lev-1114) syntmp-maps-1110))) (lambda (syntmp-var-1115 syntmp-maps-1116) (values (list (quote ref) syntmp-var-1115) syntmp-maps-1116))) (if (syntmp-ellipsis?-1111 syntmp-e-1108) (syntax-error syntmp-src-1107 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1108) syntmp-maps-1110))))) ((lambda (syntmp-tmp-1117) ((lambda (syntmp-tmp-1118) (if (if syntmp-tmp-1118 (apply (lambda (syntmp-dots-1119 syntmp-e-1120) (syntmp-ellipsis?-1111 syntmp-dots-1119)) syntmp-tmp-1118) #f) (apply (lambda (syntmp-dots-1121 syntmp-e-1122) (syntmp-gen-syntax-1072 syntmp-src-1107 syntmp-e-1122 syntmp-r-1109 syntmp-maps-1110 (lambda (syntmp-x-1123) #f))) syntmp-tmp-1118) ((lambda (syntmp-tmp-1124) (if (if syntmp-tmp-1124 (apply (lambda (syntmp-x-1125 syntmp-dots-1126 syntmp-y-1127) (syntmp-ellipsis?-1111 syntmp-dots-1126)) syntmp-tmp-1124) #f) (apply (lambda (syntmp-x-1128 syntmp-dots-1129 syntmp-y-1130) (let syntmp-f-1131 ((syntmp-y-1132 syntmp-y-1130) (syntmp-k-1133 (lambda (syntmp-maps-1134) (call-with-values (lambda () (syntmp-gen-syntax-1072 syntmp-src-1107 syntmp-x-1128 syntmp-r-1109 (cons (quote ()) syntmp-maps-1134) syntmp-ellipsis?-1111)) (lambda (syntmp-x-1135 syntmp-maps-1136) (if (null? (car syntmp-maps-1136)) (syntax-error syntmp-src-1107 "extra ellipsis in syntax form") (values (syntmp-gen-map-1075 syntmp-x-1135 (car syntmp-maps-1136)) (cdr syntmp-maps-1136)))))))) ((lambda (syntmp-tmp-1137) ((lambda (syntmp-tmp-1138) (if (if syntmp-tmp-1138 (apply (lambda (syntmp-dots-1139 syntmp-y-1140) (syntmp-ellipsis?-1111 syntmp-dots-1139)) syntmp-tmp-1138) #f) (apply (lambda (syntmp-dots-1141 syntmp-y-1142) (syntmp-f-1131 syntmp-y-1142 (lambda (syntmp-maps-1143) (call-with-values (lambda () (syntmp-k-1133 (cons (quote ()) syntmp-maps-1143))) (lambda (syntmp-x-1144 syntmp-maps-1145) (if (null? (car syntmp-maps-1145)) (syntax-error syntmp-src-1107 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1074 syntmp-x-1144 (car syntmp-maps-1145)) (cdr syntmp-maps-1145)))))))) syntmp-tmp-1138) ((lambda (syntmp-_-1146) (call-with-values (lambda () (syntmp-gen-syntax-1072 syntmp-src-1107 syntmp-y-1132 syntmp-r-1109 syntmp-maps-1110 syntmp-ellipsis?-1111)) (lambda (syntmp-y-1147 syntmp-maps-1148) (call-with-values (lambda () (syntmp-k-1133 syntmp-maps-1148)) (lambda (syntmp-x-1149 syntmp-maps-1150) (values (syntmp-gen-append-1077 syntmp-x-1149 syntmp-y-1147) syntmp-maps-1150)))))) syntmp-tmp-1137))) (syntax-dispatch syntmp-tmp-1137 (quote (any . any))))) syntmp-y-1132))) syntmp-tmp-1124) ((lambda (syntmp-tmp-1151) (if syntmp-tmp-1151 (apply (lambda (syntmp-x-1152 syntmp-y-1153) (call-with-values (lambda () (syntmp-gen-syntax-1072 syntmp-src-1107 syntmp-x-1152 syntmp-r-1109 syntmp-maps-1110 syntmp-ellipsis?-1111)) (lambda (syntmp-x-1154 syntmp-maps-1155) (call-with-values (lambda () (syntmp-gen-syntax-1072 syntmp-src-1107 syntmp-y-1153 syntmp-r-1109 syntmp-maps-1155 syntmp-ellipsis?-1111)) (lambda (syntmp-y-1156 syntmp-maps-1157) (values (syntmp-gen-cons-1076 syntmp-x-1154 syntmp-y-1156) syntmp-maps-1157)))))) syntmp-tmp-1151) ((lambda (syntmp-tmp-1158) (if syntmp-tmp-1158 (apply (lambda (syntmp-e1-1159 syntmp-e2-1160) (call-with-values (lambda () (syntmp-gen-syntax-1072 syntmp-src-1107 (cons syntmp-e1-1159 syntmp-e2-1160) syntmp-r-1109 syntmp-maps-1110 syntmp-ellipsis?-1111)) (lambda (syntmp-e-1162 syntmp-maps-1163) (values (syntmp-gen-vector-1078 syntmp-e-1162) syntmp-maps-1163)))) syntmp-tmp-1158) ((lambda (syntmp-_-1164) (values (list (quote quote) syntmp-e-1108) syntmp-maps-1110)) syntmp-tmp-1117))) (syntax-dispatch syntmp-tmp-1117 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1117 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1117 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1117 (quote (any any))))) syntmp-e-1108))))) (lambda (syntmp-e-1165 syntmp-r-1166 syntmp-w-1167 syntmp-s-1168) (let ((syntmp-e-1169 (syntmp-source-wrap-143 syntmp-e-1165 syntmp-w-1167 syntmp-s-1168))) ((lambda (syntmp-tmp-1170) ((lambda (syntmp-tmp-1171) (if syntmp-tmp-1171 (apply (lambda (syntmp-_-1172 syntmp-x-1173) (call-with-values (lambda () (syntmp-gen-syntax-1072 syntmp-e-1169 syntmp-x-1173 syntmp-r-1166 (quote ()) syntmp-ellipsis?-159)) (lambda (syntmp-e-1174 syntmp-maps-1175) (syntmp-regen-1079 syntmp-e-1174)))) syntmp-tmp-1171) ((lambda (syntmp-_-1176) (syntax-error syntmp-e-1169)) syntmp-tmp-1170))) (syntax-dispatch syntmp-tmp-1170 (quote (any any))))) syntmp-e-1169))))) (syntmp-global-extend-112 (quote core) (quote lambda) (lambda (syntmp-e-1177 syntmp-r-1178 syntmp-w-1179 syntmp-s-1180) ((lambda (syntmp-tmp-1181) ((lambda (syntmp-tmp-1182) (if syntmp-tmp-1182 (apply (lambda (syntmp-_-1183 syntmp-c-1184) (syntmp-chi-lambda-clause-155 (syntmp-source-wrap-143 syntmp-e-1177 syntmp-w-1179 syntmp-s-1180) syntmp-c-1184 syntmp-r-1178 syntmp-w-1179 (lambda (syntmp-vars-1185 syntmp-body-1186) (list (quote lambda) syntmp-vars-1185 syntmp-body-1186)))) syntmp-tmp-1182) (syntax-error syntmp-tmp-1181))) (syntax-dispatch syntmp-tmp-1181 (quote (any . any))))) syntmp-e-1177))) (syntmp-global-extend-112 (quote core) (quote let) (letrec ((syntmp-chi-let-1187 (lambda (syntmp-e-1188 syntmp-r-1189 syntmp-w-1190 syntmp-s-1191 syntmp-constructor-1192 syntmp-ids-1193 syntmp-vals-1194 syntmp-exps-1195) (if (not (syntmp-valid-bound-ids?-139 syntmp-ids-1193)) (syntax-error syntmp-e-1188 "duplicate bound variable in") (let ((syntmp-labels-1196 (syntmp-gen-labels-120 syntmp-ids-1193)) (syntmp-new-vars-1197 (map syntmp-gen-var-162 syntmp-ids-1193))) (let ((syntmp-nw-1198 (syntmp-make-binding-wrap-131 syntmp-ids-1193 syntmp-labels-1196 syntmp-w-1190)) (syntmp-nr-1199 (syntmp-extend-var-env-109 syntmp-labels-1196 syntmp-new-vars-1197 syntmp-r-1189))) (syntmp-constructor-1192 syntmp-s-1191 syntmp-new-vars-1197 (map (lambda (syntmp-x-1200) (syntmp-chi-150 syntmp-x-1200 syntmp-r-1189 syntmp-w-1190)) syntmp-vals-1194) (syntmp-chi-body-154 syntmp-exps-1195 (syntmp-source-wrap-143 syntmp-e-1188 syntmp-nw-1198 syntmp-s-1191) syntmp-nr-1199 syntmp-nw-1198)))))))) (lambda (syntmp-e-1201 syntmp-r-1202 syntmp-w-1203 syntmp-s-1204) ((lambda (syntmp-tmp-1205) ((lambda (syntmp-tmp-1206) (if syntmp-tmp-1206 (apply (lambda (syntmp-_-1207 syntmp-id-1208 syntmp-val-1209 syntmp-e1-1210 syntmp-e2-1211) (syntmp-chi-let-1187 syntmp-e-1201 syntmp-r-1202 syntmp-w-1203 syntmp-s-1204 syntmp-build-let-96 syntmp-id-1208 syntmp-val-1209 (cons syntmp-e1-1210 syntmp-e2-1211))) syntmp-tmp-1206) ((lambda (syntmp-tmp-1215) (if (if syntmp-tmp-1215 (apply (lambda (syntmp-_-1216 syntmp-f-1217 syntmp-id-1218 syntmp-val-1219 syntmp-e1-1220 syntmp-e2-1221) (syntmp-id?-114 syntmp-f-1217)) syntmp-tmp-1215) #f) (apply (lambda (syntmp-_-1222 syntmp-f-1223 syntmp-id-1224 syntmp-val-1225 syntmp-e1-1226 syntmp-e2-1227) (syntmp-chi-let-1187 syntmp-e-1201 syntmp-r-1202 syntmp-w-1203 syntmp-s-1204 syntmp-build-named-let-97 (cons syntmp-f-1223 syntmp-id-1224) syntmp-val-1225 (cons syntmp-e1-1226 syntmp-e2-1227))) syntmp-tmp-1215) ((lambda (syntmp-_-1231) (syntax-error (syntmp-source-wrap-143 syntmp-e-1201 syntmp-w-1203 syntmp-s-1204))) syntmp-tmp-1205))) (syntax-dispatch syntmp-tmp-1205 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1205 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1201)))) (syntmp-global-extend-112 (quote core) (quote letrec) (lambda (syntmp-e-1232 syntmp-r-1233 syntmp-w-1234 syntmp-s-1235) ((lambda (syntmp-tmp-1236) ((lambda (syntmp-tmp-1237) (if syntmp-tmp-1237 (apply (lambda (syntmp-_-1238 syntmp-id-1239 syntmp-val-1240 syntmp-e1-1241 syntmp-e2-1242) (let ((syntmp-ids-1243 syntmp-id-1239)) (if (not (syntmp-valid-bound-ids?-139 syntmp-ids-1243)) (syntax-error syntmp-e-1232 "duplicate bound variable in") (let ((syntmp-labels-1245 (syntmp-gen-labels-120 syntmp-ids-1243)) (syntmp-new-vars-1246 (map syntmp-gen-var-162 syntmp-ids-1243))) (let ((syntmp-w-1247 (syntmp-make-binding-wrap-131 syntmp-ids-1243 syntmp-labels-1245 syntmp-w-1234)) (syntmp-r-1248 (syntmp-extend-var-env-109 syntmp-labels-1245 syntmp-new-vars-1246 syntmp-r-1233))) (syntmp-build-letrec-98 syntmp-s-1235 syntmp-new-vars-1246 (map (lambda (syntmp-x-1249) (syntmp-chi-150 syntmp-x-1249 syntmp-r-1248 syntmp-w-1247)) syntmp-val-1240) (syntmp-chi-body-154 (cons syntmp-e1-1241 syntmp-e2-1242) (syntmp-source-wrap-143 syntmp-e-1232 syntmp-w-1247 syntmp-s-1235) syntmp-r-1248 syntmp-w-1247))))))) syntmp-tmp-1237) ((lambda (syntmp-_-1252) (syntax-error (syntmp-source-wrap-143 syntmp-e-1232 syntmp-w-1234 syntmp-s-1235))) syntmp-tmp-1236))) (syntax-dispatch syntmp-tmp-1236 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1232))) (syntmp-global-extend-112 (quote core) (quote set!) (lambda (syntmp-e-1253 syntmp-r-1254 syntmp-w-1255 syntmp-s-1256) ((lambda (syntmp-tmp-1257) ((lambda (syntmp-tmp-1258) (if (if syntmp-tmp-1258 (apply (lambda (syntmp-_-1259 syntmp-id-1260 syntmp-val-1261) (syntmp-id?-114 syntmp-id-1260)) syntmp-tmp-1258) #f) (apply (lambda (syntmp-_-1262 syntmp-id-1263 syntmp-val-1264) (let ((syntmp-val-1265 (syntmp-chi-150 syntmp-val-1264 syntmp-r-1254 syntmp-w-1255)) (syntmp-n-1266 (syntmp-id-var-name-136 syntmp-id-1263 syntmp-w-1255))) (let ((syntmp-b-1267 (syntmp-lookup-111 syntmp-n-1266 syntmp-r-1254))) (let ((syntmp-t-1268 (syntmp-binding-type-106 syntmp-b-1267))) (if (memv syntmp-t-1268 (quote (lexical))) (list (quote set!) (syntmp-binding-value-107 syntmp-b-1267) syntmp-val-1265) (if (memv syntmp-t-1268 (quote (global))) (list (quote set!) syntmp-n-1266 syntmp-val-1265) (if (memv syntmp-t-1268 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-142 syntmp-id-1263 syntmp-w-1255) "identifier out of context") (syntax-error (syntmp-source-wrap-143 syntmp-e-1253 syntmp-w-1255 syntmp-s-1256))))))))) syntmp-tmp-1258) ((lambda (syntmp-tmp-1269) (if syntmp-tmp-1269 (apply (lambda (syntmp-_-1270 syntmp-getter-1271 syntmp-arg-1272 syntmp-val-1273) (cons (syntmp-chi-150 (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 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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-1271) syntmp-r-1254 syntmp-w-1255) (map (lambda (syntmp-e-1274) (syntmp-chi-150 syntmp-e-1274 syntmp-r-1254 syntmp-w-1255)) (append syntmp-arg-1272 (list syntmp-val-1273))))) syntmp-tmp-1269) ((lambda (syntmp-_-1276) (syntax-error (syntmp-source-wrap-143 syntmp-e-1253 syntmp-w-1255 syntmp-s-1256))) syntmp-tmp-1257))) (syntax-dispatch syntmp-tmp-1257 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1257 (quote (any any any))))) syntmp-e-1253))) (syntmp-global-extend-112 (quote begin) (quote begin) (quote ())) (syntmp-global-extend-112 (quote define) (quote define) (quote ())) (syntmp-global-extend-112 (quote define-syntax) (quote define-syntax) (quote ())) (syntmp-global-extend-112 (quote eval-when) (quote eval-when) (quote ())) (syntmp-global-extend-112 (quote core) (quote syntax-case) (letrec ((syntmp-gen-syntax-case-1280 (lambda (syntmp-x-1281 syntmp-keys-1282 syntmp-clauses-1283 syntmp-r-1284) (if (null? syntmp-clauses-1283) (list (quote syntax-error) syntmp-x-1281) ((lambda (syntmp-tmp-1285) ((lambda (syntmp-tmp-1286) (if syntmp-tmp-1286 (apply (lambda (syntmp-pat-1287 syntmp-exp-1288) (if (and (syntmp-id?-114 syntmp-pat-1287) (andmap (lambda (syntmp-x-1289) (not (syntmp-free-id=?-137 syntmp-pat-1287 syntmp-x-1289))) (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 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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-1282))) (let ((syntmp-labels-1290 (list (syntmp-gen-label-119))) (syntmp-var-1291 (syntmp-gen-var-162 syntmp-pat-1287))) (list (list (quote lambda) (list syntmp-var-1291) (syntmp-chi-150 syntmp-exp-1288 (syntmp-extend-env-108 syntmp-labels-1290 (list (cons (quote syntax) (cons syntmp-var-1291 0))) syntmp-r-1284) (syntmp-make-binding-wrap-131 (list syntmp-pat-1287) syntmp-labels-1290 (quote (()))))) syntmp-x-1281)) (syntmp-gen-clause-1279 syntmp-x-1281 syntmp-keys-1282 (cdr syntmp-clauses-1283) syntmp-r-1284 syntmp-pat-1287 #t syntmp-exp-1288))) syntmp-tmp-1286) ((lambda (syntmp-tmp-1292) (if syntmp-tmp-1292 (apply (lambda (syntmp-pat-1293 syntmp-fender-1294 syntmp-exp-1295) (syntmp-gen-clause-1279 syntmp-x-1281 syntmp-keys-1282 (cdr syntmp-clauses-1283) syntmp-r-1284 syntmp-pat-1293 syntmp-fender-1294 syntmp-exp-1295)) syntmp-tmp-1292) ((lambda (syntmp-_-1296) (syntax-error (car syntmp-clauses-1283) "invalid syntax-case clause")) syntmp-tmp-1285))) (syntax-dispatch syntmp-tmp-1285 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1285 (quote (any any))))) (car syntmp-clauses-1283))))) (syntmp-gen-clause-1279 (lambda (syntmp-x-1297 syntmp-keys-1298 syntmp-clauses-1299 syntmp-r-1300 syntmp-pat-1301 syntmp-fender-1302 syntmp-exp-1303) (call-with-values (lambda () (syntmp-convert-pattern-1277 syntmp-pat-1301 syntmp-keys-1298)) (lambda (syntmp-p-1304 syntmp-pvars-1305) (cond ((not (syntmp-distinct-bound-ids?-140 (map car syntmp-pvars-1305))) (syntax-error syntmp-pat-1301 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1306) (not (syntmp-ellipsis?-159 (car syntmp-x-1306)))) syntmp-pvars-1305)) (syntax-error syntmp-pat-1301 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1307 (syntmp-gen-var-162 (quote tmp)))) (list (list (quote lambda) (list syntmp-y-1307) (let ((syntmp-y-1308 syntmp-y-1307)) (list (quote if) ((lambda (syntmp-tmp-1309) ((lambda (syntmp-tmp-1310) (if syntmp-tmp-1310 (apply (lambda () syntmp-y-1308) syntmp-tmp-1310) ((lambda (syntmp-_-1311) (list (quote if) syntmp-y-1308 (syntmp-build-dispatch-call-1278 syntmp-pvars-1305 syntmp-fender-1302 syntmp-y-1308 syntmp-r-1300) (syntmp-build-data-94 #f #f))) syntmp-tmp-1309))) (syntax-dispatch syntmp-tmp-1309 (quote #(atom #t))))) syntmp-fender-1302) (syntmp-build-dispatch-call-1278 syntmp-pvars-1305 syntmp-exp-1303 syntmp-y-1308 syntmp-r-1300) (syntmp-gen-syntax-case-1280 syntmp-x-1297 syntmp-keys-1298 syntmp-clauses-1299 syntmp-r-1300)))) (if (eq? syntmp-p-1304 (quote any)) (list (quote list) syntmp-x-1297) (list (quote syntax-dispatch) syntmp-x-1297 (syntmp-build-data-94 #f syntmp-p-1304))))))))))) (syntmp-build-dispatch-call-1278 (lambda (syntmp-pvars-1312 syntmp-exp-1313 syntmp-y-1314 syntmp-r-1315) (let ((syntmp-ids-1316 (map car syntmp-pvars-1312)) (syntmp-levels-1317 (map cdr syntmp-pvars-1312))) (let ((syntmp-labels-1318 (syntmp-gen-labels-120 syntmp-ids-1316)) (syntmp-new-vars-1319 (map syntmp-gen-var-162 syntmp-ids-1316))) (list (quote apply) (list (quote lambda) syntmp-new-vars-1319 (syntmp-chi-150 syntmp-exp-1313 (syntmp-extend-env-108 syntmp-labels-1318 (map (lambda (syntmp-var-1320 syntmp-level-1321) (cons (quote syntax) (cons syntmp-var-1320 syntmp-level-1321))) syntmp-new-vars-1319 (map cdr syntmp-pvars-1312)) syntmp-r-1315) (syntmp-make-binding-wrap-131 syntmp-ids-1316 syntmp-labels-1318 (quote (()))))) syntmp-y-1314))))) (syntmp-convert-pattern-1277 (lambda (syntmp-pattern-1322 syntmp-keys-1323) (let syntmp-cvt-1324 ((syntmp-p-1325 syntmp-pattern-1322) (syntmp-n-1326 0) (syntmp-ids-1327 (quote ()))) (if (syntmp-id?-114 syntmp-p-1325) (if (syntmp-bound-id-member?-141 syntmp-p-1325 syntmp-keys-1323) (values (vector (quote free-id) syntmp-p-1325) syntmp-ids-1327) (values (quote any) (cons (cons syntmp-p-1325 syntmp-n-1326) syntmp-ids-1327))) ((lambda (syntmp-tmp-1328) ((lambda (syntmp-tmp-1329) (if (if syntmp-tmp-1329 (apply (lambda (syntmp-x-1330 syntmp-dots-1331) (syntmp-ellipsis?-159 syntmp-dots-1331)) syntmp-tmp-1329) #f) (apply (lambda (syntmp-x-1332 syntmp-dots-1333) (call-with-values (lambda () (syntmp-cvt-1324 syntmp-x-1332 (syntmp-fx+-85 syntmp-n-1326 1) syntmp-ids-1327)) (lambda (syntmp-p-1334 syntmp-ids-1335) (values (if (eq? syntmp-p-1334 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1334)) syntmp-ids-1335)))) syntmp-tmp-1329) ((lambda (syntmp-tmp-1336) (if syntmp-tmp-1336 (apply (lambda (syntmp-x-1337 syntmp-y-1338) (call-with-values (lambda () (syntmp-cvt-1324 syntmp-y-1338 syntmp-n-1326 syntmp-ids-1327)) (lambda (syntmp-y-1339 syntmp-ids-1340) (call-with-values (lambda () (syntmp-cvt-1324 syntmp-x-1337 syntmp-n-1326 syntmp-ids-1340)) (lambda (syntmp-x-1341 syntmp-ids-1342) (values (cons syntmp-x-1341 syntmp-y-1339) syntmp-ids-1342)))))) syntmp-tmp-1336) ((lambda (syntmp-tmp-1343) (if syntmp-tmp-1343 (apply (lambda () (values (quote ()) syntmp-ids-1327)) syntmp-tmp-1343) ((lambda (syntmp-tmp-1344) (if syntmp-tmp-1344 (apply (lambda (syntmp-x-1345) (call-with-values (lambda () (syntmp-cvt-1324 syntmp-x-1345 syntmp-n-1326 syntmp-ids-1327)) (lambda (syntmp-p-1347 syntmp-ids-1348) (values (vector (quote vector) syntmp-p-1347) syntmp-ids-1348)))) syntmp-tmp-1344) ((lambda (syntmp-x-1349) (values (vector (quote atom) (syntmp-strip-161 syntmp-p-1325 (quote (())))) syntmp-ids-1327)) syntmp-tmp-1328))) (syntax-dispatch syntmp-tmp-1328 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1328 (quote ()))))) (syntax-dispatch syntmp-tmp-1328 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1328 (quote (any any))))) syntmp-p-1325)))))) (lambda (syntmp-e-1350 syntmp-r-1351 syntmp-w-1352 syntmp-s-1353) (let ((syntmp-e-1354 (syntmp-source-wrap-143 syntmp-e-1350 syntmp-w-1352 syntmp-s-1353))) ((lambda (syntmp-tmp-1355) ((lambda (syntmp-tmp-1356) (if syntmp-tmp-1356 (apply (lambda (syntmp-_-1357 syntmp-val-1358 syntmp-key-1359 syntmp-m-1360) (if (andmap (lambda (syntmp-x-1361) (and (syntmp-id?-114 syntmp-x-1361) (not (syntmp-ellipsis?-159 syntmp-x-1361)))) syntmp-key-1359) (let ((syntmp-x-1363 (syntmp-gen-var-162 (quote tmp)))) (list (list (quote lambda) (list syntmp-x-1363) (syntmp-gen-syntax-case-1280 syntmp-x-1363 syntmp-key-1359 syntmp-m-1360 syntmp-r-1351)) (syntmp-chi-150 syntmp-val-1358 syntmp-r-1351 (quote (()))))) (syntax-error syntmp-e-1354 "invalid literals list in"))) syntmp-tmp-1356) (syntax-error syntmp-tmp-1355))) (syntax-dispatch syntmp-tmp-1355 (quote (any any each-any . each-any))))) syntmp-e-1354))))) (set! sc-expand (let ((syntmp-m-1366 (quote e)) (syntmp-esew-1367 (quote (eval)))) (lambda (syntmp-x-1368) (if (and (pair? syntmp-x-1368) (equal? (car syntmp-x-1368) syntmp-noexpand-84)) (cadr syntmp-x-1368) (syntmp-chi-top-149 syntmp-x-1368 (quote ()) (quote ((top))) syntmp-m-1366 syntmp-esew-1367))))) (set! sc-expand3 (let ((syntmp-m-1369 (quote e)) (syntmp-esew-1370 (quote (eval)))) (lambda (syntmp-x-1372 . syntmp-rest-1371) (if (and (pair? syntmp-x-1372) (equal? (car syntmp-x-1372) syntmp-noexpand-84)) (cadr syntmp-x-1372) (syntmp-chi-top-149 syntmp-x-1372 (quote ()) (quote ((top))) (if (null? syntmp-rest-1371) syntmp-m-1369 (car syntmp-rest-1371)) (if (or (null? syntmp-rest-1371) (null? (cdr syntmp-rest-1371))) syntmp-esew-1370 (cadr syntmp-rest-1371))))))) (set! identifier? (lambda (syntmp-x-1373) (syntmp-nonsymbol-id?-113 syntmp-x-1373))) (set! datum->syntax-object (lambda (syntmp-id-1374 syntmp-datum-1375) (syntmp-make-syntax-object-99 syntmp-datum-1375 (syntmp-syntax-object-wrap-102 syntmp-id-1374)))) (set! syntax-object->datum (lambda (syntmp-x-1376) (syntmp-strip-161 syntmp-x-1376 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1377) (begin (let ((syntmp-x-1378 syntmp-ls-1377)) (if (not (list? syntmp-x-1378)) (syntmp-error-hook-91 (quote generate-temporaries) "invalid argument" syntmp-x-1378))) (map (lambda (syntmp-x-1379) (syntmp-wrap-142 (gensym) (quote ((top))))) syntmp-ls-1377)))) (set! free-identifier=? (lambda (syntmp-x-1380 syntmp-y-1381) (begin (let ((syntmp-x-1382 syntmp-x-1380)) (if (not (syntmp-nonsymbol-id?-113 syntmp-x-1382)) (syntmp-error-hook-91 (quote free-identifier=?) "invalid argument" syntmp-x-1382))) (let ((syntmp-x-1383 syntmp-y-1381)) (if (not (syntmp-nonsymbol-id?-113 syntmp-x-1383)) (syntmp-error-hook-91 (quote free-identifier=?) "invalid argument" syntmp-x-1383))) (syntmp-free-id=?-137 syntmp-x-1380 syntmp-y-1381)))) (set! bound-identifier=? (lambda (syntmp-x-1384 syntmp-y-1385) (begin (let ((syntmp-x-1386 syntmp-x-1384)) (if (not (syntmp-nonsymbol-id?-113 syntmp-x-1386)) (syntmp-error-hook-91 (quote bound-identifier=?) "invalid argument" syntmp-x-1386))) (let ((syntmp-x-1387 syntmp-y-1385)) (if (not (syntmp-nonsymbol-id?-113 syntmp-x-1387)) (syntmp-error-hook-91 (quote bound-identifier=?) "invalid argument" syntmp-x-1387))) (syntmp-bound-id=?-138 syntmp-x-1384 syntmp-y-1385)))) (set! syntax-error (lambda (syntmp-object-1389 . syntmp-messages-1388) (begin (for-each (lambda (syntmp-x-1390) (let ((syntmp-x-1391 syntmp-x-1390)) (if (not (string? syntmp-x-1391)) (syntmp-error-hook-91 (quote syntax-error) "invalid argument" syntmp-x-1391)))) syntmp-messages-1388) (let ((syntmp-message-1392 (if (null? syntmp-messages-1388) "invalid syntax" (apply string-append syntmp-messages-1388)))) (syntmp-error-hook-91 #f syntmp-message-1392 (syntmp-strip-161 syntmp-object-1389 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1393 syntmp-v-1394) (begin (let ((syntmp-x-1395 syntmp-sym-1393)) (if (not (symbol? syntmp-x-1395)) (syntmp-error-hook-91 (quote define-syntax) "invalid argument" syntmp-x-1395))) (let ((syntmp-x-1396 syntmp-v-1394)) (if (not (procedure? syntmp-x-1396)) (syntmp-error-hook-91 (quote define-syntax) "invalid argument" syntmp-x-1396))) (syntmp-global-extend-112 (quote macro) syntmp-sym-1393 syntmp-v-1394)))) (letrec ((syntmp-match-1401 (lambda (syntmp-e-1402 syntmp-p-1403 syntmp-w-1404 syntmp-r-1405) (cond ((not syntmp-r-1405) #f) ((eq? syntmp-p-1403 (quote any)) (cons (syntmp-wrap-142 syntmp-e-1402 syntmp-w-1404) syntmp-r-1405)) ((syntmp-syntax-object?-100 syntmp-e-1402) (syntmp-match*-1400 (let ((syntmp-e-1406 (syntmp-syntax-object-expression-101 syntmp-e-1402))) (if (annotation? syntmp-e-1406) (annotation-expression syntmp-e-1406) syntmp-e-1406)) syntmp-p-1403 (syntmp-join-wraps-133 syntmp-w-1404 (syntmp-syntax-object-wrap-102 syntmp-e-1402)) syntmp-r-1405)) (else (syntmp-match*-1400 (let ((syntmp-e-1407 syntmp-e-1402)) (if (annotation? syntmp-e-1407) (annotation-expression syntmp-e-1407) syntmp-e-1407)) syntmp-p-1403 syntmp-w-1404 syntmp-r-1405))))) (syntmp-match*-1400 (lambda (syntmp-e-1408 syntmp-p-1409 syntmp-w-1410 syntmp-r-1411) (cond ((null? syntmp-p-1409) (and (null? syntmp-e-1408) syntmp-r-1411)) ((pair? syntmp-p-1409) (and (pair? syntmp-e-1408) (syntmp-match-1401 (car syntmp-e-1408) (car syntmp-p-1409) syntmp-w-1410 (syntmp-match-1401 (cdr syntmp-e-1408) (cdr syntmp-p-1409) syntmp-w-1410 syntmp-r-1411)))) ((eq? syntmp-p-1409 (quote each-any)) (let ((syntmp-l-1412 (syntmp-match-each-any-1398 syntmp-e-1408 syntmp-w-1410))) (and syntmp-l-1412 (cons syntmp-l-1412 syntmp-r-1411)))) (else (let ((syntmp-t-1413 (vector-ref syntmp-p-1409 0))) (if (memv syntmp-t-1413 (quote (each))) (if (null? syntmp-e-1408) (syntmp-match-empty-1399 (vector-ref syntmp-p-1409 1) syntmp-r-1411) (let ((syntmp-l-1414 (syntmp-match-each-1397 syntmp-e-1408 (vector-ref syntmp-p-1409 1) syntmp-w-1410))) (and syntmp-l-1414 (let syntmp-collect-1415 ((syntmp-l-1416 syntmp-l-1414)) (if (null? (car syntmp-l-1416)) syntmp-r-1411 (cons (map car syntmp-l-1416) (syntmp-collect-1415 (map cdr syntmp-l-1416)))))))) (if (memv syntmp-t-1413 (quote (free-id))) (and (syntmp-id?-114 syntmp-e-1408) (syntmp-free-id=?-137 (syntmp-wrap-142 syntmp-e-1408 syntmp-w-1410) (vector-ref syntmp-p-1409 1)) syntmp-r-1411) (if (memv syntmp-t-1413 (quote (atom))) (and (equal? (vector-ref syntmp-p-1409 1) (syntmp-strip-161 syntmp-e-1408 syntmp-w-1410)) syntmp-r-1411) (if (memv syntmp-t-1413 (quote (vector))) (and (vector? syntmp-e-1408) (syntmp-match-1401 (vector->list syntmp-e-1408) (vector-ref syntmp-p-1409 1) syntmp-w-1410 syntmp-r-1411))))))))))) (syntmp-match-empty-1399 (lambda (syntmp-p-1417 syntmp-r-1418) (cond ((null? syntmp-p-1417) syntmp-r-1418) ((eq? syntmp-p-1417 (quote any)) (cons (quote ()) syntmp-r-1418)) ((pair? syntmp-p-1417) (syntmp-match-empty-1399 (car syntmp-p-1417) (syntmp-match-empty-1399 (cdr syntmp-p-1417) syntmp-r-1418))) ((eq? syntmp-p-1417 (quote each-any)) (cons (quote ()) syntmp-r-1418)) (else (let ((syntmp-t-1419 (vector-ref syntmp-p-1417 0))) (if (memv syntmp-t-1419 (quote (each))) (syntmp-match-empty-1399 (vector-ref syntmp-p-1417 1) syntmp-r-1418) (if (memv syntmp-t-1419 (quote (free-id atom))) syntmp-r-1418 (if (memv syntmp-t-1419 (quote (vector))) (syntmp-match-empty-1399 (vector-ref syntmp-p-1417 1) syntmp-r-1418))))))))) (syntmp-match-each-any-1398 (lambda (syntmp-e-1420 syntmp-w-1421) (cond ((annotation? syntmp-e-1420) (syntmp-match-each-any-1398 (annotation-expression syntmp-e-1420) syntmp-w-1421)) ((pair? syntmp-e-1420) (let ((syntmp-l-1422 (syntmp-match-each-any-1398 (cdr syntmp-e-1420) syntmp-w-1421))) (and syntmp-l-1422 (cons (syntmp-wrap-142 (car syntmp-e-1420) syntmp-w-1421) syntmp-l-1422)))) ((null? syntmp-e-1420) (quote ())) ((syntmp-syntax-object?-100 syntmp-e-1420) (syntmp-match-each-any-1398 (syntmp-syntax-object-expression-101 syntmp-e-1420) (syntmp-join-wraps-133 syntmp-w-1421 (syntmp-syntax-object-wrap-102 syntmp-e-1420)))) (else #f)))) (syntmp-match-each-1397 (lambda (syntmp-e-1423 syntmp-p-1424 syntmp-w-1425) (cond ((annotation? syntmp-e-1423) (syntmp-match-each-1397 (annotation-expression syntmp-e-1423) syntmp-p-1424 syntmp-w-1425)) ((pair? syntmp-e-1423) (let ((syntmp-first-1426 (syntmp-match-1401 (car syntmp-e-1423) syntmp-p-1424 syntmp-w-1425 (quote ())))) (and syntmp-first-1426 (let ((syntmp-rest-1427 (syntmp-match-each-1397 (cdr syntmp-e-1423) syntmp-p-1424 syntmp-w-1425))) (and syntmp-rest-1427 (cons syntmp-first-1426 syntmp-rest-1427)))))) ((null? syntmp-e-1423) (quote ())) ((syntmp-syntax-object?-100 syntmp-e-1423) (syntmp-match-each-1397 (syntmp-syntax-object-expression-101 syntmp-e-1423) syntmp-p-1424 (syntmp-join-wraps-133 syntmp-w-1425 (syntmp-syntax-object-wrap-102 syntmp-e-1423)))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1428 syntmp-p-1429) (cond ((eq? syntmp-p-1429 (quote any)) (list syntmp-e-1428)) ((syntmp-syntax-object?-100 syntmp-e-1428) (syntmp-match*-1400 (let ((syntmp-e-1430 (syntmp-syntax-object-expression-101 syntmp-e-1428))) (if (annotation? syntmp-e-1430) (annotation-expression syntmp-e-1430) syntmp-e-1430)) syntmp-p-1429 (syntmp-syntax-object-wrap-102 syntmp-e-1428) (quote ()))) (else (syntmp-match*-1400 (let ((syntmp-e-1431 syntmp-e-1428)) (if (annotation? syntmp-e-1431) (annotation-expression syntmp-e-1431) syntmp-e-1431)) syntmp-p-1429 (quote (())) (quote ())))))) (set! sc-chi syntmp-chi-150))))) +(install-global-transformer (quote with-syntax) (lambda (syntmp-x-1432) ((lambda (syntmp-tmp-1433) ((lambda (syntmp-tmp-1434) (if syntmp-tmp-1434 (apply (lambda (syntmp-_-1435 syntmp-e1-1436 syntmp-e2-1437) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1436 syntmp-e2-1437))) syntmp-tmp-1434) ((lambda (syntmp-tmp-1439) (if syntmp-tmp-1439 (apply (lambda (syntmp-_-1440 syntmp-out-1441 syntmp-in-1442 syntmp-e1-1443 syntmp-e2-1444) (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-1442 (quote ()) (list syntmp-out-1441 (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-1443 syntmp-e2-1444))))) syntmp-tmp-1439) ((lambda (syntmp-tmp-1446) (if syntmp-tmp-1446 (apply (lambda (syntmp-_-1447 syntmp-out-1448 syntmp-in-1449 syntmp-e1-1450 syntmp-e2-1451) (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-1449) (quote ()) (list syntmp-out-1448 (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-1450 syntmp-e2-1451))))) syntmp-tmp-1446) (syntax-error syntmp-tmp-1433))) (syntax-dispatch syntmp-tmp-1433 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1433 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1433 (quote (any () any . each-any))))) syntmp-x-1432))) +(install-global-transformer (quote syntax-rules) (lambda (syntmp-x-1473) ((lambda (syntmp-tmp-1474) ((lambda (syntmp-tmp-1475) (if syntmp-tmp-1475 (apply (lambda (syntmp-_-1476 syntmp-k-1477 syntmp-keyword-1478 syntmp-pattern-1479 syntmp-template-1480) (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-1477 (map (lambda (syntmp-tmp-1483 syntmp-tmp-1482) (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-1482) (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-1483))) syntmp-template-1480 syntmp-pattern-1479)))))) syntmp-tmp-1475) (syntax-error syntmp-tmp-1474))) (syntax-dispatch syntmp-tmp-1474 (quote (any each-any . #(each ((any . any) any))))))) syntmp-x-1473))) +(install-global-transformer (quote let*) (lambda (syntmp-x-1494) ((lambda (syntmp-tmp-1495) ((lambda (syntmp-tmp-1496) (if (if syntmp-tmp-1496 (apply (lambda (syntmp-let*-1497 syntmp-x-1498 syntmp-v-1499 syntmp-e1-1500 syntmp-e2-1501) (andmap identifier? syntmp-x-1498)) syntmp-tmp-1496) #f) (apply (lambda (syntmp-let*-1503 syntmp-x-1504 syntmp-v-1505 syntmp-e1-1506 syntmp-e2-1507) (let syntmp-f-1508 ((syntmp-bindings-1509 (map list syntmp-x-1504 syntmp-v-1505))) (if (null? syntmp-bindings-1509) (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-1506 syntmp-e2-1507))) ((lambda (syntmp-tmp-1513) ((lambda (syntmp-tmp-1514) (if syntmp-tmp-1514 (apply (lambda (syntmp-body-1515 syntmp-binding-1516) (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-1516) syntmp-body-1515)) syntmp-tmp-1514) (syntax-error syntmp-tmp-1513))) (syntax-dispatch syntmp-tmp-1513 (quote (any any))))) (list (syntmp-f-1508 (cdr syntmp-bindings-1509)) (car syntmp-bindings-1509)))))) syntmp-tmp-1496) (syntax-error syntmp-tmp-1495))) (syntax-dispatch syntmp-tmp-1495 (quote (any #(each (any any)) any . each-any))))) syntmp-x-1494))) +(install-global-transformer (quote do) (lambda (syntmp-orig-x-1536) ((lambda (syntmp-tmp-1537) ((lambda (syntmp-tmp-1538) (if syntmp-tmp-1538 (apply (lambda (syntmp-_-1539 syntmp-var-1540 syntmp-init-1541 syntmp-step-1542 syntmp-e0-1543 syntmp-e1-1544 syntmp-c-1545) ((lambda (syntmp-tmp-1546) ((lambda (syntmp-tmp-1547) (if syntmp-tmp-1547 (apply (lambda (syntmp-step-1548) ((lambda (syntmp-tmp-1549) ((lambda (syntmp-tmp-1550) (if syntmp-tmp-1550 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (map list syntmp-var-1540 syntmp-init-1541) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-e0-1543) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (append syntmp-c-1545 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-step-1548))))))) syntmp-tmp-1550) ((lambda (syntmp-tmp-1555) (if syntmp-tmp-1555 (apply (lambda (syntmp-e1-1556 syntmp-e2-1557) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (map list syntmp-var-1540 syntmp-init-1541) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-e0-1543 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (cons syntmp-e1-1556 syntmp-e2-1557)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (append syntmp-c-1545 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-step-1548))))))) syntmp-tmp-1555) (syntax-error syntmp-tmp-1549))) (syntax-dispatch syntmp-tmp-1549 (quote (any . each-any)))))) (syntax-dispatch syntmp-tmp-1549 (quote ())))) syntmp-e1-1544)) syntmp-tmp-1547) (syntax-error syntmp-tmp-1546))) (syntax-dispatch syntmp-tmp-1546 (quote each-any)))) (map (lambda (syntmp-v-1564 syntmp-s-1565) ((lambda (syntmp-tmp-1566) ((lambda (syntmp-tmp-1567) (if syntmp-tmp-1567 (apply (lambda () syntmp-v-1564) syntmp-tmp-1567) ((lambda (syntmp-tmp-1568) (if syntmp-tmp-1568 (apply (lambda (syntmp-e-1569) syntmp-e-1569) syntmp-tmp-1568) ((lambda (syntmp-_-1570) (syntax-error syntmp-orig-x-1536)) syntmp-tmp-1566))) (syntax-dispatch syntmp-tmp-1566 (quote (any)))))) (syntax-dispatch syntmp-tmp-1566 (quote ())))) syntmp-s-1565)) syntmp-var-1540 syntmp-step-1542))) syntmp-tmp-1538) (syntax-error syntmp-tmp-1537))) (syntax-dispatch syntmp-tmp-1537 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) syntmp-orig-x-1536))) +(install-global-transformer (quote quasiquote) (letrec ((syntmp-quasicons-1598 (lambda (syntmp-x-1602 syntmp-y-1603) ((lambda (syntmp-tmp-1604) ((lambda (syntmp-tmp-1605) (if syntmp-tmp-1605 (apply (lambda (syntmp-x-1606 syntmp-y-1607) ((lambda (syntmp-tmp-1608) ((lambda (syntmp-tmp-1609) (if syntmp-tmp-1609 (apply (lambda (syntmp-dy-1610) ((lambda (syntmp-tmp-1611) ((lambda (syntmp-tmp-1612) (if syntmp-tmp-1612 (apply (lambda (syntmp-dx-1613) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons syntmp-dx-1613 syntmp-dy-1610))) syntmp-tmp-1612) ((lambda (syntmp-_-1614) (if (null? syntmp-dy-1610) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1606) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1606 syntmp-y-1607))) syntmp-tmp-1611))) (syntax-dispatch syntmp-tmp-1611 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-x-1606)) syntmp-tmp-1609) ((lambda (syntmp-tmp-1615) (if syntmp-tmp-1615 (apply (lambda (syntmp-stuff-1616) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons syntmp-x-1606 syntmp-stuff-1616))) syntmp-tmp-1615) ((lambda (syntmp-else-1617) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1606 syntmp-y-1607)) syntmp-tmp-1608))) (syntax-dispatch syntmp-tmp-1608 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . any)))))) (syntax-dispatch syntmp-tmp-1608 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-y-1607)) syntmp-tmp-1605) (syntax-error syntmp-tmp-1604))) (syntax-dispatch syntmp-tmp-1604 (quote (any any))))) (list syntmp-x-1602 syntmp-y-1603)))) (syntmp-quasiappend-1599 (lambda (syntmp-x-1618 syntmp-y-1619) ((lambda (syntmp-tmp-1620) ((lambda (syntmp-tmp-1621) (if syntmp-tmp-1621 (apply (lambda (syntmp-x-1622 syntmp-y-1623) ((lambda (syntmp-tmp-1624) ((lambda (syntmp-tmp-1625) (if syntmp-tmp-1625 (apply (lambda () syntmp-x-1622) syntmp-tmp-1625) ((lambda (syntmp-_-1626) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1622 syntmp-y-1623)) syntmp-tmp-1624))) (syntax-dispatch syntmp-tmp-1624 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) ()))))) syntmp-y-1623)) syntmp-tmp-1621) (syntax-error syntmp-tmp-1620))) (syntax-dispatch syntmp-tmp-1620 (quote (any any))))) (list syntmp-x-1618 syntmp-y-1619)))) (syntmp-quasivector-1600 (lambda (syntmp-x-1627) ((lambda (syntmp-tmp-1628) ((lambda (syntmp-x-1629) ((lambda (syntmp-tmp-1630) ((lambda (syntmp-tmp-1631) (if syntmp-tmp-1631 (apply (lambda (syntmp-x-1632) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (list->vector syntmp-x-1632))) syntmp-tmp-1631) ((lambda (syntmp-tmp-1634) (if syntmp-tmp-1634 (apply (lambda (syntmp-x-1635) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1635)) syntmp-tmp-1634) ((lambda (syntmp-_-1637) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1629)) syntmp-tmp-1630))) (syntax-dispatch syntmp-tmp-1630 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . each-any)))))) (syntax-dispatch syntmp-tmp-1630 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) each-any))))) syntmp-x-1629)) syntmp-tmp-1628)) syntmp-x-1627))) (syntmp-quasi-1601 (lambda (syntmp-p-1638 syntmp-lev-1639) ((lambda (syntmp-tmp-1640) ((lambda (syntmp-tmp-1641) (if syntmp-tmp-1641 (apply (lambda (syntmp-p-1642) (if (= syntmp-lev-1639 0) syntmp-p-1642 (syntmp-quasicons-1598 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1601 (list syntmp-p-1642) (- syntmp-lev-1639 1))))) syntmp-tmp-1641) ((lambda (syntmp-tmp-1643) (if syntmp-tmp-1643 (apply (lambda (syntmp-p-1644 syntmp-q-1645) (if (= syntmp-lev-1639 0) (syntmp-quasiappend-1599 syntmp-p-1644 (syntmp-quasi-1601 syntmp-q-1645 syntmp-lev-1639)) (syntmp-quasicons-1598 (syntmp-quasicons-1598 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1601 (list syntmp-p-1644) (- syntmp-lev-1639 1))) (syntmp-quasi-1601 syntmp-q-1645 syntmp-lev-1639)))) syntmp-tmp-1643) ((lambda (syntmp-tmp-1646) (if syntmp-tmp-1646 (apply (lambda (syntmp-p-1647) (syntmp-quasicons-1598 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1601 (list syntmp-p-1647) (+ syntmp-lev-1639 1)))) syntmp-tmp-1646) ((lambda (syntmp-tmp-1648) (if syntmp-tmp-1648 (apply (lambda (syntmp-p-1649 syntmp-q-1650) (syntmp-quasicons-1598 (syntmp-quasi-1601 syntmp-p-1649 syntmp-lev-1639) (syntmp-quasi-1601 syntmp-q-1650 syntmp-lev-1639))) syntmp-tmp-1648) ((lambda (syntmp-tmp-1651) (if syntmp-tmp-1651 (apply (lambda (syntmp-x-1652) (syntmp-quasivector-1600 (syntmp-quasi-1601 syntmp-x-1652 syntmp-lev-1639))) syntmp-tmp-1651) ((lambda (syntmp-p-1654) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-p-1654)) syntmp-tmp-1640))) (syntax-dispatch syntmp-tmp-1640 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1640 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1640 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any)))))) (syntax-dispatch syntmp-tmp-1640 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any) . any)))))) (syntax-dispatch syntmp-tmp-1640 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-p-1638)))) (lambda (syntmp-x-1655) ((lambda (syntmp-tmp-1656) ((lambda (syntmp-tmp-1657) (if syntmp-tmp-1657 (apply (lambda (syntmp-_-1658 syntmp-e-1659) (syntmp-quasi-1601 syntmp-e-1659 0)) syntmp-tmp-1657) (syntax-error syntmp-tmp-1656))) (syntax-dispatch syntmp-tmp-1656 (quote (any any))))) syntmp-x-1655)))) +(install-global-transformer (quote include) (lambda (syntmp-x-1719) (letrec ((syntmp-read-file-1720 (lambda (syntmp-fn-1721 syntmp-k-1722) (let ((syntmp-p-1723 (open-input-file syntmp-fn-1721))) (let syntmp-f-1724 ((syntmp-x-1725 (read syntmp-p-1723))) (if (eof-object? syntmp-x-1725) (begin (close-input-port syntmp-p-1723) (quote ())) (cons (datum->syntax-object syntmp-k-1722 syntmp-x-1725) (syntmp-f-1724 (read syntmp-p-1723))))))))) ((lambda (syntmp-tmp-1726) ((lambda (syntmp-tmp-1727) (if syntmp-tmp-1727 (apply (lambda (syntmp-k-1728 syntmp-filename-1729) (let ((syntmp-fn-1730 (syntax-object->datum syntmp-filename-1729))) ((lambda (syntmp-tmp-1731) ((lambda (syntmp-tmp-1732) (if syntmp-tmp-1732 (apply (lambda (syntmp-exp-1733) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))))) syntmp-exp-1733)) syntmp-tmp-1732) (syntax-error syntmp-tmp-1731))) (syntax-dispatch syntmp-tmp-1731 (quote each-any)))) (syntmp-read-file-1720 syntmp-fn-1730 syntmp-k-1728)))) syntmp-tmp-1727) (syntax-error syntmp-tmp-1726))) (syntax-dispatch syntmp-tmp-1726 (quote (any any))))) syntmp-x-1719)))) +(install-global-transformer (quote unquote) (lambda (syntmp-x-1750) ((lambda (syntmp-tmp-1751) ((lambda (syntmp-tmp-1752) (if syntmp-tmp-1752 (apply (lambda (syntmp-_-1753 syntmp-e-1754) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1754))) syntmp-tmp-1752) (syntax-error syntmp-tmp-1751))) (syntax-dispatch syntmp-tmp-1751 (quote (any any))))) syntmp-x-1750))) +(install-global-transformer (quote unquote-splicing) (lambda (syntmp-x-1760) ((lambda (syntmp-tmp-1761) ((lambda (syntmp-tmp-1762) (if syntmp-tmp-1762 (apply (lambda (syntmp-_-1763 syntmp-e-1764) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1764))) syntmp-tmp-1762) (syntax-error syntmp-tmp-1761))) (syntax-dispatch syntmp-tmp-1761 (quote (any any))))) syntmp-x-1760))) +(install-global-transformer (quote case) (lambda (syntmp-x-1770) ((lambda (syntmp-tmp-1771) ((lambda (syntmp-tmp-1772) (if syntmp-tmp-1772 (apply (lambda (syntmp-_-1773 syntmp-e-1774 syntmp-m1-1775 syntmp-m2-1776) ((lambda (syntmp-tmp-1777) ((lambda (syntmp-body-1778) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-e-1774)) syntmp-body-1778)) syntmp-tmp-1777)) (let syntmp-f-1779 ((syntmp-clause-1780 syntmp-m1-1775) (syntmp-clauses-1781 syntmp-m2-1776)) (if (null? syntmp-clauses-1781) ((lambda (syntmp-tmp-1783) ((lambda (syntmp-tmp-1784) (if syntmp-tmp-1784 (apply (lambda (syntmp-e1-1785 syntmp-e2-1786) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1785 syntmp-e2-1786))) syntmp-tmp-1784) ((lambda (syntmp-tmp-1788) (if syntmp-tmp-1788 (apply (lambda (syntmp-k-1789 syntmp-e1-1790 syntmp-e2-1791) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-k-1789)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1790 syntmp-e2-1791)))) syntmp-tmp-1788) ((lambda (syntmp-_-1794) (syntax-error syntmp-x-1770)) syntmp-tmp-1783))) (syntax-dispatch syntmp-tmp-1783 (quote (each-any any . each-any)))))) (syntax-dispatch syntmp-tmp-1783 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) any . each-any))))) syntmp-clause-1780) ((lambda (syntmp-tmp-1795) ((lambda (syntmp-rest-1796) ((lambda (syntmp-tmp-1797) ((lambda (syntmp-tmp-1798) (if syntmp-tmp-1798 (apply (lambda (syntmp-k-1799 syntmp-e1-1800 syntmp-e2-1801) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-k-1799)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1800 syntmp-e2-1801)) syntmp-rest-1796)) syntmp-tmp-1798) ((lambda (syntmp-_-1804) (syntax-error syntmp-x-1770)) syntmp-tmp-1797))) (syntax-dispatch syntmp-tmp-1797 (quote (each-any any . each-any))))) syntmp-clause-1780)) syntmp-tmp-1795)) (syntmp-f-1779 (car syntmp-clauses-1781) (cdr syntmp-clauses-1781))))))) syntmp-tmp-1772) (syntax-error syntmp-tmp-1771))) (syntax-dispatch syntmp-tmp-1771 (quote (any any any . each-any))))) syntmp-x-1770))) +(install-global-transformer (quote identifier-syntax) (lambda (syntmp-x-1834) ((lambda (syntmp-tmp-1835) ((lambda (syntmp-tmp-1836) (if syntmp-tmp-1836 (apply (lambda (syntmp-_-1837 syntmp-e-1838) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-e-1838)) (list (cons syntmp-_-1837 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e-1838 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))))))))) syntmp-tmp-1836) (syntax-error syntmp-tmp-1835))) (syntax-dispatch syntmp-tmp-1835 (quote (any any))))) syntmp-x-1834))) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 22e409d3e..50efff50b 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -318,8 +318,6 @@ (define fx= =) (define fx< <) -(define annotation? (lambda (x) #f)) - (define top-level-eval-hook (lambda (x) (eval `(,noexpand ,x) (interaction-environment)))) diff --git a/module/ice-9/syncase.scm b/module/ice-9/syncase.scm index 5fd3a3214..2dbf8735e 100644 --- a/module/ice-9/syncase.scm +++ b/module/ice-9/syncase.scm @@ -19,6 +19,7 @@ (define-module (ice-9 syncase) :use-module (ice-9 debug) :use-module (ice-9 threads) + :use-module (ice-9 annotate) :export-syntax (sc-macro define-syntax define-syntax-public eval-when fluid-let-syntax identifier-syntax let-syntax diff --git a/module/language/scheme/expand.scm b/module/language/scheme/expand.scm index d0e66e9ad..ee689a092 100644 --- a/module/language/scheme/expand.scm +++ b/module/language/scheme/expand.scm @@ -284,11 +284,13 @@ ((,modname ,sym) x)) -(define-scheme-expander eval-case - (,clauses - (-> `(eval-case . ,(map (lambda (x) - (-> `(,(acar x) . ,(map re-expand (acdr x))))) - clauses))))) +(define-scheme-expander eval-when + ((,when . ,body) (guard (list? when) (and-map symbol? when)) + (if (memq 'compile when) + (primitive-eval `(begin . ,body))) + (if (memq 'load when) + (-> `(begin . ,body)) + (-> `(begin))))) ;;; Hum, I don't think this takes imported modifications to `define' ;;; properly into account. (Lexical bindings are OK because of alpha