;; Before the module system boots, there are no module names. But
;; psyntax does want a module-name definition, so give it one.
(define (module-name x)
- #f)
+ '(guile))
(define (module-add! module sym var)
(hashq-set! (%get-pre-modules-obarray) sym var))
(define module-transformer (record-accessor module-type 'transformer))
(define set-module-transformer! (record-modifier module-type 'transformer))
-(define module-name (record-accessor module-type 'name))
+;; (define module-name (record-accessor module-type 'name)) wait until mods are booted
(define set-module-name! (record-modifier module-type 'name))
(define module-kind (record-accessor module-type 'kind))
(define set-module-kind! (record-modifier module-type 'kind))
;; must have been defined by now.
;;
(set-current-module the-root-module)
+;; definition deferred for syncase's benefit
+(define module-name (record-accessor module-type 'name))
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
-(letrec ((syntmp-lambda-var-list-166 (lambda (syntmp-vars-557) (let syntmp-lvl-558 ((syntmp-vars-559 syntmp-vars-557) (syntmp-ls-560 (quote ())) (syntmp-w-561 (quote (())))) (cond ((pair? syntmp-vars-559) (syntmp-lvl-558 (cdr syntmp-vars-559) (cons (syntmp-wrap-145 (car syntmp-vars-559) syntmp-w-561 #f) syntmp-ls-560) syntmp-w-561)) ((syntmp-id?-117 syntmp-vars-559) (cons (syntmp-wrap-145 syntmp-vars-559 syntmp-w-561 #f) syntmp-ls-560)) ((null? syntmp-vars-559) syntmp-ls-560) ((syntmp-syntax-object?-101 syntmp-vars-559) (syntmp-lvl-558 (syntmp-syntax-object-expression-102 syntmp-vars-559) syntmp-ls-560 (syntmp-join-wraps-136 syntmp-w-561 (syntmp-syntax-object-wrap-103 syntmp-vars-559)))) ((annotation? syntmp-vars-559) (syntmp-lvl-558 (annotation-expression syntmp-vars-559) syntmp-ls-560 syntmp-w-561)) (else (cons syntmp-vars-559 syntmp-ls-560)))))) (syntmp-gen-var-165 (lambda (syntmp-id-562) (let ((syntmp-id-563 (if (syntmp-syntax-object?-101 syntmp-id-562) (syntmp-syntax-object-expression-102 syntmp-id-562) syntmp-id-562))) (if (annotation? syntmp-id-563) (syntmp-build-annotated-94 (annotation-source syntmp-id-563) (gensym (symbol->string (annotation-expression syntmp-id-563)))) (syntmp-build-annotated-94 #f (gensym (symbol->string syntmp-id-563))))))) (syntmp-strip-164 (lambda (syntmp-x-564 syntmp-w-565) (if (memq (quote top) (syntmp-wrap-marks-120 syntmp-w-565)) (if (or (annotation? syntmp-x-564) (and (pair? syntmp-x-564) (annotation? (car syntmp-x-564)))) (syntmp-strip-annotation-163 syntmp-x-564 #f) syntmp-x-564) (let syntmp-f-566 ((syntmp-x-567 syntmp-x-564)) (cond ((syntmp-syntax-object?-101 syntmp-x-567) (syntmp-strip-164 (syntmp-syntax-object-expression-102 syntmp-x-567) (syntmp-syntax-object-wrap-103 syntmp-x-567))) ((pair? syntmp-x-567) (let ((syntmp-a-568 (syntmp-f-566 (car syntmp-x-567))) (syntmp-d-569 (syntmp-f-566 (cdr syntmp-x-567)))) (if (and (eq? syntmp-a-568 (car syntmp-x-567)) (eq? syntmp-d-569 (cdr syntmp-x-567))) syntmp-x-567 (cons syntmp-a-568 syntmp-d-569)))) ((vector? syntmp-x-567) (let ((syntmp-old-570 (vector->list syntmp-x-567))) (let ((syntmp-new-571 (map syntmp-f-566 syntmp-old-570))) (if (andmap eq? syntmp-old-570 syntmp-new-571) syntmp-x-567 (list->vector syntmp-new-571))))) (else syntmp-x-567)))))) (syntmp-strip-annotation-163 (lambda (syntmp-x-572 syntmp-parent-573) (cond ((pair? syntmp-x-572) (let ((syntmp-new-574 (cons #f #f))) (begin (if syntmp-parent-573 (set-annotation-stripped! syntmp-parent-573 syntmp-new-574)) (set-car! syntmp-new-574 (syntmp-strip-annotation-163 (car syntmp-x-572) #f)) (set-cdr! syntmp-new-574 (syntmp-strip-annotation-163 (cdr syntmp-x-572) #f)) syntmp-new-574))) ((annotation? syntmp-x-572) (or (annotation-stripped syntmp-x-572) (syntmp-strip-annotation-163 (annotation-expression syntmp-x-572) syntmp-x-572))) ((vector? syntmp-x-572) (let ((syntmp-new-575 (make-vector (vector-length syntmp-x-572)))) (begin (if syntmp-parent-573 (set-annotation-stripped! syntmp-parent-573 syntmp-new-575)) (let syntmp-loop-576 ((syntmp-i-577 (- (vector-length syntmp-x-572) 1))) (unless (syntmp-fx<-88 syntmp-i-577 0) (vector-set! syntmp-new-575 syntmp-i-577 (syntmp-strip-annotation-163 (vector-ref syntmp-x-572 syntmp-i-577) #f)) (syntmp-loop-576 (syntmp-fx--86 syntmp-i-577 1)))) syntmp-new-575))) (else syntmp-x-572)))) (syntmp-ellipsis?-162 (lambda (syntmp-x-578) (and (syntmp-nonsymbol-id?-116 syntmp-x-578) (syntmp-free-id=?-140 syntmp-x-578 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase))))))) (syntmp-chi-void-161 (lambda () (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote void)))))) (syntmp-eval-local-transformer-160 (lambda (syntmp-expanded-579 syntmp-mod-580) (let ((syntmp-p-581 (syntmp-local-eval-hook-90 syntmp-expanded-579 syntmp-mod-580))) (if (procedure? syntmp-p-581) syntmp-p-581 (syntax-error syntmp-p-581 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-159 (lambda (syntmp-rec?-582 syntmp-e-583 syntmp-r-584 syntmp-w-585 syntmp-s-586 syntmp-mod-587 syntmp-k-588) ((lambda (syntmp-tmp-589) ((lambda (syntmp-tmp-590) (if syntmp-tmp-590 (apply (lambda (syntmp-_-591 syntmp-id-592 syntmp-val-593 syntmp-e1-594 syntmp-e2-595) (let ((syntmp-ids-596 syntmp-id-592)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-596)) (syntax-error syntmp-e-583 "duplicate bound keyword in") (let ((syntmp-labels-598 (syntmp-gen-labels-123 syntmp-ids-596))) (let ((syntmp-new-w-599 (syntmp-make-binding-wrap-134 syntmp-ids-596 syntmp-labels-598 syntmp-w-585))) (syntmp-k-588 (cons syntmp-e1-594 syntmp-e2-595) (syntmp-extend-env-111 syntmp-labels-598 (let ((syntmp-w-601 (if syntmp-rec?-582 syntmp-new-w-599 syntmp-w-585)) (syntmp-trans-r-602 (syntmp-macros-only-env-113 syntmp-r-584))) (map (lambda (syntmp-x-603) (cons (quote macro) (syntmp-eval-local-transformer-160 (syntmp-chi-153 syntmp-x-603 syntmp-trans-r-602 syntmp-w-601 syntmp-mod-587) syntmp-mod-587))) syntmp-val-593)) syntmp-r-584) syntmp-new-w-599 syntmp-s-586 syntmp-mod-587)))))) syntmp-tmp-590) ((lambda (syntmp-_-605) (syntax-error (syntmp-source-wrap-146 syntmp-e-583 syntmp-w-585 syntmp-s-586 syntmp-mod-587))) syntmp-tmp-589))) (syntax-dispatch syntmp-tmp-589 (quote (any #(each (any any)) any . each-any))))) syntmp-e-583))) (syntmp-chi-lambda-clause-158 (lambda (syntmp-e-606 syntmp-c-607 syntmp-r-608 syntmp-w-609 syntmp-mod-610 syntmp-k-611) ((lambda (syntmp-tmp-612) ((lambda (syntmp-tmp-613) (if syntmp-tmp-613 (apply (lambda (syntmp-id-614 syntmp-e1-615 syntmp-e2-616) (let ((syntmp-ids-617 syntmp-id-614)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-617)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-619 (syntmp-gen-labels-123 syntmp-ids-617)) (syntmp-new-vars-620 (map syntmp-gen-var-165 syntmp-ids-617))) (syntmp-k-611 syntmp-new-vars-620 (syntmp-chi-body-157 (cons syntmp-e1-615 syntmp-e2-616) syntmp-e-606 (syntmp-extend-var-env-112 syntmp-labels-619 syntmp-new-vars-620 syntmp-r-608) (syntmp-make-binding-wrap-134 syntmp-ids-617 syntmp-labels-619 syntmp-w-609) syntmp-mod-610)))))) syntmp-tmp-613) ((lambda (syntmp-tmp-622) (if syntmp-tmp-622 (apply (lambda (syntmp-ids-623 syntmp-e1-624 syntmp-e2-625) (let ((syntmp-old-ids-626 (syntmp-lambda-var-list-166 syntmp-ids-623))) (if (not (syntmp-valid-bound-ids?-142 syntmp-old-ids-626)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-627 (syntmp-gen-labels-123 syntmp-old-ids-626)) (syntmp-new-vars-628 (map syntmp-gen-var-165 syntmp-old-ids-626))) (syntmp-k-611 (let syntmp-f-629 ((syntmp-ls1-630 (cdr syntmp-new-vars-628)) (syntmp-ls2-631 (car syntmp-new-vars-628))) (if (null? syntmp-ls1-630) syntmp-ls2-631 (syntmp-f-629 (cdr syntmp-ls1-630) (cons (car syntmp-ls1-630) syntmp-ls2-631)))) (syntmp-chi-body-157 (cons syntmp-e1-624 syntmp-e2-625) syntmp-e-606 (syntmp-extend-var-env-112 syntmp-labels-627 syntmp-new-vars-628 syntmp-r-608) (syntmp-make-binding-wrap-134 syntmp-old-ids-626 syntmp-labels-627 syntmp-w-609) syntmp-mod-610)))))) syntmp-tmp-622) ((lambda (syntmp-_-633) (syntax-error syntmp-e-606)) syntmp-tmp-612))) (syntax-dispatch syntmp-tmp-612 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-612 (quote (each-any any . each-any))))) syntmp-c-607))) (syntmp-chi-body-157 (lambda (syntmp-body-634 syntmp-outer-form-635 syntmp-r-636 syntmp-w-637 syntmp-mod-638) (let ((syntmp-r-639 (cons (quote ("placeholder" placeholder)) syntmp-r-636))) (let ((syntmp-ribcage-640 (syntmp-make-ribcage-124 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-641 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w-637) (cons syntmp-ribcage-640 (syntmp-wrap-subst-121 syntmp-w-637))))) (let syntmp-parse-642 ((syntmp-body-643 (map (lambda (syntmp-x-649) (cons syntmp-r-639 (syntmp-wrap-145 syntmp-x-649 syntmp-w-641 syntmp-mod-638))) syntmp-body-634)) (syntmp-ids-644 (quote ())) (syntmp-labels-645 (quote ())) (syntmp-vars-646 (quote ())) (syntmp-vals-647 (quote ())) (syntmp-bindings-648 (quote ()))) (if (null? syntmp-body-643) (syntax-error syntmp-outer-form-635 "no expressions in body") (let ((syntmp-e-650 (cdar syntmp-body-643)) (syntmp-er-651 (caar syntmp-body-643))) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-650 syntmp-er-651 (quote (())) #f syntmp-ribcage-640 syntmp-mod-638)) (lambda (syntmp-type-652 syntmp-value-653 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657) (let ((syntmp-t-658 syntmp-type-652)) (if (memv syntmp-t-658 (quote (define-form))) (let ((syntmp-id-659 (syntmp-wrap-145 syntmp-value-653 syntmp-w-655 syntmp-mod-657)) (syntmp-label-660 (syntmp-gen-label-122))) (let ((syntmp-var-661 (syntmp-gen-var-165 syntmp-id-659))) (begin (syntmp-extend-ribcage!-133 syntmp-ribcage-640 syntmp-id-659 syntmp-label-660) (syntmp-parse-642 (cdr syntmp-body-643) (cons syntmp-id-659 syntmp-ids-644) (cons syntmp-label-660 syntmp-labels-645) (cons syntmp-var-661 syntmp-vars-646) (cons (cons syntmp-er-651 (syntmp-wrap-145 syntmp-e-654 syntmp-w-655 syntmp-mod-657)) syntmp-vals-647) (cons (cons (quote lexical) syntmp-var-661) syntmp-bindings-648))))) (if (memv syntmp-t-658 (quote (define-syntax-form))) (let ((syntmp-id-662 (syntmp-wrap-145 syntmp-value-653 syntmp-w-655 syntmp-mod-657)) (syntmp-label-663 (syntmp-gen-label-122))) (begin (syntmp-extend-ribcage!-133 syntmp-ribcage-640 syntmp-id-662 syntmp-label-663) (syntmp-parse-642 (cdr syntmp-body-643) (cons syntmp-id-662 syntmp-ids-644) (cons syntmp-label-663 syntmp-labels-645) syntmp-vars-646 syntmp-vals-647 (cons (cons (quote macro) (cons syntmp-er-651 (syntmp-wrap-145 syntmp-e-654 syntmp-w-655 syntmp-mod-657))) syntmp-bindings-648)))) (if (memv syntmp-t-658 (quote (begin-form))) ((lambda (syntmp-tmp-664) ((lambda (syntmp-tmp-665) (if syntmp-tmp-665 (apply (lambda (syntmp-_-666 syntmp-e1-667) (syntmp-parse-642 (let syntmp-f-668 ((syntmp-forms-669 syntmp-e1-667)) (if (null? syntmp-forms-669) (cdr syntmp-body-643) (cons (cons syntmp-er-651 (syntmp-wrap-145 (car syntmp-forms-669) syntmp-w-655 syntmp-mod-657)) (syntmp-f-668 (cdr syntmp-forms-669))))) syntmp-ids-644 syntmp-labels-645 syntmp-vars-646 syntmp-vals-647 syntmp-bindings-648)) syntmp-tmp-665) (syntax-error syntmp-tmp-664))) (syntax-dispatch syntmp-tmp-664 (quote (any . each-any))))) syntmp-e-654) (if (memv syntmp-t-658 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-653 syntmp-e-654 syntmp-er-651 syntmp-w-655 syntmp-s-656 syntmp-mod-657 (lambda (syntmp-forms-671 syntmp-er-672 syntmp-w-673 syntmp-s-674 syntmp-mod-675) (syntmp-parse-642 (let syntmp-f-676 ((syntmp-forms-677 syntmp-forms-671)) (if (null? syntmp-forms-677) (cdr syntmp-body-643) (cons (cons syntmp-er-672 (syntmp-wrap-145 (car syntmp-forms-677) syntmp-w-673 syntmp-mod-675)) (syntmp-f-676 (cdr syntmp-forms-677))))) syntmp-ids-644 syntmp-labels-645 syntmp-vars-646 syntmp-vals-647 syntmp-bindings-648))) (if (null? syntmp-ids-644) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-678) (syntmp-chi-153 (cdr syntmp-x-678) (car syntmp-x-678) (quote (())) syntmp-mod-657)) (cons (cons syntmp-er-651 (syntmp-source-wrap-146 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657)) (cdr syntmp-body-643)))) (begin (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-644)) (syntax-error syntmp-outer-form-635 "invalid or duplicate identifier in definition")) (let syntmp-loop-679 ((syntmp-bs-680 syntmp-bindings-648) (syntmp-er-cache-681 #f) (syntmp-r-cache-682 #f)) (if (not (null? syntmp-bs-680)) (let ((syntmp-b-683 (car syntmp-bs-680))) (if (eq? (car syntmp-b-683) (quote macro)) (let ((syntmp-er-684 (cadr syntmp-b-683))) (let ((syntmp-r-cache-685 (if (eq? syntmp-er-684 syntmp-er-cache-681) syntmp-r-cache-682 (syntmp-macros-only-env-113 syntmp-er-684)))) (begin (set-cdr! syntmp-b-683 (syntmp-eval-local-transformer-160 (syntmp-chi-153 (cddr syntmp-b-683) syntmp-r-cache-685 (quote (())) syntmp-mod-657) syntmp-mod-657)) (syntmp-loop-679 (cdr syntmp-bs-680) syntmp-er-684 syntmp-r-cache-685)))) (syntmp-loop-679 (cdr syntmp-bs-680) syntmp-er-cache-681 syntmp-r-cache-682))))) (set-cdr! syntmp-r-639 (syntmp-extend-env-111 syntmp-labels-645 syntmp-bindings-648 (cdr syntmp-r-639))) (syntmp-build-letrec-99 #f syntmp-vars-646 (map (lambda (syntmp-x-686) (syntmp-chi-153 (cdr syntmp-x-686) (car syntmp-x-686) (quote (())) syntmp-mod-657)) syntmp-vals-647) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-687) (syntmp-chi-153 (cdr syntmp-x-687) (car syntmp-x-687) (quote (())) syntmp-mod-657)) (cons (cons syntmp-er-651 (syntmp-source-wrap-146 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657)) (cdr syntmp-body-643)))))))))))))))))))))) (syntmp-chi-macro-156 (lambda (syntmp-p-688 syntmp-e-689 syntmp-r-690 syntmp-w-691 syntmp-rib-692 syntmp-mod-693) (letrec ((syntmp-rebuild-macro-output-694 (lambda (syntmp-x-695 syntmp-m-696) (cond ((pair? syntmp-x-695) (cons (syntmp-rebuild-macro-output-694 (car syntmp-x-695) syntmp-m-696) (syntmp-rebuild-macro-output-694 (cdr syntmp-x-695) syntmp-m-696))) ((syntmp-syntax-object?-101 syntmp-x-695) (let ((syntmp-w-697 (syntmp-syntax-object-wrap-103 syntmp-x-695))) (let ((syntmp-ms-698 (syntmp-wrap-marks-120 syntmp-w-697)) (syntmp-s-699 (syntmp-wrap-subst-121 syntmp-w-697))) (if (and (pair? syntmp-ms-698) (eq? (car syntmp-ms-698) #f)) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-695) (syntmp-make-wrap-119 (cdr syntmp-ms-698) (if syntmp-rib-692 (cons syntmp-rib-692 (cdr syntmp-s-699)) (cdr syntmp-s-699))) (syntmp-syntax-object-module-104 syntmp-x-695)) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-695) (syntmp-make-wrap-119 (cons syntmp-m-696 syntmp-ms-698) (if syntmp-rib-692 (cons syntmp-rib-692 (cons (quote shift) syntmp-s-699)) (cons (quote shift) syntmp-s-699))) (module-name (procedure-module syntmp-p-688))))))) ((vector? syntmp-x-695) (let ((syntmp-n-700 (vector-length syntmp-x-695))) (let ((syntmp-v-701 (make-vector syntmp-n-700))) (let syntmp-doloop-702 ((syntmp-i-703 0)) (if (syntmp-fx=-87 syntmp-i-703 syntmp-n-700) syntmp-v-701 (begin (vector-set! syntmp-v-701 syntmp-i-703 (syntmp-rebuild-macro-output-694 (vector-ref syntmp-x-695 syntmp-i-703) syntmp-m-696)) (syntmp-doloop-702 (syntmp-fx+-85 syntmp-i-703 1)))))))) ((symbol? syntmp-x-695) (syntax-error syntmp-x-695 "encountered raw symbol in macro output")) (else syntmp-x-695))))) (syntmp-rebuild-macro-output-694 (syntmp-p-688 (syntmp-wrap-145 syntmp-e-689 (syntmp-anti-mark-132 syntmp-w-691) syntmp-mod-693)) (string #\m))))) (syntmp-chi-application-155 (lambda (syntmp-x-704 syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) ((lambda (syntmp-tmp-710) ((lambda (syntmp-tmp-711) (if syntmp-tmp-711 (apply (lambda (syntmp-e0-712 syntmp-e1-713) (syntmp-build-annotated-94 syntmp-s-708 (cons syntmp-x-704 (map (lambda (syntmp-e-714) (syntmp-chi-153 syntmp-e-714 syntmp-r-706 syntmp-w-707 syntmp-mod-709)) syntmp-e1-713)))) syntmp-tmp-711) (syntax-error syntmp-tmp-710))) (syntax-dispatch syntmp-tmp-710 (quote (any . each-any))))) syntmp-e-705))) (syntmp-chi-expr-154 (lambda (syntmp-type-716 syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (let ((syntmp-t-723 syntmp-type-716)) (if (memv syntmp-t-723 (quote (lexical))) (syntmp-build-annotated-94 syntmp-s-721 syntmp-value-717) (if (memv syntmp-t-723 (quote (core external-macro))) (syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (module-ref))) (call-with-values (lambda () (syntmp-value-717 syntmp-e-718)) (lambda (syntmp-id-724 syntmp-mod-725) (syntmp-build-annotated-94 syntmp-s-721 (make-module-ref syntmp-mod-725 syntmp-id-724 #f)))) (if (memv syntmp-t-723 (quote (lexical-call))) (syntmp-chi-application-155 (syntmp-build-annotated-94 (syntmp-source-annotation-108 (car syntmp-e-718)) syntmp-value-717) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (global-call))) (syntmp-chi-application-155 (syntmp-build-annotated-94 (syntmp-source-annotation-108 (car syntmp-e-718)) (make-module-ref (if (syntmp-syntax-object?-101 (car syntmp-e-718)) (syntmp-syntax-object-module-104 (car syntmp-e-718)) syntmp-mod-722) syntmp-value-717 #f)) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (constant))) (syntmp-build-data-95 syntmp-s-721 (syntmp-strip-164 (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (quote (())))) (if (memv syntmp-t-723 (quote (global))) (syntmp-build-annotated-94 syntmp-s-721 (make-module-ref syntmp-mod-722 syntmp-value-717 #f)) (if (memv syntmp-t-723 (quote (call))) (syntmp-chi-application-155 (syntmp-chi-153 (car syntmp-e-718) syntmp-r-719 syntmp-w-720 syntmp-mod-722) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (begin-form))) ((lambda (syntmp-tmp-726) ((lambda (syntmp-tmp-727) (if syntmp-tmp-727 (apply (lambda (syntmp-_-728 syntmp-e1-729 syntmp-e2-730) (syntmp-chi-sequence-147 (cons syntmp-e1-729 syntmp-e2-730) syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722)) syntmp-tmp-727) (syntax-error syntmp-tmp-726))) (syntax-dispatch syntmp-tmp-726 (quote (any any . each-any))))) syntmp-e-718) (if (memv syntmp-t-723 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722 syntmp-chi-sequence-147) (if (memv syntmp-t-723 (quote (eval-when-form))) ((lambda (syntmp-tmp-732) ((lambda (syntmp-tmp-733) (if syntmp-tmp-733 (apply (lambda (syntmp-_-734 syntmp-x-735 syntmp-e1-736 syntmp-e2-737) (let ((syntmp-when-list-738 (syntmp-chi-when-list-150 syntmp-e-718 syntmp-x-735 syntmp-w-720))) (if (memq (quote eval) syntmp-when-list-738) (syntmp-chi-sequence-147 (cons syntmp-e1-736 syntmp-e2-737) syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (syntmp-chi-void-161)))) syntmp-tmp-733) (syntax-error syntmp-tmp-732))) (syntax-dispatch syntmp-tmp-732 (quote (any each-any any . each-any))))) syntmp-e-718) (if (memv syntmp-t-723 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-145 syntmp-value-717 syntmp-w-720 syntmp-mod-722) "invalid context for definition of") (if (memv syntmp-t-723 (quote (syntax))) (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) "reference to pattern variable outside syntax form") (if (memv syntmp-t-723 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722))))))))))))))))))) (syntmp-chi-153 (lambda (syntmp-e-741 syntmp-r-742 syntmp-w-743 syntmp-mod-744) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-741 syntmp-r-742 syntmp-w-743 #f #f syntmp-mod-744)) (lambda (syntmp-type-745 syntmp-value-746 syntmp-e-747 syntmp-w-748 syntmp-s-749 syntmp-mod-750) (syntmp-chi-expr-154 syntmp-type-745 syntmp-value-746 syntmp-e-747 syntmp-r-742 syntmp-w-748 syntmp-s-749 syntmp-mod-750))))) (syntmp-chi-top-152 (lambda (syntmp-e-751 syntmp-r-752 syntmp-w-753 syntmp-m-754 syntmp-esew-755 syntmp-mod-756) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-751 syntmp-r-752 syntmp-w-753 #f #f syntmp-mod-756)) (lambda (syntmp-type-771 syntmp-value-772 syntmp-e-773 syntmp-w-774 syntmp-s-775 syntmp-mod-776) (let ((syntmp-t-777 syntmp-type-771)) (if (memv syntmp-t-777 (quote (begin-form))) ((lambda (syntmp-tmp-778) ((lambda (syntmp-tmp-779) (if syntmp-tmp-779 (apply (lambda (syntmp-_-780) (syntmp-chi-void-161)) syntmp-tmp-779) ((lambda (syntmp-tmp-781) (if syntmp-tmp-781 (apply (lambda (syntmp-_-782 syntmp-e1-783 syntmp-e2-784) (syntmp-chi-top-sequence-148 (cons syntmp-e1-783 syntmp-e2-784) syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-m-754 syntmp-esew-755 syntmp-mod-776)) syntmp-tmp-781) (syntax-error syntmp-tmp-778))) (syntax-dispatch syntmp-tmp-778 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-778 (quote (any))))) syntmp-e-773) (if (memv syntmp-t-777 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-772 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-mod-776 (lambda (syntmp-body-786 syntmp-r-787 syntmp-w-788 syntmp-s-789 syntmp-mod-790) (syntmp-chi-top-sequence-148 syntmp-body-786 syntmp-r-787 syntmp-w-788 syntmp-s-789 syntmp-m-754 syntmp-esew-755 syntmp-mod-790))) (if (memv syntmp-t-777 (quote (eval-when-form))) ((lambda (syntmp-tmp-791) ((lambda (syntmp-tmp-792) (if syntmp-tmp-792 (apply (lambda (syntmp-_-793 syntmp-x-794 syntmp-e1-795 syntmp-e2-796) (let ((syntmp-when-list-797 (syntmp-chi-when-list-150 syntmp-e-773 syntmp-x-794 syntmp-w-774)) (syntmp-body-798 (cons syntmp-e1-795 syntmp-e2-796))) (cond ((eq? syntmp-m-754 (quote e)) (if (memq (quote eval) syntmp-when-list-797) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote e) (quote (eval)) syntmp-mod-776) (syntmp-chi-void-161))) ((memq (quote load) syntmp-when-list-797) (if (or (memq (quote compile) syntmp-when-list-797) (and (eq? syntmp-m-754 (quote c&e)) (memq (quote eval) syntmp-when-list-797))) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote c&e) (quote (compile load)) syntmp-mod-776) (if (memq syntmp-m-754 (quote (c c&e))) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote c) (quote (load)) syntmp-mod-776) (syntmp-chi-void-161)))) ((or (memq (quote compile) syntmp-when-list-797) (and (eq? syntmp-m-754 (quote c&e)) (memq (quote eval) syntmp-when-list-797))) (syntmp-top-level-eval-hook-89 (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote e) (quote (eval)) syntmp-mod-776) syntmp-mod-776) (syntmp-chi-void-161)) (else (syntmp-chi-void-161))))) syntmp-tmp-792) (syntax-error syntmp-tmp-791))) (syntax-dispatch syntmp-tmp-791 (quote (any each-any any . each-any))))) syntmp-e-773) (if (memv syntmp-t-777 (quote (define-syntax-form))) (let ((syntmp-n-801 (syntmp-id-var-name-139 syntmp-value-772 syntmp-w-774)) (syntmp-r-802 (syntmp-macros-only-env-113 syntmp-r-752))) (let ((syntmp-t-803 syntmp-m-754)) (if (memv syntmp-t-803 (quote (c))) (if (memq (quote compile) syntmp-esew-755) (let ((syntmp-e-804 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)))) (begin (syntmp-top-level-eval-hook-89 syntmp-e-804 syntmp-mod-776) (if (memq (quote load) syntmp-esew-755) syntmp-e-804 (syntmp-chi-void-161)))) (if (memq (quote load) syntmp-esew-755) (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)) (syntmp-chi-void-161))) (if (memv syntmp-t-803 (quote (c&e))) (let ((syntmp-e-805 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)))) (begin (syntmp-top-level-eval-hook-89 syntmp-e-805 syntmp-mod-776) syntmp-e-805)) (begin (if (memq (quote eval) syntmp-esew-755) (syntmp-top-level-eval-hook-89 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)) syntmp-mod-776)) (syntmp-chi-void-161)))))) (if (memv syntmp-t-777 (quote (define-form))) (let ((syntmp-n-806 (syntmp-id-var-name-139 syntmp-value-772 syntmp-w-774))) (let ((syntmp-type-807 (syntmp-binding-type-109 (syntmp-lookup-114 syntmp-n-806 syntmp-r-752 syntmp-mod-776)))) (let ((syntmp-t-808 syntmp-type-807)) (if (memv syntmp-t-808 (quote (global))) (let ((syntmp-x-809 (syntmp-build-annotated-94 syntmp-s-775 (list (quote define) syntmp-n-806 (syntmp-chi-153 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-mod-776))))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-809 syntmp-mod-776)) syntmp-x-809)) (if (memv syntmp-t-808 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-145 syntmp-value-772 syntmp-w-774 syntmp-mod-776) "identifier out of context") (if (eq? syntmp-type-807 (quote external-macro)) (let ((syntmp-x-810 (syntmp-build-annotated-94 syntmp-s-775 (list (quote define) syntmp-n-806 (syntmp-chi-153 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-mod-776))))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-810 syntmp-mod-776)) syntmp-x-810)) (syntax-error (syntmp-wrap-145 syntmp-value-772 syntmp-w-774 syntmp-mod-776) "cannot define keyword at top level"))))))) (let ((syntmp-x-811 (syntmp-chi-expr-154 syntmp-type-771 syntmp-value-772 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-mod-776))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-811 syntmp-mod-776)) syntmp-x-811)))))))))))) (syntmp-syntax-type-151 (lambda (syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (cond ((symbol? syntmp-e-812) (let ((syntmp-n-818 (syntmp-id-var-name-139 syntmp-e-812 syntmp-w-814))) (let ((syntmp-b-819 (syntmp-lookup-114 syntmp-n-818 syntmp-r-813 syntmp-mod-817))) (let ((syntmp-type-820 (syntmp-binding-type-109 syntmp-b-819))) (let ((syntmp-t-821 syntmp-type-820)) (if (memv syntmp-t-821 (quote (lexical))) (values syntmp-type-820 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-821 (quote (global))) (values syntmp-type-820 syntmp-n-818 syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-821 (quote (macro))) (syntmp-syntax-type-151 (syntmp-chi-macro-156 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-rib-816 syntmp-mod-817) syntmp-r-813 (quote (())) syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (values syntmp-type-820 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817))))))))) ((pair? syntmp-e-812) (let ((syntmp-first-822 (car syntmp-e-812))) (if (syntmp-id?-117 syntmp-first-822) (let ((syntmp-n-823 (syntmp-id-var-name-139 syntmp-first-822 syntmp-w-814))) (let ((syntmp-b-824 (syntmp-lookup-114 syntmp-n-823 syntmp-r-813 (or (and (syntmp-syntax-object?-101 syntmp-first-822) (syntmp-syntax-object-module-104 syntmp-first-822)) syntmp-mod-817)))) (let ((syntmp-type-825 (syntmp-binding-type-109 syntmp-b-824))) (let ((syntmp-t-826 syntmp-type-825)) (if (memv syntmp-t-826 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (global))) (values (quote global-call) syntmp-n-823 syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (macro))) (syntmp-syntax-type-151 (syntmp-chi-macro-156 (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-rib-816 syntmp-mod-817) syntmp-r-813 (quote (())) syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (if (memv syntmp-t-826 (quote (core external-macro module-ref))) (values syntmp-type-825 (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (begin))) (values (quote begin-form) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (define))) ((lambda (syntmp-tmp-827) ((lambda (syntmp-tmp-828) (if (if syntmp-tmp-828 (apply (lambda (syntmp-_-829 syntmp-name-830 syntmp-val-831) (syntmp-id?-117 syntmp-name-830)) syntmp-tmp-828) #f) (apply (lambda (syntmp-_-832 syntmp-name-833 syntmp-val-834) (values (quote define-form) syntmp-name-833 syntmp-val-834 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) syntmp-tmp-828) ((lambda (syntmp-tmp-835) (if (if syntmp-tmp-835 (apply (lambda (syntmp-_-836 syntmp-name-837 syntmp-args-838 syntmp-e1-839 syntmp-e2-840) (and (syntmp-id?-117 syntmp-name-837) (syntmp-valid-bound-ids?-142 (syntmp-lambda-var-list-166 syntmp-args-838)))) syntmp-tmp-835) #f) (apply (lambda (syntmp-_-841 syntmp-name-842 syntmp-args-843 syntmp-e1-844 syntmp-e2-845) (values (quote define-form) (syntmp-wrap-145 syntmp-name-842 syntmp-w-814 syntmp-mod-817) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase))) (syntmp-wrap-145 (cons syntmp-args-843 (cons syntmp-e1-844 syntmp-e2-845)) syntmp-w-814 syntmp-mod-817)) (quote (())) syntmp-s-815 syntmp-mod-817)) syntmp-tmp-835) ((lambda (syntmp-tmp-847) (if (if syntmp-tmp-847 (apply (lambda (syntmp-_-848 syntmp-name-849) (syntmp-id?-117 syntmp-name-849)) syntmp-tmp-847) #f) (apply (lambda (syntmp-_-850 syntmp-name-851) (values (quote define-form) (syntmp-wrap-145 syntmp-name-851 syntmp-w-814 syntmp-mod-817) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))) (quote (())) syntmp-s-815 syntmp-mod-817)) syntmp-tmp-847) (syntax-error syntmp-tmp-827))) (syntax-dispatch syntmp-tmp-827 (quote (any any)))))) (syntax-dispatch syntmp-tmp-827 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-827 (quote (any any any))))) syntmp-e-812) (if (memv syntmp-t-826 (quote (define-syntax))) ((lambda (syntmp-tmp-852) ((lambda (syntmp-tmp-853) (if (if syntmp-tmp-853 (apply (lambda (syntmp-_-854 syntmp-name-855 syntmp-val-856) (syntmp-id?-117 syntmp-name-855)) syntmp-tmp-853) #f) (apply (lambda (syntmp-_-857 syntmp-name-858 syntmp-val-859) (values (quote define-syntax-form) syntmp-name-858 syntmp-val-859 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) syntmp-tmp-853) (syntax-error syntmp-tmp-852))) (syntax-dispatch syntmp-tmp-852 (quote (any any any))))) syntmp-e-812) (values (quote call) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)))))))))))))) (values (quote call) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)))) ((syntmp-syntax-object?-101 syntmp-e-812) (syntmp-syntax-type-151 (syntmp-syntax-object-expression-102 syntmp-e-812) syntmp-r-813 (syntmp-join-wraps-136 syntmp-w-814 (syntmp-syntax-object-wrap-103 syntmp-e-812)) #f syntmp-rib-816 (or (syntmp-syntax-object-module-104 syntmp-e-812) syntmp-mod-817))) ((annotation? syntmp-e-812) (syntmp-syntax-type-151 (annotation-expression syntmp-e-812) syntmp-r-813 syntmp-w-814 (annotation-source syntmp-e-812) syntmp-rib-816 syntmp-mod-817)) ((self-evaluating? syntmp-e-812) (values (quote constant) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) (else (values (quote other) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817))))) (syntmp-chi-when-list-150 (lambda (syntmp-e-860 syntmp-when-list-861 syntmp-w-862) (let syntmp-f-863 ((syntmp-when-list-864 syntmp-when-list-861) (syntmp-situations-865 (quote ()))) (if (null? syntmp-when-list-864) syntmp-situations-865 (syntmp-f-863 (cdr syntmp-when-list-864) (cons (let ((syntmp-x-866 (car syntmp-when-list-864))) (cond ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))) (quote compile)) ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))) (quote load)) ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))) (quote eval)) (else (syntax-error (syntmp-wrap-145 syntmp-x-866 syntmp-w-862 #f) "invalid eval-when situation")))) syntmp-situations-865)))))) (syntmp-chi-install-global-149 (lambda (syntmp-name-878 syntmp-e-879) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote install-global-transformer)) (syntmp-build-data-95 #f syntmp-name-878) syntmp-e-879)))) (syntmp-chi-top-sequence-148 (lambda (syntmp-body-880 syntmp-r-881 syntmp-w-882 syntmp-s-883 syntmp-m-884 syntmp-esew-885 syntmp-mod-886) (syntmp-build-sequence-96 syntmp-s-883 (let syntmp-dobody-887 ((syntmp-body-888 syntmp-body-880) (syntmp-r-889 syntmp-r-881) (syntmp-w-890 syntmp-w-882) (syntmp-m-891 syntmp-m-884) (syntmp-esew-892 syntmp-esew-885) (syntmp-mod-893 syntmp-mod-886)) (if (null? syntmp-body-888) (quote ()) (let ((syntmp-first-894 (syntmp-chi-top-152 (car syntmp-body-888) syntmp-r-889 syntmp-w-890 syntmp-m-891 syntmp-esew-892 syntmp-mod-893))) (cons syntmp-first-894 (syntmp-dobody-887 (cdr syntmp-body-888) syntmp-r-889 syntmp-w-890 syntmp-m-891 syntmp-esew-892 syntmp-mod-893)))))))) (syntmp-chi-sequence-147 (lambda (syntmp-body-895 syntmp-r-896 syntmp-w-897 syntmp-s-898 syntmp-mod-899) (syntmp-build-sequence-96 syntmp-s-898 (let syntmp-dobody-900 ((syntmp-body-901 syntmp-body-895) (syntmp-r-902 syntmp-r-896) (syntmp-w-903 syntmp-w-897) (syntmp-mod-904 syntmp-mod-899)) (if (null? syntmp-body-901) (quote ()) (let ((syntmp-first-905 (syntmp-chi-153 (car syntmp-body-901) syntmp-r-902 syntmp-w-903 syntmp-mod-904))) (cons syntmp-first-905 (syntmp-dobody-900 (cdr syntmp-body-901) syntmp-r-902 syntmp-w-903 syntmp-mod-904)))))))) (syntmp-source-wrap-146 (lambda (syntmp-x-906 syntmp-w-907 syntmp-s-908 syntmp-defmod-909) (syntmp-wrap-145 (if syntmp-s-908 (make-annotation syntmp-x-906 syntmp-s-908 #f) syntmp-x-906) syntmp-w-907 syntmp-defmod-909))) (syntmp-wrap-145 (lambda (syntmp-x-910 syntmp-w-911 syntmp-defmod-912) (cond ((and (null? (syntmp-wrap-marks-120 syntmp-w-911)) (null? (syntmp-wrap-subst-121 syntmp-w-911))) syntmp-x-910) ((syntmp-syntax-object?-101 syntmp-x-910) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-910) (syntmp-join-wraps-136 syntmp-w-911 (syntmp-syntax-object-wrap-103 syntmp-x-910)) (syntmp-syntax-object-module-104 syntmp-x-910))) ((null? syntmp-x-910) syntmp-x-910) (else (syntmp-make-syntax-object-100 syntmp-x-910 syntmp-w-911 syntmp-defmod-912))))) (syntmp-bound-id-member?-144 (lambda (syntmp-x-913 syntmp-list-914) (and (not (null? syntmp-list-914)) (or (syntmp-bound-id=?-141 syntmp-x-913 (car syntmp-list-914)) (syntmp-bound-id-member?-144 syntmp-x-913 (cdr syntmp-list-914)))))) (syntmp-distinct-bound-ids?-143 (lambda (syntmp-ids-915) (let syntmp-distinct?-916 ((syntmp-ids-917 syntmp-ids-915)) (or (null? syntmp-ids-917) (and (not (syntmp-bound-id-member?-144 (car syntmp-ids-917) (cdr syntmp-ids-917))) (syntmp-distinct?-916 (cdr syntmp-ids-917))))))) (syntmp-valid-bound-ids?-142 (lambda (syntmp-ids-918) (and (let syntmp-all-ids?-919 ((syntmp-ids-920 syntmp-ids-918)) (or (null? syntmp-ids-920) (and (syntmp-id?-117 (car syntmp-ids-920)) (syntmp-all-ids?-919 (cdr syntmp-ids-920))))) (syntmp-distinct-bound-ids?-143 syntmp-ids-918)))) (syntmp-bound-id=?-141 (lambda (syntmp-i-921 syntmp-j-922) (if (and (syntmp-syntax-object?-101 syntmp-i-921) (syntmp-syntax-object?-101 syntmp-j-922)) (and (eq? (let ((syntmp-e-923 (syntmp-syntax-object-expression-102 syntmp-i-921))) (if (annotation? syntmp-e-923) (annotation-expression syntmp-e-923) syntmp-e-923)) (let ((syntmp-e-924 (syntmp-syntax-object-expression-102 syntmp-j-922))) (if (annotation? syntmp-e-924) (annotation-expression syntmp-e-924) syntmp-e-924))) (syntmp-same-marks?-138 (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-i-921)) (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-j-922)))) (eq? (let ((syntmp-e-925 syntmp-i-921)) (if (annotation? syntmp-e-925) (annotation-expression syntmp-e-925) syntmp-e-925)) (let ((syntmp-e-926 syntmp-j-922)) (if (annotation? syntmp-e-926) (annotation-expression syntmp-e-926) syntmp-e-926)))))) (syntmp-free-id=?-140 (lambda (syntmp-i-927 syntmp-j-928) (and (eq? (let ((syntmp-x-929 syntmp-i-927)) (let ((syntmp-e-930 (if (syntmp-syntax-object?-101 syntmp-x-929) (syntmp-syntax-object-expression-102 syntmp-x-929) syntmp-x-929))) (if (annotation? syntmp-e-930) (annotation-expression syntmp-e-930) syntmp-e-930))) (let ((syntmp-x-931 syntmp-j-928)) (let ((syntmp-e-932 (if (syntmp-syntax-object?-101 syntmp-x-931) (syntmp-syntax-object-expression-102 syntmp-x-931) syntmp-x-931))) (if (annotation? syntmp-e-932) (annotation-expression syntmp-e-932) syntmp-e-932)))) (eq? (syntmp-id-var-name-139 syntmp-i-927 (quote (()))) (syntmp-id-var-name-139 syntmp-j-928 (quote (()))))))) (syntmp-id-var-name-139 (lambda (syntmp-id-933 syntmp-w-934) (letrec ((syntmp-search-vector-rib-937 (lambda (syntmp-sym-948 syntmp-subst-949 syntmp-marks-950 syntmp-symnames-951 syntmp-ribcage-952) (let ((syntmp-n-953 (vector-length syntmp-symnames-951))) (let syntmp-f-954 ((syntmp-i-955 0)) (cond ((syntmp-fx=-87 syntmp-i-955 syntmp-n-953) (syntmp-search-935 syntmp-sym-948 (cdr syntmp-subst-949) syntmp-marks-950)) ((and (eq? (vector-ref syntmp-symnames-951 syntmp-i-955) syntmp-sym-948) (syntmp-same-marks?-138 syntmp-marks-950 (vector-ref (syntmp-ribcage-marks-127 syntmp-ribcage-952) syntmp-i-955))) (values (vector-ref (syntmp-ribcage-labels-128 syntmp-ribcage-952) syntmp-i-955) syntmp-marks-950)) (else (syntmp-f-954 (syntmp-fx+-85 syntmp-i-955 1)))))))) (syntmp-search-list-rib-936 (lambda (syntmp-sym-956 syntmp-subst-957 syntmp-marks-958 syntmp-symnames-959 syntmp-ribcage-960) (let syntmp-f-961 ((syntmp-symnames-962 syntmp-symnames-959) (syntmp-i-963 0)) (cond ((null? syntmp-symnames-962) (syntmp-search-935 syntmp-sym-956 (cdr syntmp-subst-957) syntmp-marks-958)) ((and (eq? (car syntmp-symnames-962) syntmp-sym-956) (syntmp-same-marks?-138 syntmp-marks-958 (list-ref (syntmp-ribcage-marks-127 syntmp-ribcage-960) syntmp-i-963))) (values (list-ref (syntmp-ribcage-labels-128 syntmp-ribcage-960) syntmp-i-963) syntmp-marks-958)) (else (syntmp-f-961 (cdr syntmp-symnames-962) (syntmp-fx+-85 syntmp-i-963 1))))))) (syntmp-search-935 (lambda (syntmp-sym-964 syntmp-subst-965 syntmp-marks-966) (if (null? syntmp-subst-965) (values #f syntmp-marks-966) (let ((syntmp-fst-967 (car syntmp-subst-965))) (if (eq? syntmp-fst-967 (quote shift)) (syntmp-search-935 syntmp-sym-964 (cdr syntmp-subst-965) (cdr syntmp-marks-966)) (let ((syntmp-symnames-968 (syntmp-ribcage-symnames-126 syntmp-fst-967))) (if (vector? syntmp-symnames-968) (syntmp-search-vector-rib-937 syntmp-sym-964 syntmp-subst-965 syntmp-marks-966 syntmp-symnames-968 syntmp-fst-967) (syntmp-search-list-rib-936 syntmp-sym-964 syntmp-subst-965 syntmp-marks-966 syntmp-symnames-968 syntmp-fst-967))))))))) (cond ((symbol? syntmp-id-933) (or (call-with-values (lambda () (syntmp-search-935 syntmp-id-933 (syntmp-wrap-subst-121 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w-934))) (lambda (syntmp-x-970 . syntmp-ignore-969) syntmp-x-970)) syntmp-id-933)) ((syntmp-syntax-object?-101 syntmp-id-933) (let ((syntmp-id-971 (let ((syntmp-e-973 (syntmp-syntax-object-expression-102 syntmp-id-933))) (if (annotation? syntmp-e-973) (annotation-expression syntmp-e-973) syntmp-e-973))) (syntmp-w1-972 (syntmp-syntax-object-wrap-103 syntmp-id-933))) (let ((syntmp-marks-974 (syntmp-join-marks-137 (syntmp-wrap-marks-120 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w1-972)))) (call-with-values (lambda () (syntmp-search-935 syntmp-id-971 (syntmp-wrap-subst-121 syntmp-w-934) syntmp-marks-974)) (lambda (syntmp-new-id-975 syntmp-marks-976) (or syntmp-new-id-975 (call-with-values (lambda () (syntmp-search-935 syntmp-id-971 (syntmp-wrap-subst-121 syntmp-w1-972) syntmp-marks-976)) (lambda (syntmp-x-978 . syntmp-ignore-977) syntmp-x-978)) syntmp-id-971)))))) ((annotation? syntmp-id-933) (let ((syntmp-id-979 (let ((syntmp-e-980 syntmp-id-933)) (if (annotation? syntmp-e-980) (annotation-expression syntmp-e-980) syntmp-e-980)))) (or (call-with-values (lambda () (syntmp-search-935 syntmp-id-979 (syntmp-wrap-subst-121 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w-934))) (lambda (syntmp-x-982 . syntmp-ignore-981) syntmp-x-982)) syntmp-id-979))) (else (syntmp-error-hook-91 (quote id-var-name) "invalid id" syntmp-id-933)))))) (syntmp-same-marks?-138 (lambda (syntmp-x-983 syntmp-y-984) (or (eq? syntmp-x-983 syntmp-y-984) (and (not (null? syntmp-x-983)) (not (null? syntmp-y-984)) (eq? (car syntmp-x-983) (car syntmp-y-984)) (syntmp-same-marks?-138 (cdr syntmp-x-983) (cdr syntmp-y-984)))))) (syntmp-join-marks-137 (lambda (syntmp-m1-985 syntmp-m2-986) (syntmp-smart-append-135 syntmp-m1-985 syntmp-m2-986))) (syntmp-join-wraps-136 (lambda (syntmp-w1-987 syntmp-w2-988) (let ((syntmp-m1-989 (syntmp-wrap-marks-120 syntmp-w1-987)) (syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w1-987))) (if (null? syntmp-m1-989) (if (null? syntmp-s1-990) syntmp-w2-988 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w2-988) (syntmp-smart-append-135 syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w2-988)))) (syntmp-make-wrap-119 (syntmp-smart-append-135 syntmp-m1-989 (syntmp-wrap-marks-120 syntmp-w2-988)) (syntmp-smart-append-135 syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w2-988))))))) (syntmp-smart-append-135 (lambda (syntmp-m1-991 syntmp-m2-992) (if (null? syntmp-m2-992) syntmp-m1-991 (append syntmp-m1-991 syntmp-m2-992)))) (syntmp-make-binding-wrap-134 (lambda (syntmp-ids-993 syntmp-labels-994 syntmp-w-995) (if (null? syntmp-ids-993) syntmp-w-995 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w-995) (cons (let ((syntmp-labelvec-996 (list->vector syntmp-labels-994))) (let ((syntmp-n-997 (vector-length syntmp-labelvec-996))) (let ((syntmp-symnamevec-998 (make-vector syntmp-n-997)) (syntmp-marksvec-999 (make-vector syntmp-n-997))) (begin (let syntmp-f-1000 ((syntmp-ids-1001 syntmp-ids-993) (syntmp-i-1002 0)) (if (not (null? syntmp-ids-1001)) (call-with-values (lambda () (syntmp-id-sym-name&marks-118 (car syntmp-ids-1001) syntmp-w-995)) (lambda (syntmp-symname-1003 syntmp-marks-1004) (begin (vector-set! syntmp-symnamevec-998 syntmp-i-1002 syntmp-symname-1003) (vector-set! syntmp-marksvec-999 syntmp-i-1002 syntmp-marks-1004) (syntmp-f-1000 (cdr syntmp-ids-1001) (syntmp-fx+-85 syntmp-i-1002 1))))))) (syntmp-make-ribcage-124 syntmp-symnamevec-998 syntmp-marksvec-999 syntmp-labelvec-996))))) (syntmp-wrap-subst-121 syntmp-w-995)))))) (syntmp-extend-ribcage!-133 (lambda (syntmp-ribcage-1005 syntmp-id-1006 syntmp-label-1007) (begin (syntmp-set-ribcage-symnames!-129 syntmp-ribcage-1005 (cons (let ((syntmp-e-1008 (syntmp-syntax-object-expression-102 syntmp-id-1006))) (if (annotation? syntmp-e-1008) (annotation-expression syntmp-e-1008) syntmp-e-1008)) (syntmp-ribcage-symnames-126 syntmp-ribcage-1005))) (syntmp-set-ribcage-marks!-130 syntmp-ribcage-1005 (cons (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-id-1006)) (syntmp-ribcage-marks-127 syntmp-ribcage-1005))) (syntmp-set-ribcage-labels!-131 syntmp-ribcage-1005 (cons syntmp-label-1007 (syntmp-ribcage-labels-128 syntmp-ribcage-1005)))))) (syntmp-anti-mark-132 (lambda (syntmp-w-1009) (syntmp-make-wrap-119 (cons #f (syntmp-wrap-marks-120 syntmp-w-1009)) (cons (quote shift) (syntmp-wrap-subst-121 syntmp-w-1009))))) (syntmp-set-ribcage-labels!-131 (lambda (syntmp-x-1010 syntmp-update-1011) (vector-set! syntmp-x-1010 3 syntmp-update-1011))) (syntmp-set-ribcage-marks!-130 (lambda (syntmp-x-1012 syntmp-update-1013) (vector-set! syntmp-x-1012 2 syntmp-update-1013))) (syntmp-set-ribcage-symnames!-129 (lambda (syntmp-x-1014 syntmp-update-1015) (vector-set! syntmp-x-1014 1 syntmp-update-1015))) (syntmp-ribcage-labels-128 (lambda (syntmp-x-1016) (vector-ref syntmp-x-1016 3))) (syntmp-ribcage-marks-127 (lambda (syntmp-x-1017) (vector-ref syntmp-x-1017 2))) (syntmp-ribcage-symnames-126 (lambda (syntmp-x-1018) (vector-ref syntmp-x-1018 1))) (syntmp-ribcage?-125 (lambda (syntmp-x-1019) (and (vector? syntmp-x-1019) (= (vector-length syntmp-x-1019) 4) (eq? (vector-ref syntmp-x-1019 0) (quote ribcage))))) (syntmp-make-ribcage-124 (lambda (syntmp-symnames-1020 syntmp-marks-1021 syntmp-labels-1022) (vector (quote ribcage) syntmp-symnames-1020 syntmp-marks-1021 syntmp-labels-1022))) (syntmp-gen-labels-123 (lambda (syntmp-ls-1023) (if (null? syntmp-ls-1023) (quote ()) (cons (syntmp-gen-label-122) (syntmp-gen-labels-123 (cdr syntmp-ls-1023)))))) (syntmp-gen-label-122 (lambda () (string #\i))) (syntmp-wrap-subst-121 cdr) (syntmp-wrap-marks-120 car) (syntmp-make-wrap-119 cons) (syntmp-id-sym-name&marks-118 (lambda (syntmp-x-1024 syntmp-w-1025) (if (syntmp-syntax-object?-101 syntmp-x-1024) (values (let ((syntmp-e-1026 (syntmp-syntax-object-expression-102 syntmp-x-1024))) (if (annotation? syntmp-e-1026) (annotation-expression syntmp-e-1026) syntmp-e-1026)) (syntmp-join-marks-137 (syntmp-wrap-marks-120 syntmp-w-1025) (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-x-1024)))) (values (let ((syntmp-e-1027 syntmp-x-1024)) (if (annotation? syntmp-e-1027) (annotation-expression syntmp-e-1027) syntmp-e-1027)) (syntmp-wrap-marks-120 syntmp-w-1025))))) (syntmp-id?-117 (lambda (syntmp-x-1028) (cond ((symbol? syntmp-x-1028) #t) ((syntmp-syntax-object?-101 syntmp-x-1028) (symbol? (let ((syntmp-e-1029 (syntmp-syntax-object-expression-102 syntmp-x-1028))) (if (annotation? syntmp-e-1029) (annotation-expression syntmp-e-1029) syntmp-e-1029)))) ((annotation? syntmp-x-1028) (symbol? (annotation-expression syntmp-x-1028))) (else #f)))) (syntmp-nonsymbol-id?-116 (lambda (syntmp-x-1030) (and (syntmp-syntax-object?-101 syntmp-x-1030) (symbol? (let ((syntmp-e-1031 (syntmp-syntax-object-expression-102 syntmp-x-1030))) (if (annotation? syntmp-e-1031) (annotation-expression syntmp-e-1031) syntmp-e-1031)))))) (syntmp-global-extend-115 (lambda (syntmp-type-1032 syntmp-sym-1033 syntmp-val-1034) (syntmp-put-global-definition-hook-92 syntmp-sym-1033 (cons syntmp-type-1032 syntmp-val-1034) (module-name (current-module))))) (syntmp-lookup-114 (lambda (syntmp-x-1035 syntmp-r-1036 syntmp-mod-1037) (cond ((assq syntmp-x-1035 syntmp-r-1036) => cdr) ((symbol? syntmp-x-1035) (or (syntmp-get-global-definition-hook-93 syntmp-x-1035 syntmp-mod-1037) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-113 (lambda (syntmp-r-1038) (if (null? syntmp-r-1038) (quote ()) (let ((syntmp-a-1039 (car syntmp-r-1038))) (if (eq? (cadr syntmp-a-1039) (quote macro)) (cons syntmp-a-1039 (syntmp-macros-only-env-113 (cdr syntmp-r-1038))) (syntmp-macros-only-env-113 (cdr syntmp-r-1038))))))) (syntmp-extend-var-env-112 (lambda (syntmp-labels-1040 syntmp-vars-1041 syntmp-r-1042) (if (null? syntmp-labels-1040) syntmp-r-1042 (syntmp-extend-var-env-112 (cdr syntmp-labels-1040) (cdr syntmp-vars-1041) (cons (cons (car syntmp-labels-1040) (cons (quote lexical) (car syntmp-vars-1041))) syntmp-r-1042))))) (syntmp-extend-env-111 (lambda (syntmp-labels-1043 syntmp-bindings-1044 syntmp-r-1045) (if (null? syntmp-labels-1043) syntmp-r-1045 (syntmp-extend-env-111 (cdr syntmp-labels-1043) (cdr syntmp-bindings-1044) (cons (cons (car syntmp-labels-1043) (car syntmp-bindings-1044)) syntmp-r-1045))))) (syntmp-binding-value-110 cdr) (syntmp-binding-type-109 car) (syntmp-source-annotation-108 (lambda (syntmp-x-1046) (cond ((annotation? syntmp-x-1046) (annotation-source syntmp-x-1046)) ((syntmp-syntax-object?-101 syntmp-x-1046) (syntmp-source-annotation-108 (syntmp-syntax-object-expression-102 syntmp-x-1046))) (else #f)))) (syntmp-set-syntax-object-module!-107 (lambda (syntmp-x-1047 syntmp-update-1048) (vector-set! syntmp-x-1047 3 syntmp-update-1048))) (syntmp-set-syntax-object-wrap!-106 (lambda (syntmp-x-1049 syntmp-update-1050) (vector-set! syntmp-x-1049 2 syntmp-update-1050))) (syntmp-set-syntax-object-expression!-105 (lambda (syntmp-x-1051 syntmp-update-1052) (vector-set! syntmp-x-1051 1 syntmp-update-1052))) (syntmp-syntax-object-module-104 (lambda (syntmp-x-1053) (vector-ref syntmp-x-1053 3))) (syntmp-syntax-object-wrap-103 (lambda (syntmp-x-1054) (vector-ref syntmp-x-1054 2))) (syntmp-syntax-object-expression-102 (lambda (syntmp-x-1055) (vector-ref syntmp-x-1055 1))) (syntmp-syntax-object?-101 (lambda (syntmp-x-1056) (and (vector? syntmp-x-1056) (= (vector-length syntmp-x-1056) 4) (eq? (vector-ref syntmp-x-1056 0) (quote syntax-object))))) (syntmp-make-syntax-object-100 (lambda (syntmp-expression-1057 syntmp-wrap-1058 syntmp-module-1059) (vector (quote syntax-object) syntmp-expression-1057 syntmp-wrap-1058 syntmp-module-1059))) (syntmp-build-letrec-99 (lambda (syntmp-src-1060 syntmp-vars-1061 syntmp-val-exps-1062 syntmp-body-exp-1063) (if (null? syntmp-vars-1061) (syntmp-build-annotated-94 syntmp-src-1060 syntmp-body-exp-1063) (syntmp-build-annotated-94 syntmp-src-1060 (list (quote letrec) (map list syntmp-vars-1061 syntmp-val-exps-1062) syntmp-body-exp-1063))))) (syntmp-build-named-let-98 (lambda (syntmp-src-1064 syntmp-vars-1065 syntmp-val-exps-1066 syntmp-body-exp-1067) (if (null? syntmp-vars-1065) (syntmp-build-annotated-94 syntmp-src-1064 syntmp-body-exp-1067) (syntmp-build-annotated-94 syntmp-src-1064 (list (quote let) (car syntmp-vars-1065) (map list (cdr syntmp-vars-1065) syntmp-val-exps-1066) syntmp-body-exp-1067))))) (syntmp-build-let-97 (lambda (syntmp-src-1068 syntmp-vars-1069 syntmp-val-exps-1070 syntmp-body-exp-1071) (if (null? syntmp-vars-1069) (syntmp-build-annotated-94 syntmp-src-1068 syntmp-body-exp-1071) (syntmp-build-annotated-94 syntmp-src-1068 (list (quote let) (map list syntmp-vars-1069 syntmp-val-exps-1070) syntmp-body-exp-1071))))) (syntmp-build-sequence-96 (lambda (syntmp-src-1072 syntmp-exps-1073) (if (null? (cdr syntmp-exps-1073)) (syntmp-build-annotated-94 syntmp-src-1072 (car syntmp-exps-1073)) (syntmp-build-annotated-94 syntmp-src-1072 (cons (quote begin) syntmp-exps-1073))))) (syntmp-build-data-95 (lambda (syntmp-src-1074 syntmp-exp-1075) (if (and (self-evaluating? syntmp-exp-1075) (not (vector? syntmp-exp-1075))) (syntmp-build-annotated-94 syntmp-src-1074 syntmp-exp-1075) (syntmp-build-annotated-94 syntmp-src-1074 (list (quote quote) syntmp-exp-1075))))) (syntmp-build-annotated-94 (lambda (syntmp-src-1076 syntmp-exp-1077) (if (and syntmp-src-1076 (not (annotation? syntmp-exp-1077))) (make-annotation syntmp-exp-1077 syntmp-src-1076 #t) syntmp-exp-1077))) (syntmp-get-global-definition-hook-93 (lambda (syntmp-symbol-1078 syntmp-module-1079) (let ((syntmp-module-1080 (if syntmp-module-1079 (resolve-module syntmp-module-1079) (warn "wha" syntmp-symbol-1078 (current-module))))) (let ((syntmp-v-1081 (module-variable syntmp-module-1080 syntmp-symbol-1078))) (and syntmp-v-1081 (or (object-property syntmp-v-1081 (quote *sc-expander*)) (and (variable-bound? syntmp-v-1081) (macro? (variable-ref syntmp-v-1081)) (macro-transformer (variable-ref syntmp-v-1081)) guile-macro))))))) (syntmp-put-global-definition-hook-92 (lambda (syntmp-symbol-1082 syntmp-binding-1083 syntmp-modname-1084) (let ((syntmp-module-1085 (if syntmp-modname-1084 (resolve-module syntmp-modname-1084) (current-module)))) (let ((syntmp-v-1086 (or (module-variable syntmp-module-1085 syntmp-symbol-1082) (let ((syntmp-v-1087 (make-variable (quote sc-macro)))) (begin (module-add! syntmp-module-1085 syntmp-symbol-1082 syntmp-v-1087) syntmp-v-1087))))) (begin (if (not (and (symbol-property syntmp-symbol-1082 (quote primitive-syntax)) (eq? syntmp-module-1085 the-syncase-module))) (variable-set! syntmp-v-1086 sc-macro)) (set-object-property! syntmp-v-1086 (quote *sc-expander*) syntmp-binding-1083)))))) (syntmp-error-hook-91 (lambda (syntmp-who-1088 syntmp-why-1089 syntmp-what-1090) (error syntmp-who-1088 "~a ~s" syntmp-why-1089 syntmp-what-1090))) (syntmp-local-eval-hook-90 (lambda (syntmp-x-1091 syntmp-mod-1092) (eval (list syntmp-noexpand-84 syntmp-x-1091) (if syntmp-mod-1092 (resolve-module syntmp-mod-1092) (interaction-environment))))) (syntmp-top-level-eval-hook-89 (lambda (syntmp-x-1093 syntmp-mod-1094) (eval (list syntmp-noexpand-84 syntmp-x-1093) (if syntmp-mod-1094 (resolve-module syntmp-mod-1094) (interaction-environment))))) (syntmp-fx<-88 <) (syntmp-fx=-87 =) (syntmp-fx--86 -) (syntmp-fx+-85 +) (syntmp-noexpand-84 "noexpand")) (begin (syntmp-global-extend-115 (quote local-syntax) (quote letrec-syntax) #t) (syntmp-global-extend-115 (quote local-syntax) (quote let-syntax) #f) (syntmp-global-extend-115 (quote core) (quote fluid-let-syntax) (lambda (syntmp-e-1095 syntmp-r-1096 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) ((lambda (syntmp-tmp-1100) ((lambda (syntmp-tmp-1101) (if (if syntmp-tmp-1101 (apply (lambda (syntmp-_-1102 syntmp-var-1103 syntmp-val-1104 syntmp-e1-1105 syntmp-e2-1106) (syntmp-valid-bound-ids?-142 syntmp-var-1103)) syntmp-tmp-1101) #f) (apply (lambda (syntmp-_-1108 syntmp-var-1109 syntmp-val-1110 syntmp-e1-1111 syntmp-e2-1112) (let ((syntmp-names-1113 (map (lambda (syntmp-x-1114) (syntmp-id-var-name-139 syntmp-x-1114 syntmp-w-1097)) syntmp-var-1109))) (begin (for-each (lambda (syntmp-id-1116 syntmp-n-1117) (let ((syntmp-t-1118 (syntmp-binding-type-109 (syntmp-lookup-114 syntmp-n-1117 syntmp-r-1096 syntmp-mod-1099)))) (if (memv syntmp-t-1118 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-146 syntmp-id-1116 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) "identifier out of context")))) syntmp-var-1109 syntmp-names-1113) (syntmp-chi-body-157 (cons syntmp-e1-1111 syntmp-e2-1112) (syntmp-source-wrap-146 syntmp-e-1095 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) (syntmp-extend-env-111 syntmp-names-1113 (let ((syntmp-trans-r-1121 (syntmp-macros-only-env-113 syntmp-r-1096))) (map (lambda (syntmp-x-1122) (cons (quote macro) (syntmp-eval-local-transformer-160 (syntmp-chi-153 syntmp-x-1122 syntmp-trans-r-1121 syntmp-w-1097 syntmp-mod-1099) syntmp-mod-1099))) syntmp-val-1110)) syntmp-r-1096) syntmp-w-1097 syntmp-mod-1099)))) syntmp-tmp-1101) ((lambda (syntmp-_-1124) (syntax-error (syntmp-source-wrap-146 syntmp-e-1095 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099))) syntmp-tmp-1100))) (syntax-dispatch syntmp-tmp-1100 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1095))) (syntmp-global-extend-115 (quote core) (quote quote) (lambda (syntmp-e-1125 syntmp-r-1126 syntmp-w-1127 syntmp-s-1128 syntmp-mod-1129) ((lambda (syntmp-tmp-1130) ((lambda (syntmp-tmp-1131) (if syntmp-tmp-1131 (apply (lambda (syntmp-_-1132 syntmp-e-1133) (syntmp-build-data-95 syntmp-s-1128 (syntmp-strip-164 syntmp-e-1133 syntmp-w-1127))) syntmp-tmp-1131) ((lambda (syntmp-_-1134) (syntax-error (syntmp-source-wrap-146 syntmp-e-1125 syntmp-w-1127 syntmp-s-1128 syntmp-mod-1129))) syntmp-tmp-1130))) (syntax-dispatch syntmp-tmp-1130 (quote (any any))))) syntmp-e-1125))) (syntmp-global-extend-115 (quote core) (quote syntax) (letrec ((syntmp-regen-1142 (lambda (syntmp-x-1143) (let ((syntmp-t-1144 (car syntmp-x-1143))) (if (memv syntmp-t-1144 (quote (ref))) (syntmp-build-annotated-94 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (primitive))) (syntmp-build-annotated-94 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (quote))) (syntmp-build-data-95 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (lambda))) (syntmp-build-annotated-94 #f (list (quote lambda) (cadr syntmp-x-1143) (syntmp-regen-1142 (caddr syntmp-x-1143)))) (if (memv syntmp-t-1144 (quote (map))) (let ((syntmp-ls-1145 (map syntmp-regen-1142 (cdr syntmp-x-1143)))) (syntmp-build-annotated-94 #f (cons (if (syntmp-fx=-87 (length syntmp-ls-1145) 2) (syntmp-build-annotated-94 #f (quote map)) (syntmp-build-annotated-94 #f (quote map))) syntmp-ls-1145))) (syntmp-build-annotated-94 #f (cons (syntmp-build-annotated-94 #f (car syntmp-x-1143)) (map syntmp-regen-1142 (cdr syntmp-x-1143)))))))))))) (syntmp-gen-vector-1141 (lambda (syntmp-x-1146) (cond ((eq? (car syntmp-x-1146) (quote list)) (cons (quote vector) (cdr syntmp-x-1146))) ((eq? (car syntmp-x-1146) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1146)))) (else (list (quote list->vector) syntmp-x-1146))))) (syntmp-gen-append-1140 (lambda (syntmp-x-1147 syntmp-y-1148) (if (equal? syntmp-y-1148 (quote (quote ()))) syntmp-x-1147 (list (quote append) syntmp-x-1147 syntmp-y-1148)))) (syntmp-gen-cons-1139 (lambda (syntmp-x-1149 syntmp-y-1150) (let ((syntmp-t-1151 (car syntmp-y-1150))) (if (memv syntmp-t-1151 (quote (quote))) (if (eq? (car syntmp-x-1149) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1149) (cadr syntmp-y-1150))) (if (eq? (cadr syntmp-y-1150) (quote ())) (list (quote list) syntmp-x-1149) (list (quote cons) syntmp-x-1149 syntmp-y-1150))) (if (memv syntmp-t-1151 (quote (list))) (cons (quote list) (cons syntmp-x-1149 (cdr syntmp-y-1150))) (list (quote cons) syntmp-x-1149 syntmp-y-1150)))))) (syntmp-gen-map-1138 (lambda (syntmp-e-1152 syntmp-map-env-1153) (let ((syntmp-formals-1154 (map cdr syntmp-map-env-1153)) (syntmp-actuals-1155 (map (lambda (syntmp-x-1156) (list (quote ref) (car syntmp-x-1156))) syntmp-map-env-1153))) (cond ((eq? (car syntmp-e-1152) (quote ref)) (car syntmp-actuals-1155)) ((andmap (lambda (syntmp-x-1157) (and (eq? (car syntmp-x-1157) (quote ref)) (memq (cadr syntmp-x-1157) syntmp-formals-1154))) (cdr syntmp-e-1152)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1152)) (map (let ((syntmp-r-1158 (map cons syntmp-formals-1154 syntmp-actuals-1155))) (lambda (syntmp-x-1159) (cdr (assq (cadr syntmp-x-1159) syntmp-r-1158)))) (cdr syntmp-e-1152))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1154 syntmp-e-1152) syntmp-actuals-1155))))))) (syntmp-gen-mappend-1137 (lambda (syntmp-e-1160 syntmp-map-env-1161) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1138 syntmp-e-1160 syntmp-map-env-1161)))) (syntmp-gen-ref-1136 (lambda (syntmp-src-1162 syntmp-var-1163 syntmp-level-1164 syntmp-maps-1165) (if (syntmp-fx=-87 syntmp-level-1164 0) (values syntmp-var-1163 syntmp-maps-1165) (if (null? syntmp-maps-1165) (syntax-error syntmp-src-1162 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1136 syntmp-src-1162 syntmp-var-1163 (syntmp-fx--86 syntmp-level-1164 1) (cdr syntmp-maps-1165))) (lambda (syntmp-outer-var-1166 syntmp-outer-maps-1167) (let ((syntmp-b-1168 (assq syntmp-outer-var-1166 (car syntmp-maps-1165)))) (if syntmp-b-1168 (values (cdr syntmp-b-1168) syntmp-maps-1165) (let ((syntmp-inner-var-1169 (syntmp-gen-var-165 (quote tmp)))) (values syntmp-inner-var-1169 (cons (cons (cons syntmp-outer-var-1166 syntmp-inner-var-1169) (car syntmp-maps-1165)) syntmp-outer-maps-1167))))))))))) (syntmp-gen-syntax-1135 (lambda (syntmp-src-1170 syntmp-e-1171 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175) (if (syntmp-id?-117 syntmp-e-1171) (let ((syntmp-label-1176 (syntmp-id-var-name-139 syntmp-e-1171 (quote (()))))) (let ((syntmp-b-1177 (syntmp-lookup-114 syntmp-label-1176 syntmp-r-1172 syntmp-mod-1175))) (if (eq? (syntmp-binding-type-109 syntmp-b-1177) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1178 (syntmp-binding-value-110 syntmp-b-1177))) (syntmp-gen-ref-1136 syntmp-src-1170 (car syntmp-var.lev-1178) (cdr syntmp-var.lev-1178) syntmp-maps-1173))) (lambda (syntmp-var-1179 syntmp-maps-1180) (values (list (quote ref) syntmp-var-1179) syntmp-maps-1180))) (if (syntmp-ellipsis?-1174 syntmp-e-1171) (syntax-error syntmp-src-1170 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1171) syntmp-maps-1173))))) ((lambda (syntmp-tmp-1181) ((lambda (syntmp-tmp-1182) (if (if syntmp-tmp-1182 (apply (lambda (syntmp-dots-1183 syntmp-e-1184) (syntmp-ellipsis?-1174 syntmp-dots-1183)) syntmp-tmp-1182) #f) (apply (lambda (syntmp-dots-1185 syntmp-e-1186) (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-e-1186 syntmp-r-1172 syntmp-maps-1173 (lambda (syntmp-x-1187) #f) syntmp-mod-1175)) syntmp-tmp-1182) ((lambda (syntmp-tmp-1188) (if (if syntmp-tmp-1188 (apply (lambda (syntmp-x-1189 syntmp-dots-1190 syntmp-y-1191) (syntmp-ellipsis?-1174 syntmp-dots-1190)) syntmp-tmp-1188) #f) (apply (lambda (syntmp-x-1192 syntmp-dots-1193 syntmp-y-1194) (let syntmp-f-1195 ((syntmp-y-1196 syntmp-y-1194) (syntmp-k-1197 (lambda (syntmp-maps-1198) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-x-1192 syntmp-r-1172 (cons (quote ()) syntmp-maps-1198) syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-x-1199 syntmp-maps-1200) (if (null? (car syntmp-maps-1200)) (syntax-error syntmp-src-1170 "extra ellipsis in syntax form") (values (syntmp-gen-map-1138 syntmp-x-1199 (car syntmp-maps-1200)) (cdr syntmp-maps-1200)))))))) ((lambda (syntmp-tmp-1201) ((lambda (syntmp-tmp-1202) (if (if syntmp-tmp-1202 (apply (lambda (syntmp-dots-1203 syntmp-y-1204) (syntmp-ellipsis?-1174 syntmp-dots-1203)) syntmp-tmp-1202) #f) (apply (lambda (syntmp-dots-1205 syntmp-y-1206) (syntmp-f-1195 syntmp-y-1206 (lambda (syntmp-maps-1207) (call-with-values (lambda () (syntmp-k-1197 (cons (quote ()) syntmp-maps-1207))) (lambda (syntmp-x-1208 syntmp-maps-1209) (if (null? (car syntmp-maps-1209)) (syntax-error syntmp-src-1170 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1137 syntmp-x-1208 (car syntmp-maps-1209)) (cdr syntmp-maps-1209)))))))) syntmp-tmp-1202) ((lambda (syntmp-_-1210) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-y-1196 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-y-1211 syntmp-maps-1212) (call-with-values (lambda () (syntmp-k-1197 syntmp-maps-1212)) (lambda (syntmp-x-1213 syntmp-maps-1214) (values (syntmp-gen-append-1140 syntmp-x-1213 syntmp-y-1211) syntmp-maps-1214)))))) syntmp-tmp-1201))) (syntax-dispatch syntmp-tmp-1201 (quote (any . any))))) syntmp-y-1196))) syntmp-tmp-1188) ((lambda (syntmp-tmp-1215) (if syntmp-tmp-1215 (apply (lambda (syntmp-x-1216 syntmp-y-1217) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-x-1216 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-x-1218 syntmp-maps-1219) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-y-1217 syntmp-r-1172 syntmp-maps-1219 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-y-1220 syntmp-maps-1221) (values (syntmp-gen-cons-1139 syntmp-x-1218 syntmp-y-1220) syntmp-maps-1221)))))) syntmp-tmp-1215) ((lambda (syntmp-tmp-1222) (if syntmp-tmp-1222 (apply (lambda (syntmp-e1-1223 syntmp-e2-1224) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 (cons syntmp-e1-1223 syntmp-e2-1224) syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-e-1226 syntmp-maps-1227) (values (syntmp-gen-vector-1141 syntmp-e-1226) syntmp-maps-1227)))) syntmp-tmp-1222) ((lambda (syntmp-_-1228) (values (list (quote quote) syntmp-e-1171) syntmp-maps-1173)) syntmp-tmp-1181))) (syntax-dispatch syntmp-tmp-1181 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1181 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1181 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1181 (quote (any any))))) syntmp-e-1171))))) (lambda (syntmp-e-1229 syntmp-r-1230 syntmp-w-1231 syntmp-s-1232 syntmp-mod-1233) (let ((syntmp-e-1234 (syntmp-source-wrap-146 syntmp-e-1229 syntmp-w-1231 syntmp-s-1232 syntmp-mod-1233))) ((lambda (syntmp-tmp-1235) ((lambda (syntmp-tmp-1236) (if syntmp-tmp-1236 (apply (lambda (syntmp-_-1237 syntmp-x-1238) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-e-1234 syntmp-x-1238 syntmp-r-1230 (quote ()) syntmp-ellipsis?-162 syntmp-mod-1233)) (lambda (syntmp-e-1239 syntmp-maps-1240) (syntmp-regen-1142 syntmp-e-1239)))) syntmp-tmp-1236) ((lambda (syntmp-_-1241) (syntax-error syntmp-e-1234)) syntmp-tmp-1235))) (syntax-dispatch syntmp-tmp-1235 (quote (any any))))) syntmp-e-1234))))) (syntmp-global-extend-115 (quote core) (quote lambda) (lambda (syntmp-e-1242 syntmp-r-1243 syntmp-w-1244 syntmp-s-1245 syntmp-mod-1246) ((lambda (syntmp-tmp-1247) ((lambda (syntmp-tmp-1248) (if syntmp-tmp-1248 (apply (lambda (syntmp-_-1249 syntmp-c-1250) (syntmp-chi-lambda-clause-158 (syntmp-source-wrap-146 syntmp-e-1242 syntmp-w-1244 syntmp-s-1245 syntmp-mod-1246) syntmp-c-1250 syntmp-r-1243 syntmp-w-1244 syntmp-mod-1246 (lambda (syntmp-vars-1251 syntmp-body-1252) (syntmp-build-annotated-94 syntmp-s-1245 (list (quote lambda) syntmp-vars-1251 syntmp-body-1252))))) syntmp-tmp-1248) (syntax-error syntmp-tmp-1247))) (syntax-dispatch syntmp-tmp-1247 (quote (any . any))))) syntmp-e-1242))) (syntmp-global-extend-115 (quote core) (quote let) (letrec ((syntmp-chi-let-1253 (lambda (syntmp-e-1254 syntmp-r-1255 syntmp-w-1256 syntmp-s-1257 syntmp-mod-1258 syntmp-constructor-1259 syntmp-ids-1260 syntmp-vals-1261 syntmp-exps-1262) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-1260)) (syntax-error syntmp-e-1254 "duplicate bound variable in") (let ((syntmp-labels-1263 (syntmp-gen-labels-123 syntmp-ids-1260)) (syntmp-new-vars-1264 (map syntmp-gen-var-165 syntmp-ids-1260))) (let ((syntmp-nw-1265 (syntmp-make-binding-wrap-134 syntmp-ids-1260 syntmp-labels-1263 syntmp-w-1256)) (syntmp-nr-1266 (syntmp-extend-var-env-112 syntmp-labels-1263 syntmp-new-vars-1264 syntmp-r-1255))) (syntmp-constructor-1259 syntmp-s-1257 syntmp-new-vars-1264 (map (lambda (syntmp-x-1267) (syntmp-chi-153 syntmp-x-1267 syntmp-r-1255 syntmp-w-1256 syntmp-mod-1258)) syntmp-vals-1261) (syntmp-chi-body-157 syntmp-exps-1262 (syntmp-source-wrap-146 syntmp-e-1254 syntmp-nw-1265 syntmp-s-1257 syntmp-mod-1258) syntmp-nr-1266 syntmp-nw-1265 syntmp-mod-1258)))))))) (lambda (syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272) ((lambda (syntmp-tmp-1273) ((lambda (syntmp-tmp-1274) (if syntmp-tmp-1274 (apply (lambda (syntmp-_-1275 syntmp-id-1276 syntmp-val-1277 syntmp-e1-1278 syntmp-e2-1279) (syntmp-chi-let-1253 syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272 syntmp-build-let-97 syntmp-id-1276 syntmp-val-1277 (cons syntmp-e1-1278 syntmp-e2-1279))) syntmp-tmp-1274) ((lambda (syntmp-tmp-1283) (if (if syntmp-tmp-1283 (apply (lambda (syntmp-_-1284 syntmp-f-1285 syntmp-id-1286 syntmp-val-1287 syntmp-e1-1288 syntmp-e2-1289) (syntmp-id?-117 syntmp-f-1285)) syntmp-tmp-1283) #f) (apply (lambda (syntmp-_-1290 syntmp-f-1291 syntmp-id-1292 syntmp-val-1293 syntmp-e1-1294 syntmp-e2-1295) (syntmp-chi-let-1253 syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272 syntmp-build-named-let-98 (cons syntmp-f-1291 syntmp-id-1292) syntmp-val-1293 (cons syntmp-e1-1294 syntmp-e2-1295))) syntmp-tmp-1283) ((lambda (syntmp-_-1299) (syntax-error (syntmp-source-wrap-146 syntmp-e-1268 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272))) syntmp-tmp-1273))) (syntax-dispatch syntmp-tmp-1273 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1273 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1268)))) (syntmp-global-extend-115 (quote core) (quote letrec) (lambda (syntmp-e-1300 syntmp-r-1301 syntmp-w-1302 syntmp-s-1303 syntmp-mod-1304) ((lambda (syntmp-tmp-1305) ((lambda (syntmp-tmp-1306) (if syntmp-tmp-1306 (apply (lambda (syntmp-_-1307 syntmp-id-1308 syntmp-val-1309 syntmp-e1-1310 syntmp-e2-1311) (let ((syntmp-ids-1312 syntmp-id-1308)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-1312)) (syntax-error syntmp-e-1300 "duplicate bound variable in") (let ((syntmp-labels-1314 (syntmp-gen-labels-123 syntmp-ids-1312)) (syntmp-new-vars-1315 (map syntmp-gen-var-165 syntmp-ids-1312))) (let ((syntmp-w-1316 (syntmp-make-binding-wrap-134 syntmp-ids-1312 syntmp-labels-1314 syntmp-w-1302)) (syntmp-r-1317 (syntmp-extend-var-env-112 syntmp-labels-1314 syntmp-new-vars-1315 syntmp-r-1301))) (syntmp-build-letrec-99 syntmp-s-1303 syntmp-new-vars-1315 (map (lambda (syntmp-x-1318) (syntmp-chi-153 syntmp-x-1318 syntmp-r-1317 syntmp-w-1316 syntmp-mod-1304)) syntmp-val-1309) (syntmp-chi-body-157 (cons syntmp-e1-1310 syntmp-e2-1311) (syntmp-source-wrap-146 syntmp-e-1300 syntmp-w-1316 syntmp-s-1303 syntmp-mod-1304) syntmp-r-1317 syntmp-w-1316 syntmp-mod-1304))))))) syntmp-tmp-1306) ((lambda (syntmp-_-1321) (syntax-error (syntmp-source-wrap-146 syntmp-e-1300 syntmp-w-1302 syntmp-s-1303 syntmp-mod-1304))) syntmp-tmp-1305))) (syntax-dispatch syntmp-tmp-1305 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1300))) (syntmp-global-extend-115 (quote core) (quote set!) (lambda (syntmp-e-1322 syntmp-r-1323 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326) ((lambda (syntmp-tmp-1327) ((lambda (syntmp-tmp-1328) (if (if syntmp-tmp-1328 (apply (lambda (syntmp-_-1329 syntmp-id-1330 syntmp-val-1331) (syntmp-id?-117 syntmp-id-1330)) syntmp-tmp-1328) #f) (apply (lambda (syntmp-_-1332 syntmp-id-1333 syntmp-val-1334) (let ((syntmp-val-1335 (syntmp-chi-153 syntmp-val-1334 syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326)) (syntmp-n-1336 (syntmp-id-var-name-139 syntmp-id-1333 syntmp-w-1324))) (let ((syntmp-b-1337 (syntmp-lookup-114 syntmp-n-1336 syntmp-r-1323 syntmp-mod-1326))) (let ((syntmp-t-1338 (syntmp-binding-type-109 syntmp-b-1337))) (if (memv syntmp-t-1338 (quote (lexical))) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (syntmp-binding-value-110 syntmp-b-1337) syntmp-val-1335)) (if (memv syntmp-t-1338 (quote (global))) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (make-module-ref syntmp-mod-1326 syntmp-n-1336 #f) syntmp-val-1335)) (if (memv syntmp-t-1338 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-145 syntmp-id-1333 syntmp-w-1324 syntmp-mod-1326) "identifier out of context") (syntax-error (syntmp-source-wrap-146 syntmp-e-1322 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326))))))))) syntmp-tmp-1328) ((lambda (syntmp-tmp-1339) (if syntmp-tmp-1339 (apply (lambda (syntmp-_-1340 syntmp-head-1341 syntmp-tail-1342 syntmp-val-1343) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-head-1341 syntmp-r-1323 (quote (())) #f #f syntmp-mod-1326)) (lambda (syntmp-type-1344 syntmp-value-1345 syntmp-ee-1346 syntmp-ww-1347 syntmp-ss-1348 syntmp-modmod-1349) (let ((syntmp-t-1350 syntmp-type-1344)) (if (memv syntmp-t-1350 (quote (module-ref))) (call-with-values (lambda () (syntmp-value-1345 (cons syntmp-head-1341 syntmp-tail-1342))) (lambda (syntmp-id-1352 syntmp-mod-1353) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (make-module-ref syntmp-mod-1353 syntmp-id-1352 #f) syntmp-val-1343)))) (syntmp-build-annotated-94 syntmp-s-1325 (cons (syntmp-chi-153 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase))) syntmp-head-1341) syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326) (map (lambda (syntmp-e-1354) (syntmp-chi-153 syntmp-e-1354 syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326)) (append syntmp-tail-1342 (list syntmp-val-1343)))))))))) syntmp-tmp-1339) ((lambda (syntmp-_-1356) (syntax-error (syntmp-source-wrap-146 syntmp-e-1322 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326))) syntmp-tmp-1327))) (syntax-dispatch syntmp-tmp-1327 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1327 (quote (any any any))))) syntmp-e-1322))) (syntmp-global-extend-115 (quote module-ref) (quote @) (lambda (syntmp-e-1357) ((lambda (syntmp-tmp-1358) ((lambda (syntmp-tmp-1359) (if (if syntmp-tmp-1359 (apply (lambda (syntmp-_-1360 syntmp-mod-1361 syntmp-id-1362) (and (andmap syntmp-id?-117 syntmp-mod-1361) (syntmp-id?-117 syntmp-id-1362))) syntmp-tmp-1359) #f) (apply (lambda (syntmp-_-1364 syntmp-mod-1365 syntmp-id-1366) (values (syntax-object->datum syntmp-id-1366) (syntax-object->datum (append syntmp-mod-1365 (quote (#(syntax-object %module-public-interface ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))))))) syntmp-tmp-1359) (syntax-error syntmp-tmp-1358))) (syntax-dispatch syntmp-tmp-1358 (quote (any each-any any))))) syntmp-e-1357))) (syntmp-global-extend-115 (quote module-ref) (quote @@) (lambda (syntmp-e-1368) ((lambda (syntmp-tmp-1369) ((lambda (syntmp-tmp-1370) (if (if syntmp-tmp-1370 (apply (lambda (syntmp-_-1371 syntmp-mod-1372 syntmp-id-1373) (and (andmap syntmp-id?-117 syntmp-mod-1372) (syntmp-id?-117 syntmp-id-1373))) syntmp-tmp-1370) #f) (apply (lambda (syntmp-_-1375 syntmp-mod-1376 syntmp-id-1377) (values (syntax-object->datum syntmp-id-1377) (syntax-object->datum syntmp-mod-1376))) syntmp-tmp-1370) (syntax-error syntmp-tmp-1369))) (syntax-dispatch syntmp-tmp-1369 (quote (any each-any any))))) syntmp-e-1368))) (syntmp-global-extend-115 (quote begin) (quote begin) (quote ())) (syntmp-global-extend-115 (quote define) (quote define) (quote ())) (syntmp-global-extend-115 (quote define-syntax) (quote define-syntax) (quote ())) (syntmp-global-extend-115 (quote eval-when) (quote eval-when) (quote ())) (syntmp-global-extend-115 (quote core) (quote syntax-case) (letrec ((syntmp-gen-syntax-case-1382 (lambda (syntmp-x-1383 syntmp-keys-1384 syntmp-clauses-1385 syntmp-r-1386 syntmp-mod-1387) (if (null? syntmp-clauses-1385) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote syntax-error)) syntmp-x-1383)) ((lambda (syntmp-tmp-1388) ((lambda (syntmp-tmp-1389) (if syntmp-tmp-1389 (apply (lambda (syntmp-pat-1390 syntmp-exp-1391) (if (and (syntmp-id?-117 syntmp-pat-1390) (andmap (lambda (syntmp-x-1392) (not (syntmp-free-id=?-140 syntmp-pat-1390 syntmp-x-1392))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase))) syntmp-keys-1384))) (let ((syntmp-labels-1393 (list (syntmp-gen-label-122))) (syntmp-var-1394 (syntmp-gen-var-165 syntmp-pat-1390))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-var-1394) (syntmp-chi-153 syntmp-exp-1391 (syntmp-extend-env-111 syntmp-labels-1393 (list (cons (quote syntax) (cons syntmp-var-1394 0))) syntmp-r-1386) (syntmp-make-binding-wrap-134 (list syntmp-pat-1390) syntmp-labels-1393 (quote (()))) syntmp-mod-1387))) syntmp-x-1383))) (syntmp-gen-clause-1381 syntmp-x-1383 syntmp-keys-1384 (cdr syntmp-clauses-1385) syntmp-r-1386 syntmp-pat-1390 #t syntmp-exp-1391 syntmp-mod-1387))) syntmp-tmp-1389) ((lambda (syntmp-tmp-1395) (if syntmp-tmp-1395 (apply (lambda (syntmp-pat-1396 syntmp-fender-1397 syntmp-exp-1398) (syntmp-gen-clause-1381 syntmp-x-1383 syntmp-keys-1384 (cdr syntmp-clauses-1385) syntmp-r-1386 syntmp-pat-1396 syntmp-fender-1397 syntmp-exp-1398 syntmp-mod-1387)) syntmp-tmp-1395) ((lambda (syntmp-_-1399) (syntax-error (car syntmp-clauses-1385) "invalid syntax-case clause")) syntmp-tmp-1388))) (syntax-dispatch syntmp-tmp-1388 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1388 (quote (any any))))) (car syntmp-clauses-1385))))) (syntmp-gen-clause-1381 (lambda (syntmp-x-1400 syntmp-keys-1401 syntmp-clauses-1402 syntmp-r-1403 syntmp-pat-1404 syntmp-fender-1405 syntmp-exp-1406 syntmp-mod-1407) (call-with-values (lambda () (syntmp-convert-pattern-1379 syntmp-pat-1404 syntmp-keys-1401)) (lambda (syntmp-p-1408 syntmp-pvars-1409) (cond ((not (syntmp-distinct-bound-ids?-143 (map car syntmp-pvars-1409))) (syntax-error syntmp-pat-1404 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1410) (not (syntmp-ellipsis?-162 (car syntmp-x-1410)))) syntmp-pvars-1409)) (syntax-error syntmp-pat-1404 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1411 (syntmp-gen-var-165 (quote tmp)))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-y-1411) (let ((syntmp-y-1412 (syntmp-build-annotated-94 #f syntmp-y-1411))) (syntmp-build-annotated-94 #f (list (quote if) ((lambda (syntmp-tmp-1413) ((lambda (syntmp-tmp-1414) (if syntmp-tmp-1414 (apply (lambda () syntmp-y-1412) syntmp-tmp-1414) ((lambda (syntmp-_-1415) (syntmp-build-annotated-94 #f (list (quote if) syntmp-y-1412 (syntmp-build-dispatch-call-1380 syntmp-pvars-1409 syntmp-fender-1405 syntmp-y-1412 syntmp-r-1403 syntmp-mod-1407) (syntmp-build-data-95 #f #f)))) syntmp-tmp-1413))) (syntax-dispatch syntmp-tmp-1413 (quote #(atom #t))))) syntmp-fender-1405) (syntmp-build-dispatch-call-1380 syntmp-pvars-1409 syntmp-exp-1406 syntmp-y-1412 syntmp-r-1403 syntmp-mod-1407) (syntmp-gen-syntax-case-1382 syntmp-x-1400 syntmp-keys-1401 syntmp-clauses-1402 syntmp-r-1403 syntmp-mod-1407)))))) (if (eq? syntmp-p-1408 (quote any)) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote list)) syntmp-x-1400)) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote syntax-dispatch)) syntmp-x-1400 (syntmp-build-data-95 #f syntmp-p-1408))))))))))))) (syntmp-build-dispatch-call-1380 (lambda (syntmp-pvars-1416 syntmp-exp-1417 syntmp-y-1418 syntmp-r-1419 syntmp-mod-1420) (let ((syntmp-ids-1421 (map car syntmp-pvars-1416)) (syntmp-levels-1422 (map cdr syntmp-pvars-1416))) (let ((syntmp-labels-1423 (syntmp-gen-labels-123 syntmp-ids-1421)) (syntmp-new-vars-1424 (map syntmp-gen-var-165 syntmp-ids-1421))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote apply)) (syntmp-build-annotated-94 #f (list (quote lambda) syntmp-new-vars-1424 (syntmp-chi-153 syntmp-exp-1417 (syntmp-extend-env-111 syntmp-labels-1423 (map (lambda (syntmp-var-1425 syntmp-level-1426) (cons (quote syntax) (cons syntmp-var-1425 syntmp-level-1426))) syntmp-new-vars-1424 (map cdr syntmp-pvars-1416)) syntmp-r-1419) (syntmp-make-binding-wrap-134 syntmp-ids-1421 syntmp-labels-1423 (quote (()))) syntmp-mod-1420))) syntmp-y-1418)))))) (syntmp-convert-pattern-1379 (lambda (syntmp-pattern-1427 syntmp-keys-1428) (let syntmp-cvt-1429 ((syntmp-p-1430 syntmp-pattern-1427) (syntmp-n-1431 0) (syntmp-ids-1432 (quote ()))) (if (syntmp-id?-117 syntmp-p-1430) (if (syntmp-bound-id-member?-144 syntmp-p-1430 syntmp-keys-1428) (values (vector (quote free-id) syntmp-p-1430) syntmp-ids-1432) (values (quote any) (cons (cons syntmp-p-1430 syntmp-n-1431) syntmp-ids-1432))) ((lambda (syntmp-tmp-1433) ((lambda (syntmp-tmp-1434) (if (if syntmp-tmp-1434 (apply (lambda (syntmp-x-1435 syntmp-dots-1436) (syntmp-ellipsis?-162 syntmp-dots-1436)) syntmp-tmp-1434) #f) (apply (lambda (syntmp-x-1437 syntmp-dots-1438) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1437 (syntmp-fx+-85 syntmp-n-1431 1) syntmp-ids-1432)) (lambda (syntmp-p-1439 syntmp-ids-1440) (values (if (eq? syntmp-p-1439 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1439)) syntmp-ids-1440)))) syntmp-tmp-1434) ((lambda (syntmp-tmp-1441) (if syntmp-tmp-1441 (apply (lambda (syntmp-x-1442 syntmp-y-1443) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-y-1443 syntmp-n-1431 syntmp-ids-1432)) (lambda (syntmp-y-1444 syntmp-ids-1445) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1442 syntmp-n-1431 syntmp-ids-1445)) (lambda (syntmp-x-1446 syntmp-ids-1447) (values (cons syntmp-x-1446 syntmp-y-1444) syntmp-ids-1447)))))) syntmp-tmp-1441) ((lambda (syntmp-tmp-1448) (if syntmp-tmp-1448 (apply (lambda () (values (quote ()) syntmp-ids-1432)) syntmp-tmp-1448) ((lambda (syntmp-tmp-1449) (if syntmp-tmp-1449 (apply (lambda (syntmp-x-1450) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1450 syntmp-n-1431 syntmp-ids-1432)) (lambda (syntmp-p-1452 syntmp-ids-1453) (values (vector (quote vector) syntmp-p-1452) syntmp-ids-1453)))) syntmp-tmp-1449) ((lambda (syntmp-x-1454) (values (vector (quote atom) (syntmp-strip-164 syntmp-p-1430 (quote (())))) syntmp-ids-1432)) syntmp-tmp-1433))) (syntax-dispatch syntmp-tmp-1433 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1433 (quote ()))))) (syntax-dispatch syntmp-tmp-1433 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1433 (quote (any any))))) syntmp-p-1430)))))) (lambda (syntmp-e-1455 syntmp-r-1456 syntmp-w-1457 syntmp-s-1458 syntmp-mod-1459) (let ((syntmp-e-1460 (syntmp-source-wrap-146 syntmp-e-1455 syntmp-w-1457 syntmp-s-1458 syntmp-mod-1459))) ((lambda (syntmp-tmp-1461) ((lambda (syntmp-tmp-1462) (if syntmp-tmp-1462 (apply (lambda (syntmp-_-1463 syntmp-val-1464 syntmp-key-1465 syntmp-m-1466) (if (andmap (lambda (syntmp-x-1467) (and (syntmp-id?-117 syntmp-x-1467) (not (syntmp-ellipsis?-162 syntmp-x-1467)))) syntmp-key-1465) (let ((syntmp-x-1469 (syntmp-gen-var-165 (quote tmp)))) (syntmp-build-annotated-94 syntmp-s-1458 (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-x-1469) (syntmp-gen-syntax-case-1382 (syntmp-build-annotated-94 #f syntmp-x-1469) syntmp-key-1465 syntmp-m-1466 syntmp-r-1456 syntmp-mod-1459))) (syntmp-chi-153 syntmp-val-1464 syntmp-r-1456 (quote (())) syntmp-mod-1459)))) (syntax-error syntmp-e-1460 "invalid literals list in"))) syntmp-tmp-1462) (syntax-error syntmp-tmp-1461))) (syntax-dispatch syntmp-tmp-1461 (quote (any any each-any . each-any))))) syntmp-e-1460))))) (set! sc-expand (let ((syntmp-m-1472 (quote e)) (syntmp-esew-1473 (quote (eval)))) (lambda (syntmp-x-1474) (if (and (pair? syntmp-x-1474) (equal? (car syntmp-x-1474) syntmp-noexpand-84)) (cadr syntmp-x-1474) (syntmp-chi-top-152 syntmp-x-1474 (quote ()) (quote ((top))) syntmp-m-1472 syntmp-esew-1473 (module-name (current-module))))))) (set! sc-expand3 (let ((syntmp-m-1475 (quote e)) (syntmp-esew-1476 (quote (eval)))) (lambda (syntmp-x-1478 . syntmp-rest-1477) (if (and (pair? syntmp-x-1478) (equal? (car syntmp-x-1478) syntmp-noexpand-84)) (cadr syntmp-x-1478) (syntmp-chi-top-152 syntmp-x-1478 (quote ()) (quote ((top))) (if (null? syntmp-rest-1477) syntmp-m-1475 (car syntmp-rest-1477)) (if (or (null? syntmp-rest-1477) (null? (cdr syntmp-rest-1477))) syntmp-esew-1476 (cadr syntmp-rest-1477)) (module-name (current-module))))))) (set! identifier? (lambda (syntmp-x-1479) (syntmp-nonsymbol-id?-116 syntmp-x-1479))) (set! datum->syntax-object (lambda (syntmp-id-1480 syntmp-datum-1481) (syntmp-make-syntax-object-100 syntmp-datum-1481 (syntmp-syntax-object-wrap-103 syntmp-id-1480) #f))) (set! syntax-object->datum (lambda (syntmp-x-1482) (syntmp-strip-164 syntmp-x-1482 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1483) (begin (let ((syntmp-x-1484 syntmp-ls-1483)) (if (not (list? syntmp-x-1484)) (syntmp-error-hook-91 (quote generate-temporaries) "invalid argument" syntmp-x-1484))) (map (lambda (syntmp-x-1485) (syntmp-wrap-145 (gensym) (quote ((top))) #f)) syntmp-ls-1483)))) (set! free-identifier=? (lambda (syntmp-x-1486 syntmp-y-1487) (begin (let ((syntmp-x-1488 syntmp-x-1486)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1488)) (syntmp-error-hook-91 (quote free-identifier=?) "invalid argument" syntmp-x-1488))) (let ((syntmp-x-1489 syntmp-y-1487)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1489)) (syntmp-error-hook-91 (quote free-identifier=?) "invalid argument" syntmp-x-1489))) (syntmp-free-id=?-140 syntmp-x-1486 syntmp-y-1487)))) (set! bound-identifier=? (lambda (syntmp-x-1490 syntmp-y-1491) (begin (let ((syntmp-x-1492 syntmp-x-1490)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1492)) (syntmp-error-hook-91 (quote bound-identifier=?) "invalid argument" syntmp-x-1492))) (let ((syntmp-x-1493 syntmp-y-1491)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1493)) (syntmp-error-hook-91 (quote bound-identifier=?) "invalid argument" syntmp-x-1493))) (syntmp-bound-id=?-141 syntmp-x-1490 syntmp-y-1491)))) (set! syntax-error (lambda (syntmp-object-1495 . syntmp-messages-1494) (begin (for-each (lambda (syntmp-x-1496) (let ((syntmp-x-1497 syntmp-x-1496)) (if (not (string? syntmp-x-1497)) (syntmp-error-hook-91 (quote syntax-error) "invalid argument" syntmp-x-1497)))) syntmp-messages-1494) (let ((syntmp-message-1498 (if (null? syntmp-messages-1494) "invalid syntax" (apply string-append syntmp-messages-1494)))) (syntmp-error-hook-91 #f syntmp-message-1498 (syntmp-strip-164 syntmp-object-1495 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1499 syntmp-v-1500) (begin (let ((syntmp-x-1501 syntmp-sym-1499)) (if (not (symbol? syntmp-x-1501)) (syntmp-error-hook-91 (quote define-syntax) "invalid argument" syntmp-x-1501))) (let ((syntmp-x-1502 syntmp-v-1500)) (if (not (procedure? syntmp-x-1502)) (syntmp-error-hook-91 (quote define-syntax) "invalid argument" syntmp-x-1502))) (syntmp-global-extend-115 (quote macro) syntmp-sym-1499 syntmp-v-1500)))) (letrec ((syntmp-match-1507 (lambda (syntmp-e-1508 syntmp-p-1509 syntmp-w-1510 syntmp-r-1511 syntmp-mod-1512) (cond ((not syntmp-r-1511) #f) ((eq? syntmp-p-1509 (quote any)) (cons (syntmp-wrap-145 syntmp-e-1508 syntmp-w-1510 syntmp-mod-1512) syntmp-r-1511)) ((syntmp-syntax-object?-101 syntmp-e-1508) (syntmp-match*-1506 (let ((syntmp-e-1513 (syntmp-syntax-object-expression-102 syntmp-e-1508))) (if (annotation? syntmp-e-1513) (annotation-expression syntmp-e-1513) syntmp-e-1513)) syntmp-p-1509 (syntmp-join-wraps-136 syntmp-w-1510 (syntmp-syntax-object-wrap-103 syntmp-e-1508)) syntmp-r-1511 (syntmp-syntax-object-module-104 syntmp-e-1508))) (else (syntmp-match*-1506 (let ((syntmp-e-1514 syntmp-e-1508)) (if (annotation? syntmp-e-1514) (annotation-expression syntmp-e-1514) syntmp-e-1514)) syntmp-p-1509 syntmp-w-1510 syntmp-r-1511 syntmp-mod-1512))))) (syntmp-match*-1506 (lambda (syntmp-e-1515 syntmp-p-1516 syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519) (cond ((null? syntmp-p-1516) (and (null? syntmp-e-1515) syntmp-r-1518)) ((pair? syntmp-p-1516) (and (pair? syntmp-e-1515) (syntmp-match-1507 (car syntmp-e-1515) (car syntmp-p-1516) syntmp-w-1517 (syntmp-match-1507 (cdr syntmp-e-1515) (cdr syntmp-p-1516) syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519) syntmp-mod-1519))) ((eq? syntmp-p-1516 (quote each-any)) (let ((syntmp-l-1520 (syntmp-match-each-any-1504 syntmp-e-1515 syntmp-w-1517 syntmp-mod-1519))) (and syntmp-l-1520 (cons syntmp-l-1520 syntmp-r-1518)))) (else (let ((syntmp-t-1521 (vector-ref syntmp-p-1516 0))) (if (memv syntmp-t-1521 (quote (each))) (if (null? syntmp-e-1515) (syntmp-match-empty-1505 (vector-ref syntmp-p-1516 1) syntmp-r-1518) (let ((syntmp-l-1522 (syntmp-match-each-1503 syntmp-e-1515 (vector-ref syntmp-p-1516 1) syntmp-w-1517 syntmp-mod-1519))) (and syntmp-l-1522 (let syntmp-collect-1523 ((syntmp-l-1524 syntmp-l-1522)) (if (null? (car syntmp-l-1524)) syntmp-r-1518 (cons (map car syntmp-l-1524) (syntmp-collect-1523 (map cdr syntmp-l-1524)))))))) (if (memv syntmp-t-1521 (quote (free-id))) (and (syntmp-id?-117 syntmp-e-1515) (syntmp-free-id=?-140 (syntmp-wrap-145 syntmp-e-1515 syntmp-w-1517 syntmp-mod-1519) (vector-ref syntmp-p-1516 1)) syntmp-r-1518) (if (memv syntmp-t-1521 (quote (atom))) (and (equal? (vector-ref syntmp-p-1516 1) (syntmp-strip-164 syntmp-e-1515 syntmp-w-1517)) syntmp-r-1518) (if (memv syntmp-t-1521 (quote (vector))) (and (vector? syntmp-e-1515) (syntmp-match-1507 (vector->list syntmp-e-1515) (vector-ref syntmp-p-1516 1) syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519))))))))))) (syntmp-match-empty-1505 (lambda (syntmp-p-1525 syntmp-r-1526) (cond ((null? syntmp-p-1525) syntmp-r-1526) ((eq? syntmp-p-1525 (quote any)) (cons (quote ()) syntmp-r-1526)) ((pair? syntmp-p-1525) (syntmp-match-empty-1505 (car syntmp-p-1525) (syntmp-match-empty-1505 (cdr syntmp-p-1525) syntmp-r-1526))) ((eq? syntmp-p-1525 (quote each-any)) (cons (quote ()) syntmp-r-1526)) (else (let ((syntmp-t-1527 (vector-ref syntmp-p-1525 0))) (if (memv syntmp-t-1527 (quote (each))) (syntmp-match-empty-1505 (vector-ref syntmp-p-1525 1) syntmp-r-1526) (if (memv syntmp-t-1527 (quote (free-id atom))) syntmp-r-1526 (if (memv syntmp-t-1527 (quote (vector))) (syntmp-match-empty-1505 (vector-ref syntmp-p-1525 1) syntmp-r-1526))))))))) (syntmp-match-each-any-1504 (lambda (syntmp-e-1528 syntmp-w-1529 syntmp-mod-1530) (cond ((annotation? syntmp-e-1528) (syntmp-match-each-any-1504 (annotation-expression syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530)) ((pair? syntmp-e-1528) (let ((syntmp-l-1531 (syntmp-match-each-any-1504 (cdr syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530))) (and syntmp-l-1531 (cons (syntmp-wrap-145 (car syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530) syntmp-l-1531)))) ((null? syntmp-e-1528) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1528) (syntmp-match-each-any-1504 (syntmp-syntax-object-expression-102 syntmp-e-1528) (syntmp-join-wraps-136 syntmp-w-1529 (syntmp-syntax-object-wrap-103 syntmp-e-1528)) syntmp-mod-1530)) (else #f)))) (syntmp-match-each-1503 (lambda (syntmp-e-1532 syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535) (cond ((annotation? syntmp-e-1532) (syntmp-match-each-1503 (annotation-expression syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535)) ((pair? syntmp-e-1532) (let ((syntmp-first-1536 (syntmp-match-1507 (car syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 (quote ()) syntmp-mod-1535))) (and syntmp-first-1536 (let ((syntmp-rest-1537 (syntmp-match-each-1503 (cdr syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535))) (and syntmp-rest-1537 (cons syntmp-first-1536 syntmp-rest-1537)))))) ((null? syntmp-e-1532) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1532) (syntmp-match-each-1503 (syntmp-syntax-object-expression-102 syntmp-e-1532) syntmp-p-1533 (syntmp-join-wraps-136 syntmp-w-1534 (syntmp-syntax-object-wrap-103 syntmp-e-1532)) (syntmp-syntax-object-module-104 syntmp-e-1532))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1538 syntmp-p-1539) (cond ((eq? syntmp-p-1539 (quote any)) (list syntmp-e-1538)) ((syntmp-syntax-object?-101 syntmp-e-1538) (syntmp-match*-1506 (let ((syntmp-e-1540 (syntmp-syntax-object-expression-102 syntmp-e-1538))) (if (annotation? syntmp-e-1540) (annotation-expression syntmp-e-1540) syntmp-e-1540)) syntmp-p-1539 (syntmp-syntax-object-wrap-103 syntmp-e-1538) (quote ()) (syntmp-syntax-object-module-104 syntmp-e-1538))) (else (syntmp-match*-1506 (let ((syntmp-e-1541 syntmp-e-1538)) (if (annotation? syntmp-e-1541) (annotation-expression syntmp-e-1541) syntmp-e-1541)) syntmp-p-1539 (quote (())) (quote ()) #f))))) (set! sc-chi syntmp-chi-153)))))
+(letrec ((syntmp-lambda-var-list-166 (lambda (syntmp-vars-557) (let syntmp-lvl-558 ((syntmp-vars-559 syntmp-vars-557) (syntmp-ls-560 (quote ())) (syntmp-w-561 (quote (())))) (cond ((pair? syntmp-vars-559) (syntmp-lvl-558 (cdr syntmp-vars-559) (cons (syntmp-wrap-145 (car syntmp-vars-559) syntmp-w-561 #f) syntmp-ls-560) syntmp-w-561)) ((syntmp-id?-117 syntmp-vars-559) (cons (syntmp-wrap-145 syntmp-vars-559 syntmp-w-561 #f) syntmp-ls-560)) ((null? syntmp-vars-559) syntmp-ls-560) ((syntmp-syntax-object?-101 syntmp-vars-559) (syntmp-lvl-558 (syntmp-syntax-object-expression-102 syntmp-vars-559) syntmp-ls-560 (syntmp-join-wraps-136 syntmp-w-561 (syntmp-syntax-object-wrap-103 syntmp-vars-559)))) ((annotation? syntmp-vars-559) (syntmp-lvl-558 (annotation-expression syntmp-vars-559) syntmp-ls-560 syntmp-w-561)) (else (cons syntmp-vars-559 syntmp-ls-560)))))) (syntmp-gen-var-165 (lambda (syntmp-id-562) (let ((syntmp-id-563 (if (syntmp-syntax-object?-101 syntmp-id-562) (syntmp-syntax-object-expression-102 syntmp-id-562) syntmp-id-562))) (if (annotation? syntmp-id-563) (syntmp-build-annotated-94 (annotation-source syntmp-id-563) (gensym (symbol->string (annotation-expression syntmp-id-563)))) (syntmp-build-annotated-94 #f (gensym (symbol->string syntmp-id-563))))))) (syntmp-strip-164 (lambda (syntmp-x-564 syntmp-w-565) (if (memq (quote top) (syntmp-wrap-marks-120 syntmp-w-565)) (if (or (annotation? syntmp-x-564) (and (pair? syntmp-x-564) (annotation? (car syntmp-x-564)))) (syntmp-strip-annotation-163 syntmp-x-564 #f) syntmp-x-564) (let syntmp-f-566 ((syntmp-x-567 syntmp-x-564)) (cond ((syntmp-syntax-object?-101 syntmp-x-567) (syntmp-strip-164 (syntmp-syntax-object-expression-102 syntmp-x-567) (syntmp-syntax-object-wrap-103 syntmp-x-567))) ((pair? syntmp-x-567) (let ((syntmp-a-568 (syntmp-f-566 (car syntmp-x-567))) (syntmp-d-569 (syntmp-f-566 (cdr syntmp-x-567)))) (if (and (eq? syntmp-a-568 (car syntmp-x-567)) (eq? syntmp-d-569 (cdr syntmp-x-567))) syntmp-x-567 (cons syntmp-a-568 syntmp-d-569)))) ((vector? syntmp-x-567) (let ((syntmp-old-570 (vector->list syntmp-x-567))) (let ((syntmp-new-571 (map syntmp-f-566 syntmp-old-570))) (if (andmap eq? syntmp-old-570 syntmp-new-571) syntmp-x-567 (list->vector syntmp-new-571))))) (else syntmp-x-567)))))) (syntmp-strip-annotation-163 (lambda (syntmp-x-572 syntmp-parent-573) (cond ((pair? syntmp-x-572) (let ((syntmp-new-574 (cons #f #f))) (begin (if syntmp-parent-573 (set-annotation-stripped! syntmp-parent-573 syntmp-new-574)) (set-car! syntmp-new-574 (syntmp-strip-annotation-163 (car syntmp-x-572) #f)) (set-cdr! syntmp-new-574 (syntmp-strip-annotation-163 (cdr syntmp-x-572) #f)) syntmp-new-574))) ((annotation? syntmp-x-572) (or (annotation-stripped syntmp-x-572) (syntmp-strip-annotation-163 (annotation-expression syntmp-x-572) syntmp-x-572))) ((vector? syntmp-x-572) (let ((syntmp-new-575 (make-vector (vector-length syntmp-x-572)))) (begin (if syntmp-parent-573 (set-annotation-stripped! syntmp-parent-573 syntmp-new-575)) (let syntmp-loop-576 ((syntmp-i-577 (- (vector-length syntmp-x-572) 1))) (unless (syntmp-fx<-88 syntmp-i-577 0) (vector-set! syntmp-new-575 syntmp-i-577 (syntmp-strip-annotation-163 (vector-ref syntmp-x-572 syntmp-i-577) #f)) (syntmp-loop-576 (syntmp-fx--86 syntmp-i-577 1)))) syntmp-new-575))) (else syntmp-x-572)))) (syntmp-ellipsis?-162 (lambda (syntmp-x-578) (and (syntmp-nonsymbol-id?-116 syntmp-x-578) (syntmp-free-id=?-140 syntmp-x-578 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase))))))) (syntmp-chi-void-161 (lambda () (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote void)))))) (syntmp-eval-local-transformer-160 (lambda (syntmp-expanded-579 syntmp-mod-580) (let ((syntmp-p-581 (syntmp-local-eval-hook-90 syntmp-expanded-579 syntmp-mod-580))) (if (procedure? syntmp-p-581) syntmp-p-581 (syntax-error syntmp-p-581 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-159 (lambda (syntmp-rec?-582 syntmp-e-583 syntmp-r-584 syntmp-w-585 syntmp-s-586 syntmp-mod-587 syntmp-k-588) ((lambda (syntmp-tmp-589) ((lambda (syntmp-tmp-590) (if syntmp-tmp-590 (apply (lambda (syntmp-_-591 syntmp-id-592 syntmp-val-593 syntmp-e1-594 syntmp-e2-595) (let ((syntmp-ids-596 syntmp-id-592)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-596)) (syntax-error syntmp-e-583 "duplicate bound keyword in") (let ((syntmp-labels-598 (syntmp-gen-labels-123 syntmp-ids-596))) (let ((syntmp-new-w-599 (syntmp-make-binding-wrap-134 syntmp-ids-596 syntmp-labels-598 syntmp-w-585))) (syntmp-k-588 (cons syntmp-e1-594 syntmp-e2-595) (syntmp-extend-env-111 syntmp-labels-598 (let ((syntmp-w-601 (if syntmp-rec?-582 syntmp-new-w-599 syntmp-w-585)) (syntmp-trans-r-602 (syntmp-macros-only-env-113 syntmp-r-584))) (map (lambda (syntmp-x-603) (cons (quote macro) (syntmp-eval-local-transformer-160 (syntmp-chi-153 syntmp-x-603 syntmp-trans-r-602 syntmp-w-601 syntmp-mod-587) syntmp-mod-587))) syntmp-val-593)) syntmp-r-584) syntmp-new-w-599 syntmp-s-586 syntmp-mod-587)))))) syntmp-tmp-590) ((lambda (syntmp-_-605) (syntax-error (syntmp-source-wrap-146 syntmp-e-583 syntmp-w-585 syntmp-s-586 syntmp-mod-587))) syntmp-tmp-589))) (syntax-dispatch syntmp-tmp-589 (quote (any #(each (any any)) any . each-any))))) syntmp-e-583))) (syntmp-chi-lambda-clause-158 (lambda (syntmp-e-606 syntmp-c-607 syntmp-r-608 syntmp-w-609 syntmp-mod-610 syntmp-k-611) ((lambda (syntmp-tmp-612) ((lambda (syntmp-tmp-613) (if syntmp-tmp-613 (apply (lambda (syntmp-id-614 syntmp-e1-615 syntmp-e2-616) (let ((syntmp-ids-617 syntmp-id-614)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-617)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-619 (syntmp-gen-labels-123 syntmp-ids-617)) (syntmp-new-vars-620 (map syntmp-gen-var-165 syntmp-ids-617))) (syntmp-k-611 syntmp-new-vars-620 (syntmp-chi-body-157 (cons syntmp-e1-615 syntmp-e2-616) syntmp-e-606 (syntmp-extend-var-env-112 syntmp-labels-619 syntmp-new-vars-620 syntmp-r-608) (syntmp-make-binding-wrap-134 syntmp-ids-617 syntmp-labels-619 syntmp-w-609) syntmp-mod-610)))))) syntmp-tmp-613) ((lambda (syntmp-tmp-622) (if syntmp-tmp-622 (apply (lambda (syntmp-ids-623 syntmp-e1-624 syntmp-e2-625) (let ((syntmp-old-ids-626 (syntmp-lambda-var-list-166 syntmp-ids-623))) (if (not (syntmp-valid-bound-ids?-142 syntmp-old-ids-626)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-627 (syntmp-gen-labels-123 syntmp-old-ids-626)) (syntmp-new-vars-628 (map syntmp-gen-var-165 syntmp-old-ids-626))) (syntmp-k-611 (let syntmp-f-629 ((syntmp-ls1-630 (cdr syntmp-new-vars-628)) (syntmp-ls2-631 (car syntmp-new-vars-628))) (if (null? syntmp-ls1-630) syntmp-ls2-631 (syntmp-f-629 (cdr syntmp-ls1-630) (cons (car syntmp-ls1-630) syntmp-ls2-631)))) (syntmp-chi-body-157 (cons syntmp-e1-624 syntmp-e2-625) syntmp-e-606 (syntmp-extend-var-env-112 syntmp-labels-627 syntmp-new-vars-628 syntmp-r-608) (syntmp-make-binding-wrap-134 syntmp-old-ids-626 syntmp-labels-627 syntmp-w-609) syntmp-mod-610)))))) syntmp-tmp-622) ((lambda (syntmp-_-633) (syntax-error syntmp-e-606)) syntmp-tmp-612))) (syntax-dispatch syntmp-tmp-612 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-612 (quote (each-any any . each-any))))) syntmp-c-607))) (syntmp-chi-body-157 (lambda (syntmp-body-634 syntmp-outer-form-635 syntmp-r-636 syntmp-w-637 syntmp-mod-638) (let ((syntmp-r-639 (cons (quote ("placeholder" placeholder)) syntmp-r-636))) (let ((syntmp-ribcage-640 (syntmp-make-ribcage-124 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-641 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w-637) (cons syntmp-ribcage-640 (syntmp-wrap-subst-121 syntmp-w-637))))) (let syntmp-parse-642 ((syntmp-body-643 (map (lambda (syntmp-x-649) (cons syntmp-r-639 (syntmp-wrap-145 syntmp-x-649 syntmp-w-641 syntmp-mod-638))) syntmp-body-634)) (syntmp-ids-644 (quote ())) (syntmp-labels-645 (quote ())) (syntmp-vars-646 (quote ())) (syntmp-vals-647 (quote ())) (syntmp-bindings-648 (quote ()))) (if (null? syntmp-body-643) (syntax-error syntmp-outer-form-635 "no expressions in body") (let ((syntmp-e-650 (cdar syntmp-body-643)) (syntmp-er-651 (caar syntmp-body-643))) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-650 syntmp-er-651 (quote (())) #f syntmp-ribcage-640 syntmp-mod-638)) (lambda (syntmp-type-652 syntmp-value-653 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657) (let ((syntmp-t-658 syntmp-type-652)) (if (memv syntmp-t-658 (quote (define-form))) (let ((syntmp-id-659 (syntmp-wrap-145 syntmp-value-653 syntmp-w-655 syntmp-mod-657)) (syntmp-label-660 (syntmp-gen-label-122))) (let ((syntmp-var-661 (syntmp-gen-var-165 syntmp-id-659))) (begin (syntmp-extend-ribcage!-133 syntmp-ribcage-640 syntmp-id-659 syntmp-label-660) (syntmp-parse-642 (cdr syntmp-body-643) (cons syntmp-id-659 syntmp-ids-644) (cons syntmp-label-660 syntmp-labels-645) (cons syntmp-var-661 syntmp-vars-646) (cons (cons syntmp-er-651 (syntmp-wrap-145 syntmp-e-654 syntmp-w-655 syntmp-mod-657)) syntmp-vals-647) (cons (cons (quote lexical) syntmp-var-661) syntmp-bindings-648))))) (if (memv syntmp-t-658 (quote (define-syntax-form))) (let ((syntmp-id-662 (syntmp-wrap-145 syntmp-value-653 syntmp-w-655 syntmp-mod-657)) (syntmp-label-663 (syntmp-gen-label-122))) (begin (syntmp-extend-ribcage!-133 syntmp-ribcage-640 syntmp-id-662 syntmp-label-663) (syntmp-parse-642 (cdr syntmp-body-643) (cons syntmp-id-662 syntmp-ids-644) (cons syntmp-label-663 syntmp-labels-645) syntmp-vars-646 syntmp-vals-647 (cons (cons (quote macro) (cons syntmp-er-651 (syntmp-wrap-145 syntmp-e-654 syntmp-w-655 syntmp-mod-657))) syntmp-bindings-648)))) (if (memv syntmp-t-658 (quote (begin-form))) ((lambda (syntmp-tmp-664) ((lambda (syntmp-tmp-665) (if syntmp-tmp-665 (apply (lambda (syntmp-_-666 syntmp-e1-667) (syntmp-parse-642 (let syntmp-f-668 ((syntmp-forms-669 syntmp-e1-667)) (if (null? syntmp-forms-669) (cdr syntmp-body-643) (cons (cons syntmp-er-651 (syntmp-wrap-145 (car syntmp-forms-669) syntmp-w-655 syntmp-mod-657)) (syntmp-f-668 (cdr syntmp-forms-669))))) syntmp-ids-644 syntmp-labels-645 syntmp-vars-646 syntmp-vals-647 syntmp-bindings-648)) syntmp-tmp-665) (syntax-error syntmp-tmp-664))) (syntax-dispatch syntmp-tmp-664 (quote (any . each-any))))) syntmp-e-654) (if (memv syntmp-t-658 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-653 syntmp-e-654 syntmp-er-651 syntmp-w-655 syntmp-s-656 syntmp-mod-657 (lambda (syntmp-forms-671 syntmp-er-672 syntmp-w-673 syntmp-s-674 syntmp-mod-675) (syntmp-parse-642 (let syntmp-f-676 ((syntmp-forms-677 syntmp-forms-671)) (if (null? syntmp-forms-677) (cdr syntmp-body-643) (cons (cons syntmp-er-672 (syntmp-wrap-145 (car syntmp-forms-677) syntmp-w-673 syntmp-mod-675)) (syntmp-f-676 (cdr syntmp-forms-677))))) syntmp-ids-644 syntmp-labels-645 syntmp-vars-646 syntmp-vals-647 syntmp-bindings-648))) (if (null? syntmp-ids-644) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-678) (syntmp-chi-153 (cdr syntmp-x-678) (car syntmp-x-678) (quote (())) syntmp-mod-657)) (cons (cons syntmp-er-651 (syntmp-source-wrap-146 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657)) (cdr syntmp-body-643)))) (begin (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-644)) (syntax-error syntmp-outer-form-635 "invalid or duplicate identifier in definition")) (let syntmp-loop-679 ((syntmp-bs-680 syntmp-bindings-648) (syntmp-er-cache-681 #f) (syntmp-r-cache-682 #f)) (if (not (null? syntmp-bs-680)) (let ((syntmp-b-683 (car syntmp-bs-680))) (if (eq? (car syntmp-b-683) (quote macro)) (let ((syntmp-er-684 (cadr syntmp-b-683))) (let ((syntmp-r-cache-685 (if (eq? syntmp-er-684 syntmp-er-cache-681) syntmp-r-cache-682 (syntmp-macros-only-env-113 syntmp-er-684)))) (begin (set-cdr! syntmp-b-683 (syntmp-eval-local-transformer-160 (syntmp-chi-153 (cddr syntmp-b-683) syntmp-r-cache-685 (quote (())) syntmp-mod-657) syntmp-mod-657)) (syntmp-loop-679 (cdr syntmp-bs-680) syntmp-er-684 syntmp-r-cache-685)))) (syntmp-loop-679 (cdr syntmp-bs-680) syntmp-er-cache-681 syntmp-r-cache-682))))) (set-cdr! syntmp-r-639 (syntmp-extend-env-111 syntmp-labels-645 syntmp-bindings-648 (cdr syntmp-r-639))) (syntmp-build-letrec-99 #f syntmp-vars-646 (map (lambda (syntmp-x-686) (syntmp-chi-153 (cdr syntmp-x-686) (car syntmp-x-686) (quote (())) syntmp-mod-657)) syntmp-vals-647) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-687) (syntmp-chi-153 (cdr syntmp-x-687) (car syntmp-x-687) (quote (())) syntmp-mod-657)) (cons (cons syntmp-er-651 (syntmp-source-wrap-146 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657)) (cdr syntmp-body-643)))))))))))))))))))))) (syntmp-chi-macro-156 (lambda (syntmp-p-688 syntmp-e-689 syntmp-r-690 syntmp-w-691 syntmp-rib-692 syntmp-mod-693) (letrec ((syntmp-rebuild-macro-output-694 (lambda (syntmp-x-695 syntmp-m-696) (cond ((pair? syntmp-x-695) (cons (syntmp-rebuild-macro-output-694 (car syntmp-x-695) syntmp-m-696) (syntmp-rebuild-macro-output-694 (cdr syntmp-x-695) syntmp-m-696))) ((syntmp-syntax-object?-101 syntmp-x-695) (let ((syntmp-w-697 (syntmp-syntax-object-wrap-103 syntmp-x-695))) (let ((syntmp-ms-698 (syntmp-wrap-marks-120 syntmp-w-697)) (syntmp-s-699 (syntmp-wrap-subst-121 syntmp-w-697))) (if (and (pair? syntmp-ms-698) (eq? (car syntmp-ms-698) #f)) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-695) (syntmp-make-wrap-119 (cdr syntmp-ms-698) (if syntmp-rib-692 (cons syntmp-rib-692 (cdr syntmp-s-699)) (cdr syntmp-s-699))) (syntmp-syntax-object-module-104 syntmp-x-695)) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-695) (syntmp-make-wrap-119 (cons syntmp-m-696 syntmp-ms-698) (if syntmp-rib-692 (cons syntmp-rib-692 (cons (quote shift) syntmp-s-699)) (cons (quote shift) syntmp-s-699))) (module-name (procedure-module syntmp-p-688))))))) ((vector? syntmp-x-695) (let ((syntmp-n-700 (vector-length syntmp-x-695))) (let ((syntmp-v-701 (make-vector syntmp-n-700))) (let syntmp-doloop-702 ((syntmp-i-703 0)) (if (syntmp-fx=-87 syntmp-i-703 syntmp-n-700) syntmp-v-701 (begin (vector-set! syntmp-v-701 syntmp-i-703 (syntmp-rebuild-macro-output-694 (vector-ref syntmp-x-695 syntmp-i-703) syntmp-m-696)) (syntmp-doloop-702 (syntmp-fx+-85 syntmp-i-703 1)))))))) ((symbol? syntmp-x-695) (syntax-error syntmp-x-695 "encountered raw symbol in macro output")) (else syntmp-x-695))))) (syntmp-rebuild-macro-output-694 (syntmp-p-688 (syntmp-wrap-145 syntmp-e-689 (syntmp-anti-mark-132 syntmp-w-691) syntmp-mod-693)) (string #\m))))) (syntmp-chi-application-155 (lambda (syntmp-x-704 syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) ((lambda (syntmp-tmp-710) ((lambda (syntmp-tmp-711) (if syntmp-tmp-711 (apply (lambda (syntmp-e0-712 syntmp-e1-713) (syntmp-build-annotated-94 syntmp-s-708 (cons syntmp-x-704 (map (lambda (syntmp-e-714) (syntmp-chi-153 syntmp-e-714 syntmp-r-706 syntmp-w-707 syntmp-mod-709)) syntmp-e1-713)))) syntmp-tmp-711) (syntax-error syntmp-tmp-710))) (syntax-dispatch syntmp-tmp-710 (quote (any . each-any))))) syntmp-e-705))) (syntmp-chi-expr-154 (lambda (syntmp-type-716 syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (let ((syntmp-t-723 syntmp-type-716)) (if (memv syntmp-t-723 (quote (lexical))) (syntmp-build-annotated-94 syntmp-s-721 syntmp-value-717) (if (memv syntmp-t-723 (quote (core external-macro))) (syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (module-ref))) (call-with-values (lambda () (syntmp-value-717 syntmp-e-718)) (lambda (syntmp-id-724 syntmp-mod-725) (syntmp-build-annotated-94 syntmp-s-721 (make-module-ref syntmp-mod-725 syntmp-id-724 #f)))) (if (memv syntmp-t-723 (quote (lexical-call))) (syntmp-chi-application-155 (syntmp-build-annotated-94 (syntmp-source-annotation-108 (car syntmp-e-718)) syntmp-value-717) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (global-call))) (syntmp-chi-application-155 (syntmp-build-annotated-94 (syntmp-source-annotation-108 (car syntmp-e-718)) (make-module-ref (if (syntmp-syntax-object?-101 (car syntmp-e-718)) (syntmp-syntax-object-module-104 (car syntmp-e-718)) syntmp-mod-722) syntmp-value-717 #f)) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (constant))) (syntmp-build-data-95 syntmp-s-721 (syntmp-strip-164 (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (quote (())))) (if (memv syntmp-t-723 (quote (global))) (syntmp-build-annotated-94 syntmp-s-721 (make-module-ref syntmp-mod-722 syntmp-value-717 #f)) (if (memv syntmp-t-723 (quote (call))) (syntmp-chi-application-155 (syntmp-chi-153 (car syntmp-e-718) syntmp-r-719 syntmp-w-720 syntmp-mod-722) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (begin-form))) ((lambda (syntmp-tmp-726) ((lambda (syntmp-tmp-727) (if syntmp-tmp-727 (apply (lambda (syntmp-_-728 syntmp-e1-729 syntmp-e2-730) (syntmp-chi-sequence-147 (cons syntmp-e1-729 syntmp-e2-730) syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722)) syntmp-tmp-727) (syntax-error syntmp-tmp-726))) (syntax-dispatch syntmp-tmp-726 (quote (any any . each-any))))) syntmp-e-718) (if (memv syntmp-t-723 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722 syntmp-chi-sequence-147) (if (memv syntmp-t-723 (quote (eval-when-form))) ((lambda (syntmp-tmp-732) ((lambda (syntmp-tmp-733) (if syntmp-tmp-733 (apply (lambda (syntmp-_-734 syntmp-x-735 syntmp-e1-736 syntmp-e2-737) (let ((syntmp-when-list-738 (syntmp-chi-when-list-150 syntmp-e-718 syntmp-x-735 syntmp-w-720))) (if (memq (quote eval) syntmp-when-list-738) (syntmp-chi-sequence-147 (cons syntmp-e1-736 syntmp-e2-737) syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (syntmp-chi-void-161)))) syntmp-tmp-733) (syntax-error syntmp-tmp-732))) (syntax-dispatch syntmp-tmp-732 (quote (any each-any any . each-any))))) syntmp-e-718) (if (memv syntmp-t-723 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-145 syntmp-value-717 syntmp-w-720 syntmp-mod-722) "invalid context for definition of") (if (memv syntmp-t-723 (quote (syntax))) (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) "reference to pattern variable outside syntax form") (if (memv syntmp-t-723 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722))))))))))))))))))) (syntmp-chi-153 (lambda (syntmp-e-741 syntmp-r-742 syntmp-w-743 syntmp-mod-744) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-741 syntmp-r-742 syntmp-w-743 #f #f syntmp-mod-744)) (lambda (syntmp-type-745 syntmp-value-746 syntmp-e-747 syntmp-w-748 syntmp-s-749 syntmp-mod-750) (syntmp-chi-expr-154 syntmp-type-745 syntmp-value-746 syntmp-e-747 syntmp-r-742 syntmp-w-748 syntmp-s-749 syntmp-mod-750))))) (syntmp-chi-top-152 (lambda (syntmp-e-751 syntmp-r-752 syntmp-w-753 syntmp-m-754 syntmp-esew-755 syntmp-mod-756) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-751 syntmp-r-752 syntmp-w-753 #f #f syntmp-mod-756)) (lambda (syntmp-type-771 syntmp-value-772 syntmp-e-773 syntmp-w-774 syntmp-s-775 syntmp-mod-776) (let ((syntmp-t-777 syntmp-type-771)) (if (memv syntmp-t-777 (quote (begin-form))) ((lambda (syntmp-tmp-778) ((lambda (syntmp-tmp-779) (if syntmp-tmp-779 (apply (lambda (syntmp-_-780) (syntmp-chi-void-161)) syntmp-tmp-779) ((lambda (syntmp-tmp-781) (if syntmp-tmp-781 (apply (lambda (syntmp-_-782 syntmp-e1-783 syntmp-e2-784) (syntmp-chi-top-sequence-148 (cons syntmp-e1-783 syntmp-e2-784) syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-m-754 syntmp-esew-755 syntmp-mod-776)) syntmp-tmp-781) (syntax-error syntmp-tmp-778))) (syntax-dispatch syntmp-tmp-778 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-778 (quote (any))))) syntmp-e-773) (if (memv syntmp-t-777 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-772 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-mod-776 (lambda (syntmp-body-786 syntmp-r-787 syntmp-w-788 syntmp-s-789 syntmp-mod-790) (syntmp-chi-top-sequence-148 syntmp-body-786 syntmp-r-787 syntmp-w-788 syntmp-s-789 syntmp-m-754 syntmp-esew-755 syntmp-mod-790))) (if (memv syntmp-t-777 (quote (eval-when-form))) ((lambda (syntmp-tmp-791) ((lambda (syntmp-tmp-792) (if syntmp-tmp-792 (apply (lambda (syntmp-_-793 syntmp-x-794 syntmp-e1-795 syntmp-e2-796) (let ((syntmp-when-list-797 (syntmp-chi-when-list-150 syntmp-e-773 syntmp-x-794 syntmp-w-774)) (syntmp-body-798 (cons syntmp-e1-795 syntmp-e2-796))) (cond ((eq? syntmp-m-754 (quote e)) (if (memq (quote eval) syntmp-when-list-797) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote e) (quote (eval)) syntmp-mod-776) (syntmp-chi-void-161))) ((memq (quote load) syntmp-when-list-797) (if (or (memq (quote compile) syntmp-when-list-797) (and (eq? syntmp-m-754 (quote c&e)) (memq (quote eval) syntmp-when-list-797))) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote c&e) (quote (compile load)) syntmp-mod-776) (if (memq syntmp-m-754 (quote (c c&e))) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote c) (quote (load)) syntmp-mod-776) (syntmp-chi-void-161)))) ((or (memq (quote compile) syntmp-when-list-797) (and (eq? syntmp-m-754 (quote c&e)) (memq (quote eval) syntmp-when-list-797))) (syntmp-top-level-eval-hook-89 (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote e) (quote (eval)) syntmp-mod-776) syntmp-mod-776) (syntmp-chi-void-161)) (else (syntmp-chi-void-161))))) syntmp-tmp-792) (syntax-error syntmp-tmp-791))) (syntax-dispatch syntmp-tmp-791 (quote (any each-any any . each-any))))) syntmp-e-773) (if (memv syntmp-t-777 (quote (define-syntax-form))) (let ((syntmp-n-801 (syntmp-id-var-name-139 syntmp-value-772 syntmp-w-774)) (syntmp-r-802 (syntmp-macros-only-env-113 syntmp-r-752))) (let ((syntmp-t-803 syntmp-m-754)) (if (memv syntmp-t-803 (quote (c))) (if (memq (quote compile) syntmp-esew-755) (let ((syntmp-e-804 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)))) (begin (syntmp-top-level-eval-hook-89 syntmp-e-804 syntmp-mod-776) (if (memq (quote load) syntmp-esew-755) syntmp-e-804 (syntmp-chi-void-161)))) (if (memq (quote load) syntmp-esew-755) (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)) (syntmp-chi-void-161))) (if (memv syntmp-t-803 (quote (c&e))) (let ((syntmp-e-805 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)))) (begin (syntmp-top-level-eval-hook-89 syntmp-e-805 syntmp-mod-776) syntmp-e-805)) (begin (if (memq (quote eval) syntmp-esew-755) (syntmp-top-level-eval-hook-89 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)) syntmp-mod-776)) (syntmp-chi-void-161)))))) (if (memv syntmp-t-777 (quote (define-form))) (let ((syntmp-n-806 (syntmp-id-var-name-139 syntmp-value-772 syntmp-w-774))) (let ((syntmp-type-807 (syntmp-binding-type-109 (syntmp-lookup-114 syntmp-n-806 syntmp-r-752 syntmp-mod-776)))) (let ((syntmp-t-808 syntmp-type-807)) (if (memv syntmp-t-808 (quote (global))) (let ((syntmp-x-809 (syntmp-build-annotated-94 syntmp-s-775 (list (quote define) syntmp-n-806 (syntmp-chi-153 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-mod-776))))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-809 syntmp-mod-776)) syntmp-x-809)) (if (memv syntmp-t-808 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-145 syntmp-value-772 syntmp-w-774 syntmp-mod-776) "identifier out of context") (if (eq? syntmp-type-807 (quote external-macro)) (let ((syntmp-x-810 (syntmp-build-annotated-94 syntmp-s-775 (list (quote define) syntmp-n-806 (syntmp-chi-153 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-mod-776))))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-810 syntmp-mod-776)) syntmp-x-810)) (syntax-error (syntmp-wrap-145 syntmp-value-772 syntmp-w-774 syntmp-mod-776) "cannot define keyword at top level"))))))) (let ((syntmp-x-811 (syntmp-chi-expr-154 syntmp-type-771 syntmp-value-772 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-mod-776))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-811 syntmp-mod-776)) syntmp-x-811)))))))))))) (syntmp-syntax-type-151 (lambda (syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (cond ((symbol? syntmp-e-812) (let ((syntmp-n-818 (syntmp-id-var-name-139 syntmp-e-812 syntmp-w-814))) (let ((syntmp-b-819 (syntmp-lookup-114 syntmp-n-818 syntmp-r-813 syntmp-mod-817))) (let ((syntmp-type-820 (syntmp-binding-type-109 syntmp-b-819))) (let ((syntmp-t-821 syntmp-type-820)) (if (memv syntmp-t-821 (quote (lexical))) (values syntmp-type-820 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-821 (quote (global))) (values syntmp-type-820 syntmp-n-818 syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-821 (quote (macro))) (syntmp-syntax-type-151 (syntmp-chi-macro-156 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-rib-816 syntmp-mod-817) syntmp-r-813 (quote (())) syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (values syntmp-type-820 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817))))))))) ((pair? syntmp-e-812) (let ((syntmp-first-822 (car syntmp-e-812))) (if (syntmp-id?-117 syntmp-first-822) (let ((syntmp-n-823 (syntmp-id-var-name-139 syntmp-first-822 syntmp-w-814))) (let ((syntmp-b-824 (syntmp-lookup-114 syntmp-n-823 syntmp-r-813 (or (and (syntmp-syntax-object?-101 syntmp-first-822) (syntmp-syntax-object-module-104 syntmp-first-822)) syntmp-mod-817)))) (let ((syntmp-type-825 (syntmp-binding-type-109 syntmp-b-824))) (let ((syntmp-t-826 syntmp-type-825)) (if (memv syntmp-t-826 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (global))) (values (quote global-call) syntmp-n-823 syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (macro))) (syntmp-syntax-type-151 (syntmp-chi-macro-156 (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-rib-816 syntmp-mod-817) syntmp-r-813 (quote (())) syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (if (memv syntmp-t-826 (quote (core external-macro module-ref))) (values syntmp-type-825 (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (begin))) (values (quote begin-form) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (define))) ((lambda (syntmp-tmp-827) ((lambda (syntmp-tmp-828) (if (if syntmp-tmp-828 (apply (lambda (syntmp-_-829 syntmp-name-830 syntmp-val-831) (syntmp-id?-117 syntmp-name-830)) syntmp-tmp-828) #f) (apply (lambda (syntmp-_-832 syntmp-name-833 syntmp-val-834) (values (quote define-form) syntmp-name-833 syntmp-val-834 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) syntmp-tmp-828) ((lambda (syntmp-tmp-835) (if (if syntmp-tmp-835 (apply (lambda (syntmp-_-836 syntmp-name-837 syntmp-args-838 syntmp-e1-839 syntmp-e2-840) (and (syntmp-id?-117 syntmp-name-837) (syntmp-valid-bound-ids?-142 (syntmp-lambda-var-list-166 syntmp-args-838)))) syntmp-tmp-835) #f) (apply (lambda (syntmp-_-841 syntmp-name-842 syntmp-args-843 syntmp-e1-844 syntmp-e2-845) (values (quote define-form) (syntmp-wrap-145 syntmp-name-842 syntmp-w-814 syntmp-mod-817) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase))) (syntmp-wrap-145 (cons syntmp-args-843 (cons syntmp-e1-844 syntmp-e2-845)) syntmp-w-814 syntmp-mod-817)) (quote (())) syntmp-s-815 syntmp-mod-817)) syntmp-tmp-835) ((lambda (syntmp-tmp-847) (if (if syntmp-tmp-847 (apply (lambda (syntmp-_-848 syntmp-name-849) (syntmp-id?-117 syntmp-name-849)) syntmp-tmp-847) #f) (apply (lambda (syntmp-_-850 syntmp-name-851) (values (quote define-form) (syntmp-wrap-145 syntmp-name-851 syntmp-w-814 syntmp-mod-817) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))) (quote (())) syntmp-s-815 syntmp-mod-817)) syntmp-tmp-847) (syntax-error syntmp-tmp-827))) (syntax-dispatch syntmp-tmp-827 (quote (any any)))))) (syntax-dispatch syntmp-tmp-827 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-827 (quote (any any any))))) syntmp-e-812) (if (memv syntmp-t-826 (quote (define-syntax))) ((lambda (syntmp-tmp-852) ((lambda (syntmp-tmp-853) (if (if syntmp-tmp-853 (apply (lambda (syntmp-_-854 syntmp-name-855 syntmp-val-856) (syntmp-id?-117 syntmp-name-855)) syntmp-tmp-853) #f) (apply (lambda (syntmp-_-857 syntmp-name-858 syntmp-val-859) (values (quote define-syntax-form) syntmp-name-858 syntmp-val-859 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) syntmp-tmp-853) (syntax-error syntmp-tmp-852))) (syntax-dispatch syntmp-tmp-852 (quote (any any any))))) syntmp-e-812) (values (quote call) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)))))))))))))) (values (quote call) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)))) ((syntmp-syntax-object?-101 syntmp-e-812) (syntmp-syntax-type-151 (syntmp-syntax-object-expression-102 syntmp-e-812) syntmp-r-813 (syntmp-join-wraps-136 syntmp-w-814 (syntmp-syntax-object-wrap-103 syntmp-e-812)) #f syntmp-rib-816 (or (syntmp-syntax-object-module-104 syntmp-e-812) syntmp-mod-817))) ((annotation? syntmp-e-812) (syntmp-syntax-type-151 (annotation-expression syntmp-e-812) syntmp-r-813 syntmp-w-814 (annotation-source syntmp-e-812) syntmp-rib-816 syntmp-mod-817)) ((self-evaluating? syntmp-e-812) (values (quote constant) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) (else (values (quote other) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817))))) (syntmp-chi-when-list-150 (lambda (syntmp-e-860 syntmp-when-list-861 syntmp-w-862) (let syntmp-f-863 ((syntmp-when-list-864 syntmp-when-list-861) (syntmp-situations-865 (quote ()))) (if (null? syntmp-when-list-864) syntmp-situations-865 (syntmp-f-863 (cdr syntmp-when-list-864) (cons (let ((syntmp-x-866 (car syntmp-when-list-864))) (cond ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))) (quote compile)) ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))) (quote load)) ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))) (quote eval)) (else (syntax-error (syntmp-wrap-145 syntmp-x-866 syntmp-w-862 #f) "invalid eval-when situation")))) syntmp-situations-865)))))) (syntmp-chi-install-global-149 (lambda (syntmp-name-878 syntmp-e-879) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote install-global-transformer)) (syntmp-build-data-95 #f syntmp-name-878) syntmp-e-879)))) (syntmp-chi-top-sequence-148 (lambda (syntmp-body-880 syntmp-r-881 syntmp-w-882 syntmp-s-883 syntmp-m-884 syntmp-esew-885 syntmp-mod-886) (syntmp-build-sequence-96 syntmp-s-883 (let syntmp-dobody-887 ((syntmp-body-888 syntmp-body-880) (syntmp-r-889 syntmp-r-881) (syntmp-w-890 syntmp-w-882) (syntmp-m-891 syntmp-m-884) (syntmp-esew-892 syntmp-esew-885) (syntmp-mod-893 syntmp-mod-886)) (if (null? syntmp-body-888) (quote ()) (let ((syntmp-first-894 (syntmp-chi-top-152 (car syntmp-body-888) syntmp-r-889 syntmp-w-890 syntmp-m-891 syntmp-esew-892 syntmp-mod-893))) (cons syntmp-first-894 (syntmp-dobody-887 (cdr syntmp-body-888) syntmp-r-889 syntmp-w-890 syntmp-m-891 syntmp-esew-892 syntmp-mod-893)))))))) (syntmp-chi-sequence-147 (lambda (syntmp-body-895 syntmp-r-896 syntmp-w-897 syntmp-s-898 syntmp-mod-899) (syntmp-build-sequence-96 syntmp-s-898 (let syntmp-dobody-900 ((syntmp-body-901 syntmp-body-895) (syntmp-r-902 syntmp-r-896) (syntmp-w-903 syntmp-w-897) (syntmp-mod-904 syntmp-mod-899)) (if (null? syntmp-body-901) (quote ()) (let ((syntmp-first-905 (syntmp-chi-153 (car syntmp-body-901) syntmp-r-902 syntmp-w-903 syntmp-mod-904))) (cons syntmp-first-905 (syntmp-dobody-900 (cdr syntmp-body-901) syntmp-r-902 syntmp-w-903 syntmp-mod-904)))))))) (syntmp-source-wrap-146 (lambda (syntmp-x-906 syntmp-w-907 syntmp-s-908 syntmp-defmod-909) (syntmp-wrap-145 (if syntmp-s-908 (make-annotation syntmp-x-906 syntmp-s-908 #f) syntmp-x-906) syntmp-w-907 syntmp-defmod-909))) (syntmp-wrap-145 (lambda (syntmp-x-910 syntmp-w-911 syntmp-defmod-912) (cond ((and (null? (syntmp-wrap-marks-120 syntmp-w-911)) (null? (syntmp-wrap-subst-121 syntmp-w-911))) syntmp-x-910) ((syntmp-syntax-object?-101 syntmp-x-910) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-910) (syntmp-join-wraps-136 syntmp-w-911 (syntmp-syntax-object-wrap-103 syntmp-x-910)) (syntmp-syntax-object-module-104 syntmp-x-910))) ((null? syntmp-x-910) syntmp-x-910) (else (syntmp-make-syntax-object-100 syntmp-x-910 syntmp-w-911 syntmp-defmod-912))))) (syntmp-bound-id-member?-144 (lambda (syntmp-x-913 syntmp-list-914) (and (not (null? syntmp-list-914)) (or (syntmp-bound-id=?-141 syntmp-x-913 (car syntmp-list-914)) (syntmp-bound-id-member?-144 syntmp-x-913 (cdr syntmp-list-914)))))) (syntmp-distinct-bound-ids?-143 (lambda (syntmp-ids-915) (let syntmp-distinct?-916 ((syntmp-ids-917 syntmp-ids-915)) (or (null? syntmp-ids-917) (and (not (syntmp-bound-id-member?-144 (car syntmp-ids-917) (cdr syntmp-ids-917))) (syntmp-distinct?-916 (cdr syntmp-ids-917))))))) (syntmp-valid-bound-ids?-142 (lambda (syntmp-ids-918) (and (let syntmp-all-ids?-919 ((syntmp-ids-920 syntmp-ids-918)) (or (null? syntmp-ids-920) (and (syntmp-id?-117 (car syntmp-ids-920)) (syntmp-all-ids?-919 (cdr syntmp-ids-920))))) (syntmp-distinct-bound-ids?-143 syntmp-ids-918)))) (syntmp-bound-id=?-141 (lambda (syntmp-i-921 syntmp-j-922) (if (and (syntmp-syntax-object?-101 syntmp-i-921) (syntmp-syntax-object?-101 syntmp-j-922)) (and (eq? (let ((syntmp-e-923 (syntmp-syntax-object-expression-102 syntmp-i-921))) (if (annotation? syntmp-e-923) (annotation-expression syntmp-e-923) syntmp-e-923)) (let ((syntmp-e-924 (syntmp-syntax-object-expression-102 syntmp-j-922))) (if (annotation? syntmp-e-924) (annotation-expression syntmp-e-924) syntmp-e-924))) (syntmp-same-marks?-138 (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-i-921)) (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-j-922)))) (eq? (let ((syntmp-e-925 syntmp-i-921)) (if (annotation? syntmp-e-925) (annotation-expression syntmp-e-925) syntmp-e-925)) (let ((syntmp-e-926 syntmp-j-922)) (if (annotation? syntmp-e-926) (annotation-expression syntmp-e-926) syntmp-e-926)))))) (syntmp-free-id=?-140 (lambda (syntmp-i-927 syntmp-j-928) (and (eq? (let ((syntmp-x-929 syntmp-i-927)) (let ((syntmp-e-930 (if (syntmp-syntax-object?-101 syntmp-x-929) (syntmp-syntax-object-expression-102 syntmp-x-929) syntmp-x-929))) (if (annotation? syntmp-e-930) (annotation-expression syntmp-e-930) syntmp-e-930))) (let ((syntmp-x-931 syntmp-j-928)) (let ((syntmp-e-932 (if (syntmp-syntax-object?-101 syntmp-x-931) (syntmp-syntax-object-expression-102 syntmp-x-931) syntmp-x-931))) (if (annotation? syntmp-e-932) (annotation-expression syntmp-e-932) syntmp-e-932)))) (eq? (syntmp-id-var-name-139 syntmp-i-927 (quote (()))) (syntmp-id-var-name-139 syntmp-j-928 (quote (()))))))) (syntmp-id-var-name-139 (lambda (syntmp-id-933 syntmp-w-934) (letrec ((syntmp-search-vector-rib-937 (lambda (syntmp-sym-948 syntmp-subst-949 syntmp-marks-950 syntmp-symnames-951 syntmp-ribcage-952) (let ((syntmp-n-953 (vector-length syntmp-symnames-951))) (let syntmp-f-954 ((syntmp-i-955 0)) (cond ((syntmp-fx=-87 syntmp-i-955 syntmp-n-953) (syntmp-search-935 syntmp-sym-948 (cdr syntmp-subst-949) syntmp-marks-950)) ((and (eq? (vector-ref syntmp-symnames-951 syntmp-i-955) syntmp-sym-948) (syntmp-same-marks?-138 syntmp-marks-950 (vector-ref (syntmp-ribcage-marks-127 syntmp-ribcage-952) syntmp-i-955))) (values (vector-ref (syntmp-ribcage-labels-128 syntmp-ribcage-952) syntmp-i-955) syntmp-marks-950)) (else (syntmp-f-954 (syntmp-fx+-85 syntmp-i-955 1)))))))) (syntmp-search-list-rib-936 (lambda (syntmp-sym-956 syntmp-subst-957 syntmp-marks-958 syntmp-symnames-959 syntmp-ribcage-960) (let syntmp-f-961 ((syntmp-symnames-962 syntmp-symnames-959) (syntmp-i-963 0)) (cond ((null? syntmp-symnames-962) (syntmp-search-935 syntmp-sym-956 (cdr syntmp-subst-957) syntmp-marks-958)) ((and (eq? (car syntmp-symnames-962) syntmp-sym-956) (syntmp-same-marks?-138 syntmp-marks-958 (list-ref (syntmp-ribcage-marks-127 syntmp-ribcage-960) syntmp-i-963))) (values (list-ref (syntmp-ribcage-labels-128 syntmp-ribcage-960) syntmp-i-963) syntmp-marks-958)) (else (syntmp-f-961 (cdr syntmp-symnames-962) (syntmp-fx+-85 syntmp-i-963 1))))))) (syntmp-search-935 (lambda (syntmp-sym-964 syntmp-subst-965 syntmp-marks-966) (if (null? syntmp-subst-965) (values #f syntmp-marks-966) (let ((syntmp-fst-967 (car syntmp-subst-965))) (if (eq? syntmp-fst-967 (quote shift)) (syntmp-search-935 syntmp-sym-964 (cdr syntmp-subst-965) (cdr syntmp-marks-966)) (let ((syntmp-symnames-968 (syntmp-ribcage-symnames-126 syntmp-fst-967))) (if (vector? syntmp-symnames-968) (syntmp-search-vector-rib-937 syntmp-sym-964 syntmp-subst-965 syntmp-marks-966 syntmp-symnames-968 syntmp-fst-967) (syntmp-search-list-rib-936 syntmp-sym-964 syntmp-subst-965 syntmp-marks-966 syntmp-symnames-968 syntmp-fst-967))))))))) (cond ((symbol? syntmp-id-933) (or (call-with-values (lambda () (syntmp-search-935 syntmp-id-933 (syntmp-wrap-subst-121 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w-934))) (lambda (syntmp-x-970 . syntmp-ignore-969) syntmp-x-970)) syntmp-id-933)) ((syntmp-syntax-object?-101 syntmp-id-933) (let ((syntmp-id-971 (let ((syntmp-e-973 (syntmp-syntax-object-expression-102 syntmp-id-933))) (if (annotation? syntmp-e-973) (annotation-expression syntmp-e-973) syntmp-e-973))) (syntmp-w1-972 (syntmp-syntax-object-wrap-103 syntmp-id-933))) (let ((syntmp-marks-974 (syntmp-join-marks-137 (syntmp-wrap-marks-120 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w1-972)))) (call-with-values (lambda () (syntmp-search-935 syntmp-id-971 (syntmp-wrap-subst-121 syntmp-w-934) syntmp-marks-974)) (lambda (syntmp-new-id-975 syntmp-marks-976) (or syntmp-new-id-975 (call-with-values (lambda () (syntmp-search-935 syntmp-id-971 (syntmp-wrap-subst-121 syntmp-w1-972) syntmp-marks-976)) (lambda (syntmp-x-978 . syntmp-ignore-977) syntmp-x-978)) syntmp-id-971)))))) ((annotation? syntmp-id-933) (let ((syntmp-id-979 (let ((syntmp-e-980 syntmp-id-933)) (if (annotation? syntmp-e-980) (annotation-expression syntmp-e-980) syntmp-e-980)))) (or (call-with-values (lambda () (syntmp-search-935 syntmp-id-979 (syntmp-wrap-subst-121 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w-934))) (lambda (syntmp-x-982 . syntmp-ignore-981) syntmp-x-982)) syntmp-id-979))) (else (syntmp-error-hook-91 (quote id-var-name) "invalid id" syntmp-id-933)))))) (syntmp-same-marks?-138 (lambda (syntmp-x-983 syntmp-y-984) (or (eq? syntmp-x-983 syntmp-y-984) (and (not (null? syntmp-x-983)) (not (null? syntmp-y-984)) (eq? (car syntmp-x-983) (car syntmp-y-984)) (syntmp-same-marks?-138 (cdr syntmp-x-983) (cdr syntmp-y-984)))))) (syntmp-join-marks-137 (lambda (syntmp-m1-985 syntmp-m2-986) (syntmp-smart-append-135 syntmp-m1-985 syntmp-m2-986))) (syntmp-join-wraps-136 (lambda (syntmp-w1-987 syntmp-w2-988) (let ((syntmp-m1-989 (syntmp-wrap-marks-120 syntmp-w1-987)) (syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w1-987))) (if (null? syntmp-m1-989) (if (null? syntmp-s1-990) syntmp-w2-988 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w2-988) (syntmp-smart-append-135 syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w2-988)))) (syntmp-make-wrap-119 (syntmp-smart-append-135 syntmp-m1-989 (syntmp-wrap-marks-120 syntmp-w2-988)) (syntmp-smart-append-135 syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w2-988))))))) (syntmp-smart-append-135 (lambda (syntmp-m1-991 syntmp-m2-992) (if (null? syntmp-m2-992) syntmp-m1-991 (append syntmp-m1-991 syntmp-m2-992)))) (syntmp-make-binding-wrap-134 (lambda (syntmp-ids-993 syntmp-labels-994 syntmp-w-995) (if (null? syntmp-ids-993) syntmp-w-995 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w-995) (cons (let ((syntmp-labelvec-996 (list->vector syntmp-labels-994))) (let ((syntmp-n-997 (vector-length syntmp-labelvec-996))) (let ((syntmp-symnamevec-998 (make-vector syntmp-n-997)) (syntmp-marksvec-999 (make-vector syntmp-n-997))) (begin (let syntmp-f-1000 ((syntmp-ids-1001 syntmp-ids-993) (syntmp-i-1002 0)) (if (not (null? syntmp-ids-1001)) (call-with-values (lambda () (syntmp-id-sym-name&marks-118 (car syntmp-ids-1001) syntmp-w-995)) (lambda (syntmp-symname-1003 syntmp-marks-1004) (begin (vector-set! syntmp-symnamevec-998 syntmp-i-1002 syntmp-symname-1003) (vector-set! syntmp-marksvec-999 syntmp-i-1002 syntmp-marks-1004) (syntmp-f-1000 (cdr syntmp-ids-1001) (syntmp-fx+-85 syntmp-i-1002 1))))))) (syntmp-make-ribcage-124 syntmp-symnamevec-998 syntmp-marksvec-999 syntmp-labelvec-996))))) (syntmp-wrap-subst-121 syntmp-w-995)))))) (syntmp-extend-ribcage!-133 (lambda (syntmp-ribcage-1005 syntmp-id-1006 syntmp-label-1007) (begin (syntmp-set-ribcage-symnames!-129 syntmp-ribcage-1005 (cons (let ((syntmp-e-1008 (syntmp-syntax-object-expression-102 syntmp-id-1006))) (if (annotation? syntmp-e-1008) (annotation-expression syntmp-e-1008) syntmp-e-1008)) (syntmp-ribcage-symnames-126 syntmp-ribcage-1005))) (syntmp-set-ribcage-marks!-130 syntmp-ribcage-1005 (cons (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-id-1006)) (syntmp-ribcage-marks-127 syntmp-ribcage-1005))) (syntmp-set-ribcage-labels!-131 syntmp-ribcage-1005 (cons syntmp-label-1007 (syntmp-ribcage-labels-128 syntmp-ribcage-1005)))))) (syntmp-anti-mark-132 (lambda (syntmp-w-1009) (syntmp-make-wrap-119 (cons #f (syntmp-wrap-marks-120 syntmp-w-1009)) (cons (quote shift) (syntmp-wrap-subst-121 syntmp-w-1009))))) (syntmp-set-ribcage-labels!-131 (lambda (syntmp-x-1010 syntmp-update-1011) (vector-set! syntmp-x-1010 3 syntmp-update-1011))) (syntmp-set-ribcage-marks!-130 (lambda (syntmp-x-1012 syntmp-update-1013) (vector-set! syntmp-x-1012 2 syntmp-update-1013))) (syntmp-set-ribcage-symnames!-129 (lambda (syntmp-x-1014 syntmp-update-1015) (vector-set! syntmp-x-1014 1 syntmp-update-1015))) (syntmp-ribcage-labels-128 (lambda (syntmp-x-1016) (vector-ref syntmp-x-1016 3))) (syntmp-ribcage-marks-127 (lambda (syntmp-x-1017) (vector-ref syntmp-x-1017 2))) (syntmp-ribcage-symnames-126 (lambda (syntmp-x-1018) (vector-ref syntmp-x-1018 1))) (syntmp-ribcage?-125 (lambda (syntmp-x-1019) (and (vector? syntmp-x-1019) (= (vector-length syntmp-x-1019) 4) (eq? (vector-ref syntmp-x-1019 0) (quote ribcage))))) (syntmp-make-ribcage-124 (lambda (syntmp-symnames-1020 syntmp-marks-1021 syntmp-labels-1022) (vector (quote ribcage) syntmp-symnames-1020 syntmp-marks-1021 syntmp-labels-1022))) (syntmp-gen-labels-123 (lambda (syntmp-ls-1023) (if (null? syntmp-ls-1023) (quote ()) (cons (syntmp-gen-label-122) (syntmp-gen-labels-123 (cdr syntmp-ls-1023)))))) (syntmp-gen-label-122 (lambda () (string #\i))) (syntmp-wrap-subst-121 cdr) (syntmp-wrap-marks-120 car) (syntmp-make-wrap-119 cons) (syntmp-id-sym-name&marks-118 (lambda (syntmp-x-1024 syntmp-w-1025) (if (syntmp-syntax-object?-101 syntmp-x-1024) (values (let ((syntmp-e-1026 (syntmp-syntax-object-expression-102 syntmp-x-1024))) (if (annotation? syntmp-e-1026) (annotation-expression syntmp-e-1026) syntmp-e-1026)) (syntmp-join-marks-137 (syntmp-wrap-marks-120 syntmp-w-1025) (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-x-1024)))) (values (let ((syntmp-e-1027 syntmp-x-1024)) (if (annotation? syntmp-e-1027) (annotation-expression syntmp-e-1027) syntmp-e-1027)) (syntmp-wrap-marks-120 syntmp-w-1025))))) (syntmp-id?-117 (lambda (syntmp-x-1028) (cond ((symbol? syntmp-x-1028) #t) ((syntmp-syntax-object?-101 syntmp-x-1028) (symbol? (let ((syntmp-e-1029 (syntmp-syntax-object-expression-102 syntmp-x-1028))) (if (annotation? syntmp-e-1029) (annotation-expression syntmp-e-1029) syntmp-e-1029)))) ((annotation? syntmp-x-1028) (symbol? (annotation-expression syntmp-x-1028))) (else #f)))) (syntmp-nonsymbol-id?-116 (lambda (syntmp-x-1030) (and (syntmp-syntax-object?-101 syntmp-x-1030) (symbol? (let ((syntmp-e-1031 (syntmp-syntax-object-expression-102 syntmp-x-1030))) (if (annotation? syntmp-e-1031) (annotation-expression syntmp-e-1031) syntmp-e-1031)))))) (syntmp-global-extend-115 (lambda (syntmp-type-1032 syntmp-sym-1033 syntmp-val-1034) (syntmp-put-global-definition-hook-92 syntmp-sym-1033 (cons syntmp-type-1032 syntmp-val-1034) (module-name (current-module))))) (syntmp-lookup-114 (lambda (syntmp-x-1035 syntmp-r-1036 syntmp-mod-1037) (cond ((assq syntmp-x-1035 syntmp-r-1036) => cdr) ((symbol? syntmp-x-1035) (or (syntmp-get-global-definition-hook-93 syntmp-x-1035 syntmp-mod-1037) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-113 (lambda (syntmp-r-1038) (if (null? syntmp-r-1038) (quote ()) (let ((syntmp-a-1039 (car syntmp-r-1038))) (if (eq? (cadr syntmp-a-1039) (quote macro)) (cons syntmp-a-1039 (syntmp-macros-only-env-113 (cdr syntmp-r-1038))) (syntmp-macros-only-env-113 (cdr syntmp-r-1038))))))) (syntmp-extend-var-env-112 (lambda (syntmp-labels-1040 syntmp-vars-1041 syntmp-r-1042) (if (null? syntmp-labels-1040) syntmp-r-1042 (syntmp-extend-var-env-112 (cdr syntmp-labels-1040) (cdr syntmp-vars-1041) (cons (cons (car syntmp-labels-1040) (cons (quote lexical) (car syntmp-vars-1041))) syntmp-r-1042))))) (syntmp-extend-env-111 (lambda (syntmp-labels-1043 syntmp-bindings-1044 syntmp-r-1045) (if (null? syntmp-labels-1043) syntmp-r-1045 (syntmp-extend-env-111 (cdr syntmp-labels-1043) (cdr syntmp-bindings-1044) (cons (cons (car syntmp-labels-1043) (car syntmp-bindings-1044)) syntmp-r-1045))))) (syntmp-binding-value-110 cdr) (syntmp-binding-type-109 car) (syntmp-source-annotation-108 (lambda (syntmp-x-1046) (cond ((annotation? syntmp-x-1046) (annotation-source syntmp-x-1046)) ((syntmp-syntax-object?-101 syntmp-x-1046) (syntmp-source-annotation-108 (syntmp-syntax-object-expression-102 syntmp-x-1046))) (else #f)))) (syntmp-set-syntax-object-module!-107 (lambda (syntmp-x-1047 syntmp-update-1048) (vector-set! syntmp-x-1047 3 syntmp-update-1048))) (syntmp-set-syntax-object-wrap!-106 (lambda (syntmp-x-1049 syntmp-update-1050) (vector-set! syntmp-x-1049 2 syntmp-update-1050))) (syntmp-set-syntax-object-expression!-105 (lambda (syntmp-x-1051 syntmp-update-1052) (vector-set! syntmp-x-1051 1 syntmp-update-1052))) (syntmp-syntax-object-module-104 (lambda (syntmp-x-1053) (vector-ref syntmp-x-1053 3))) (syntmp-syntax-object-wrap-103 (lambda (syntmp-x-1054) (vector-ref syntmp-x-1054 2))) (syntmp-syntax-object-expression-102 (lambda (syntmp-x-1055) (vector-ref syntmp-x-1055 1))) (syntmp-syntax-object?-101 (lambda (syntmp-x-1056) (and (vector? syntmp-x-1056) (= (vector-length syntmp-x-1056) 4) (eq? (vector-ref syntmp-x-1056 0) (quote syntax-object))))) (syntmp-make-syntax-object-100 (lambda (syntmp-expression-1057 syntmp-wrap-1058 syntmp-module-1059) (vector (quote syntax-object) syntmp-expression-1057 syntmp-wrap-1058 syntmp-module-1059))) (syntmp-build-letrec-99 (lambda (syntmp-src-1060 syntmp-vars-1061 syntmp-val-exps-1062 syntmp-body-exp-1063) (if (null? syntmp-vars-1061) (syntmp-build-annotated-94 syntmp-src-1060 syntmp-body-exp-1063) (syntmp-build-annotated-94 syntmp-src-1060 (list (quote letrec) (map list syntmp-vars-1061 syntmp-val-exps-1062) syntmp-body-exp-1063))))) (syntmp-build-named-let-98 (lambda (syntmp-src-1064 syntmp-vars-1065 syntmp-val-exps-1066 syntmp-body-exp-1067) (if (null? syntmp-vars-1065) (syntmp-build-annotated-94 syntmp-src-1064 syntmp-body-exp-1067) (syntmp-build-annotated-94 syntmp-src-1064 (list (quote let) (car syntmp-vars-1065) (map list (cdr syntmp-vars-1065) syntmp-val-exps-1066) syntmp-body-exp-1067))))) (syntmp-build-let-97 (lambda (syntmp-src-1068 syntmp-vars-1069 syntmp-val-exps-1070 syntmp-body-exp-1071) (if (null? syntmp-vars-1069) (syntmp-build-annotated-94 syntmp-src-1068 syntmp-body-exp-1071) (syntmp-build-annotated-94 syntmp-src-1068 (list (quote let) (map list syntmp-vars-1069 syntmp-val-exps-1070) syntmp-body-exp-1071))))) (syntmp-build-sequence-96 (lambda (syntmp-src-1072 syntmp-exps-1073) (if (null? (cdr syntmp-exps-1073)) (syntmp-build-annotated-94 syntmp-src-1072 (car syntmp-exps-1073)) (syntmp-build-annotated-94 syntmp-src-1072 (cons (quote begin) syntmp-exps-1073))))) (syntmp-build-data-95 (lambda (syntmp-src-1074 syntmp-exp-1075) (if (and (self-evaluating? syntmp-exp-1075) (not (vector? syntmp-exp-1075))) (syntmp-build-annotated-94 syntmp-src-1074 syntmp-exp-1075) (syntmp-build-annotated-94 syntmp-src-1074 (list (quote quote) syntmp-exp-1075))))) (syntmp-build-annotated-94 (lambda (syntmp-src-1076 syntmp-exp-1077) (if (and syntmp-src-1076 (not (annotation? syntmp-exp-1077))) (make-annotation syntmp-exp-1077 syntmp-src-1076 #t) syntmp-exp-1077))) (syntmp-get-global-definition-hook-93 (lambda (syntmp-symbol-1078 syntmp-module-1079) (let ((syntmp-module-1080 (if syntmp-module-1079 (resolve-module syntmp-module-1079) (warn "wha" syntmp-symbol-1078 (current-module))))) (let ((syntmp-v-1081 (module-variable syntmp-module-1080 syntmp-symbol-1078))) (and syntmp-v-1081 (or (object-property syntmp-v-1081 (quote *sc-expander*)) (and (variable-bound? syntmp-v-1081) (macro? (variable-ref syntmp-v-1081)) (macro-transformer (variable-ref syntmp-v-1081)) guile-macro))))))) (syntmp-put-global-definition-hook-92 (lambda (syntmp-symbol-1082 syntmp-binding-1083 syntmp-modname-1084) (let ((syntmp-module-1085 (if syntmp-modname-1084 (resolve-module syntmp-modname-1084) (current-module)))) (let ((syntmp-v-1086 (or (module-variable syntmp-module-1085 syntmp-symbol-1082) (let ((syntmp-v-1087 (make-variable (quote sc-macro)))) (begin (module-add! syntmp-module-1085 syntmp-symbol-1082 syntmp-v-1087) syntmp-v-1087))))) (begin (if (not (variable-bound? syntmp-v-1086)) (variable-set! syntmp-v-1086 (gensym))) (set-object-property! syntmp-v-1086 (quote *sc-expander*) syntmp-binding-1083)))))) (syntmp-error-hook-91 (lambda (syntmp-who-1088 syntmp-why-1089 syntmp-what-1090) (error syntmp-who-1088 "~a ~s" syntmp-why-1089 syntmp-what-1090))) (syntmp-local-eval-hook-90 (lambda (syntmp-x-1091 syntmp-mod-1092) (eval (list syntmp-noexpand-84 syntmp-x-1091) (if syntmp-mod-1092 (resolve-module syntmp-mod-1092) (interaction-environment))))) (syntmp-top-level-eval-hook-89 (lambda (syntmp-x-1093 syntmp-mod-1094) (eval (list syntmp-noexpand-84 syntmp-x-1093) (if syntmp-mod-1094 (resolve-module syntmp-mod-1094) (interaction-environment))))) (syntmp-fx<-88 <) (syntmp-fx=-87 =) (syntmp-fx--86 -) (syntmp-fx+-85 +) (syntmp-noexpand-84 "noexpand")) (begin (syntmp-global-extend-115 (quote local-syntax) (quote letrec-syntax) #t) (syntmp-global-extend-115 (quote local-syntax) (quote let-syntax) #f) (syntmp-global-extend-115 (quote core) (quote fluid-let-syntax) (lambda (syntmp-e-1095 syntmp-r-1096 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) ((lambda (syntmp-tmp-1100) ((lambda (syntmp-tmp-1101) (if (if syntmp-tmp-1101 (apply (lambda (syntmp-_-1102 syntmp-var-1103 syntmp-val-1104 syntmp-e1-1105 syntmp-e2-1106) (syntmp-valid-bound-ids?-142 syntmp-var-1103)) syntmp-tmp-1101) #f) (apply (lambda (syntmp-_-1108 syntmp-var-1109 syntmp-val-1110 syntmp-e1-1111 syntmp-e2-1112) (let ((syntmp-names-1113 (map (lambda (syntmp-x-1114) (syntmp-id-var-name-139 syntmp-x-1114 syntmp-w-1097)) syntmp-var-1109))) (begin (for-each (lambda (syntmp-id-1116 syntmp-n-1117) (let ((syntmp-t-1118 (syntmp-binding-type-109 (syntmp-lookup-114 syntmp-n-1117 syntmp-r-1096 syntmp-mod-1099)))) (if (memv syntmp-t-1118 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-146 syntmp-id-1116 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) "identifier out of context")))) syntmp-var-1109 syntmp-names-1113) (syntmp-chi-body-157 (cons syntmp-e1-1111 syntmp-e2-1112) (syntmp-source-wrap-146 syntmp-e-1095 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) (syntmp-extend-env-111 syntmp-names-1113 (let ((syntmp-trans-r-1121 (syntmp-macros-only-env-113 syntmp-r-1096))) (map (lambda (syntmp-x-1122) (cons (quote macro) (syntmp-eval-local-transformer-160 (syntmp-chi-153 syntmp-x-1122 syntmp-trans-r-1121 syntmp-w-1097 syntmp-mod-1099) syntmp-mod-1099))) syntmp-val-1110)) syntmp-r-1096) syntmp-w-1097 syntmp-mod-1099)))) syntmp-tmp-1101) ((lambda (syntmp-_-1124) (syntax-error (syntmp-source-wrap-146 syntmp-e-1095 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099))) syntmp-tmp-1100))) (syntax-dispatch syntmp-tmp-1100 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1095))) (syntmp-global-extend-115 (quote core) (quote quote) (lambda (syntmp-e-1125 syntmp-r-1126 syntmp-w-1127 syntmp-s-1128 syntmp-mod-1129) ((lambda (syntmp-tmp-1130) ((lambda (syntmp-tmp-1131) (if syntmp-tmp-1131 (apply (lambda (syntmp-_-1132 syntmp-e-1133) (syntmp-build-data-95 syntmp-s-1128 (syntmp-strip-164 syntmp-e-1133 syntmp-w-1127))) syntmp-tmp-1131) ((lambda (syntmp-_-1134) (syntax-error (syntmp-source-wrap-146 syntmp-e-1125 syntmp-w-1127 syntmp-s-1128 syntmp-mod-1129))) syntmp-tmp-1130))) (syntax-dispatch syntmp-tmp-1130 (quote (any any))))) syntmp-e-1125))) (syntmp-global-extend-115 (quote core) (quote syntax) (letrec ((syntmp-regen-1142 (lambda (syntmp-x-1143) (let ((syntmp-t-1144 (car syntmp-x-1143))) (if (memv syntmp-t-1144 (quote (ref))) (syntmp-build-annotated-94 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (primitive))) (syntmp-build-annotated-94 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (quote))) (syntmp-build-data-95 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (lambda))) (syntmp-build-annotated-94 #f (list (quote lambda) (cadr syntmp-x-1143) (syntmp-regen-1142 (caddr syntmp-x-1143)))) (if (memv syntmp-t-1144 (quote (map))) (let ((syntmp-ls-1145 (map syntmp-regen-1142 (cdr syntmp-x-1143)))) (syntmp-build-annotated-94 #f (cons (if (syntmp-fx=-87 (length syntmp-ls-1145) 2) (syntmp-build-annotated-94 #f (quote map)) (syntmp-build-annotated-94 #f (quote map))) syntmp-ls-1145))) (syntmp-build-annotated-94 #f (cons (syntmp-build-annotated-94 #f (car syntmp-x-1143)) (map syntmp-regen-1142 (cdr syntmp-x-1143)))))))))))) (syntmp-gen-vector-1141 (lambda (syntmp-x-1146) (cond ((eq? (car syntmp-x-1146) (quote list)) (cons (quote vector) (cdr syntmp-x-1146))) ((eq? (car syntmp-x-1146) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1146)))) (else (list (quote list->vector) syntmp-x-1146))))) (syntmp-gen-append-1140 (lambda (syntmp-x-1147 syntmp-y-1148) (if (equal? syntmp-y-1148 (quote (quote ()))) syntmp-x-1147 (list (quote append) syntmp-x-1147 syntmp-y-1148)))) (syntmp-gen-cons-1139 (lambda (syntmp-x-1149 syntmp-y-1150) (let ((syntmp-t-1151 (car syntmp-y-1150))) (if (memv syntmp-t-1151 (quote (quote))) (if (eq? (car syntmp-x-1149) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1149) (cadr syntmp-y-1150))) (if (eq? (cadr syntmp-y-1150) (quote ())) (list (quote list) syntmp-x-1149) (list (quote cons) syntmp-x-1149 syntmp-y-1150))) (if (memv syntmp-t-1151 (quote (list))) (cons (quote list) (cons syntmp-x-1149 (cdr syntmp-y-1150))) (list (quote cons) syntmp-x-1149 syntmp-y-1150)))))) (syntmp-gen-map-1138 (lambda (syntmp-e-1152 syntmp-map-env-1153) (let ((syntmp-formals-1154 (map cdr syntmp-map-env-1153)) (syntmp-actuals-1155 (map (lambda (syntmp-x-1156) (list (quote ref) (car syntmp-x-1156))) syntmp-map-env-1153))) (cond ((eq? (car syntmp-e-1152) (quote ref)) (car syntmp-actuals-1155)) ((andmap (lambda (syntmp-x-1157) (and (eq? (car syntmp-x-1157) (quote ref)) (memq (cadr syntmp-x-1157) syntmp-formals-1154))) (cdr syntmp-e-1152)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1152)) (map (let ((syntmp-r-1158 (map cons syntmp-formals-1154 syntmp-actuals-1155))) (lambda (syntmp-x-1159) (cdr (assq (cadr syntmp-x-1159) syntmp-r-1158)))) (cdr syntmp-e-1152))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1154 syntmp-e-1152) syntmp-actuals-1155))))))) (syntmp-gen-mappend-1137 (lambda (syntmp-e-1160 syntmp-map-env-1161) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1138 syntmp-e-1160 syntmp-map-env-1161)))) (syntmp-gen-ref-1136 (lambda (syntmp-src-1162 syntmp-var-1163 syntmp-level-1164 syntmp-maps-1165) (if (syntmp-fx=-87 syntmp-level-1164 0) (values syntmp-var-1163 syntmp-maps-1165) (if (null? syntmp-maps-1165) (syntax-error syntmp-src-1162 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1136 syntmp-src-1162 syntmp-var-1163 (syntmp-fx--86 syntmp-level-1164 1) (cdr syntmp-maps-1165))) (lambda (syntmp-outer-var-1166 syntmp-outer-maps-1167) (let ((syntmp-b-1168 (assq syntmp-outer-var-1166 (car syntmp-maps-1165)))) (if syntmp-b-1168 (values (cdr syntmp-b-1168) syntmp-maps-1165) (let ((syntmp-inner-var-1169 (syntmp-gen-var-165 (quote tmp)))) (values syntmp-inner-var-1169 (cons (cons (cons syntmp-outer-var-1166 syntmp-inner-var-1169) (car syntmp-maps-1165)) syntmp-outer-maps-1167))))))))))) (syntmp-gen-syntax-1135 (lambda (syntmp-src-1170 syntmp-e-1171 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175) (if (syntmp-id?-117 syntmp-e-1171) (let ((syntmp-label-1176 (syntmp-id-var-name-139 syntmp-e-1171 (quote (()))))) (let ((syntmp-b-1177 (syntmp-lookup-114 syntmp-label-1176 syntmp-r-1172 syntmp-mod-1175))) (if (eq? (syntmp-binding-type-109 syntmp-b-1177) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1178 (syntmp-binding-value-110 syntmp-b-1177))) (syntmp-gen-ref-1136 syntmp-src-1170 (car syntmp-var.lev-1178) (cdr syntmp-var.lev-1178) syntmp-maps-1173))) (lambda (syntmp-var-1179 syntmp-maps-1180) (values (list (quote ref) syntmp-var-1179) syntmp-maps-1180))) (if (syntmp-ellipsis?-1174 syntmp-e-1171) (syntax-error syntmp-src-1170 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1171) syntmp-maps-1173))))) ((lambda (syntmp-tmp-1181) ((lambda (syntmp-tmp-1182) (if (if syntmp-tmp-1182 (apply (lambda (syntmp-dots-1183 syntmp-e-1184) (syntmp-ellipsis?-1174 syntmp-dots-1183)) syntmp-tmp-1182) #f) (apply (lambda (syntmp-dots-1185 syntmp-e-1186) (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-e-1186 syntmp-r-1172 syntmp-maps-1173 (lambda (syntmp-x-1187) #f) syntmp-mod-1175)) syntmp-tmp-1182) ((lambda (syntmp-tmp-1188) (if (if syntmp-tmp-1188 (apply (lambda (syntmp-x-1189 syntmp-dots-1190 syntmp-y-1191) (syntmp-ellipsis?-1174 syntmp-dots-1190)) syntmp-tmp-1188) #f) (apply (lambda (syntmp-x-1192 syntmp-dots-1193 syntmp-y-1194) (let syntmp-f-1195 ((syntmp-y-1196 syntmp-y-1194) (syntmp-k-1197 (lambda (syntmp-maps-1198) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-x-1192 syntmp-r-1172 (cons (quote ()) syntmp-maps-1198) syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-x-1199 syntmp-maps-1200) (if (null? (car syntmp-maps-1200)) (syntax-error syntmp-src-1170 "extra ellipsis in syntax form") (values (syntmp-gen-map-1138 syntmp-x-1199 (car syntmp-maps-1200)) (cdr syntmp-maps-1200)))))))) ((lambda (syntmp-tmp-1201) ((lambda (syntmp-tmp-1202) (if (if syntmp-tmp-1202 (apply (lambda (syntmp-dots-1203 syntmp-y-1204) (syntmp-ellipsis?-1174 syntmp-dots-1203)) syntmp-tmp-1202) #f) (apply (lambda (syntmp-dots-1205 syntmp-y-1206) (syntmp-f-1195 syntmp-y-1206 (lambda (syntmp-maps-1207) (call-with-values (lambda () (syntmp-k-1197 (cons (quote ()) syntmp-maps-1207))) (lambda (syntmp-x-1208 syntmp-maps-1209) (if (null? (car syntmp-maps-1209)) (syntax-error syntmp-src-1170 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1137 syntmp-x-1208 (car syntmp-maps-1209)) (cdr syntmp-maps-1209)))))))) syntmp-tmp-1202) ((lambda (syntmp-_-1210) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-y-1196 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-y-1211 syntmp-maps-1212) (call-with-values (lambda () (syntmp-k-1197 syntmp-maps-1212)) (lambda (syntmp-x-1213 syntmp-maps-1214) (values (syntmp-gen-append-1140 syntmp-x-1213 syntmp-y-1211) syntmp-maps-1214)))))) syntmp-tmp-1201))) (syntax-dispatch syntmp-tmp-1201 (quote (any . any))))) syntmp-y-1196))) syntmp-tmp-1188) ((lambda (syntmp-tmp-1215) (if syntmp-tmp-1215 (apply (lambda (syntmp-x-1216 syntmp-y-1217) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-x-1216 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-x-1218 syntmp-maps-1219) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-y-1217 syntmp-r-1172 syntmp-maps-1219 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-y-1220 syntmp-maps-1221) (values (syntmp-gen-cons-1139 syntmp-x-1218 syntmp-y-1220) syntmp-maps-1221)))))) syntmp-tmp-1215) ((lambda (syntmp-tmp-1222) (if syntmp-tmp-1222 (apply (lambda (syntmp-e1-1223 syntmp-e2-1224) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 (cons syntmp-e1-1223 syntmp-e2-1224) syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-e-1226 syntmp-maps-1227) (values (syntmp-gen-vector-1141 syntmp-e-1226) syntmp-maps-1227)))) syntmp-tmp-1222) ((lambda (syntmp-_-1228) (values (list (quote quote) syntmp-e-1171) syntmp-maps-1173)) syntmp-tmp-1181))) (syntax-dispatch syntmp-tmp-1181 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1181 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1181 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1181 (quote (any any))))) syntmp-e-1171))))) (lambda (syntmp-e-1229 syntmp-r-1230 syntmp-w-1231 syntmp-s-1232 syntmp-mod-1233) (let ((syntmp-e-1234 (syntmp-source-wrap-146 syntmp-e-1229 syntmp-w-1231 syntmp-s-1232 syntmp-mod-1233))) ((lambda (syntmp-tmp-1235) ((lambda (syntmp-tmp-1236) (if syntmp-tmp-1236 (apply (lambda (syntmp-_-1237 syntmp-x-1238) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-e-1234 syntmp-x-1238 syntmp-r-1230 (quote ()) syntmp-ellipsis?-162 syntmp-mod-1233)) (lambda (syntmp-e-1239 syntmp-maps-1240) (syntmp-regen-1142 syntmp-e-1239)))) syntmp-tmp-1236) ((lambda (syntmp-_-1241) (syntax-error syntmp-e-1234)) syntmp-tmp-1235))) (syntax-dispatch syntmp-tmp-1235 (quote (any any))))) syntmp-e-1234))))) (syntmp-global-extend-115 (quote core) (quote lambda) (lambda (syntmp-e-1242 syntmp-r-1243 syntmp-w-1244 syntmp-s-1245 syntmp-mod-1246) ((lambda (syntmp-tmp-1247) ((lambda (syntmp-tmp-1248) (if syntmp-tmp-1248 (apply (lambda (syntmp-_-1249 syntmp-c-1250) (syntmp-chi-lambda-clause-158 (syntmp-source-wrap-146 syntmp-e-1242 syntmp-w-1244 syntmp-s-1245 syntmp-mod-1246) syntmp-c-1250 syntmp-r-1243 syntmp-w-1244 syntmp-mod-1246 (lambda (syntmp-vars-1251 syntmp-body-1252) (syntmp-build-annotated-94 syntmp-s-1245 (list (quote lambda) syntmp-vars-1251 syntmp-body-1252))))) syntmp-tmp-1248) (syntax-error syntmp-tmp-1247))) (syntax-dispatch syntmp-tmp-1247 (quote (any . any))))) syntmp-e-1242))) (syntmp-global-extend-115 (quote core) (quote let) (letrec ((syntmp-chi-let-1253 (lambda (syntmp-e-1254 syntmp-r-1255 syntmp-w-1256 syntmp-s-1257 syntmp-mod-1258 syntmp-constructor-1259 syntmp-ids-1260 syntmp-vals-1261 syntmp-exps-1262) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-1260)) (syntax-error syntmp-e-1254 "duplicate bound variable in") (let ((syntmp-labels-1263 (syntmp-gen-labels-123 syntmp-ids-1260)) (syntmp-new-vars-1264 (map syntmp-gen-var-165 syntmp-ids-1260))) (let ((syntmp-nw-1265 (syntmp-make-binding-wrap-134 syntmp-ids-1260 syntmp-labels-1263 syntmp-w-1256)) (syntmp-nr-1266 (syntmp-extend-var-env-112 syntmp-labels-1263 syntmp-new-vars-1264 syntmp-r-1255))) (syntmp-constructor-1259 syntmp-s-1257 syntmp-new-vars-1264 (map (lambda (syntmp-x-1267) (syntmp-chi-153 syntmp-x-1267 syntmp-r-1255 syntmp-w-1256 syntmp-mod-1258)) syntmp-vals-1261) (syntmp-chi-body-157 syntmp-exps-1262 (syntmp-source-wrap-146 syntmp-e-1254 syntmp-nw-1265 syntmp-s-1257 syntmp-mod-1258) syntmp-nr-1266 syntmp-nw-1265 syntmp-mod-1258)))))))) (lambda (syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272) ((lambda (syntmp-tmp-1273) ((lambda (syntmp-tmp-1274) (if syntmp-tmp-1274 (apply (lambda (syntmp-_-1275 syntmp-id-1276 syntmp-val-1277 syntmp-e1-1278 syntmp-e2-1279) (syntmp-chi-let-1253 syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272 syntmp-build-let-97 syntmp-id-1276 syntmp-val-1277 (cons syntmp-e1-1278 syntmp-e2-1279))) syntmp-tmp-1274) ((lambda (syntmp-tmp-1283) (if (if syntmp-tmp-1283 (apply (lambda (syntmp-_-1284 syntmp-f-1285 syntmp-id-1286 syntmp-val-1287 syntmp-e1-1288 syntmp-e2-1289) (syntmp-id?-117 syntmp-f-1285)) syntmp-tmp-1283) #f) (apply (lambda (syntmp-_-1290 syntmp-f-1291 syntmp-id-1292 syntmp-val-1293 syntmp-e1-1294 syntmp-e2-1295) (syntmp-chi-let-1253 syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272 syntmp-build-named-let-98 (cons syntmp-f-1291 syntmp-id-1292) syntmp-val-1293 (cons syntmp-e1-1294 syntmp-e2-1295))) syntmp-tmp-1283) ((lambda (syntmp-_-1299) (syntax-error (syntmp-source-wrap-146 syntmp-e-1268 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272))) syntmp-tmp-1273))) (syntax-dispatch syntmp-tmp-1273 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1273 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1268)))) (syntmp-global-extend-115 (quote core) (quote letrec) (lambda (syntmp-e-1300 syntmp-r-1301 syntmp-w-1302 syntmp-s-1303 syntmp-mod-1304) ((lambda (syntmp-tmp-1305) ((lambda (syntmp-tmp-1306) (if syntmp-tmp-1306 (apply (lambda (syntmp-_-1307 syntmp-id-1308 syntmp-val-1309 syntmp-e1-1310 syntmp-e2-1311) (let ((syntmp-ids-1312 syntmp-id-1308)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-1312)) (syntax-error syntmp-e-1300 "duplicate bound variable in") (let ((syntmp-labels-1314 (syntmp-gen-labels-123 syntmp-ids-1312)) (syntmp-new-vars-1315 (map syntmp-gen-var-165 syntmp-ids-1312))) (let ((syntmp-w-1316 (syntmp-make-binding-wrap-134 syntmp-ids-1312 syntmp-labels-1314 syntmp-w-1302)) (syntmp-r-1317 (syntmp-extend-var-env-112 syntmp-labels-1314 syntmp-new-vars-1315 syntmp-r-1301))) (syntmp-build-letrec-99 syntmp-s-1303 syntmp-new-vars-1315 (map (lambda (syntmp-x-1318) (syntmp-chi-153 syntmp-x-1318 syntmp-r-1317 syntmp-w-1316 syntmp-mod-1304)) syntmp-val-1309) (syntmp-chi-body-157 (cons syntmp-e1-1310 syntmp-e2-1311) (syntmp-source-wrap-146 syntmp-e-1300 syntmp-w-1316 syntmp-s-1303 syntmp-mod-1304) syntmp-r-1317 syntmp-w-1316 syntmp-mod-1304))))))) syntmp-tmp-1306) ((lambda (syntmp-_-1321) (syntax-error (syntmp-source-wrap-146 syntmp-e-1300 syntmp-w-1302 syntmp-s-1303 syntmp-mod-1304))) syntmp-tmp-1305))) (syntax-dispatch syntmp-tmp-1305 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1300))) (syntmp-global-extend-115 (quote core) (quote set!) (lambda (syntmp-e-1322 syntmp-r-1323 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326) ((lambda (syntmp-tmp-1327) ((lambda (syntmp-tmp-1328) (if (if syntmp-tmp-1328 (apply (lambda (syntmp-_-1329 syntmp-id-1330 syntmp-val-1331) (syntmp-id?-117 syntmp-id-1330)) syntmp-tmp-1328) #f) (apply (lambda (syntmp-_-1332 syntmp-id-1333 syntmp-val-1334) (let ((syntmp-val-1335 (syntmp-chi-153 syntmp-val-1334 syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326)) (syntmp-n-1336 (syntmp-id-var-name-139 syntmp-id-1333 syntmp-w-1324))) (let ((syntmp-b-1337 (syntmp-lookup-114 syntmp-n-1336 syntmp-r-1323 syntmp-mod-1326))) (let ((syntmp-t-1338 (syntmp-binding-type-109 syntmp-b-1337))) (if (memv syntmp-t-1338 (quote (lexical))) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (syntmp-binding-value-110 syntmp-b-1337) syntmp-val-1335)) (if (memv syntmp-t-1338 (quote (global))) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (make-module-ref syntmp-mod-1326 syntmp-n-1336 #f) syntmp-val-1335)) (if (memv syntmp-t-1338 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-145 syntmp-id-1333 syntmp-w-1324 syntmp-mod-1326) "identifier out of context") (syntax-error (syntmp-source-wrap-146 syntmp-e-1322 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326))))))))) syntmp-tmp-1328) ((lambda (syntmp-tmp-1339) (if syntmp-tmp-1339 (apply (lambda (syntmp-_-1340 syntmp-head-1341 syntmp-tail-1342 syntmp-val-1343) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-head-1341 syntmp-r-1323 (quote (())) #f #f syntmp-mod-1326)) (lambda (syntmp-type-1344 syntmp-value-1345 syntmp-ee-1346 syntmp-ww-1347 syntmp-ss-1348 syntmp-modmod-1349) (let ((syntmp-t-1350 syntmp-type-1344)) (if (memv syntmp-t-1350 (quote (module-ref))) (call-with-values (lambda () (syntmp-value-1345 (cons syntmp-head-1341 syntmp-tail-1342))) (lambda (syntmp-id-1352 syntmp-mod-1353) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (make-module-ref syntmp-mod-1353 syntmp-id-1352 #f) syntmp-val-1343)))) (syntmp-build-annotated-94 syntmp-s-1325 (cons (syntmp-chi-153 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase))) syntmp-head-1341) syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326) (map (lambda (syntmp-e-1354) (syntmp-chi-153 syntmp-e-1354 syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326)) (append syntmp-tail-1342 (list syntmp-val-1343)))))))))) syntmp-tmp-1339) ((lambda (syntmp-_-1356) (syntax-error (syntmp-source-wrap-146 syntmp-e-1322 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326))) syntmp-tmp-1327))) (syntax-dispatch syntmp-tmp-1327 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1327 (quote (any any any))))) syntmp-e-1322))) (syntmp-global-extend-115 (quote module-ref) (quote @) (lambda (syntmp-e-1357) ((lambda (syntmp-tmp-1358) ((lambda (syntmp-tmp-1359) (if (if syntmp-tmp-1359 (apply (lambda (syntmp-_-1360 syntmp-mod-1361 syntmp-id-1362) (and (andmap syntmp-id?-117 syntmp-mod-1361) (syntmp-id?-117 syntmp-id-1362))) syntmp-tmp-1359) #f) (apply (lambda (syntmp-_-1364 syntmp-mod-1365 syntmp-id-1366) (values (syntax-object->datum syntmp-id-1366) (syntax-object->datum (append syntmp-mod-1365 (quote (#(syntax-object %module-public-interface ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase)))))))) syntmp-tmp-1359) (syntax-error syntmp-tmp-1358))) (syntax-dispatch syntmp-tmp-1358 (quote (any each-any any))))) syntmp-e-1357))) (syntmp-global-extend-115 (quote module-ref) (quote @@) (lambda (syntmp-e-1368) ((lambda (syntmp-tmp-1369) ((lambda (syntmp-tmp-1370) (if (if syntmp-tmp-1370 (apply (lambda (syntmp-_-1371 syntmp-mod-1372 syntmp-id-1373) (and (andmap syntmp-id?-117 syntmp-mod-1372) (syntmp-id?-117 syntmp-id-1373))) syntmp-tmp-1370) #f) (apply (lambda (syntmp-_-1375 syntmp-mod-1376 syntmp-id-1377) (values (syntax-object->datum syntmp-id-1377) (syntax-object->datum syntmp-mod-1376))) syntmp-tmp-1370) (syntax-error syntmp-tmp-1369))) (syntax-dispatch syntmp-tmp-1369 (quote (any each-any any))))) syntmp-e-1368))) (syntmp-global-extend-115 (quote begin) (quote begin) (quote ())) (syntmp-global-extend-115 (quote define) (quote define) (quote ())) (syntmp-global-extend-115 (quote define-syntax) (quote define-syntax) (quote ())) (syntmp-global-extend-115 (quote eval-when) (quote eval-when) (quote ())) (syntmp-global-extend-115 (quote core) (quote syntax-case) (letrec ((syntmp-gen-syntax-case-1382 (lambda (syntmp-x-1383 syntmp-keys-1384 syntmp-clauses-1385 syntmp-r-1386 syntmp-mod-1387) (if (null? syntmp-clauses-1385) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote syntax-error)) syntmp-x-1383)) ((lambda (syntmp-tmp-1388) ((lambda (syntmp-tmp-1389) (if syntmp-tmp-1389 (apply (lambda (syntmp-pat-1390 syntmp-exp-1391) (if (and (syntmp-id?-117 syntmp-pat-1390) (andmap (lambda (syntmp-x-1392) (not (syntmp-free-id=?-140 syntmp-pat-1390 syntmp-x-1392))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (ice-9 syncase))) syntmp-keys-1384))) (let ((syntmp-labels-1393 (list (syntmp-gen-label-122))) (syntmp-var-1394 (syntmp-gen-var-165 syntmp-pat-1390))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-var-1394) (syntmp-chi-153 syntmp-exp-1391 (syntmp-extend-env-111 syntmp-labels-1393 (list (cons (quote syntax) (cons syntmp-var-1394 0))) syntmp-r-1386) (syntmp-make-binding-wrap-134 (list syntmp-pat-1390) syntmp-labels-1393 (quote (()))) syntmp-mod-1387))) syntmp-x-1383))) (syntmp-gen-clause-1381 syntmp-x-1383 syntmp-keys-1384 (cdr syntmp-clauses-1385) syntmp-r-1386 syntmp-pat-1390 #t syntmp-exp-1391 syntmp-mod-1387))) syntmp-tmp-1389) ((lambda (syntmp-tmp-1395) (if syntmp-tmp-1395 (apply (lambda (syntmp-pat-1396 syntmp-fender-1397 syntmp-exp-1398) (syntmp-gen-clause-1381 syntmp-x-1383 syntmp-keys-1384 (cdr syntmp-clauses-1385) syntmp-r-1386 syntmp-pat-1396 syntmp-fender-1397 syntmp-exp-1398 syntmp-mod-1387)) syntmp-tmp-1395) ((lambda (syntmp-_-1399) (syntax-error (car syntmp-clauses-1385) "invalid syntax-case clause")) syntmp-tmp-1388))) (syntax-dispatch syntmp-tmp-1388 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1388 (quote (any any))))) (car syntmp-clauses-1385))))) (syntmp-gen-clause-1381 (lambda (syntmp-x-1400 syntmp-keys-1401 syntmp-clauses-1402 syntmp-r-1403 syntmp-pat-1404 syntmp-fender-1405 syntmp-exp-1406 syntmp-mod-1407) (call-with-values (lambda () (syntmp-convert-pattern-1379 syntmp-pat-1404 syntmp-keys-1401)) (lambda (syntmp-p-1408 syntmp-pvars-1409) (cond ((not (syntmp-distinct-bound-ids?-143 (map car syntmp-pvars-1409))) (syntax-error syntmp-pat-1404 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1410) (not (syntmp-ellipsis?-162 (car syntmp-x-1410)))) syntmp-pvars-1409)) (syntax-error syntmp-pat-1404 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1411 (syntmp-gen-var-165 (quote tmp)))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-y-1411) (let ((syntmp-y-1412 (syntmp-build-annotated-94 #f syntmp-y-1411))) (syntmp-build-annotated-94 #f (list (quote if) ((lambda (syntmp-tmp-1413) ((lambda (syntmp-tmp-1414) (if syntmp-tmp-1414 (apply (lambda () syntmp-y-1412) syntmp-tmp-1414) ((lambda (syntmp-_-1415) (syntmp-build-annotated-94 #f (list (quote if) syntmp-y-1412 (syntmp-build-dispatch-call-1380 syntmp-pvars-1409 syntmp-fender-1405 syntmp-y-1412 syntmp-r-1403 syntmp-mod-1407) (syntmp-build-data-95 #f #f)))) syntmp-tmp-1413))) (syntax-dispatch syntmp-tmp-1413 (quote #(atom #t))))) syntmp-fender-1405) (syntmp-build-dispatch-call-1380 syntmp-pvars-1409 syntmp-exp-1406 syntmp-y-1412 syntmp-r-1403 syntmp-mod-1407) (syntmp-gen-syntax-case-1382 syntmp-x-1400 syntmp-keys-1401 syntmp-clauses-1402 syntmp-r-1403 syntmp-mod-1407)))))) (if (eq? syntmp-p-1408 (quote any)) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote list)) syntmp-x-1400)) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote syntax-dispatch)) syntmp-x-1400 (syntmp-build-data-95 #f syntmp-p-1408))))))))))))) (syntmp-build-dispatch-call-1380 (lambda (syntmp-pvars-1416 syntmp-exp-1417 syntmp-y-1418 syntmp-r-1419 syntmp-mod-1420) (let ((syntmp-ids-1421 (map car syntmp-pvars-1416)) (syntmp-levels-1422 (map cdr syntmp-pvars-1416))) (let ((syntmp-labels-1423 (syntmp-gen-labels-123 syntmp-ids-1421)) (syntmp-new-vars-1424 (map syntmp-gen-var-165 syntmp-ids-1421))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote apply)) (syntmp-build-annotated-94 #f (list (quote lambda) syntmp-new-vars-1424 (syntmp-chi-153 syntmp-exp-1417 (syntmp-extend-env-111 syntmp-labels-1423 (map (lambda (syntmp-var-1425 syntmp-level-1426) (cons (quote syntax) (cons syntmp-var-1425 syntmp-level-1426))) syntmp-new-vars-1424 (map cdr syntmp-pvars-1416)) syntmp-r-1419) (syntmp-make-binding-wrap-134 syntmp-ids-1421 syntmp-labels-1423 (quote (()))) syntmp-mod-1420))) syntmp-y-1418)))))) (syntmp-convert-pattern-1379 (lambda (syntmp-pattern-1427 syntmp-keys-1428) (let syntmp-cvt-1429 ((syntmp-p-1430 syntmp-pattern-1427) (syntmp-n-1431 0) (syntmp-ids-1432 (quote ()))) (if (syntmp-id?-117 syntmp-p-1430) (if (syntmp-bound-id-member?-144 syntmp-p-1430 syntmp-keys-1428) (values (vector (quote free-id) syntmp-p-1430) syntmp-ids-1432) (values (quote any) (cons (cons syntmp-p-1430 syntmp-n-1431) syntmp-ids-1432))) ((lambda (syntmp-tmp-1433) ((lambda (syntmp-tmp-1434) (if (if syntmp-tmp-1434 (apply (lambda (syntmp-x-1435 syntmp-dots-1436) (syntmp-ellipsis?-162 syntmp-dots-1436)) syntmp-tmp-1434) #f) (apply (lambda (syntmp-x-1437 syntmp-dots-1438) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1437 (syntmp-fx+-85 syntmp-n-1431 1) syntmp-ids-1432)) (lambda (syntmp-p-1439 syntmp-ids-1440) (values (if (eq? syntmp-p-1439 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1439)) syntmp-ids-1440)))) syntmp-tmp-1434) ((lambda (syntmp-tmp-1441) (if syntmp-tmp-1441 (apply (lambda (syntmp-x-1442 syntmp-y-1443) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-y-1443 syntmp-n-1431 syntmp-ids-1432)) (lambda (syntmp-y-1444 syntmp-ids-1445) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1442 syntmp-n-1431 syntmp-ids-1445)) (lambda (syntmp-x-1446 syntmp-ids-1447) (values (cons syntmp-x-1446 syntmp-y-1444) syntmp-ids-1447)))))) syntmp-tmp-1441) ((lambda (syntmp-tmp-1448) (if syntmp-tmp-1448 (apply (lambda () (values (quote ()) syntmp-ids-1432)) syntmp-tmp-1448) ((lambda (syntmp-tmp-1449) (if syntmp-tmp-1449 (apply (lambda (syntmp-x-1450) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1450 syntmp-n-1431 syntmp-ids-1432)) (lambda (syntmp-p-1452 syntmp-ids-1453) (values (vector (quote vector) syntmp-p-1452) syntmp-ids-1453)))) syntmp-tmp-1449) ((lambda (syntmp-x-1454) (values (vector (quote atom) (syntmp-strip-164 syntmp-p-1430 (quote (())))) syntmp-ids-1432)) syntmp-tmp-1433))) (syntax-dispatch syntmp-tmp-1433 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1433 (quote ()))))) (syntax-dispatch syntmp-tmp-1433 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1433 (quote (any any))))) syntmp-p-1430)))))) (lambda (syntmp-e-1455 syntmp-r-1456 syntmp-w-1457 syntmp-s-1458 syntmp-mod-1459) (let ((syntmp-e-1460 (syntmp-source-wrap-146 syntmp-e-1455 syntmp-w-1457 syntmp-s-1458 syntmp-mod-1459))) ((lambda (syntmp-tmp-1461) ((lambda (syntmp-tmp-1462) (if syntmp-tmp-1462 (apply (lambda (syntmp-_-1463 syntmp-val-1464 syntmp-key-1465 syntmp-m-1466) (if (andmap (lambda (syntmp-x-1467) (and (syntmp-id?-117 syntmp-x-1467) (not (syntmp-ellipsis?-162 syntmp-x-1467)))) syntmp-key-1465) (let ((syntmp-x-1469 (syntmp-gen-var-165 (quote tmp)))) (syntmp-build-annotated-94 syntmp-s-1458 (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-x-1469) (syntmp-gen-syntax-case-1382 (syntmp-build-annotated-94 #f syntmp-x-1469) syntmp-key-1465 syntmp-m-1466 syntmp-r-1456 syntmp-mod-1459))) (syntmp-chi-153 syntmp-val-1464 syntmp-r-1456 (quote (())) syntmp-mod-1459)))) (syntax-error syntmp-e-1460 "invalid literals list in"))) syntmp-tmp-1462) (syntax-error syntmp-tmp-1461))) (syntax-dispatch syntmp-tmp-1461 (quote (any any each-any . each-any))))) syntmp-e-1460))))) (set! sc-expand (let ((syntmp-m-1472 (quote e)) (syntmp-esew-1473 (quote (eval)))) (lambda (syntmp-x-1474) (if (and (pair? syntmp-x-1474) (equal? (car syntmp-x-1474) syntmp-noexpand-84)) (cadr syntmp-x-1474) (syntmp-chi-top-152 syntmp-x-1474 (quote ()) (quote ((top))) syntmp-m-1472 syntmp-esew-1473 (module-name (current-module))))))) (set! sc-expand3 (let ((syntmp-m-1475 (quote e)) (syntmp-esew-1476 (quote (eval)))) (lambda (syntmp-x-1478 . syntmp-rest-1477) (if (and (pair? syntmp-x-1478) (equal? (car syntmp-x-1478) syntmp-noexpand-84)) (cadr syntmp-x-1478) (syntmp-chi-top-152 syntmp-x-1478 (quote ()) (quote ((top))) (if (null? syntmp-rest-1477) syntmp-m-1475 (car syntmp-rest-1477)) (if (or (null? syntmp-rest-1477) (null? (cdr syntmp-rest-1477))) syntmp-esew-1476 (cadr syntmp-rest-1477)) (module-name (current-module))))))) (set! identifier? (lambda (syntmp-x-1479) (syntmp-nonsymbol-id?-116 syntmp-x-1479))) (set! datum->syntax-object (lambda (syntmp-id-1480 syntmp-datum-1481) (syntmp-make-syntax-object-100 syntmp-datum-1481 (syntmp-syntax-object-wrap-103 syntmp-id-1480) #f))) (set! syntax-object->datum (lambda (syntmp-x-1482) (syntmp-strip-164 syntmp-x-1482 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1483) (begin (let ((syntmp-x-1484 syntmp-ls-1483)) (if (not (list? syntmp-x-1484)) (syntmp-error-hook-91 (quote generate-temporaries) "invalid argument" syntmp-x-1484))) (map (lambda (syntmp-x-1485) (syntmp-wrap-145 (gensym) (quote ((top))) #f)) syntmp-ls-1483)))) (set! free-identifier=? (lambda (syntmp-x-1486 syntmp-y-1487) (begin (let ((syntmp-x-1488 syntmp-x-1486)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1488)) (syntmp-error-hook-91 (quote free-identifier=?) "invalid argument" syntmp-x-1488))) (let ((syntmp-x-1489 syntmp-y-1487)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1489)) (syntmp-error-hook-91 (quote free-identifier=?) "invalid argument" syntmp-x-1489))) (syntmp-free-id=?-140 syntmp-x-1486 syntmp-y-1487)))) (set! bound-identifier=? (lambda (syntmp-x-1490 syntmp-y-1491) (begin (let ((syntmp-x-1492 syntmp-x-1490)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1492)) (syntmp-error-hook-91 (quote bound-identifier=?) "invalid argument" syntmp-x-1492))) (let ((syntmp-x-1493 syntmp-y-1491)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1493)) (syntmp-error-hook-91 (quote bound-identifier=?) "invalid argument" syntmp-x-1493))) (syntmp-bound-id=?-141 syntmp-x-1490 syntmp-y-1491)))) (set! syntax-error (lambda (syntmp-object-1495 . syntmp-messages-1494) (begin (for-each (lambda (syntmp-x-1496) (let ((syntmp-x-1497 syntmp-x-1496)) (if (not (string? syntmp-x-1497)) (syntmp-error-hook-91 (quote syntax-error) "invalid argument" syntmp-x-1497)))) syntmp-messages-1494) (let ((syntmp-message-1498 (if (null? syntmp-messages-1494) "invalid syntax" (apply string-append syntmp-messages-1494)))) (syntmp-error-hook-91 #f syntmp-message-1498 (syntmp-strip-164 syntmp-object-1495 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1499 syntmp-v-1500) (begin (let ((syntmp-x-1501 syntmp-sym-1499)) (if (not (symbol? syntmp-x-1501)) (syntmp-error-hook-91 (quote define-syntax) "invalid argument" syntmp-x-1501))) (let ((syntmp-x-1502 syntmp-v-1500)) (if (not (procedure? syntmp-x-1502)) (syntmp-error-hook-91 (quote define-syntax) "invalid argument" syntmp-x-1502))) (syntmp-global-extend-115 (quote macro) syntmp-sym-1499 syntmp-v-1500)))) (letrec ((syntmp-match-1507 (lambda (syntmp-e-1508 syntmp-p-1509 syntmp-w-1510 syntmp-r-1511 syntmp-mod-1512) (cond ((not syntmp-r-1511) #f) ((eq? syntmp-p-1509 (quote any)) (cons (syntmp-wrap-145 syntmp-e-1508 syntmp-w-1510 syntmp-mod-1512) syntmp-r-1511)) ((syntmp-syntax-object?-101 syntmp-e-1508) (syntmp-match*-1506 (let ((syntmp-e-1513 (syntmp-syntax-object-expression-102 syntmp-e-1508))) (if (annotation? syntmp-e-1513) (annotation-expression syntmp-e-1513) syntmp-e-1513)) syntmp-p-1509 (syntmp-join-wraps-136 syntmp-w-1510 (syntmp-syntax-object-wrap-103 syntmp-e-1508)) syntmp-r-1511 (syntmp-syntax-object-module-104 syntmp-e-1508))) (else (syntmp-match*-1506 (let ((syntmp-e-1514 syntmp-e-1508)) (if (annotation? syntmp-e-1514) (annotation-expression syntmp-e-1514) syntmp-e-1514)) syntmp-p-1509 syntmp-w-1510 syntmp-r-1511 syntmp-mod-1512))))) (syntmp-match*-1506 (lambda (syntmp-e-1515 syntmp-p-1516 syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519) (cond ((null? syntmp-p-1516) (and (null? syntmp-e-1515) syntmp-r-1518)) ((pair? syntmp-p-1516) (and (pair? syntmp-e-1515) (syntmp-match-1507 (car syntmp-e-1515) (car syntmp-p-1516) syntmp-w-1517 (syntmp-match-1507 (cdr syntmp-e-1515) (cdr syntmp-p-1516) syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519) syntmp-mod-1519))) ((eq? syntmp-p-1516 (quote each-any)) (let ((syntmp-l-1520 (syntmp-match-each-any-1504 syntmp-e-1515 syntmp-w-1517 syntmp-mod-1519))) (and syntmp-l-1520 (cons syntmp-l-1520 syntmp-r-1518)))) (else (let ((syntmp-t-1521 (vector-ref syntmp-p-1516 0))) (if (memv syntmp-t-1521 (quote (each))) (if (null? syntmp-e-1515) (syntmp-match-empty-1505 (vector-ref syntmp-p-1516 1) syntmp-r-1518) (let ((syntmp-l-1522 (syntmp-match-each-1503 syntmp-e-1515 (vector-ref syntmp-p-1516 1) syntmp-w-1517 syntmp-mod-1519))) (and syntmp-l-1522 (let syntmp-collect-1523 ((syntmp-l-1524 syntmp-l-1522)) (if (null? (car syntmp-l-1524)) syntmp-r-1518 (cons (map car syntmp-l-1524) (syntmp-collect-1523 (map cdr syntmp-l-1524)))))))) (if (memv syntmp-t-1521 (quote (free-id))) (and (syntmp-id?-117 syntmp-e-1515) (syntmp-free-id=?-140 (syntmp-wrap-145 syntmp-e-1515 syntmp-w-1517 syntmp-mod-1519) (vector-ref syntmp-p-1516 1)) syntmp-r-1518) (if (memv syntmp-t-1521 (quote (atom))) (and (equal? (vector-ref syntmp-p-1516 1) (syntmp-strip-164 syntmp-e-1515 syntmp-w-1517)) syntmp-r-1518) (if (memv syntmp-t-1521 (quote (vector))) (and (vector? syntmp-e-1515) (syntmp-match-1507 (vector->list syntmp-e-1515) (vector-ref syntmp-p-1516 1) syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519))))))))))) (syntmp-match-empty-1505 (lambda (syntmp-p-1525 syntmp-r-1526) (cond ((null? syntmp-p-1525) syntmp-r-1526) ((eq? syntmp-p-1525 (quote any)) (cons (quote ()) syntmp-r-1526)) ((pair? syntmp-p-1525) (syntmp-match-empty-1505 (car syntmp-p-1525) (syntmp-match-empty-1505 (cdr syntmp-p-1525) syntmp-r-1526))) ((eq? syntmp-p-1525 (quote each-any)) (cons (quote ()) syntmp-r-1526)) (else (let ((syntmp-t-1527 (vector-ref syntmp-p-1525 0))) (if (memv syntmp-t-1527 (quote (each))) (syntmp-match-empty-1505 (vector-ref syntmp-p-1525 1) syntmp-r-1526) (if (memv syntmp-t-1527 (quote (free-id atom))) syntmp-r-1526 (if (memv syntmp-t-1527 (quote (vector))) (syntmp-match-empty-1505 (vector-ref syntmp-p-1525 1) syntmp-r-1526))))))))) (syntmp-match-each-any-1504 (lambda (syntmp-e-1528 syntmp-w-1529 syntmp-mod-1530) (cond ((annotation? syntmp-e-1528) (syntmp-match-each-any-1504 (annotation-expression syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530)) ((pair? syntmp-e-1528) (let ((syntmp-l-1531 (syntmp-match-each-any-1504 (cdr syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530))) (and syntmp-l-1531 (cons (syntmp-wrap-145 (car syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530) syntmp-l-1531)))) ((null? syntmp-e-1528) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1528) (syntmp-match-each-any-1504 (syntmp-syntax-object-expression-102 syntmp-e-1528) (syntmp-join-wraps-136 syntmp-w-1529 (syntmp-syntax-object-wrap-103 syntmp-e-1528)) syntmp-mod-1530)) (else #f)))) (syntmp-match-each-1503 (lambda (syntmp-e-1532 syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535) (cond ((annotation? syntmp-e-1532) (syntmp-match-each-1503 (annotation-expression syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535)) ((pair? syntmp-e-1532) (let ((syntmp-first-1536 (syntmp-match-1507 (car syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 (quote ()) syntmp-mod-1535))) (and syntmp-first-1536 (let ((syntmp-rest-1537 (syntmp-match-each-1503 (cdr syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535))) (and syntmp-rest-1537 (cons syntmp-first-1536 syntmp-rest-1537)))))) ((null? syntmp-e-1532) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1532) (syntmp-match-each-1503 (syntmp-syntax-object-expression-102 syntmp-e-1532) syntmp-p-1533 (syntmp-join-wraps-136 syntmp-w-1534 (syntmp-syntax-object-wrap-103 syntmp-e-1532)) (syntmp-syntax-object-module-104 syntmp-e-1532))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1538 syntmp-p-1539) (cond ((eq? syntmp-p-1539 (quote any)) (list syntmp-e-1538)) ((syntmp-syntax-object?-101 syntmp-e-1538) (syntmp-match*-1506 (let ((syntmp-e-1540 (syntmp-syntax-object-expression-102 syntmp-e-1538))) (if (annotation? syntmp-e-1540) (annotation-expression syntmp-e-1540) syntmp-e-1540)) syntmp-p-1539 (syntmp-syntax-object-wrap-103 syntmp-e-1538) (quote ()) (syntmp-syntax-object-module-104 syntmp-e-1538))) (else (syntmp-match*-1506 (let ((syntmp-e-1541 syntmp-e-1538)) (if (annotation? syntmp-e-1541) (annotation-expression syntmp-e-1541) syntmp-e-1541)) syntmp-p-1539 (quote (())) (quote ()) #f))))) (set! sc-chi syntmp-chi-153)))))
(install-global-transformer (quote with-syntax) (lambda (syntmp-x-1542) ((lambda (syntmp-tmp-1543) ((lambda (syntmp-tmp-1544) (if syntmp-tmp-1544 (apply (lambda (syntmp-_-1545 syntmp-e1-1546 syntmp-e2-1547) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (cons syntmp-e1-1546 syntmp-e2-1547))) syntmp-tmp-1544) ((lambda (syntmp-tmp-1549) (if syntmp-tmp-1549 (apply (lambda (syntmp-_-1550 syntmp-out-1551 syntmp-in-1552 syntmp-e1-1553 syntmp-e2-1554) (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"))) (ice-9 syncase))) syntmp-in-1552 (quote ()) (list syntmp-out-1551 (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"))) (ice-9 syncase))) (cons syntmp-e1-1553 syntmp-e2-1554))))) syntmp-tmp-1549) ((lambda (syntmp-tmp-1556) (if syntmp-tmp-1556 (apply (lambda (syntmp-_-1557 syntmp-out-1558 syntmp-in-1559 syntmp-e1-1560 syntmp-e2-1561) (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"))) (ice-9 syncase))) (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"))) (ice-9 syncase))) syntmp-in-1559) (quote ()) (list syntmp-out-1558 (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"))) (ice-9 syncase))) (cons syntmp-e1-1560 syntmp-e2-1561))))) syntmp-tmp-1556) (syntax-error syntmp-tmp-1543))) (syntax-dispatch syntmp-tmp-1543 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1543 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1543 (quote (any () any . each-any))))) syntmp-x-1542)))
(install-global-transformer (quote syntax-rules) (lambda (syntmp-x-1583) ((lambda (syntmp-tmp-1584) ((lambda (syntmp-tmp-1585) (if syntmp-tmp-1585 (apply (lambda (syntmp-_-1586 syntmp-k-1587 syntmp-keyword-1588 syntmp-pattern-1589 syntmp-template-1590) (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"))) (ice-9 syncase))) (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"))) (ice-9 syncase)))) (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"))) (ice-9 syncase))) (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"))) (ice-9 syncase))) (cons syntmp-k-1587 (map (lambda (syntmp-tmp-1593 syntmp-tmp-1592) (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"))) (ice-9 syncase))) syntmp-tmp-1592) (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"))) (ice-9 syncase))) syntmp-tmp-1593))) syntmp-template-1590 syntmp-pattern-1589)))))) syntmp-tmp-1585) (syntax-error syntmp-tmp-1584))) (syntax-dispatch syntmp-tmp-1584 (quote (any each-any . #(each ((any . any) any))))))) syntmp-x-1583)))
(install-global-transformer (quote let*) (lambda (syntmp-x-1604) ((lambda (syntmp-tmp-1605) ((lambda (syntmp-tmp-1606) (if (if syntmp-tmp-1606 (apply (lambda (syntmp-let*-1607 syntmp-x-1608 syntmp-v-1609 syntmp-e1-1610 syntmp-e2-1611) (andmap identifier? syntmp-x-1608)) syntmp-tmp-1606) #f) (apply (lambda (syntmp-let*-1613 syntmp-x-1614 syntmp-v-1615 syntmp-e1-1616 syntmp-e2-1617) (let syntmp-f-1618 ((syntmp-bindings-1619 (map list syntmp-x-1614 syntmp-v-1615))) (if (null? syntmp-bindings-1619) (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"))) (ice-9 syncase))) (cons (quote ()) (cons syntmp-e1-1616 syntmp-e2-1617))) ((lambda (syntmp-tmp-1623) ((lambda (syntmp-tmp-1624) (if syntmp-tmp-1624 (apply (lambda (syntmp-body-1625 syntmp-binding-1626) (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"))) (ice-9 syncase))) (list syntmp-binding-1626) syntmp-body-1625)) syntmp-tmp-1624) (syntax-error syntmp-tmp-1623))) (syntax-dispatch syntmp-tmp-1623 (quote (any any))))) (list (syntmp-f-1618 (cdr syntmp-bindings-1619)) (car syntmp-bindings-1619)))))) syntmp-tmp-1606) (syntax-error syntmp-tmp-1605))) (syntax-dispatch syntmp-tmp-1605 (quote (any #(each (any any)) any . each-any))))) syntmp-x-1604)))
(let ((v (make-variable 'sc-macro)))
(module-add! module symbol v)
v))))
- ;; Don't destroy Guile macros corresponding to primitive syntax
- ;; when syncase boots.
- (if (not (and (symbol-property symbol 'primitive-syntax)
- (eq? module the-syncase-module)))
- (variable-set! v sc-macro))
+ (if (not (variable-bound? v))
+ (variable-set! v (gensym)))
;; Properties are tied to variable objects
(set-object-property! v '*sc-expander* binding))))
HCoop / bpt / guile.git / commitdiff