a few fixups
[bpt/guile.git] / module / ice-9 / psyntax-pp.scm
dissimilarity index 91%
index 02d9e99..4476212 100644 (file)
@@ -1,11 +1,13 @@
-(letrec ((syntmp-lambda-var-list-153 (lambda (syntmp-vars-544) (let syntmp-lvl-545 ((syntmp-vars-546 syntmp-vars-544) (syntmp-ls-547 (quote ())) (syntmp-w-548 (quote (())))) (cond ((pair? syntmp-vars-546) (syntmp-lvl-545 (cdr syntmp-vars-546) (cons (syntmp-wrap-132 (car syntmp-vars-546) syntmp-w-548 #f) syntmp-ls-547) syntmp-w-548)) ((syntmp-id?-104 syntmp-vars-546) (cons (syntmp-wrap-132 syntmp-vars-546 syntmp-w-548 #f) syntmp-ls-547)) ((null? syntmp-vars-546) syntmp-ls-547) ((syntmp-syntax-object?-88 syntmp-vars-546) (syntmp-lvl-545 (syntmp-syntax-object-expression-89 syntmp-vars-546) syntmp-ls-547 (syntmp-join-wraps-123 syntmp-w-548 (syntmp-syntax-object-wrap-90 syntmp-vars-546)))) ((annotation? syntmp-vars-546) (syntmp-lvl-545 (annotation-expression syntmp-vars-546) syntmp-ls-547 syntmp-w-548)) (else (cons syntmp-vars-546 syntmp-ls-547)))))) (syntmp-gen-var-152 (lambda (syntmp-id-549) (let ((syntmp-id-550 (if (syntmp-syntax-object?-88 syntmp-id-549) (syntmp-syntax-object-expression-89 syntmp-id-549) syntmp-id-549))) (if (annotation? syntmp-id-550) (syntmp-build-annotated-81 (annotation-source syntmp-id-550) (gensym (symbol->string (annotation-expression syntmp-id-550)))) (syntmp-build-annotated-81 #f (gensym (symbol->string syntmp-id-550))))))) (syntmp-strip-151 (lambda (syntmp-x-551 syntmp-w-552) (if (memq (quote top) (syntmp-wrap-marks-107 syntmp-w-552)) (if (or (annotation? syntmp-x-551) (and (pair? syntmp-x-551) (annotation? (car syntmp-x-551)))) (syntmp-strip-annotation-150 syntmp-x-551 #f) syntmp-x-551) (let syntmp-f-553 ((syntmp-x-554 syntmp-x-551)) (cond ((syntmp-syntax-object?-88 syntmp-x-554) (syntmp-strip-151 (syntmp-syntax-object-expression-89 syntmp-x-554) (syntmp-syntax-object-wrap-90 syntmp-x-554))) ((pair? syntmp-x-554) (let ((syntmp-a-555 (syntmp-f-553 (car syntmp-x-554))) (syntmp-d-556 (syntmp-f-553 (cdr syntmp-x-554)))) (if (and (eq? syntmp-a-555 (car syntmp-x-554)) (eq? syntmp-d-556 (cdr syntmp-x-554))) syntmp-x-554 (cons syntmp-a-555 syntmp-d-556)))) ((vector? syntmp-x-554) (let ((syntmp-old-557 (vector->list syntmp-x-554))) (let ((syntmp-new-558 (map syntmp-f-553 syntmp-old-557))) (if (andmap eq? syntmp-old-557 syntmp-new-558) syntmp-x-554 (list->vector syntmp-new-558))))) (else syntmp-x-554)))))) (syntmp-strip-annotation-150 (lambda (syntmp-x-559 syntmp-parent-560) (cond ((pair? syntmp-x-559) (let ((syntmp-new-561 (cons #f #f))) (begin (if syntmp-parent-560 (set-annotation-stripped! syntmp-parent-560 syntmp-new-561)) (set-car! syntmp-new-561 (syntmp-strip-annotation-150 (car syntmp-x-559) #f)) (set-cdr! syntmp-new-561 (syntmp-strip-annotation-150 (cdr syntmp-x-559) #f)) syntmp-new-561))) ((annotation? syntmp-x-559) (or (annotation-stripped syntmp-x-559) (syntmp-strip-annotation-150 (annotation-expression syntmp-x-559) syntmp-x-559))) ((vector? syntmp-x-559) (let ((syntmp-new-562 (make-vector (vector-length syntmp-x-559)))) (begin (if syntmp-parent-560 (set-annotation-stripped! syntmp-parent-560 syntmp-new-562)) (let syntmp-loop-563 ((syntmp-i-564 (- (vector-length syntmp-x-559) 1))) (unless (syntmp-fx<-75 syntmp-i-564 0) (vector-set! syntmp-new-562 syntmp-i-564 (syntmp-strip-annotation-150 (vector-ref syntmp-x-559 syntmp-i-564) #f)) (syntmp-loop-563 (syntmp-fx--73 syntmp-i-564 1)))) syntmp-new-562))) (else syntmp-x-559)))) (syntmp-ellipsis?-149 (lambda (syntmp-x-565) (and (syntmp-nonsymbol-id?-103 syntmp-x-565) (syntmp-free-id=?-127 syntmp-x-565 (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-148 (lambda () (syntmp-build-annotated-81 #f (list (syntmp-build-annotated-81 #f (quote void)))))) (syntmp-eval-local-transformer-147 (lambda (syntmp-expanded-566 syntmp-mod-567) (let ((syntmp-p-568 (syntmp-local-eval-hook-77 syntmp-expanded-566 syntmp-mod-567))) (if (procedure? syntmp-p-568) syntmp-p-568 (syntax-error syntmp-p-568 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-146 (lambda (syntmp-rec?-569 syntmp-e-570 syntmp-r-571 syntmp-w-572 syntmp-s-573 syntmp-mod-574 syntmp-k-575) ((lambda (syntmp-tmp-576) ((lambda (syntmp-tmp-577) (if syntmp-tmp-577 (apply (lambda (syntmp-_-578 syntmp-id-579 syntmp-val-580 syntmp-e1-581 syntmp-e2-582) (let ((syntmp-ids-583 syntmp-id-579)) (if (not (syntmp-valid-bound-ids?-129 syntmp-ids-583)) (syntax-error syntmp-e-570 "duplicate bound keyword in") (let ((syntmp-labels-585 (syntmp-gen-labels-110 syntmp-ids-583))) (let ((syntmp-new-w-586 (syntmp-make-binding-wrap-121 syntmp-ids-583 syntmp-labels-585 syntmp-w-572))) (syntmp-k-575 (cons syntmp-e1-581 syntmp-e2-582) (syntmp-extend-env-98 syntmp-labels-585 (let ((syntmp-w-588 (if syntmp-rec?-569 syntmp-new-w-586 syntmp-w-572)) (syntmp-trans-r-589 (syntmp-macros-only-env-100 syntmp-r-571))) (map (lambda (syntmp-x-590) (cons (quote macro) (syntmp-eval-local-transformer-147 (syntmp-chi-140 syntmp-x-590 syntmp-trans-r-589 syntmp-w-588 syntmp-mod-574) syntmp-mod-574))) syntmp-val-580)) syntmp-r-571) syntmp-new-w-586 syntmp-s-573 syntmp-mod-574)))))) syntmp-tmp-577) ((lambda (syntmp-_-592) (syntax-error (syntmp-source-wrap-133 syntmp-e-570 syntmp-w-572 syntmp-s-573 syntmp-mod-574))) syntmp-tmp-576))) (syntax-dispatch syntmp-tmp-576 (quote (any #(each (any any)) any . each-any))))) syntmp-e-570))) (syntmp-chi-lambda-clause-145 (lambda (syntmp-e-593 syntmp-c-594 syntmp-r-595 syntmp-w-596 syntmp-mod-597 syntmp-k-598) ((lambda (syntmp-tmp-599) ((lambda (syntmp-tmp-600) (if syntmp-tmp-600 (apply (lambda (syntmp-id-601 syntmp-e1-602 syntmp-e2-603) (let ((syntmp-ids-604 syntmp-id-601)) (if (not (syntmp-valid-bound-ids?-129 syntmp-ids-604)) (syntax-error syntmp-e-593 "invalid parameter list in") (let ((syntmp-labels-606 (syntmp-gen-labels-110 syntmp-ids-604)) (syntmp-new-vars-607 (map syntmp-gen-var-152 syntmp-ids-604))) (syntmp-k-598 syntmp-new-vars-607 (syntmp-chi-body-144 (cons syntmp-e1-602 syntmp-e2-603) syntmp-e-593 (syntmp-extend-var-env-99 syntmp-labels-606 syntmp-new-vars-607 syntmp-r-595) (syntmp-make-binding-wrap-121 syntmp-ids-604 syntmp-labels-606 syntmp-w-596) syntmp-mod-597)))))) syntmp-tmp-600) ((lambda (syntmp-tmp-609) (if syntmp-tmp-609 (apply (lambda (syntmp-ids-610 syntmp-e1-611 syntmp-e2-612) (let ((syntmp-old-ids-613 (syntmp-lambda-var-list-153 syntmp-ids-610))) (if (not (syntmp-valid-bound-ids?-129 syntmp-old-ids-613)) (syntax-error syntmp-e-593 "invalid parameter list in") (let ((syntmp-labels-614 (syntmp-gen-labels-110 syntmp-old-ids-613)) (syntmp-new-vars-615 (map syntmp-gen-var-152 syntmp-old-ids-613))) (syntmp-k-598 (let syntmp-f-616 ((syntmp-ls1-617 (cdr syntmp-new-vars-615)) (syntmp-ls2-618 (car syntmp-new-vars-615))) (if (null? syntmp-ls1-617) syntmp-ls2-618 (syntmp-f-616 (cdr syntmp-ls1-617) (cons (car syntmp-ls1-617) syntmp-ls2-618)))) (syntmp-chi-body-144 (cons syntmp-e1-611 syntmp-e2-612) syntmp-e-593 (syntmp-extend-var-env-99 syntmp-labels-614 syntmp-new-vars-615 syntmp-r-595) (syntmp-make-binding-wrap-121 syntmp-old-ids-613 syntmp-labels-614 syntmp-w-596) syntmp-mod-597)))))) syntmp-tmp-609) ((lambda (syntmp-_-620) (syntax-error syntmp-e-593)) syntmp-tmp-599))) (syntax-dispatch syntmp-tmp-599 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-599 (quote (each-any any . each-any))))) syntmp-c-594))) (syntmp-chi-body-144 (lambda (syntmp-body-621 syntmp-outer-form-622 syntmp-r-623 syntmp-w-624 syntmp-mod-625) (let ((syntmp-r-626 (cons (quote ("placeholder" placeholder)) syntmp-r-623))) (let ((syntmp-ribcage-627 (syntmp-make-ribcage-111 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-628 (syntmp-make-wrap-106 (syntmp-wrap-marks-107 syntmp-w-624) (cons syntmp-ribcage-627 (syntmp-wrap-subst-108 syntmp-w-624))))) (let syntmp-parse-629 ((syntmp-body-630 (map (lambda (syntmp-x-636) (cons syntmp-r-626 (syntmp-wrap-132 syntmp-x-636 syntmp-w-628 syntmp-mod-625))) syntmp-body-621)) (syntmp-ids-631 (quote ())) (syntmp-labels-632 (quote ())) (syntmp-vars-633 (quote ())) (syntmp-vals-634 (quote ())) (syntmp-bindings-635 (quote ()))) (if (null? syntmp-body-630) (syntax-error syntmp-outer-form-622 "no expressions in body") (let ((syntmp-e-637 (cdar syntmp-body-630)) (syntmp-er-638 (caar syntmp-body-630))) (call-with-values (lambda () (syntmp-syntax-type-138 syntmp-e-637 syntmp-er-638 (quote (())) #f syntmp-ribcage-627 syntmp-mod-625)) (lambda (syntmp-type-639 syntmp-value-640 syntmp-e-641 syntmp-w-642 syntmp-s-643 syntmp-mod-644) (let ((syntmp-t-645 syntmp-type-639)) (if (memv syntmp-t-645 (quote (define-form))) (let ((syntmp-id-646 (syntmp-wrap-132 syntmp-value-640 syntmp-w-642 syntmp-mod-644)) (syntmp-label-647 (syntmp-gen-label-109))) (let ((syntmp-var-648 (syntmp-gen-var-152 syntmp-id-646))) (begin (syntmp-extend-ribcage!-120 syntmp-ribcage-627 syntmp-id-646 syntmp-label-647) (syntmp-parse-629 (cdr syntmp-body-630) (cons syntmp-id-646 syntmp-ids-631) (cons syntmp-label-647 syntmp-labels-632) (cons syntmp-var-648 syntmp-vars-633) (cons (cons syntmp-er-638 (syntmp-wrap-132 syntmp-e-641 syntmp-w-642 syntmp-mod-644)) syntmp-vals-634) (cons (cons (quote lexical) syntmp-var-648) syntmp-bindings-635))))) (if (memv syntmp-t-645 (quote (define-syntax-form))) (let ((syntmp-id-649 (syntmp-wrap-132 syntmp-value-640 syntmp-w-642 syntmp-mod-644)) (syntmp-label-650 (syntmp-gen-label-109))) (begin (syntmp-extend-ribcage!-120 syntmp-ribcage-627 syntmp-id-649 syntmp-label-650) (syntmp-parse-629 (cdr syntmp-body-630) (cons syntmp-id-649 syntmp-ids-631) (cons syntmp-label-650 syntmp-labels-632) syntmp-vars-633 syntmp-vals-634 (cons (cons (quote macro) (cons syntmp-er-638 (syntmp-wrap-132 syntmp-e-641 syntmp-w-642 syntmp-mod-644))) syntmp-bindings-635)))) (if (memv syntmp-t-645 (quote (begin-form))) ((lambda (syntmp-tmp-651) ((lambda (syntmp-tmp-652) (if syntmp-tmp-652 (apply (lambda (syntmp-_-653 syntmp-e1-654) (syntmp-parse-629 (let syntmp-f-655 ((syntmp-forms-656 syntmp-e1-654)) (if (null? syntmp-forms-656) (cdr syntmp-body-630) (cons (cons syntmp-er-638 (syntmp-wrap-132 (car syntmp-forms-656) syntmp-w-642 syntmp-mod-644)) (syntmp-f-655 (cdr syntmp-forms-656))))) syntmp-ids-631 syntmp-labels-632 syntmp-vars-633 syntmp-vals-634 syntmp-bindings-635)) syntmp-tmp-652) (syntax-error syntmp-tmp-651))) (syntax-dispatch syntmp-tmp-651 (quote (any . each-any))))) syntmp-e-641) (if (memv syntmp-t-645 (quote (local-syntax-form))) (syntmp-chi-local-syntax-146 syntmp-value-640 syntmp-e-641 syntmp-er-638 syntmp-w-642 syntmp-s-643 syntmp-mod-644 (lambda (syntmp-forms-658 syntmp-er-659 syntmp-w-660 syntmp-s-661 syntmp-mod-662) (syntmp-parse-629 (let syntmp-f-663 ((syntmp-forms-664 syntmp-forms-658)) (if (null? syntmp-forms-664) (cdr syntmp-body-630) (cons (cons syntmp-er-659 (syntmp-wrap-132 (car syntmp-forms-664) syntmp-w-660 syntmp-mod-662)) (syntmp-f-663 (cdr syntmp-forms-664))))) syntmp-ids-631 syntmp-labels-632 syntmp-vars-633 syntmp-vals-634 syntmp-bindings-635))) (if (null? syntmp-ids-631) (syntmp-build-sequence-83 #f (map (lambda (syntmp-x-665) (syntmp-chi-140 (cdr syntmp-x-665) (car syntmp-x-665) (quote (())) syntmp-mod-644)) (cons (cons syntmp-er-638 (syntmp-source-wrap-133 syntmp-e-641 syntmp-w-642 syntmp-s-643 syntmp-mod-644)) (cdr syntmp-body-630)))) (begin (if (not (syntmp-valid-bound-ids?-129 syntmp-ids-631)) (syntax-error syntmp-outer-form-622 "invalid or duplicate identifier in definition")) (let syntmp-loop-666 ((syntmp-bs-667 syntmp-bindings-635) (syntmp-er-cache-668 #f) (syntmp-r-cache-669 #f)) (if (not (null? syntmp-bs-667)) (let ((syntmp-b-670 (car syntmp-bs-667))) (if (eq? (car syntmp-b-670) (quote macro)) (let ((syntmp-er-671 (cadr syntmp-b-670))) (let ((syntmp-r-cache-672 (if (eq? syntmp-er-671 syntmp-er-cache-668) syntmp-r-cache-669 (syntmp-macros-only-env-100 syntmp-er-671)))) (begin (set-cdr! syntmp-b-670 (syntmp-eval-local-transformer-147 (syntmp-chi-140 (cddr syntmp-b-670) syntmp-r-cache-672 (quote (())) syntmp-mod-644) syntmp-mod-644)) (syntmp-loop-666 (cdr syntmp-bs-667) syntmp-er-671 syntmp-r-cache-672)))) (syntmp-loop-666 (cdr syntmp-bs-667) syntmp-er-cache-668 syntmp-r-cache-669))))) (set-cdr! syntmp-r-626 (syntmp-extend-env-98 syntmp-labels-632 syntmp-bindings-635 (cdr syntmp-r-626))) (syntmp-build-letrec-86 #f syntmp-vars-633 (map (lambda (syntmp-x-673) (syntmp-chi-140 (cdr syntmp-x-673) (car syntmp-x-673) (quote (())) syntmp-mod-644)) syntmp-vals-634) (syntmp-build-sequence-83 #f (map (lambda (syntmp-x-674) (syntmp-chi-140 (cdr syntmp-x-674) (car syntmp-x-674) (quote (())) syntmp-mod-644)) (cons (cons syntmp-er-638 (syntmp-source-wrap-133 syntmp-e-641 syntmp-w-642 syntmp-s-643 syntmp-mod-644)) (cdr syntmp-body-630)))))))))))))))))))))) (syntmp-chi-macro-143 (lambda (syntmp-p-675 syntmp-e-676 syntmp-r-677 syntmp-w-678 syntmp-rib-679 syntmp-mod-680) (letrec ((syntmp-rebuild-macro-output-681 (lambda (syntmp-x-682 syntmp-m-683) (cond ((pair? syntmp-x-682) (cons (syntmp-rebuild-macro-output-681 (car syntmp-x-682) syntmp-m-683) (syntmp-rebuild-macro-output-681 (cdr syntmp-x-682) syntmp-m-683))) ((syntmp-syntax-object?-88 syntmp-x-682) (let ((syntmp-w-684 (syntmp-syntax-object-wrap-90 syntmp-x-682))) (let ((syntmp-ms-685 (syntmp-wrap-marks-107 syntmp-w-684)) (syntmp-s-686 (syntmp-wrap-subst-108 syntmp-w-684))) (if (and (pair? syntmp-ms-685) (eq? (car syntmp-ms-685) #f)) (syntmp-make-syntax-object-87 (syntmp-syntax-object-expression-89 syntmp-x-682) (syntmp-make-wrap-106 (cdr syntmp-ms-685) (if syntmp-rib-679 (cons syntmp-rib-679 (cdr syntmp-s-686)) (cdr syntmp-s-686))) (syntmp-syntax-object-module-91 syntmp-x-682)) (syntmp-make-syntax-object-87 (syntmp-syntax-object-expression-89 syntmp-x-682) (syntmp-make-wrap-106 (cons syntmp-m-683 syntmp-ms-685) (if syntmp-rib-679 (cons syntmp-rib-679 (cons (quote shift) syntmp-s-686)) (cons (quote shift) syntmp-s-686))) (module-name (procedure-module syntmp-p-675))))))) ((vector? syntmp-x-682) (let ((syntmp-n-687 (vector-length syntmp-x-682))) (let ((syntmp-v-688 (make-vector syntmp-n-687))) (let syntmp-doloop-689 ((syntmp-i-690 0)) (if (syntmp-fx=-74 syntmp-i-690 syntmp-n-687) syntmp-v-688 (begin (vector-set! syntmp-v-688 syntmp-i-690 (syntmp-rebuild-macro-output-681 (vector-ref syntmp-x-682 syntmp-i-690) syntmp-m-683)) (syntmp-doloop-689 (syntmp-fx+-72 syntmp-i-690 1)))))))) ((symbol? syntmp-x-682) (syntax-error syntmp-x-682 "encountered raw symbol in macro output")) (else syntmp-x-682))))) (syntmp-rebuild-macro-output-681 (syntmp-p-675 (syntmp-wrap-132 syntmp-e-676 (syntmp-anti-mark-119 syntmp-w-678) syntmp-mod-680)) (string #\m))))) (syntmp-chi-application-142 (lambda (syntmp-x-691 syntmp-e-692 syntmp-r-693 syntmp-w-694 syntmp-s-695 syntmp-mod-696) ((lambda (syntmp-tmp-697) ((lambda (syntmp-tmp-698) (if syntmp-tmp-698 (apply (lambda (syntmp-e0-699 syntmp-e1-700) (syntmp-build-annotated-81 syntmp-s-695 (cons syntmp-x-691 (map (lambda (syntmp-e-701) (syntmp-chi-140 syntmp-e-701 syntmp-r-693 syntmp-w-694 syntmp-mod-696)) syntmp-e1-700)))) syntmp-tmp-698) (syntax-error syntmp-tmp-697))) (syntax-dispatch syntmp-tmp-697 (quote (any . each-any))))) syntmp-e-692))) (syntmp-chi-expr-141 (lambda (syntmp-type-703 syntmp-value-704 syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) (let ((syntmp-t-710 syntmp-type-703)) (if (memv syntmp-t-710 (quote (lexical))) (syntmp-build-annotated-81 syntmp-s-708 syntmp-value-704) (if (memv syntmp-t-710 (quote (core external-macro))) (syntmp-value-704 syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) (if (memv syntmp-t-710 (quote (module-ref))) (call-with-values (lambda () (syntmp-value-704 syntmp-e-705)) (lambda (syntmp-id-711 syntmp-mod-712) (syntmp-build-annotated-81 syntmp-s-708 (make-module-ref syntmp-mod-712 syntmp-id-711 #f)))) (if (memv syntmp-t-710 (quote (lexical-call))) (syntmp-chi-application-142 (syntmp-build-annotated-81 (syntmp-source-annotation-95 (car syntmp-e-705)) syntmp-value-704) syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) (if (memv syntmp-t-710 (quote (global-call))) (syntmp-chi-application-142 (syntmp-build-annotated-81 (syntmp-source-annotation-95 (car syntmp-e-705)) (make-module-ref (if (syntmp-syntax-object?-88 (car syntmp-e-705)) (syntmp-syntax-object-module-91 (car syntmp-e-705)) syntmp-mod-709) syntmp-value-704 #f)) syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) (if (memv syntmp-t-710 (quote (constant))) (syntmp-build-data-82 syntmp-s-708 (syntmp-strip-151 (syntmp-source-wrap-133 syntmp-e-705 syntmp-w-707 syntmp-s-708 syntmp-mod-709) (quote (())))) (if (memv syntmp-t-710 (quote (global))) (syntmp-build-annotated-81 syntmp-s-708 (make-module-ref syntmp-mod-709 syntmp-value-704 #f)) (if (memv syntmp-t-710 (quote (call))) (syntmp-chi-application-142 (syntmp-chi-140 (car syntmp-e-705) syntmp-r-706 syntmp-w-707 syntmp-mod-709) syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) (if (memv syntmp-t-710 (quote (begin-form))) ((lambda (syntmp-tmp-713) ((lambda (syntmp-tmp-714) (if syntmp-tmp-714 (apply (lambda (syntmp-_-715 syntmp-e1-716 syntmp-e2-717) (syntmp-chi-sequence-134 (cons syntmp-e1-716 syntmp-e2-717) syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709)) syntmp-tmp-714) (syntax-error syntmp-tmp-713))) (syntax-dispatch syntmp-tmp-713 (quote (any any . each-any))))) syntmp-e-705) (if (memv syntmp-t-710 (quote (local-syntax-form))) (syntmp-chi-local-syntax-146 syntmp-value-704 syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709 syntmp-chi-sequence-134) (if (memv syntmp-t-710 (quote (eval-when-form))) ((lambda (syntmp-tmp-719) ((lambda (syntmp-tmp-720) (if syntmp-tmp-720 (apply (lambda (syntmp-_-721 syntmp-x-722 syntmp-e1-723 syntmp-e2-724) (let ((syntmp-when-list-725 (syntmp-chi-when-list-137 syntmp-e-705 syntmp-x-722 syntmp-w-707))) (if (memq (quote eval) syntmp-when-list-725) (syntmp-chi-sequence-134 (cons syntmp-e1-723 syntmp-e2-724) syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) (syntmp-chi-void-148)))) syntmp-tmp-720) (syntax-error syntmp-tmp-719))) (syntax-dispatch syntmp-tmp-719 (quote (any each-any any . each-any))))) syntmp-e-705) (if (memv syntmp-t-710 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-132 syntmp-value-704 syntmp-w-707 syntmp-mod-709) "invalid context for definition of") (if (memv syntmp-t-710 (quote (syntax))) (syntax-error (syntmp-source-wrap-133 syntmp-e-705 syntmp-w-707 syntmp-s-708 syntmp-mod-709) "reference to pattern variable outside syntax form") (if (memv syntmp-t-710 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-133 syntmp-e-705 syntmp-w-707 syntmp-s-708 syntmp-mod-709) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-133 syntmp-e-705 syntmp-w-707 syntmp-s-708 syntmp-mod-709))))))))))))))))))) (syntmp-chi-140 (lambda (syntmp-e-728 syntmp-r-729 syntmp-w-730 syntmp-mod-731) (call-with-values (lambda () (syntmp-syntax-type-138 syntmp-e-728 syntmp-r-729 syntmp-w-730 #f #f syntmp-mod-731)) (lambda (syntmp-type-732 syntmp-value-733 syntmp-e-734 syntmp-w-735 syntmp-s-736 syntmp-mod-737) (syntmp-chi-expr-141 syntmp-type-732 syntmp-value-733 syntmp-e-734 syntmp-r-729 syntmp-w-735 syntmp-s-736 syntmp-mod-737))))) (syntmp-chi-top-139 (lambda (syntmp-e-738 syntmp-r-739 syntmp-w-740 syntmp-m-741 syntmp-esew-742 syntmp-mod-743) (call-with-values (lambda () (syntmp-syntax-type-138 syntmp-e-738 syntmp-r-739 syntmp-w-740 #f #f syntmp-mod-743)) (lambda (syntmp-type-758 syntmp-value-759 syntmp-e-760 syntmp-w-761 syntmp-s-762 syntmp-mod-763) (let ((syntmp-t-764 syntmp-type-758)) (if (memv syntmp-t-764 (quote (begin-form))) ((lambda (syntmp-tmp-765) ((lambda (syntmp-tmp-766) (if syntmp-tmp-766 (apply (lambda (syntmp-_-767) (syntmp-chi-void-148)) syntmp-tmp-766) ((lambda (syntmp-tmp-768) (if syntmp-tmp-768 (apply (lambda (syntmp-_-769 syntmp-e1-770 syntmp-e2-771) (syntmp-chi-top-sequence-135 (cons syntmp-e1-770 syntmp-e2-771) syntmp-r-739 syntmp-w-761 syntmp-s-762 syntmp-m-741 syntmp-esew-742 syntmp-mod-763)) syntmp-tmp-768) (syntax-error syntmp-tmp-765))) (syntax-dispatch syntmp-tmp-765 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-765 (quote (any))))) syntmp-e-760) (if (memv syntmp-t-764 (quote (local-syntax-form))) (syntmp-chi-local-syntax-146 syntmp-value-759 syntmp-e-760 syntmp-r-739 syntmp-w-761 syntmp-s-762 syntmp-mod-763 (lambda (syntmp-body-773 syntmp-r-774 syntmp-w-775 syntmp-s-776 syntmp-mod-777) (syntmp-chi-top-sequence-135 syntmp-body-773 syntmp-r-774 syntmp-w-775 syntmp-s-776 syntmp-m-741 syntmp-esew-742 syntmp-mod-777))) (if (memv syntmp-t-764 (quote (eval-when-form))) ((lambda (syntmp-tmp-778) ((lambda (syntmp-tmp-779) (if syntmp-tmp-779 (apply (lambda (syntmp-_-780 syntmp-x-781 syntmp-e1-782 syntmp-e2-783) (let ((syntmp-when-list-784 (syntmp-chi-when-list-137 syntmp-e-760 syntmp-x-781 syntmp-w-761)) (syntmp-body-785 (cons syntmp-e1-782 syntmp-e2-783))) (cond ((eq? syntmp-m-741 (quote e)) (if (memq (quote eval) syntmp-when-list-784) (syntmp-chi-top-sequence-135 syntmp-body-785 syntmp-r-739 syntmp-w-761 syntmp-s-762 (quote e) (quote (eval)) syntmp-mod-763) (syntmp-chi-void-148))) ((memq (quote load) syntmp-when-list-784) (if (or (memq (quote compile) syntmp-when-list-784) (and (eq? syntmp-m-741 (quote c&e)) (memq (quote eval) syntmp-when-list-784))) (syntmp-chi-top-sequence-135 syntmp-body-785 syntmp-r-739 syntmp-w-761 syntmp-s-762 (quote c&e) (quote (compile load)) syntmp-mod-763) (if (memq syntmp-m-741 (quote (c c&e))) (syntmp-chi-top-sequence-135 syntmp-body-785 syntmp-r-739 syntmp-w-761 syntmp-s-762 (quote c) (quote (load)) syntmp-mod-763) (syntmp-chi-void-148)))) ((or (memq (quote compile) syntmp-when-list-784) (and (eq? syntmp-m-741 (quote c&e)) (memq (quote eval) syntmp-when-list-784))) (syntmp-top-level-eval-hook-76 (syntmp-chi-top-sequence-135 syntmp-body-785 syntmp-r-739 syntmp-w-761 syntmp-s-762 (quote e) (quote (eval)) syntmp-mod-763) syntmp-mod-763) (syntmp-chi-void-148)) (else (syntmp-chi-void-148))))) syntmp-tmp-779) (syntax-error syntmp-tmp-778))) (syntax-dispatch syntmp-tmp-778 (quote (any each-any any . each-any))))) syntmp-e-760) (if (memv syntmp-t-764 (quote (define-syntax-form))) (let ((syntmp-n-788 (syntmp-id-var-name-126 syntmp-value-759 syntmp-w-761)) (syntmp-r-789 (syntmp-macros-only-env-100 syntmp-r-739))) (let ((syntmp-t-790 syntmp-m-741)) (if (memv syntmp-t-790 (quote (c))) (if (memq (quote compile) syntmp-esew-742) (let ((syntmp-e-791 (syntmp-chi-install-global-136 syntmp-n-788 (syntmp-chi-140 syntmp-e-760 syntmp-r-789 syntmp-w-761 syntmp-mod-763)))) (begin (syntmp-top-level-eval-hook-76 syntmp-e-791 syntmp-mod-763) (if (memq (quote load) syntmp-esew-742) syntmp-e-791 (syntmp-chi-void-148)))) (if (memq (quote load) syntmp-esew-742) (syntmp-chi-install-global-136 syntmp-n-788 (syntmp-chi-140 syntmp-e-760 syntmp-r-789 syntmp-w-761 syntmp-mod-763)) (syntmp-chi-void-148))) (if (memv syntmp-t-790 (quote (c&e))) (let ((syntmp-e-792 (syntmp-chi-install-global-136 syntmp-n-788 (syntmp-chi-140 syntmp-e-760 syntmp-r-789 syntmp-w-761 syntmp-mod-763)))) (begin (syntmp-top-level-eval-hook-76 syntmp-e-792 syntmp-mod-763) syntmp-e-792)) (begin (if (memq (quote eval) syntmp-esew-742) (syntmp-top-level-eval-hook-76 (syntmp-chi-install-global-136 syntmp-n-788 (syntmp-chi-140 syntmp-e-760 syntmp-r-789 syntmp-w-761 syntmp-mod-763)) syntmp-mod-763)) (syntmp-chi-void-148)))))) (if (memv syntmp-t-764 (quote (define-form))) (let ((syntmp-n-793 (syntmp-id-var-name-126 syntmp-value-759 syntmp-w-761))) (let ((syntmp-type-794 (syntmp-binding-type-96 (syntmp-lookup-101 syntmp-n-793 syntmp-r-739 syntmp-mod-763)))) (let ((syntmp-t-795 syntmp-type-794)) (if (memv syntmp-t-795 (quote (global))) (let ((syntmp-x-796 (syntmp-build-annotated-81 syntmp-s-762 (list (quote define) syntmp-n-793 (syntmp-chi-140 syntmp-e-760 syntmp-r-739 syntmp-w-761 syntmp-mod-763))))) (begin (if (eq? syntmp-m-741 (quote c&e)) (syntmp-top-level-eval-hook-76 syntmp-x-796 syntmp-mod-763)) syntmp-x-796)) (if (memv syntmp-t-795 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-132 syntmp-value-759 syntmp-w-761 syntmp-mod-763) "identifier out of context") (if (eq? syntmp-type-794 (quote external-macro)) (let ((syntmp-x-797 (syntmp-build-annotated-81 syntmp-s-762 (list (quote define) syntmp-n-793 (syntmp-chi-140 syntmp-e-760 syntmp-r-739 syntmp-w-761 syntmp-mod-763))))) (begin (if (eq? syntmp-m-741 (quote c&e)) (syntmp-top-level-eval-hook-76 syntmp-x-797 syntmp-mod-763)) syntmp-x-797)) (syntax-error (syntmp-wrap-132 syntmp-value-759 syntmp-w-761 syntmp-mod-763) "cannot define keyword at top level"))))))) (let ((syntmp-x-798 (syntmp-chi-expr-141 syntmp-type-758 syntmp-value-759 syntmp-e-760 syntmp-r-739 syntmp-w-761 syntmp-s-762 syntmp-mod-763))) (begin (if (eq? syntmp-m-741 (quote c&e)) (syntmp-top-level-eval-hook-76 syntmp-x-798 syntmp-mod-763)) syntmp-x-798)))))))))))) (syntmp-syntax-type-138 (lambda (syntmp-e-799 syntmp-r-800 syntmp-w-801 syntmp-s-802 syntmp-rib-803 syntmp-mod-804) (cond ((symbol? syntmp-e-799) (let ((syntmp-n-805 (syntmp-id-var-name-126 syntmp-e-799 syntmp-w-801))) (let ((syntmp-b-806 (syntmp-lookup-101 syntmp-n-805 syntmp-r-800 syntmp-mod-804))) (let ((syntmp-type-807 (syntmp-binding-type-96 syntmp-b-806))) (let ((syntmp-t-808 syntmp-type-807)) (if (memv syntmp-t-808 (quote (lexical))) (values syntmp-type-807 (syntmp-binding-value-97 syntmp-b-806) syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804) (if (memv syntmp-t-808 (quote (global))) (values syntmp-type-807 syntmp-n-805 syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804) (if (memv syntmp-t-808 (quote (macro))) (syntmp-syntax-type-138 (syntmp-chi-macro-143 (syntmp-binding-value-97 syntmp-b-806) syntmp-e-799 syntmp-r-800 syntmp-w-801 syntmp-rib-803 syntmp-mod-804) syntmp-r-800 (quote (())) syntmp-s-802 syntmp-rib-803 syntmp-mod-804) (values syntmp-type-807 (syntmp-binding-value-97 syntmp-b-806) syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804))))))))) ((pair? syntmp-e-799) (let ((syntmp-first-809 (car syntmp-e-799))) (if (syntmp-id?-104 syntmp-first-809) (let ((syntmp-n-810 (syntmp-id-var-name-126 syntmp-first-809 syntmp-w-801))) (let ((syntmp-b-811 (syntmp-lookup-101 syntmp-n-810 syntmp-r-800 (or (and (syntmp-syntax-object?-88 syntmp-first-809) (syntmp-syntax-object-module-91 syntmp-first-809)) syntmp-mod-804)))) (let ((syntmp-type-812 (syntmp-binding-type-96 syntmp-b-811))) (let ((syntmp-t-813 syntmp-type-812)) (if (memv syntmp-t-813 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-97 syntmp-b-811) syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804) (if (memv syntmp-t-813 (quote (global))) (values (quote global-call) syntmp-n-810 syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804) (if (memv syntmp-t-813 (quote (macro))) (syntmp-syntax-type-138 (syntmp-chi-macro-143 (syntmp-binding-value-97 syntmp-b-811) syntmp-e-799 syntmp-r-800 syntmp-w-801 syntmp-rib-803 syntmp-mod-804) syntmp-r-800 (quote (())) syntmp-s-802 syntmp-rib-803 syntmp-mod-804) (if (memv syntmp-t-813 (quote (core external-macro module-ref))) (values syntmp-type-812 (syntmp-binding-value-97 syntmp-b-811) syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804) (if (memv syntmp-t-813 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-97 syntmp-b-811) syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804) (if (memv syntmp-t-813 (quote (begin))) (values (quote begin-form) #f syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804) (if (memv syntmp-t-813 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804) (if (memv syntmp-t-813 (quote (define))) ((lambda (syntmp-tmp-814) ((lambda (syntmp-tmp-815) (if (if syntmp-tmp-815 (apply (lambda (syntmp-_-816 syntmp-name-817 syntmp-val-818) (syntmp-id?-104 syntmp-name-817)) syntmp-tmp-815) #f) (apply (lambda (syntmp-_-819 syntmp-name-820 syntmp-val-821) (values (quote define-form) syntmp-name-820 syntmp-val-821 syntmp-w-801 syntmp-s-802 syntmp-mod-804)) syntmp-tmp-815) ((lambda (syntmp-tmp-822) (if (if syntmp-tmp-822 (apply (lambda (syntmp-_-823 syntmp-name-824 syntmp-args-825 syntmp-e1-826 syntmp-e2-827) (and (syntmp-id?-104 syntmp-name-824) (syntmp-valid-bound-ids?-129 (syntmp-lambda-var-list-153 syntmp-args-825)))) syntmp-tmp-822) #f) (apply (lambda (syntmp-_-828 syntmp-name-829 syntmp-args-830 syntmp-e1-831 syntmp-e2-832) (values (quote define-form) (syntmp-wrap-132 syntmp-name-829 syntmp-w-801 syntmp-mod-804) (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-132 (cons syntmp-args-830 (cons syntmp-e1-831 syntmp-e2-832)) syntmp-w-801 syntmp-mod-804)) (quote (())) syntmp-s-802 syntmp-mod-804)) syntmp-tmp-822) ((lambda (syntmp-tmp-834) (if (if syntmp-tmp-834 (apply (lambda (syntmp-_-835 syntmp-name-836) (syntmp-id?-104 syntmp-name-836)) syntmp-tmp-834) #f) (apply (lambda (syntmp-_-837 syntmp-name-838) (values (quote define-form) (syntmp-wrap-132 syntmp-name-838 syntmp-w-801 syntmp-mod-804) (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-802 syntmp-mod-804)) syntmp-tmp-834) (syntax-error syntmp-tmp-814))) (syntax-dispatch syntmp-tmp-814 (quote (any any)))))) (syntax-dispatch syntmp-tmp-814 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-814 (quote (any any any))))) syntmp-e-799) (if (memv syntmp-t-813 (quote (define-syntax))) ((lambda (syntmp-tmp-839) ((lambda (syntmp-tmp-840) (if (if syntmp-tmp-840 (apply (lambda (syntmp-_-841 syntmp-name-842 syntmp-val-843) (syntmp-id?-104 syntmp-name-842)) syntmp-tmp-840) #f) (apply (lambda (syntmp-_-844 syntmp-name-845 syntmp-val-846) (values (quote define-syntax-form) syntmp-name-845 syntmp-val-846 syntmp-w-801 syntmp-s-802 syntmp-mod-804)) syntmp-tmp-840) (syntax-error syntmp-tmp-839))) (syntax-dispatch syntmp-tmp-839 (quote (any any any))))) syntmp-e-799) (values (quote call) #f syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804)))))))))))))) (values (quote call) #f syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804)))) ((syntmp-syntax-object?-88 syntmp-e-799) (syntmp-syntax-type-138 (syntmp-syntax-object-expression-89 syntmp-e-799) syntmp-r-800 (syntmp-join-wraps-123 syntmp-w-801 (syntmp-syntax-object-wrap-90 syntmp-e-799)) #f syntmp-rib-803 (or (syntmp-syntax-object-module-91 syntmp-e-799) syntmp-mod-804))) ((annotation? syntmp-e-799) (syntmp-syntax-type-138 (annotation-expression syntmp-e-799) syntmp-r-800 syntmp-w-801 (annotation-source syntmp-e-799) syntmp-rib-803 syntmp-mod-804)) ((self-evaluating? syntmp-e-799) (values (quote constant) #f syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804)) (else (values (quote other) #f syntmp-e-799 syntmp-w-801 syntmp-s-802 syntmp-mod-804))))) (syntmp-chi-when-list-137 (lambda (syntmp-e-847 syntmp-when-list-848 syntmp-w-849) (let syntmp-f-850 ((syntmp-when-list-851 syntmp-when-list-848) (syntmp-situations-852 (quote ()))) (if (null? syntmp-when-list-851) syntmp-situations-852 (syntmp-f-850 (cdr syntmp-when-list-851) (cons (let ((syntmp-x-853 (car syntmp-when-list-851))) (cond ((syntmp-free-id=?-127 syntmp-x-853 (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=?-127 syntmp-x-853 (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=?-127 syntmp-x-853 (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-132 syntmp-x-853 syntmp-w-849 #f) "invalid eval-when situation")))) syntmp-situations-852)))))) (syntmp-chi-install-global-136 (lambda (syntmp-name-854 syntmp-e-855) (syntmp-build-annotated-81 #f (list (syntmp-build-annotated-81 #f (quote install-global-transformer)) (syntmp-build-data-82 #f syntmp-name-854) syntmp-e-855)))) (syntmp-chi-top-sequence-135 (lambda (syntmp-body-856 syntmp-r-857 syntmp-w-858 syntmp-s-859 syntmp-m-860 syntmp-esew-861 syntmp-mod-862) (syntmp-build-sequence-83 syntmp-s-859 (let syntmp-dobody-863 ((syntmp-body-864 syntmp-body-856) (syntmp-r-865 syntmp-r-857) (syntmp-w-866 syntmp-w-858) (syntmp-m-867 syntmp-m-860) (syntmp-esew-868 syntmp-esew-861) (syntmp-mod-869 syntmp-mod-862)) (if (null? syntmp-body-864) (quote ()) (let ((syntmp-first-870 (syntmp-chi-top-139 (car syntmp-body-864) syntmp-r-865 syntmp-w-866 syntmp-m-867 syntmp-esew-868 syntmp-mod-869))) (cons syntmp-first-870 (syntmp-dobody-863 (cdr syntmp-body-864) syntmp-r-865 syntmp-w-866 syntmp-m-867 syntmp-esew-868 syntmp-mod-869)))))))) (syntmp-chi-sequence-134 (lambda (syntmp-body-871 syntmp-r-872 syntmp-w-873 syntmp-s-874 syntmp-mod-875) (syntmp-build-sequence-83 syntmp-s-874 (let syntmp-dobody-876 ((syntmp-body-877 syntmp-body-871) (syntmp-r-878 syntmp-r-872) (syntmp-w-879 syntmp-w-873) (syntmp-mod-880 syntmp-mod-875)) (if (null? syntmp-body-877) (quote ()) (let ((syntmp-first-881 (syntmp-chi-140 (car syntmp-body-877) syntmp-r-878 syntmp-w-879 syntmp-mod-880))) (cons syntmp-first-881 (syntmp-dobody-876 (cdr syntmp-body-877) syntmp-r-878 syntmp-w-879 syntmp-mod-880)))))))) (syntmp-source-wrap-133 (lambda (syntmp-x-882 syntmp-w-883 syntmp-s-884 syntmp-defmod-885) (syntmp-wrap-132 (if syntmp-s-884 (make-annotation syntmp-x-882 syntmp-s-884 #f) syntmp-x-882) syntmp-w-883 syntmp-defmod-885))) (syntmp-wrap-132 (lambda (syntmp-x-886 syntmp-w-887 syntmp-defmod-888) (cond ((and (null? (syntmp-wrap-marks-107 syntmp-w-887)) (null? (syntmp-wrap-subst-108 syntmp-w-887))) syntmp-x-886) ((syntmp-syntax-object?-88 syntmp-x-886) (syntmp-make-syntax-object-87 (syntmp-syntax-object-expression-89 syntmp-x-886) (syntmp-join-wraps-123 syntmp-w-887 (syntmp-syntax-object-wrap-90 syntmp-x-886)) (syntmp-syntax-object-module-91 syntmp-x-886))) ((null? syntmp-x-886) syntmp-x-886) (else (syntmp-make-syntax-object-87 syntmp-x-886 syntmp-w-887 syntmp-defmod-888))))) (syntmp-bound-id-member?-131 (lambda (syntmp-x-889 syntmp-list-890) (and (not (null? syntmp-list-890)) (or (syntmp-bound-id=?-128 syntmp-x-889 (car syntmp-list-890)) (syntmp-bound-id-member?-131 syntmp-x-889 (cdr syntmp-list-890)))))) (syntmp-distinct-bound-ids?-130 (lambda (syntmp-ids-891) (let syntmp-distinct?-892 ((syntmp-ids-893 syntmp-ids-891)) (or (null? syntmp-ids-893) (and (not (syntmp-bound-id-member?-131 (car syntmp-ids-893) (cdr syntmp-ids-893))) (syntmp-distinct?-892 (cdr syntmp-ids-893))))))) (syntmp-valid-bound-ids?-129 (lambda (syntmp-ids-894) (and (let syntmp-all-ids?-895 ((syntmp-ids-896 syntmp-ids-894)) (or (null? syntmp-ids-896) (and (syntmp-id?-104 (car syntmp-ids-896)) (syntmp-all-ids?-895 (cdr syntmp-ids-896))))) (syntmp-distinct-bound-ids?-130 syntmp-ids-894)))) (syntmp-bound-id=?-128 (lambda (syntmp-i-897 syntmp-j-898) (if (and (syntmp-syntax-object?-88 syntmp-i-897) (syntmp-syntax-object?-88 syntmp-j-898)) (and (eq? (let ((syntmp-e-899 (syntmp-syntax-object-expression-89 syntmp-i-897))) (if (annotation? syntmp-e-899) (annotation-expression syntmp-e-899) syntmp-e-899)) (let ((syntmp-e-900 (syntmp-syntax-object-expression-89 syntmp-j-898))) (if (annotation? syntmp-e-900) (annotation-expression syntmp-e-900) syntmp-e-900))) (syntmp-same-marks?-125 (syntmp-wrap-marks-107 (syntmp-syntax-object-wrap-90 syntmp-i-897)) (syntmp-wrap-marks-107 (syntmp-syntax-object-wrap-90 syntmp-j-898)))) (eq? (let ((syntmp-e-901 syntmp-i-897)) (if (annotation? syntmp-e-901) (annotation-expression syntmp-e-901) syntmp-e-901)) (let ((syntmp-e-902 syntmp-j-898)) (if (annotation? syntmp-e-902) (annotation-expression syntmp-e-902) syntmp-e-902)))))) (syntmp-free-id=?-127 (lambda (syntmp-i-903 syntmp-j-904) (and (eq? (let ((syntmp-x-905 syntmp-i-903)) (let ((syntmp-e-906 (if (syntmp-syntax-object?-88 syntmp-x-905) (syntmp-syntax-object-expression-89 syntmp-x-905) syntmp-x-905))) (if (annotation? syntmp-e-906) (annotation-expression syntmp-e-906) syntmp-e-906))) (let ((syntmp-x-907 syntmp-j-904)) (let ((syntmp-e-908 (if (syntmp-syntax-object?-88 syntmp-x-907) (syntmp-syntax-object-expression-89 syntmp-x-907) syntmp-x-907))) (if (annotation? syntmp-e-908) (annotation-expression syntmp-e-908) syntmp-e-908)))) (eq? (syntmp-id-var-name-126 syntmp-i-903 (quote (()))) (syntmp-id-var-name-126 syntmp-j-904 (quote (()))))))) (syntmp-id-var-name-126 (lambda (syntmp-id-909 syntmp-w-910) (letrec ((syntmp-search-vector-rib-913 (lambda (syntmp-sym-924 syntmp-subst-925 syntmp-marks-926 syntmp-symnames-927 syntmp-ribcage-928) (let ((syntmp-n-929 (vector-length syntmp-symnames-927))) (let syntmp-f-930 ((syntmp-i-931 0)) (cond ((syntmp-fx=-74 syntmp-i-931 syntmp-n-929) (syntmp-search-911 syntmp-sym-924 (cdr syntmp-subst-925) syntmp-marks-926)) ((and (eq? (vector-ref syntmp-symnames-927 syntmp-i-931) syntmp-sym-924) (syntmp-same-marks?-125 syntmp-marks-926 (vector-ref (syntmp-ribcage-marks-114 syntmp-ribcage-928) syntmp-i-931))) (values (vector-ref (syntmp-ribcage-labels-115 syntmp-ribcage-928) syntmp-i-931) syntmp-marks-926)) (else (syntmp-f-930 (syntmp-fx+-72 syntmp-i-931 1)))))))) (syntmp-search-list-rib-912 (lambda (syntmp-sym-932 syntmp-subst-933 syntmp-marks-934 syntmp-symnames-935 syntmp-ribcage-936) (let syntmp-f-937 ((syntmp-symnames-938 syntmp-symnames-935) (syntmp-i-939 0)) (cond ((null? syntmp-symnames-938) (syntmp-search-911 syntmp-sym-932 (cdr syntmp-subst-933) syntmp-marks-934)) ((and (eq? (car syntmp-symnames-938) syntmp-sym-932) (syntmp-same-marks?-125 syntmp-marks-934 (list-ref (syntmp-ribcage-marks-114 syntmp-ribcage-936) syntmp-i-939))) (values (list-ref (syntmp-ribcage-labels-115 syntmp-ribcage-936) syntmp-i-939) syntmp-marks-934)) (else (syntmp-f-937 (cdr syntmp-symnames-938) (syntmp-fx+-72 syntmp-i-939 1))))))) (syntmp-search-911 (lambda (syntmp-sym-940 syntmp-subst-941 syntmp-marks-942) (if (null? syntmp-subst-941) (values #f syntmp-marks-942) (let ((syntmp-fst-943 (car syntmp-subst-941))) (if (eq? syntmp-fst-943 (quote shift)) (syntmp-search-911 syntmp-sym-940 (cdr syntmp-subst-941) (cdr syntmp-marks-942)) (let ((syntmp-symnames-944 (syntmp-ribcage-symnames-113 syntmp-fst-943))) (if (vector? syntmp-symnames-944) (syntmp-search-vector-rib-913 syntmp-sym-940 syntmp-subst-941 syntmp-marks-942 syntmp-symnames-944 syntmp-fst-943) (syntmp-search-list-rib-912 syntmp-sym-940 syntmp-subst-941 syntmp-marks-942 syntmp-symnames-944 syntmp-fst-943))))))))) (cond ((symbol? syntmp-id-909) (or (call-with-values (lambda () (syntmp-search-911 syntmp-id-909 (syntmp-wrap-subst-108 syntmp-w-910) (syntmp-wrap-marks-107 syntmp-w-910))) (lambda (syntmp-x-946 . syntmp-ignore-945) syntmp-x-946)) syntmp-id-909)) ((syntmp-syntax-object?-88 syntmp-id-909) (let ((syntmp-id-947 (let ((syntmp-e-949 (syntmp-syntax-object-expression-89 syntmp-id-909))) (if (annotation? syntmp-e-949) (annotation-expression syntmp-e-949) syntmp-e-949))) (syntmp-w1-948 (syntmp-syntax-object-wrap-90 syntmp-id-909))) (let ((syntmp-marks-950 (syntmp-join-marks-124 (syntmp-wrap-marks-107 syntmp-w-910) (syntmp-wrap-marks-107 syntmp-w1-948)))) (call-with-values (lambda () (syntmp-search-911 syntmp-id-947 (syntmp-wrap-subst-108 syntmp-w-910) syntmp-marks-950)) (lambda (syntmp-new-id-951 syntmp-marks-952) (or syntmp-new-id-951 (call-with-values (lambda () (syntmp-search-911 syntmp-id-947 (syntmp-wrap-subst-108 syntmp-w1-948) syntmp-marks-952)) (lambda (syntmp-x-954 . syntmp-ignore-953) syntmp-x-954)) syntmp-id-947)))))) ((annotation? syntmp-id-909) (let ((syntmp-id-955 (let ((syntmp-e-956 syntmp-id-909)) (if (annotation? syntmp-e-956) (annotation-expression syntmp-e-956) syntmp-e-956)))) (or (call-with-values (lambda () (syntmp-search-911 syntmp-id-955 (syntmp-wrap-subst-108 syntmp-w-910) (syntmp-wrap-marks-107 syntmp-w-910))) (lambda (syntmp-x-958 . syntmp-ignore-957) syntmp-x-958)) syntmp-id-955))) (else (syntmp-error-hook-78 (quote id-var-name) "invalid id" syntmp-id-909)))))) (syntmp-same-marks?-125 (lambda (syntmp-x-959 syntmp-y-960) (or (eq? syntmp-x-959 syntmp-y-960) (and (not (null? syntmp-x-959)) (not (null? syntmp-y-960)) (eq? (car syntmp-x-959) (car syntmp-y-960)) (syntmp-same-marks?-125 (cdr syntmp-x-959) (cdr syntmp-y-960)))))) (syntmp-join-marks-124 (lambda (syntmp-m1-961 syntmp-m2-962) (syntmp-smart-append-122 syntmp-m1-961 syntmp-m2-962))) (syntmp-join-wraps-123 (lambda (syntmp-w1-963 syntmp-w2-964) (let ((syntmp-m1-965 (syntmp-wrap-marks-107 syntmp-w1-963)) (syntmp-s1-966 (syntmp-wrap-subst-108 syntmp-w1-963))) (if (null? syntmp-m1-965) (if (null? syntmp-s1-966) syntmp-w2-964 (syntmp-make-wrap-106 (syntmp-wrap-marks-107 syntmp-w2-964) (syntmp-smart-append-122 syntmp-s1-966 (syntmp-wrap-subst-108 syntmp-w2-964)))) (syntmp-make-wrap-106 (syntmp-smart-append-122 syntmp-m1-965 (syntmp-wrap-marks-107 syntmp-w2-964)) (syntmp-smart-append-122 syntmp-s1-966 (syntmp-wrap-subst-108 syntmp-w2-964))))))) (syntmp-smart-append-122 (lambda (syntmp-m1-967 syntmp-m2-968) (if (null? syntmp-m2-968) syntmp-m1-967 (append syntmp-m1-967 syntmp-m2-968)))) (syntmp-make-binding-wrap-121 (lambda (syntmp-ids-969 syntmp-labels-970 syntmp-w-971) (if (null? syntmp-ids-969) syntmp-w-971 (syntmp-make-wrap-106 (syntmp-wrap-marks-107 syntmp-w-971) (cons (let ((syntmp-labelvec-972 (list->vector syntmp-labels-970))) (let ((syntmp-n-973 (vector-length syntmp-labelvec-972))) (let ((syntmp-symnamevec-974 (make-vector syntmp-n-973)) (syntmp-marksvec-975 (make-vector syntmp-n-973))) (begin (let syntmp-f-976 ((syntmp-ids-977 syntmp-ids-969) (syntmp-i-978 0)) (if (not (null? syntmp-ids-977)) (call-with-values (lambda () (syntmp-id-sym-name&marks-105 (car syntmp-ids-977) syntmp-w-971)) (lambda (syntmp-symname-979 syntmp-marks-980) (begin (vector-set! syntmp-symnamevec-974 syntmp-i-978 syntmp-symname-979) (vector-set! syntmp-marksvec-975 syntmp-i-978 syntmp-marks-980) (syntmp-f-976 (cdr syntmp-ids-977) (syntmp-fx+-72 syntmp-i-978 1))))))) (syntmp-make-ribcage-111 syntmp-symnamevec-974 syntmp-marksvec-975 syntmp-labelvec-972))))) (syntmp-wrap-subst-108 syntmp-w-971)))))) (syntmp-extend-ribcage!-120 (lambda (syntmp-ribcage-981 syntmp-id-982 syntmp-label-983) (begin (syntmp-set-ribcage-symnames!-116 syntmp-ribcage-981 (cons (let ((syntmp-e-984 (syntmp-syntax-object-expression-89 syntmp-id-982))) (if (annotation? syntmp-e-984) (annotation-expression syntmp-e-984) syntmp-e-984)) (syntmp-ribcage-symnames-113 syntmp-ribcage-981))) (syntmp-set-ribcage-marks!-117 syntmp-ribcage-981 (cons (syntmp-wrap-marks-107 (syntmp-syntax-object-wrap-90 syntmp-id-982)) (syntmp-ribcage-marks-114 syntmp-ribcage-981))) (syntmp-set-ribcage-labels!-118 syntmp-ribcage-981 (cons syntmp-label-983 (syntmp-ribcage-labels-115 syntmp-ribcage-981)))))) (syntmp-anti-mark-119 (lambda (syntmp-w-985) (syntmp-make-wrap-106 (cons #f (syntmp-wrap-marks-107 syntmp-w-985)) (cons (quote shift) (syntmp-wrap-subst-108 syntmp-w-985))))) (syntmp-set-ribcage-labels!-118 (lambda (syntmp-x-986 syntmp-update-987) (vector-set! syntmp-x-986 3 syntmp-update-987))) (syntmp-set-ribcage-marks!-117 (lambda (syntmp-x-988 syntmp-update-989) (vector-set! syntmp-x-988 2 syntmp-update-989))) (syntmp-set-ribcage-symnames!-116 (lambda (syntmp-x-990 syntmp-update-991) (vector-set! syntmp-x-990 1 syntmp-update-991))) (syntmp-ribcage-labels-115 (lambda (syntmp-x-992) (vector-ref syntmp-x-992 3))) (syntmp-ribcage-marks-114 (lambda (syntmp-x-993) (vector-ref syntmp-x-993 2))) (syntmp-ribcage-symnames-113 (lambda (syntmp-x-994) (vector-ref syntmp-x-994 1))) (syntmp-ribcage?-112 (lambda (syntmp-x-995) (and (vector? syntmp-x-995) (= (vector-length syntmp-x-995) 4) (eq? (vector-ref syntmp-x-995 0) (quote ribcage))))) (syntmp-make-ribcage-111 (lambda (syntmp-symnames-996 syntmp-marks-997 syntmp-labels-998) (vector (quote ribcage) syntmp-symnames-996 syntmp-marks-997 syntmp-labels-998))) (syntmp-gen-labels-110 (lambda (syntmp-ls-999) (if (null? syntmp-ls-999) (quote ()) (cons (syntmp-gen-label-109) (syntmp-gen-labels-110 (cdr syntmp-ls-999)))))) (syntmp-gen-label-109 (lambda () (string #\i))) (syntmp-wrap-subst-108 cdr) (syntmp-wrap-marks-107 car) (syntmp-make-wrap-106 cons) (syntmp-id-sym-name&marks-105 (lambda (syntmp-x-1000 syntmp-w-1001) (if (syntmp-syntax-object?-88 syntmp-x-1000) (values (let ((syntmp-e-1002 (syntmp-syntax-object-expression-89 syntmp-x-1000))) (if (annotation? syntmp-e-1002) (annotation-expression syntmp-e-1002) syntmp-e-1002)) (syntmp-join-marks-124 (syntmp-wrap-marks-107 syntmp-w-1001) (syntmp-wrap-marks-107 (syntmp-syntax-object-wrap-90 syntmp-x-1000)))) (values (let ((syntmp-e-1003 syntmp-x-1000)) (if (annotation? syntmp-e-1003) (annotation-expression syntmp-e-1003) syntmp-e-1003)) (syntmp-wrap-marks-107 syntmp-w-1001))))) (syntmp-id?-104 (lambda (syntmp-x-1004) (cond ((symbol? syntmp-x-1004) #t) ((syntmp-syntax-object?-88 syntmp-x-1004) (symbol? (let ((syntmp-e-1005 (syntmp-syntax-object-expression-89 syntmp-x-1004))) (if (annotation? syntmp-e-1005) (annotation-expression syntmp-e-1005) syntmp-e-1005)))) ((annotation? syntmp-x-1004) (symbol? (annotation-expression syntmp-x-1004))) (else #f)))) (syntmp-nonsymbol-id?-103 (lambda (syntmp-x-1006) (and (syntmp-syntax-object?-88 syntmp-x-1006) (symbol? (let ((syntmp-e-1007 (syntmp-syntax-object-expression-89 syntmp-x-1006))) (if (annotation? syntmp-e-1007) (annotation-expression syntmp-e-1007) syntmp-e-1007)))))) (syntmp-global-extend-102 (lambda (syntmp-type-1008 syntmp-sym-1009 syntmp-val-1010) (syntmp-put-global-definition-hook-79 syntmp-sym-1009 (cons syntmp-type-1008 syntmp-val-1010) (module-name (current-module))))) (syntmp-lookup-101 (lambda (syntmp-x-1011 syntmp-r-1012 syntmp-mod-1013) (cond ((assq syntmp-x-1011 syntmp-r-1012) => cdr) ((symbol? syntmp-x-1011) (or (syntmp-get-global-definition-hook-80 syntmp-x-1011 syntmp-mod-1013) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-100 (lambda (syntmp-r-1014) (if (null? syntmp-r-1014) (quote ()) (let ((syntmp-a-1015 (car syntmp-r-1014))) (if (eq? (cadr syntmp-a-1015) (quote macro)) (cons syntmp-a-1015 (syntmp-macros-only-env-100 (cdr syntmp-r-1014))) (syntmp-macros-only-env-100 (cdr syntmp-r-1014))))))) (syntmp-extend-var-env-99 (lambda (syntmp-labels-1016 syntmp-vars-1017 syntmp-r-1018) (if (null? syntmp-labels-1016) syntmp-r-1018 (syntmp-extend-var-env-99 (cdr syntmp-labels-1016) (cdr syntmp-vars-1017) (cons (cons (car syntmp-labels-1016) (cons (quote lexical) (car syntmp-vars-1017))) syntmp-r-1018))))) (syntmp-extend-env-98 (lambda (syntmp-labels-1019 syntmp-bindings-1020 syntmp-r-1021) (if (null? syntmp-labels-1019) syntmp-r-1021 (syntmp-extend-env-98 (cdr syntmp-labels-1019) (cdr syntmp-bindings-1020) (cons (cons (car syntmp-labels-1019) (car syntmp-bindings-1020)) syntmp-r-1021))))) (syntmp-binding-value-97 cdr) (syntmp-binding-type-96 car) (syntmp-source-annotation-95 (lambda (syntmp-x-1022) (cond ((annotation? syntmp-x-1022) (annotation-source syntmp-x-1022)) ((syntmp-syntax-object?-88 syntmp-x-1022) (syntmp-source-annotation-95 (syntmp-syntax-object-expression-89 syntmp-x-1022))) (else #f)))) (syntmp-set-syntax-object-module!-94 (lambda (syntmp-x-1023 syntmp-update-1024) (vector-set! syntmp-x-1023 3 syntmp-update-1024))) (syntmp-set-syntax-object-wrap!-93 (lambda (syntmp-x-1025 syntmp-update-1026) (vector-set! syntmp-x-1025 2 syntmp-update-1026))) (syntmp-set-syntax-object-expression!-92 (lambda (syntmp-x-1027 syntmp-update-1028) (vector-set! syntmp-x-1027 1 syntmp-update-1028))) (syntmp-syntax-object-module-91 (lambda (syntmp-x-1029) (vector-ref syntmp-x-1029 3))) (syntmp-syntax-object-wrap-90 (lambda (syntmp-x-1030) (vector-ref syntmp-x-1030 2))) (syntmp-syntax-object-expression-89 (lambda (syntmp-x-1031) (vector-ref syntmp-x-1031 1))) (syntmp-syntax-object?-88 (lambda (syntmp-x-1032) (and (vector? syntmp-x-1032) (= (vector-length syntmp-x-1032) 4) (eq? (vector-ref syntmp-x-1032 0) (quote syntax-object))))) (syntmp-make-syntax-object-87 (lambda (syntmp-expression-1033 syntmp-wrap-1034 syntmp-module-1035) (vector (quote syntax-object) syntmp-expression-1033 syntmp-wrap-1034 syntmp-module-1035))) (syntmp-build-letrec-86 (lambda (syntmp-src-1036 syntmp-vars-1037 syntmp-val-exps-1038 syntmp-body-exp-1039) (if (null? syntmp-vars-1037) (syntmp-build-annotated-81 syntmp-src-1036 syntmp-body-exp-1039) (syntmp-build-annotated-81 syntmp-src-1036 (list (quote letrec) (map list syntmp-vars-1037 syntmp-val-exps-1038) syntmp-body-exp-1039))))) (syntmp-build-named-let-85 (lambda (syntmp-src-1040 syntmp-vars-1041 syntmp-val-exps-1042 syntmp-body-exp-1043) (if (null? syntmp-vars-1041) (syntmp-build-annotated-81 syntmp-src-1040 syntmp-body-exp-1043) (syntmp-build-annotated-81 syntmp-src-1040 (list (quote let) (car syntmp-vars-1041) (map list (cdr syntmp-vars-1041) syntmp-val-exps-1042) syntmp-body-exp-1043))))) (syntmp-build-let-84 (lambda (syntmp-src-1044 syntmp-vars-1045 syntmp-val-exps-1046 syntmp-body-exp-1047) (if (null? syntmp-vars-1045) (syntmp-build-annotated-81 syntmp-src-1044 syntmp-body-exp-1047) (syntmp-build-annotated-81 syntmp-src-1044 (list (quote let) (map list syntmp-vars-1045 syntmp-val-exps-1046) syntmp-body-exp-1047))))) (syntmp-build-sequence-83 (lambda (syntmp-src-1048 syntmp-exps-1049) (if (null? (cdr syntmp-exps-1049)) (syntmp-build-annotated-81 syntmp-src-1048 (car syntmp-exps-1049)) (syntmp-build-annotated-81 syntmp-src-1048 (cons (quote begin) syntmp-exps-1049))))) (syntmp-build-data-82 (lambda (syntmp-src-1050 syntmp-exp-1051) (if (and (self-evaluating? syntmp-exp-1051) (not (vector? syntmp-exp-1051))) (syntmp-build-annotated-81 syntmp-src-1050 syntmp-exp-1051) (syntmp-build-annotated-81 syntmp-src-1050 (list (quote quote) syntmp-exp-1051))))) (syntmp-build-annotated-81 (lambda (syntmp-src-1052 syntmp-exp-1053) (if (and syntmp-src-1052 (not (annotation? syntmp-exp-1053))) (make-annotation syntmp-exp-1053 syntmp-src-1052 #t) syntmp-exp-1053))) (syntmp-get-global-definition-hook-80 (lambda (syntmp-symbol-1054 syntmp-module-1055) (let ((syntmp-module-1056 (if syntmp-module-1055 (resolve-module syntmp-module-1055) (warn "wha" syntmp-symbol-1054 (current-module))))) (let ((syntmp-v-1057 (module-variable syntmp-module-1056 syntmp-symbol-1054))) (and syntmp-v-1057 (or (object-property syntmp-v-1057 (quote *sc-expander*)) (and (variable-bound? syntmp-v-1057) (macro? (variable-ref syntmp-v-1057)) (macro-transformer (variable-ref syntmp-v-1057)) guile-macro))))))) (syntmp-put-global-definition-hook-79 (lambda (syntmp-symbol-1058 syntmp-binding-1059 syntmp-module-1060) (let ((syntmp-module-1061 (if syntmp-module-1060 (resolve-module syntmp-module-1060) (warn "wha" syntmp-symbol-1058 (current-module))))) (let ((syntmp-v-1062 (or (module-variable syntmp-module-1061 syntmp-symbol-1058) (let ((syntmp-v-1063 (make-variable sc-macro))) (begin (module-add! syntmp-module-1061 syntmp-symbol-1058 syntmp-v-1063) syntmp-v-1063))))) (begin (if (not (and (symbol-property syntmp-symbol-1058 (quote primitive-syntax)) (eq? syntmp-module-1061 the-syncase-module))) (variable-set! syntmp-v-1062 sc-macro)) (set-object-property! syntmp-v-1062 (quote *sc-expander*) syntmp-binding-1059)))))) (syntmp-error-hook-78 (lambda (syntmp-who-1064 syntmp-why-1065 syntmp-what-1066) (error syntmp-who-1064 "~a ~s" syntmp-why-1065 syntmp-what-1066))) (syntmp-local-eval-hook-77 (lambda (syntmp-x-1067 syntmp-mod-1068) (eval (list syntmp-noexpand-71 syntmp-x-1067) (if syntmp-mod-1068 (resolve-module syntmp-mod-1068) (interaction-environment))))) (syntmp-top-level-eval-hook-76 (lambda (syntmp-x-1069 syntmp-mod-1070) (eval (list syntmp-noexpand-71 syntmp-x-1069) (if syntmp-mod-1070 (resolve-module syntmp-mod-1070) (interaction-environment))))) (syntmp-fx<-75 <) (syntmp-fx=-74 =) (syntmp-fx--73 -) (syntmp-fx+-72 +) (syntmp-noexpand-71 "noexpand")) (begin (syntmp-global-extend-102 (quote local-syntax) (quote letrec-syntax) #t) (syntmp-global-extend-102 (quote local-syntax) (quote let-syntax) #f) (syntmp-global-extend-102 (quote core) (quote fluid-let-syntax) (lambda (syntmp-e-1071 syntmp-r-1072 syntmp-w-1073 syntmp-s-1074 syntmp-mod-1075) ((lambda (syntmp-tmp-1076) ((lambda (syntmp-tmp-1077) (if (if syntmp-tmp-1077 (apply (lambda (syntmp-_-1078 syntmp-var-1079 syntmp-val-1080 syntmp-e1-1081 syntmp-e2-1082) (syntmp-valid-bound-ids?-129 syntmp-var-1079)) syntmp-tmp-1077) #f) (apply (lambda (syntmp-_-1084 syntmp-var-1085 syntmp-val-1086 syntmp-e1-1087 syntmp-e2-1088) (let ((syntmp-names-1089 (map (lambda (syntmp-x-1090) (syntmp-id-var-name-126 syntmp-x-1090 syntmp-w-1073)) syntmp-var-1085))) (begin (for-each (lambda (syntmp-id-1092 syntmp-n-1093) (let ((syntmp-t-1094 (syntmp-binding-type-96 (syntmp-lookup-101 syntmp-n-1093 syntmp-r-1072 syntmp-mod-1075)))) (if (memv syntmp-t-1094 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-133 syntmp-id-1092 syntmp-w-1073 syntmp-s-1074 syntmp-mod-1075) "identifier out of context")))) syntmp-var-1085 syntmp-names-1089) (syntmp-chi-body-144 (cons syntmp-e1-1087 syntmp-e2-1088) (syntmp-source-wrap-133 syntmp-e-1071 syntmp-w-1073 syntmp-s-1074 syntmp-mod-1075) (syntmp-extend-env-98 syntmp-names-1089 (let ((syntmp-trans-r-1097 (syntmp-macros-only-env-100 syntmp-r-1072))) (map (lambda (syntmp-x-1098) (cons (quote macro) (syntmp-eval-local-transformer-147 (syntmp-chi-140 syntmp-x-1098 syntmp-trans-r-1097 syntmp-w-1073 syntmp-mod-1075) syntmp-mod-1075))) syntmp-val-1086)) syntmp-r-1072) syntmp-w-1073 syntmp-mod-1075)))) syntmp-tmp-1077) ((lambda (syntmp-_-1100) (syntax-error (syntmp-source-wrap-133 syntmp-e-1071 syntmp-w-1073 syntmp-s-1074 syntmp-mod-1075))) syntmp-tmp-1076))) (syntax-dispatch syntmp-tmp-1076 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1071))) (syntmp-global-extend-102 (quote core) (quote quote) (lambda (syntmp-e-1101 syntmp-r-1102 syntmp-w-1103 syntmp-s-1104 syntmp-mod-1105) ((lambda (syntmp-tmp-1106) ((lambda (syntmp-tmp-1107) (if syntmp-tmp-1107 (apply (lambda (syntmp-_-1108 syntmp-e-1109) (syntmp-build-data-82 syntmp-s-1104 (syntmp-strip-151 syntmp-e-1109 syntmp-w-1103))) syntmp-tmp-1107) ((lambda (syntmp-_-1110) (syntax-error (syntmp-source-wrap-133 syntmp-e-1101 syntmp-w-1103 syntmp-s-1104 syntmp-mod-1105))) syntmp-tmp-1106))) (syntax-dispatch syntmp-tmp-1106 (quote (any any))))) syntmp-e-1101))) (syntmp-global-extend-102 (quote core) (quote syntax) (letrec ((syntmp-regen-1118 (lambda (syntmp-x-1119) (let ((syntmp-t-1120 (car syntmp-x-1119))) (if (memv syntmp-t-1120 (quote (ref))) (syntmp-build-annotated-81 #f (cadr syntmp-x-1119)) (if (memv syntmp-t-1120 (quote (primitive))) (syntmp-build-annotated-81 #f (cadr syntmp-x-1119)) (if (memv syntmp-t-1120 (quote (quote))) (syntmp-build-data-82 #f (cadr syntmp-x-1119)) (if (memv syntmp-t-1120 (quote (lambda))) (syntmp-build-annotated-81 #f (list (quote lambda) (cadr syntmp-x-1119) (syntmp-regen-1118 (caddr syntmp-x-1119)))) (if (memv syntmp-t-1120 (quote (map))) (let ((syntmp-ls-1121 (map syntmp-regen-1118 (cdr syntmp-x-1119)))) (syntmp-build-annotated-81 #f (cons (if (syntmp-fx=-74 (length syntmp-ls-1121) 2) (syntmp-build-annotated-81 #f (quote map)) (syntmp-build-annotated-81 #f (quote map))) syntmp-ls-1121))) (syntmp-build-annotated-81 #f (cons (syntmp-build-annotated-81 #f (car syntmp-x-1119)) (map syntmp-regen-1118 (cdr syntmp-x-1119)))))))))))) (syntmp-gen-vector-1117 (lambda (syntmp-x-1122) (cond ((eq? (car syntmp-x-1122) (quote list)) (cons (quote vector) (cdr syntmp-x-1122))) ((eq? (car syntmp-x-1122) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1122)))) (else (list (quote list->vector) syntmp-x-1122))))) (syntmp-gen-append-1116 (lambda (syntmp-x-1123 syntmp-y-1124) (if (equal? syntmp-y-1124 (quote (quote ()))) syntmp-x-1123 (list (quote append) syntmp-x-1123 syntmp-y-1124)))) (syntmp-gen-cons-1115 (lambda (syntmp-x-1125 syntmp-y-1126) (let ((syntmp-t-1127 (car syntmp-y-1126))) (if (memv syntmp-t-1127 (quote (quote))) (if (eq? (car syntmp-x-1125) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1125) (cadr syntmp-y-1126))) (if (eq? (cadr syntmp-y-1126) (quote ())) (list (quote list) syntmp-x-1125) (list (quote cons) syntmp-x-1125 syntmp-y-1126))) (if (memv syntmp-t-1127 (quote (list))) (cons (quote list) (cons syntmp-x-1125 (cdr syntmp-y-1126))) (list (quote cons) syntmp-x-1125 syntmp-y-1126)))))) (syntmp-gen-map-1114 (lambda (syntmp-e-1128 syntmp-map-env-1129) (let ((syntmp-formals-1130 (map cdr syntmp-map-env-1129)) (syntmp-actuals-1131 (map (lambda (syntmp-x-1132) (list (quote ref) (car syntmp-x-1132))) syntmp-map-env-1129))) (cond ((eq? (car syntmp-e-1128) (quote ref)) (car syntmp-actuals-1131)) ((andmap (lambda (syntmp-x-1133) (and (eq? (car syntmp-x-1133) (quote ref)) (memq (cadr syntmp-x-1133) syntmp-formals-1130))) (cdr syntmp-e-1128)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1128)) (map (let ((syntmp-r-1134 (map cons syntmp-formals-1130 syntmp-actuals-1131))) (lambda (syntmp-x-1135) (cdr (assq (cadr syntmp-x-1135) syntmp-r-1134)))) (cdr syntmp-e-1128))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1130 syntmp-e-1128) syntmp-actuals-1131))))))) (syntmp-gen-mappend-1113 (lambda (syntmp-e-1136 syntmp-map-env-1137) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1114 syntmp-e-1136 syntmp-map-env-1137)))) (syntmp-gen-ref-1112 (lambda (syntmp-src-1138 syntmp-var-1139 syntmp-level-1140 syntmp-maps-1141) (if (syntmp-fx=-74 syntmp-level-1140 0) (values syntmp-var-1139 syntmp-maps-1141) (if (null? syntmp-maps-1141) (syntax-error syntmp-src-1138 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1112 syntmp-src-1138 syntmp-var-1139 (syntmp-fx--73 syntmp-level-1140 1) (cdr syntmp-maps-1141))) (lambda (syntmp-outer-var-1142 syntmp-outer-maps-1143) (let ((syntmp-b-1144 (assq syntmp-outer-var-1142 (car syntmp-maps-1141)))) (if syntmp-b-1144 (values (cdr syntmp-b-1144) syntmp-maps-1141) (let ((syntmp-inner-var-1145 (syntmp-gen-var-152 (quote tmp)))) (values syntmp-inner-var-1145 (cons (cons (cons syntmp-outer-var-1142 syntmp-inner-var-1145) (car syntmp-maps-1141)) syntmp-outer-maps-1143))))))))))) (syntmp-gen-syntax-1111 (lambda (syntmp-src-1146 syntmp-e-1147 syntmp-r-1148 syntmp-maps-1149 syntmp-ellipsis?-1150 syntmp-mod-1151) (if (syntmp-id?-104 syntmp-e-1147) (let ((syntmp-label-1152 (syntmp-id-var-name-126 syntmp-e-1147 (quote (()))))) (let ((syntmp-b-1153 (syntmp-lookup-101 syntmp-label-1152 syntmp-r-1148 syntmp-mod-1151))) (if (eq? (syntmp-binding-type-96 syntmp-b-1153) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1154 (syntmp-binding-value-97 syntmp-b-1153))) (syntmp-gen-ref-1112 syntmp-src-1146 (car syntmp-var.lev-1154) (cdr syntmp-var.lev-1154) syntmp-maps-1149))) (lambda (syntmp-var-1155 syntmp-maps-1156) (values (list (quote ref) syntmp-var-1155) syntmp-maps-1156))) (if (syntmp-ellipsis?-1150 syntmp-e-1147) (syntax-error syntmp-src-1146 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1147) syntmp-maps-1149))))) ((lambda (syntmp-tmp-1157) ((lambda (syntmp-tmp-1158) (if (if syntmp-tmp-1158 (apply (lambda (syntmp-dots-1159 syntmp-e-1160) (syntmp-ellipsis?-1150 syntmp-dots-1159)) syntmp-tmp-1158) #f) (apply (lambda (syntmp-dots-1161 syntmp-e-1162) (syntmp-gen-syntax-1111 syntmp-src-1146 syntmp-e-1162 syntmp-r-1148 syntmp-maps-1149 (lambda (syntmp-x-1163) #f) syntmp-mod-1151)) syntmp-tmp-1158) ((lambda (syntmp-tmp-1164) (if (if syntmp-tmp-1164 (apply (lambda (syntmp-x-1165 syntmp-dots-1166 syntmp-y-1167) (syntmp-ellipsis?-1150 syntmp-dots-1166)) syntmp-tmp-1164) #f) (apply (lambda (syntmp-x-1168 syntmp-dots-1169 syntmp-y-1170) (let syntmp-f-1171 ((syntmp-y-1172 syntmp-y-1170) (syntmp-k-1173 (lambda (syntmp-maps-1174) (call-with-values (lambda () (syntmp-gen-syntax-1111 syntmp-src-1146 syntmp-x-1168 syntmp-r-1148 (cons (quote ()) syntmp-maps-1174) syntmp-ellipsis?-1150 syntmp-mod-1151)) (lambda (syntmp-x-1175 syntmp-maps-1176) (if (null? (car syntmp-maps-1176)) (syntax-error syntmp-src-1146 "extra ellipsis in syntax form") (values (syntmp-gen-map-1114 syntmp-x-1175 (car syntmp-maps-1176)) (cdr syntmp-maps-1176)))))))) ((lambda (syntmp-tmp-1177) ((lambda (syntmp-tmp-1178) (if (if syntmp-tmp-1178 (apply (lambda (syntmp-dots-1179 syntmp-y-1180) (syntmp-ellipsis?-1150 syntmp-dots-1179)) syntmp-tmp-1178) #f) (apply (lambda (syntmp-dots-1181 syntmp-y-1182) (syntmp-f-1171 syntmp-y-1182 (lambda (syntmp-maps-1183) (call-with-values (lambda () (syntmp-k-1173 (cons (quote ()) syntmp-maps-1183))) (lambda (syntmp-x-1184 syntmp-maps-1185) (if (null? (car syntmp-maps-1185)) (syntax-error syntmp-src-1146 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1113 syntmp-x-1184 (car syntmp-maps-1185)) (cdr syntmp-maps-1185)))))))) syntmp-tmp-1178) ((lambda (syntmp-_-1186) (call-with-values (lambda () (syntmp-gen-syntax-1111 syntmp-src-1146 syntmp-y-1172 syntmp-r-1148 syntmp-maps-1149 syntmp-ellipsis?-1150 syntmp-mod-1151)) (lambda (syntmp-y-1187 syntmp-maps-1188) (call-with-values (lambda () (syntmp-k-1173 syntmp-maps-1188)) (lambda (syntmp-x-1189 syntmp-maps-1190) (values (syntmp-gen-append-1116 syntmp-x-1189 syntmp-y-1187) syntmp-maps-1190)))))) syntmp-tmp-1177))) (syntax-dispatch syntmp-tmp-1177 (quote (any . any))))) syntmp-y-1172))) syntmp-tmp-1164) ((lambda (syntmp-tmp-1191) (if syntmp-tmp-1191 (apply (lambda (syntmp-x-1192 syntmp-y-1193) (call-with-values (lambda () (syntmp-gen-syntax-1111 syntmp-src-1146 syntmp-x-1192 syntmp-r-1148 syntmp-maps-1149 syntmp-ellipsis?-1150 syntmp-mod-1151)) (lambda (syntmp-x-1194 syntmp-maps-1195) (call-with-values (lambda () (syntmp-gen-syntax-1111 syntmp-src-1146 syntmp-y-1193 syntmp-r-1148 syntmp-maps-1195 syntmp-ellipsis?-1150 syntmp-mod-1151)) (lambda (syntmp-y-1196 syntmp-maps-1197) (values (syntmp-gen-cons-1115 syntmp-x-1194 syntmp-y-1196) syntmp-maps-1197)))))) syntmp-tmp-1191) ((lambda (syntmp-tmp-1198) (if syntmp-tmp-1198 (apply (lambda (syntmp-e1-1199 syntmp-e2-1200) (call-with-values (lambda () (syntmp-gen-syntax-1111 syntmp-src-1146 (cons syntmp-e1-1199 syntmp-e2-1200) syntmp-r-1148 syntmp-maps-1149 syntmp-ellipsis?-1150 syntmp-mod-1151)) (lambda (syntmp-e-1202 syntmp-maps-1203) (values (syntmp-gen-vector-1117 syntmp-e-1202) syntmp-maps-1203)))) syntmp-tmp-1198) ((lambda (syntmp-_-1204) (values (list (quote quote) syntmp-e-1147) syntmp-maps-1149)) syntmp-tmp-1157))) (syntax-dispatch syntmp-tmp-1157 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1157 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1157 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1157 (quote (any any))))) syntmp-e-1147))))) (lambda (syntmp-e-1205 syntmp-r-1206 syntmp-w-1207 syntmp-s-1208 syntmp-mod-1209) (let ((syntmp-e-1210 (syntmp-source-wrap-133 syntmp-e-1205 syntmp-w-1207 syntmp-s-1208 syntmp-mod-1209))) ((lambda (syntmp-tmp-1211) ((lambda (syntmp-tmp-1212) (if syntmp-tmp-1212 (apply (lambda (syntmp-_-1213 syntmp-x-1214) (call-with-values (lambda () (syntmp-gen-syntax-1111 syntmp-e-1210 syntmp-x-1214 syntmp-r-1206 (quote ()) syntmp-ellipsis?-149 syntmp-mod-1209)) (lambda (syntmp-e-1215 syntmp-maps-1216) (syntmp-regen-1118 syntmp-e-1215)))) syntmp-tmp-1212) ((lambda (syntmp-_-1217) (syntax-error syntmp-e-1210)) syntmp-tmp-1211))) (syntax-dispatch syntmp-tmp-1211 (quote (any any))))) syntmp-e-1210))))) (syntmp-global-extend-102 (quote core) (quote lambda) (lambda (syntmp-e-1218 syntmp-r-1219 syntmp-w-1220 syntmp-s-1221 syntmp-mod-1222) ((lambda (syntmp-tmp-1223) ((lambda (syntmp-tmp-1224) (if syntmp-tmp-1224 (apply (lambda (syntmp-_-1225 syntmp-c-1226) (syntmp-chi-lambda-clause-145 (syntmp-source-wrap-133 syntmp-e-1218 syntmp-w-1220 syntmp-s-1221 syntmp-mod-1222) syntmp-c-1226 syntmp-r-1219 syntmp-w-1220 syntmp-mod-1222 (lambda (syntmp-vars-1227 syntmp-body-1228) (syntmp-build-annotated-81 syntmp-s-1221 (list (quote lambda) syntmp-vars-1227 syntmp-body-1228))))) syntmp-tmp-1224) (syntax-error syntmp-tmp-1223))) (syntax-dispatch syntmp-tmp-1223 (quote (any . any))))) syntmp-e-1218))) (syntmp-global-extend-102 (quote core) (quote let) (letrec ((syntmp-chi-let-1229 (lambda (syntmp-e-1230 syntmp-r-1231 syntmp-w-1232 syntmp-s-1233 syntmp-mod-1234 syntmp-constructor-1235 syntmp-ids-1236 syntmp-vals-1237 syntmp-exps-1238) (if (not (syntmp-valid-bound-ids?-129 syntmp-ids-1236)) (syntax-error syntmp-e-1230 "duplicate bound variable in") (let ((syntmp-labels-1239 (syntmp-gen-labels-110 syntmp-ids-1236)) (syntmp-new-vars-1240 (map syntmp-gen-var-152 syntmp-ids-1236))) (let ((syntmp-nw-1241 (syntmp-make-binding-wrap-121 syntmp-ids-1236 syntmp-labels-1239 syntmp-w-1232)) (syntmp-nr-1242 (syntmp-extend-var-env-99 syntmp-labels-1239 syntmp-new-vars-1240 syntmp-r-1231))) (syntmp-constructor-1235 syntmp-s-1233 syntmp-new-vars-1240 (map (lambda (syntmp-x-1243) (syntmp-chi-140 syntmp-x-1243 syntmp-r-1231 syntmp-w-1232 syntmp-mod-1234)) syntmp-vals-1237) (syntmp-chi-body-144 syntmp-exps-1238 (syntmp-source-wrap-133 syntmp-e-1230 syntmp-nw-1241 syntmp-s-1233 syntmp-mod-1234) syntmp-nr-1242 syntmp-nw-1241 syntmp-mod-1234)))))))) (lambda (syntmp-e-1244 syntmp-r-1245 syntmp-w-1246 syntmp-s-1247 syntmp-mod-1248) ((lambda (syntmp-tmp-1249) ((lambda (syntmp-tmp-1250) (if syntmp-tmp-1250 (apply (lambda (syntmp-_-1251 syntmp-id-1252 syntmp-val-1253 syntmp-e1-1254 syntmp-e2-1255) (syntmp-chi-let-1229 syntmp-e-1244 syntmp-r-1245 syntmp-w-1246 syntmp-s-1247 syntmp-mod-1248 syntmp-build-let-84 syntmp-id-1252 syntmp-val-1253 (cons syntmp-e1-1254 syntmp-e2-1255))) syntmp-tmp-1250) ((lambda (syntmp-tmp-1259) (if (if syntmp-tmp-1259 (apply (lambda (syntmp-_-1260 syntmp-f-1261 syntmp-id-1262 syntmp-val-1263 syntmp-e1-1264 syntmp-e2-1265) (syntmp-id?-104 syntmp-f-1261)) syntmp-tmp-1259) #f) (apply (lambda (syntmp-_-1266 syntmp-f-1267 syntmp-id-1268 syntmp-val-1269 syntmp-e1-1270 syntmp-e2-1271) (syntmp-chi-let-1229 syntmp-e-1244 syntmp-r-1245 syntmp-w-1246 syntmp-s-1247 syntmp-mod-1248 syntmp-build-named-let-85 (cons syntmp-f-1267 syntmp-id-1268) syntmp-val-1269 (cons syntmp-e1-1270 syntmp-e2-1271))) syntmp-tmp-1259) ((lambda (syntmp-_-1275) (syntax-error (syntmp-source-wrap-133 syntmp-e-1244 syntmp-w-1246 syntmp-s-1247 syntmp-mod-1248))) syntmp-tmp-1249))) (syntax-dispatch syntmp-tmp-1249 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1249 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1244)))) (syntmp-global-extend-102 (quote core) (quote letrec) (lambda (syntmp-e-1276 syntmp-r-1277 syntmp-w-1278 syntmp-s-1279 syntmp-mod-1280) ((lambda (syntmp-tmp-1281) ((lambda (syntmp-tmp-1282) (if syntmp-tmp-1282 (apply (lambda (syntmp-_-1283 syntmp-id-1284 syntmp-val-1285 syntmp-e1-1286 syntmp-e2-1287) (let ((syntmp-ids-1288 syntmp-id-1284)) (if (not (syntmp-valid-bound-ids?-129 syntmp-ids-1288)) (syntax-error syntmp-e-1276 "duplicate bound variable in") (let ((syntmp-labels-1290 (syntmp-gen-labels-110 syntmp-ids-1288)) (syntmp-new-vars-1291 (map syntmp-gen-var-152 syntmp-ids-1288))) (let ((syntmp-w-1292 (syntmp-make-binding-wrap-121 syntmp-ids-1288 syntmp-labels-1290 syntmp-w-1278)) (syntmp-r-1293 (syntmp-extend-var-env-99 syntmp-labels-1290 syntmp-new-vars-1291 syntmp-r-1277))) (syntmp-build-letrec-86 syntmp-s-1279 syntmp-new-vars-1291 (map (lambda (syntmp-x-1294) (syntmp-chi-140 syntmp-x-1294 syntmp-r-1293 syntmp-w-1292 syntmp-mod-1280)) syntmp-val-1285) (syntmp-chi-body-144 (cons syntmp-e1-1286 syntmp-e2-1287) (syntmp-source-wrap-133 syntmp-e-1276 syntmp-w-1292 syntmp-s-1279 syntmp-mod-1280) syntmp-r-1293 syntmp-w-1292 syntmp-mod-1280))))))) syntmp-tmp-1282) ((lambda (syntmp-_-1297) (syntax-error (syntmp-source-wrap-133 syntmp-e-1276 syntmp-w-1278 syntmp-s-1279 syntmp-mod-1280))) syntmp-tmp-1281))) (syntax-dispatch syntmp-tmp-1281 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1276))) (syntmp-global-extend-102 (quote core) (quote set!) (lambda (syntmp-e-1298 syntmp-r-1299 syntmp-w-1300 syntmp-s-1301 syntmp-mod-1302) ((lambda (syntmp-tmp-1303) ((lambda (syntmp-tmp-1304) (if (if syntmp-tmp-1304 (apply (lambda (syntmp-_-1305 syntmp-id-1306 syntmp-val-1307) (syntmp-id?-104 syntmp-id-1306)) syntmp-tmp-1304) #f) (apply (lambda (syntmp-_-1308 syntmp-id-1309 syntmp-val-1310) (let ((syntmp-val-1311 (syntmp-chi-140 syntmp-val-1310 syntmp-r-1299 syntmp-w-1300 syntmp-mod-1302)) (syntmp-n-1312 (syntmp-id-var-name-126 syntmp-id-1309 syntmp-w-1300))) (let ((syntmp-b-1313 (syntmp-lookup-101 syntmp-n-1312 syntmp-r-1299 syntmp-mod-1302))) (let ((syntmp-t-1314 (syntmp-binding-type-96 syntmp-b-1313))) (if (memv syntmp-t-1314 (quote (lexical))) (syntmp-build-annotated-81 syntmp-s-1301 (list (quote set!) (syntmp-binding-value-97 syntmp-b-1313) syntmp-val-1311)) (if (memv syntmp-t-1314 (quote (global))) (syntmp-build-annotated-81 syntmp-s-1301 (list (quote set!) (make-module-ref syntmp-mod-1302 syntmp-n-1312 #f) syntmp-val-1311)) (if (memv syntmp-t-1314 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-132 syntmp-id-1309 syntmp-w-1300 syntmp-mod-1302) "identifier out of context") (syntax-error (syntmp-source-wrap-133 syntmp-e-1298 syntmp-w-1300 syntmp-s-1301 syntmp-mod-1302))))))))) syntmp-tmp-1304) ((lambda (syntmp-tmp-1315) (if syntmp-tmp-1315 (apply (lambda (syntmp-_-1316 syntmp-head-1317 syntmp-tail-1318 syntmp-val-1319) (call-with-values (lambda () (syntmp-syntax-type-138 syntmp-head-1317 syntmp-r-1299 (quote (())) #f #f syntmp-mod-1302)) (lambda (syntmp-type-1320 syntmp-value-1321 syntmp-ee-1322 syntmp-ww-1323 syntmp-ss-1324 syntmp-modmod-1325) (let ((syntmp-t-1326 syntmp-type-1320)) (if (memv syntmp-t-1326 (quote (module-ref))) (call-with-values (lambda () (syntmp-value-1321 (cons syntmp-head-1317 syntmp-tail-1318))) (lambda (syntmp-id-1328 syntmp-mod-1329) (syntmp-build-annotated-81 syntmp-s-1301 (list (quote set!) (make-module-ref syntmp-mod-1329 syntmp-id-1328 #f) syntmp-val-1319)))) (syntmp-build-annotated-81 syntmp-s-1301 (cons (syntmp-chi-140 (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-1317) syntmp-r-1299 syntmp-w-1300 syntmp-mod-1302) (map (lambda (syntmp-e-1330) (syntmp-chi-140 syntmp-e-1330 syntmp-r-1299 syntmp-w-1300 syntmp-mod-1302)) (append syntmp-tail-1318 (list syntmp-val-1319)))))))))) syntmp-tmp-1315) ((lambda (syntmp-_-1332) (syntax-error (syntmp-source-wrap-133 syntmp-e-1298 syntmp-w-1300 syntmp-s-1301 syntmp-mod-1302))) syntmp-tmp-1303))) (syntax-dispatch syntmp-tmp-1303 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1303 (quote (any any any))))) syntmp-e-1298))) (syntmp-global-extend-102 (quote module-ref) (quote @) (lambda (syntmp-e-1333) ((lambda (syntmp-tmp-1334) ((lambda (syntmp-tmp-1335) (if (if syntmp-tmp-1335 (apply (lambda (syntmp-_-1336 syntmp-mod-1337 syntmp-id-1338) (and (andmap syntmp-id?-104 syntmp-mod-1337) (syntmp-id?-104 syntmp-id-1338))) syntmp-tmp-1335) #f) (apply (lambda (syntmp-_-1340 syntmp-mod-1341 syntmp-id-1342) (values (syntax-object->datum syntmp-id-1342) (syntax-object->datum (append syntmp-mod-1341 (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-1335) (syntax-error syntmp-tmp-1334))) (syntax-dispatch syntmp-tmp-1334 (quote (any each-any any))))) syntmp-e-1333))) (syntmp-global-extend-102 (quote module-ref) (quote @@) (lambda (syntmp-e-1344) ((lambda (syntmp-tmp-1345) ((lambda (syntmp-tmp-1346) (if (if syntmp-tmp-1346 (apply (lambda (syntmp-_-1347 syntmp-mod-1348 syntmp-id-1349) (and (andmap syntmp-id?-104 syntmp-mod-1348) (syntmp-id?-104 syntmp-id-1349))) syntmp-tmp-1346) #f) (apply (lambda (syntmp-_-1351 syntmp-mod-1352 syntmp-id-1353) (values (syntax-object->datum syntmp-id-1353) (syntax-object->datum syntmp-mod-1352))) syntmp-tmp-1346) (syntax-error syntmp-tmp-1345))) (syntax-dispatch syntmp-tmp-1345 (quote (any each-any any))))) syntmp-e-1344))) (syntmp-global-extend-102 (quote begin) (quote begin) (quote ())) (syntmp-global-extend-102 (quote define) (quote define) (quote ())) (syntmp-global-extend-102 (quote define-syntax) (quote define-syntax) (quote ())) (syntmp-global-extend-102 (quote eval-when) (quote eval-when) (quote ())) (syntmp-global-extend-102 (quote core) (quote syntax-case) (letrec ((syntmp-gen-syntax-case-1358 (lambda (syntmp-x-1359 syntmp-keys-1360 syntmp-clauses-1361 syntmp-r-1362 syntmp-mod-1363) (if (null? syntmp-clauses-1361) (syntmp-build-annotated-81 #f (list (syntmp-build-annotated-81 #f (quote syntax-error)) syntmp-x-1359)) ((lambda (syntmp-tmp-1364) ((lambda (syntmp-tmp-1365) (if syntmp-tmp-1365 (apply (lambda (syntmp-pat-1366 syntmp-exp-1367) (if (and (syntmp-id?-104 syntmp-pat-1366) (andmap (lambda (syntmp-x-1368) (not (syntmp-free-id=?-127 syntmp-pat-1366 syntmp-x-1368))) (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-1360))) (let ((syntmp-labels-1369 (list (syntmp-gen-label-109))) (syntmp-var-1370 (syntmp-gen-var-152 syntmp-pat-1366))) (syntmp-build-annotated-81 #f (list (syntmp-build-annotated-81 #f (list (quote lambda) (list syntmp-var-1370) (syntmp-chi-140 syntmp-exp-1367 (syntmp-extend-env-98 syntmp-labels-1369 (list (cons (quote syntax) (cons syntmp-var-1370 0))) syntmp-r-1362) (syntmp-make-binding-wrap-121 (list syntmp-pat-1366) syntmp-labels-1369 (quote (()))) syntmp-mod-1363))) syntmp-x-1359))) (syntmp-gen-clause-1357 syntmp-x-1359 syntmp-keys-1360 (cdr syntmp-clauses-1361) syntmp-r-1362 syntmp-pat-1366 #t syntmp-exp-1367 syntmp-mod-1363))) syntmp-tmp-1365) ((lambda (syntmp-tmp-1371) (if syntmp-tmp-1371 (apply (lambda (syntmp-pat-1372 syntmp-fender-1373 syntmp-exp-1374) (syntmp-gen-clause-1357 syntmp-x-1359 syntmp-keys-1360 (cdr syntmp-clauses-1361) syntmp-r-1362 syntmp-pat-1372 syntmp-fender-1373 syntmp-exp-1374 syntmp-mod-1363)) syntmp-tmp-1371) ((lambda (syntmp-_-1375) (syntax-error (car syntmp-clauses-1361) "invalid syntax-case clause")) syntmp-tmp-1364))) (syntax-dispatch syntmp-tmp-1364 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1364 (quote (any any))))) (car syntmp-clauses-1361))))) (syntmp-gen-clause-1357 (lambda (syntmp-x-1376 syntmp-keys-1377 syntmp-clauses-1378 syntmp-r-1379 syntmp-pat-1380 syntmp-fender-1381 syntmp-exp-1382 syntmp-mod-1383) (call-with-values (lambda () (syntmp-convert-pattern-1355 syntmp-pat-1380 syntmp-keys-1377)) (lambda (syntmp-p-1384 syntmp-pvars-1385) (cond ((not (syntmp-distinct-bound-ids?-130 (map car syntmp-pvars-1385))) (syntax-error syntmp-pat-1380 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1386) (not (syntmp-ellipsis?-149 (car syntmp-x-1386)))) syntmp-pvars-1385)) (syntax-error syntmp-pat-1380 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1387 (syntmp-gen-var-152 (quote tmp)))) (syntmp-build-annotated-81 #f (list (syntmp-build-annotated-81 #f (list (quote lambda) (list syntmp-y-1387) (let ((syntmp-y-1388 (syntmp-build-annotated-81 #f syntmp-y-1387))) (syntmp-build-annotated-81 #f (list (quote if) ((lambda (syntmp-tmp-1389) ((lambda (syntmp-tmp-1390) (if syntmp-tmp-1390 (apply (lambda () syntmp-y-1388) syntmp-tmp-1390) ((lambda (syntmp-_-1391) (syntmp-build-annotated-81 #f (list (quote if) syntmp-y-1388 (syntmp-build-dispatch-call-1356 syntmp-pvars-1385 syntmp-fender-1381 syntmp-y-1388 syntmp-r-1379 syntmp-mod-1383) (syntmp-build-data-82 #f #f)))) syntmp-tmp-1389))) (syntax-dispatch syntmp-tmp-1389 (quote #(atom #t))))) syntmp-fender-1381) (syntmp-build-dispatch-call-1356 syntmp-pvars-1385 syntmp-exp-1382 syntmp-y-1388 syntmp-r-1379 syntmp-mod-1383) (syntmp-gen-syntax-case-1358 syntmp-x-1376 syntmp-keys-1377 syntmp-clauses-1378 syntmp-r-1379 syntmp-mod-1383)))))) (if (eq? syntmp-p-1384 (quote any)) (syntmp-build-annotated-81 #f (list (syntmp-build-annotated-81 #f (quote list)) syntmp-x-1376)) (syntmp-build-annotated-81 #f (list (syntmp-build-annotated-81 #f (quote syntax-dispatch)) syntmp-x-1376 (syntmp-build-data-82 #f syntmp-p-1384))))))))))))) (syntmp-build-dispatch-call-1356 (lambda (syntmp-pvars-1392 syntmp-exp-1393 syntmp-y-1394 syntmp-r-1395 syntmp-mod-1396) (let ((syntmp-ids-1397 (map car syntmp-pvars-1392)) (syntmp-levels-1398 (map cdr syntmp-pvars-1392))) (let ((syntmp-labels-1399 (syntmp-gen-labels-110 syntmp-ids-1397)) (syntmp-new-vars-1400 (map syntmp-gen-var-152 syntmp-ids-1397))) (syntmp-build-annotated-81 #f (list (syntmp-build-annotated-81 #f (quote apply)) (syntmp-build-annotated-81 #f (list (quote lambda) syntmp-new-vars-1400 (syntmp-chi-140 syntmp-exp-1393 (syntmp-extend-env-98 syntmp-labels-1399 (map (lambda (syntmp-var-1401 syntmp-level-1402) (cons (quote syntax) (cons syntmp-var-1401 syntmp-level-1402))) syntmp-new-vars-1400 (map cdr syntmp-pvars-1392)) syntmp-r-1395) (syntmp-make-binding-wrap-121 syntmp-ids-1397 syntmp-labels-1399 (quote (()))) syntmp-mod-1396))) syntmp-y-1394)))))) (syntmp-convert-pattern-1355 (lambda (syntmp-pattern-1403 syntmp-keys-1404) (let syntmp-cvt-1405 ((syntmp-p-1406 syntmp-pattern-1403) (syntmp-n-1407 0) (syntmp-ids-1408 (quote ()))) (if (syntmp-id?-104 syntmp-p-1406) (if (syntmp-bound-id-member?-131 syntmp-p-1406 syntmp-keys-1404) (values (vector (quote free-id) syntmp-p-1406) syntmp-ids-1408) (values (quote any) (cons (cons syntmp-p-1406 syntmp-n-1407) syntmp-ids-1408))) ((lambda (syntmp-tmp-1409) ((lambda (syntmp-tmp-1410) (if (if syntmp-tmp-1410 (apply (lambda (syntmp-x-1411 syntmp-dots-1412) (syntmp-ellipsis?-149 syntmp-dots-1412)) syntmp-tmp-1410) #f) (apply (lambda (syntmp-x-1413 syntmp-dots-1414) (call-with-values (lambda () (syntmp-cvt-1405 syntmp-x-1413 (syntmp-fx+-72 syntmp-n-1407 1) syntmp-ids-1408)) (lambda (syntmp-p-1415 syntmp-ids-1416) (values (if (eq? syntmp-p-1415 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1415)) syntmp-ids-1416)))) syntmp-tmp-1410) ((lambda (syntmp-tmp-1417) (if syntmp-tmp-1417 (apply (lambda (syntmp-x-1418 syntmp-y-1419) (call-with-values (lambda () (syntmp-cvt-1405 syntmp-y-1419 syntmp-n-1407 syntmp-ids-1408)) (lambda (syntmp-y-1420 syntmp-ids-1421) (call-with-values (lambda () (syntmp-cvt-1405 syntmp-x-1418 syntmp-n-1407 syntmp-ids-1421)) (lambda (syntmp-x-1422 syntmp-ids-1423) (values (cons syntmp-x-1422 syntmp-y-1420) syntmp-ids-1423)))))) syntmp-tmp-1417) ((lambda (syntmp-tmp-1424) (if syntmp-tmp-1424 (apply (lambda () (values (quote ()) syntmp-ids-1408)) syntmp-tmp-1424) ((lambda (syntmp-tmp-1425) (if syntmp-tmp-1425 (apply (lambda (syntmp-x-1426) (call-with-values (lambda () (syntmp-cvt-1405 syntmp-x-1426 syntmp-n-1407 syntmp-ids-1408)) (lambda (syntmp-p-1428 syntmp-ids-1429) (values (vector (quote vector) syntmp-p-1428) syntmp-ids-1429)))) syntmp-tmp-1425) ((lambda (syntmp-x-1430) (values (vector (quote atom) (syntmp-strip-151 syntmp-p-1406 (quote (())))) syntmp-ids-1408)) syntmp-tmp-1409))) (syntax-dispatch syntmp-tmp-1409 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1409 (quote ()))))) (syntax-dispatch syntmp-tmp-1409 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1409 (quote (any any))))) syntmp-p-1406)))))) (lambda (syntmp-e-1431 syntmp-r-1432 syntmp-w-1433 syntmp-s-1434 syntmp-mod-1435) (let ((syntmp-e-1436 (syntmp-source-wrap-133 syntmp-e-1431 syntmp-w-1433 syntmp-s-1434 syntmp-mod-1435))) ((lambda (syntmp-tmp-1437) ((lambda (syntmp-tmp-1438) (if syntmp-tmp-1438 (apply (lambda (syntmp-_-1439 syntmp-val-1440 syntmp-key-1441 syntmp-m-1442) (if (andmap (lambda (syntmp-x-1443) (and (syntmp-id?-104 syntmp-x-1443) (not (syntmp-ellipsis?-149 syntmp-x-1443)))) syntmp-key-1441) (let ((syntmp-x-1445 (syntmp-gen-var-152 (quote tmp)))) (syntmp-build-annotated-81 syntmp-s-1434 (list (syntmp-build-annotated-81 #f (list (quote lambda) (list syntmp-x-1445) (syntmp-gen-syntax-case-1358 (syntmp-build-annotated-81 #f syntmp-x-1445) syntmp-key-1441 syntmp-m-1442 syntmp-r-1432 syntmp-mod-1435))) (syntmp-chi-140 syntmp-val-1440 syntmp-r-1432 (quote (())) syntmp-mod-1435)))) (syntax-error syntmp-e-1436 "invalid literals list in"))) syntmp-tmp-1438) (syntax-error syntmp-tmp-1437))) (syntax-dispatch syntmp-tmp-1437 (quote (any any each-any . each-any))))) syntmp-e-1436))))) (set! sc-expand (let ((syntmp-m-1448 (quote e)) (syntmp-esew-1449 (quote (eval)))) (lambda (syntmp-x-1450) (if (and (pair? syntmp-x-1450) (equal? (car syntmp-x-1450) syntmp-noexpand-71)) (cadr syntmp-x-1450) (syntmp-chi-top-139 syntmp-x-1450 (quote ()) (quote ((top))) syntmp-m-1448 syntmp-esew-1449 (module-name (current-module))))))) (set! sc-expand3 (let ((syntmp-m-1451 (quote e)) (syntmp-esew-1452 (quote (eval)))) (lambda (syntmp-x-1454 . syntmp-rest-1453) (if (and (pair? syntmp-x-1454) (equal? (car syntmp-x-1454) syntmp-noexpand-71)) (cadr syntmp-x-1454) (syntmp-chi-top-139 syntmp-x-1454 (quote ()) (quote ((top))) (if (null? syntmp-rest-1453) syntmp-m-1451 (car syntmp-rest-1453)) (if (or (null? syntmp-rest-1453) (null? (cdr syntmp-rest-1453))) syntmp-esew-1452 (cadr syntmp-rest-1453)) (module-name (current-module))))))) (set! identifier? (lambda (syntmp-x-1455) (syntmp-nonsymbol-id?-103 syntmp-x-1455))) (set! datum->syntax-object (lambda (syntmp-id-1456 syntmp-datum-1457) (syntmp-make-syntax-object-87 syntmp-datum-1457 (syntmp-syntax-object-wrap-90 syntmp-id-1456) #f))) (set! syntax-object->datum (lambda (syntmp-x-1458) (syntmp-strip-151 syntmp-x-1458 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1459) (begin (let ((syntmp-x-1460 syntmp-ls-1459)) (if (not (list? syntmp-x-1460)) (syntmp-error-hook-78 (quote generate-temporaries) "invalid argument" syntmp-x-1460))) (map (lambda (syntmp-x-1461) (syntmp-wrap-132 (gensym) (quote ((top))) #f)) syntmp-ls-1459)))) (set! free-identifier=? (lambda (syntmp-x-1462 syntmp-y-1463) (begin (let ((syntmp-x-1464 syntmp-x-1462)) (if (not (syntmp-nonsymbol-id?-103 syntmp-x-1464)) (syntmp-error-hook-78 (quote free-identifier=?) "invalid argument" syntmp-x-1464))) (let ((syntmp-x-1465 syntmp-y-1463)) (if (not (syntmp-nonsymbol-id?-103 syntmp-x-1465)) (syntmp-error-hook-78 (quote free-identifier=?) "invalid argument" syntmp-x-1465))) (syntmp-free-id=?-127 syntmp-x-1462 syntmp-y-1463)))) (set! bound-identifier=? (lambda (syntmp-x-1466 syntmp-y-1467) (begin (let ((syntmp-x-1468 syntmp-x-1466)) (if (not (syntmp-nonsymbol-id?-103 syntmp-x-1468)) (syntmp-error-hook-78 (quote bound-identifier=?) "invalid argument" syntmp-x-1468))) (let ((syntmp-x-1469 syntmp-y-1467)) (if (not (syntmp-nonsymbol-id?-103 syntmp-x-1469)) (syntmp-error-hook-78 (quote bound-identifier=?) "invalid argument" syntmp-x-1469))) (syntmp-bound-id=?-128 syntmp-x-1466 syntmp-y-1467)))) (set! syntax-error (lambda (syntmp-object-1471 . syntmp-messages-1470) (begin (for-each (lambda (syntmp-x-1472) (let ((syntmp-x-1473 syntmp-x-1472)) (if (not (string? syntmp-x-1473)) (syntmp-error-hook-78 (quote syntax-error) "invalid argument" syntmp-x-1473)))) syntmp-messages-1470) (let ((syntmp-message-1474 (if (null? syntmp-messages-1470) "invalid syntax" (apply string-append syntmp-messages-1470)))) (syntmp-error-hook-78 #f syntmp-message-1474 (syntmp-strip-151 syntmp-object-1471 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1475 syntmp-v-1476) (begin (let ((syntmp-x-1477 syntmp-sym-1475)) (if (not (symbol? syntmp-x-1477)) (syntmp-error-hook-78 (quote define-syntax) "invalid argument" syntmp-x-1477))) (let ((syntmp-x-1478 syntmp-v-1476)) (if (not (procedure? syntmp-x-1478)) (syntmp-error-hook-78 (quote define-syntax) "invalid argument" syntmp-x-1478))) (syntmp-global-extend-102 (quote macro) syntmp-sym-1475 syntmp-v-1476)))) (letrec ((syntmp-match-1483 (lambda (syntmp-e-1484 syntmp-p-1485 syntmp-w-1486 syntmp-r-1487 syntmp-mod-1488) (cond ((not syntmp-r-1487) #f) ((eq? syntmp-p-1485 (quote any)) (cons (syntmp-wrap-132 syntmp-e-1484 syntmp-w-1486 syntmp-mod-1488) syntmp-r-1487)) ((syntmp-syntax-object?-88 syntmp-e-1484) (syntmp-match*-1482 (let ((syntmp-e-1489 (syntmp-syntax-object-expression-89 syntmp-e-1484))) (if (annotation? syntmp-e-1489) (annotation-expression syntmp-e-1489) syntmp-e-1489)) syntmp-p-1485 (syntmp-join-wraps-123 syntmp-w-1486 (syntmp-syntax-object-wrap-90 syntmp-e-1484)) syntmp-r-1487 (syntmp-syntax-object-module-91 syntmp-e-1484))) (else (syntmp-match*-1482 (let ((syntmp-e-1490 syntmp-e-1484)) (if (annotation? syntmp-e-1490) (annotation-expression syntmp-e-1490) syntmp-e-1490)) syntmp-p-1485 syntmp-w-1486 syntmp-r-1487 syntmp-mod-1488))))) (syntmp-match*-1482 (lambda (syntmp-e-1491 syntmp-p-1492 syntmp-w-1493 syntmp-r-1494 syntmp-mod-1495) (cond ((null? syntmp-p-1492) (and (null? syntmp-e-1491) syntmp-r-1494)) ((pair? syntmp-p-1492) (and (pair? syntmp-e-1491) (syntmp-match-1483 (car syntmp-e-1491) (car syntmp-p-1492) syntmp-w-1493 (syntmp-match-1483 (cdr syntmp-e-1491) (cdr syntmp-p-1492) syntmp-w-1493 syntmp-r-1494 syntmp-mod-1495) syntmp-mod-1495))) ((eq? syntmp-p-1492 (quote each-any)) (let ((syntmp-l-1496 (syntmp-match-each-any-1480 syntmp-e-1491 syntmp-w-1493 syntmp-mod-1495))) (and syntmp-l-1496 (cons syntmp-l-1496 syntmp-r-1494)))) (else (let ((syntmp-t-1497 (vector-ref syntmp-p-1492 0))) (if (memv syntmp-t-1497 (quote (each))) (if (null? syntmp-e-1491) (syntmp-match-empty-1481 (vector-ref syntmp-p-1492 1) syntmp-r-1494) (let ((syntmp-l-1498 (syntmp-match-each-1479 syntmp-e-1491 (vector-ref syntmp-p-1492 1) syntmp-w-1493 syntmp-mod-1495))) (and syntmp-l-1498 (let syntmp-collect-1499 ((syntmp-l-1500 syntmp-l-1498)) (if (null? (car syntmp-l-1500)) syntmp-r-1494 (cons (map car syntmp-l-1500) (syntmp-collect-1499 (map cdr syntmp-l-1500)))))))) (if (memv syntmp-t-1497 (quote (free-id))) (and (syntmp-id?-104 syntmp-e-1491) (syntmp-free-id=?-127 (syntmp-wrap-132 syntmp-e-1491 syntmp-w-1493 syntmp-mod-1495) (vector-ref syntmp-p-1492 1)) syntmp-r-1494) (if (memv syntmp-t-1497 (quote (atom))) (and (equal? (vector-ref syntmp-p-1492 1) (syntmp-strip-151 syntmp-e-1491 syntmp-w-1493)) syntmp-r-1494) (if (memv syntmp-t-1497 (quote (vector))) (and (vector? syntmp-e-1491) (syntmp-match-1483 (vector->list syntmp-e-1491) (vector-ref syntmp-p-1492 1) syntmp-w-1493 syntmp-r-1494 syntmp-mod-1495))))))))))) (syntmp-match-empty-1481 (lambda (syntmp-p-1501 syntmp-r-1502) (cond ((null? syntmp-p-1501) syntmp-r-1502) ((eq? syntmp-p-1501 (quote any)) (cons (quote ()) syntmp-r-1502)) ((pair? syntmp-p-1501) (syntmp-match-empty-1481 (car syntmp-p-1501) (syntmp-match-empty-1481 (cdr syntmp-p-1501) syntmp-r-1502))) ((eq? syntmp-p-1501 (quote each-any)) (cons (quote ()) syntmp-r-1502)) (else (let ((syntmp-t-1503 (vector-ref syntmp-p-1501 0))) (if (memv syntmp-t-1503 (quote (each))) (syntmp-match-empty-1481 (vector-ref syntmp-p-1501 1) syntmp-r-1502) (if (memv syntmp-t-1503 (quote (free-id atom))) syntmp-r-1502 (if (memv syntmp-t-1503 (quote (vector))) (syntmp-match-empty-1481 (vector-ref syntmp-p-1501 1) syntmp-r-1502))))))))) (syntmp-match-each-any-1480 (lambda (syntmp-e-1504 syntmp-w-1505 syntmp-mod-1506) (cond ((annotation? syntmp-e-1504) (syntmp-match-each-any-1480 (annotation-expression syntmp-e-1504) syntmp-w-1505 syntmp-mod-1506)) ((pair? syntmp-e-1504) (let ((syntmp-l-1507 (syntmp-match-each-any-1480 (cdr syntmp-e-1504) syntmp-w-1505 syntmp-mod-1506))) (and syntmp-l-1507 (cons (syntmp-wrap-132 (car syntmp-e-1504) syntmp-w-1505 syntmp-mod-1506) syntmp-l-1507)))) ((null? syntmp-e-1504) (quote ())) ((syntmp-syntax-object?-88 syntmp-e-1504) (syntmp-match-each-any-1480 (syntmp-syntax-object-expression-89 syntmp-e-1504) (syntmp-join-wraps-123 syntmp-w-1505 (syntmp-syntax-object-wrap-90 syntmp-e-1504)) syntmp-mod-1506)) (else #f)))) (syntmp-match-each-1479 (lambda (syntmp-e-1508 syntmp-p-1509 syntmp-w-1510 syntmp-mod-1511) (cond ((annotation? syntmp-e-1508) (syntmp-match-each-1479 (annotation-expression syntmp-e-1508) syntmp-p-1509 syntmp-w-1510 syntmp-mod-1511)) ((pair? syntmp-e-1508) (let ((syntmp-first-1512 (syntmp-match-1483 (car syntmp-e-1508) syntmp-p-1509 syntmp-w-1510 (quote ()) syntmp-mod-1511))) (and syntmp-first-1512 (let ((syntmp-rest-1513 (syntmp-match-each-1479 (cdr syntmp-e-1508) syntmp-p-1509 syntmp-w-1510 syntmp-mod-1511))) (and syntmp-rest-1513 (cons syntmp-first-1512 syntmp-rest-1513)))))) ((null? syntmp-e-1508) (quote ())) ((syntmp-syntax-object?-88 syntmp-e-1508) (syntmp-match-each-1479 (syntmp-syntax-object-expression-89 syntmp-e-1508) syntmp-p-1509 (syntmp-join-wraps-123 syntmp-w-1510 (syntmp-syntax-object-wrap-90 syntmp-e-1508)) (syntmp-syntax-object-module-91 syntmp-e-1508))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1514 syntmp-p-1515) (cond ((eq? syntmp-p-1515 (quote any)) (list syntmp-e-1514)) ((syntmp-syntax-object?-88 syntmp-e-1514) (syntmp-match*-1482 (let ((syntmp-e-1516 (syntmp-syntax-object-expression-89 syntmp-e-1514))) (if (annotation? syntmp-e-1516) (annotation-expression syntmp-e-1516) syntmp-e-1516)) syntmp-p-1515 (syntmp-syntax-object-wrap-90 syntmp-e-1514) (quote ()) (syntmp-syntax-object-module-91 syntmp-e-1514))) (else (syntmp-match*-1482 (let ((syntmp-e-1517 syntmp-e-1514)) (if (annotation? syntmp-e-1517) (annotation-expression syntmp-e-1517) syntmp-e-1517)) syntmp-p-1515 (quote (())) (quote ()) #f))))) (set! sc-chi syntmp-chi-140)))))
-(install-global-transformer (quote with-syntax) (lambda (syntmp-x-1518) ((lambda (syntmp-tmp-1519) ((lambda (syntmp-tmp-1520) (if syntmp-tmp-1520 (apply (lambda (syntmp-_-1521 syntmp-e1-1522 syntmp-e2-1523) (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-1522 syntmp-e2-1523))) syntmp-tmp-1520) ((lambda (syntmp-tmp-1525) (if syntmp-tmp-1525 (apply (lambda (syntmp-_-1526 syntmp-out-1527 syntmp-in-1528 syntmp-e1-1529 syntmp-e2-1530) (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-1528 (quote ()) (list syntmp-out-1527 (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-1529 syntmp-e2-1530))))) syntmp-tmp-1525) ((lambda (syntmp-tmp-1532) (if syntmp-tmp-1532 (apply (lambda (syntmp-_-1533 syntmp-out-1534 syntmp-in-1535 syntmp-e1-1536 syntmp-e2-1537) (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-1535) (quote ()) (list syntmp-out-1534 (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-1536 syntmp-e2-1537))))) syntmp-tmp-1532) (syntax-error syntmp-tmp-1519))) (syntax-dispatch syntmp-tmp-1519 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1519 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1519 (quote (any () any . each-any))))) syntmp-x-1518)))
-(install-global-transformer (quote syntax-rules) (lambda (syntmp-x-1559) ((lambda (syntmp-tmp-1560) ((lambda (syntmp-tmp-1561) (if syntmp-tmp-1561 (apply (lambda (syntmp-_-1562 syntmp-k-1563 syntmp-keyword-1564 syntmp-pattern-1565 syntmp-template-1566) (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-1563 (map (lambda (syntmp-tmp-1569 syntmp-tmp-1568) (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-1568) (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-1569))) syntmp-template-1566 syntmp-pattern-1565)))))) syntmp-tmp-1561) (syntax-error syntmp-tmp-1560))) (syntax-dispatch syntmp-tmp-1560 (quote (any each-any . #(each ((any . any) any))))))) syntmp-x-1559)))
-(install-global-transformer (quote let*) (lambda (syntmp-x-1580) ((lambda (syntmp-tmp-1581) ((lambda (syntmp-tmp-1582) (if (if syntmp-tmp-1582 (apply (lambda (syntmp-let*-1583 syntmp-x-1584 syntmp-v-1585 syntmp-e1-1586 syntmp-e2-1587) (andmap identifier? syntmp-x-1584)) syntmp-tmp-1582) #f) (apply (lambda (syntmp-let*-1589 syntmp-x-1590 syntmp-v-1591 syntmp-e1-1592 syntmp-e2-1593) (let syntmp-f-1594 ((syntmp-bindings-1595 (map list syntmp-x-1590 syntmp-v-1591))) (if (null? syntmp-bindings-1595) (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-1592 syntmp-e2-1593))) ((lambda (syntmp-tmp-1599) ((lambda (syntmp-tmp-1600) (if syntmp-tmp-1600 (apply (lambda (syntmp-body-1601 syntmp-binding-1602) (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-1602) syntmp-body-1601)) syntmp-tmp-1600) (syntax-error syntmp-tmp-1599))) (syntax-dispatch syntmp-tmp-1599 (quote (any any))))) (list (syntmp-f-1594 (cdr syntmp-bindings-1595)) (car syntmp-bindings-1595)))))) syntmp-tmp-1582) (syntax-error syntmp-tmp-1581))) (syntax-dispatch syntmp-tmp-1581 (quote (any #(each (any any)) any . each-any))))) syntmp-x-1580)))
-(install-global-transformer (quote do) (lambda (syntmp-orig-x-1622) ((lambda (syntmp-tmp-1623) ((lambda (syntmp-tmp-1624) (if syntmp-tmp-1624 (apply (lambda (syntmp-_-1625 syntmp-var-1626 syntmp-init-1627 syntmp-step-1628 syntmp-e0-1629 syntmp-e1-1630 syntmp-c-1631) ((lambda (syntmp-tmp-1632) ((lambda (syntmp-tmp-1633) (if syntmp-tmp-1633 (apply (lambda (syntmp-step-1634) ((lambda (syntmp-tmp-1635) ((lambda (syntmp-tmp-1636) (if syntmp-tmp-1636 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) (map list syntmp-var-1626 syntmp-init-1627) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) syntmp-e0-1629) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) (append syntmp-c-1631 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) syntmp-step-1634))))))) syntmp-tmp-1636) ((lambda (syntmp-tmp-1641) (if syntmp-tmp-1641 (apply (lambda (syntmp-e1-1642 syntmp-e2-1643) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) (map list syntmp-var-1626 syntmp-init-1627) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) syntmp-e0-1629 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) (cons syntmp-e1-1642 syntmp-e2-1643)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) (append syntmp-c-1631 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (ice-9 syncase))) syntmp-step-1634))))))) syntmp-tmp-1641) (syntax-error syntmp-tmp-1635))) (syntax-dispatch syntmp-tmp-1635 (quote (any . each-any)))))) (syntax-dispatch syntmp-tmp-1635 (quote ())))) syntmp-e1-1630)) syntmp-tmp-1633) (syntax-error syntmp-tmp-1632))) (syntax-dispatch syntmp-tmp-1632 (quote each-any)))) (map (lambda (syntmp-v-1650 syntmp-s-1651) ((lambda (syntmp-tmp-1652) ((lambda (syntmp-tmp-1653) (if syntmp-tmp-1653 (apply (lambda () syntmp-v-1650) syntmp-tmp-1653) ((lambda (syntmp-tmp-1654) (if syntmp-tmp-1654 (apply (lambda (syntmp-e-1655) syntmp-e-1655) syntmp-tmp-1654) ((lambda (syntmp-_-1656) (syntax-error syntmp-orig-x-1622)) syntmp-tmp-1652))) (syntax-dispatch syntmp-tmp-1652 (quote (any)))))) (syntax-dispatch syntmp-tmp-1652 (quote ())))) syntmp-s-1651)) syntmp-var-1626 syntmp-step-1628))) syntmp-tmp-1624) (syntax-error syntmp-tmp-1623))) (syntax-dispatch syntmp-tmp-1623 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) syntmp-orig-x-1622)))
-(install-global-transformer (quote quasiquote) (letrec ((syntmp-quasicons-1684 (lambda (syntmp-x-1688 syntmp-y-1689) ((lambda (syntmp-tmp-1690) ((lambda (syntmp-tmp-1691) (if syntmp-tmp-1691 (apply (lambda (syntmp-x-1692 syntmp-y-1693) ((lambda (syntmp-tmp-1694) ((lambda (syntmp-tmp-1695) (if syntmp-tmp-1695 (apply (lambda (syntmp-dy-1696) ((lambda (syntmp-tmp-1697) ((lambda (syntmp-tmp-1698) (if syntmp-tmp-1698 (apply (lambda (syntmp-dx-1699) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) (cons syntmp-dx-1699 syntmp-dy-1696))) syntmp-tmp-1698) ((lambda (syntmp-_-1700) (if (null? syntmp-dy-1696) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) syntmp-x-1692) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) syntmp-x-1692 syntmp-y-1693))) syntmp-tmp-1697))) (syntax-dispatch syntmp-tmp-1697 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) any))))) syntmp-x-1692)) syntmp-tmp-1695) ((lambda (syntmp-tmp-1701) (if syntmp-tmp-1701 (apply (lambda (syntmp-stuff-1702) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) (cons syntmp-x-1692 syntmp-stuff-1702))) syntmp-tmp-1701) ((lambda (syntmp-else-1703) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) syntmp-x-1692 syntmp-y-1693)) syntmp-tmp-1694))) (syntax-dispatch syntmp-tmp-1694 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) . any)))))) (syntax-dispatch syntmp-tmp-1694 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) any))))) syntmp-y-1693)) syntmp-tmp-1691) (syntax-error syntmp-tmp-1690))) (syntax-dispatch syntmp-tmp-1690 (quote (any any))))) (list syntmp-x-1688 syntmp-y-1689)))) (syntmp-quasiappend-1685 (lambda (syntmp-x-1704 syntmp-y-1705) ((lambda (syntmp-tmp-1706) ((lambda (syntmp-tmp-1707) (if syntmp-tmp-1707 (apply (lambda (syntmp-x-1708 syntmp-y-1709) ((lambda (syntmp-tmp-1710) ((lambda (syntmp-tmp-1711) (if syntmp-tmp-1711 (apply (lambda () syntmp-x-1708) syntmp-tmp-1711) ((lambda (syntmp-_-1712) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) syntmp-x-1708 syntmp-y-1709)) syntmp-tmp-1710))) (syntax-dispatch syntmp-tmp-1710 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) ()))))) syntmp-y-1709)) syntmp-tmp-1707) (syntax-error syntmp-tmp-1706))) (syntax-dispatch syntmp-tmp-1706 (quote (any any))))) (list syntmp-x-1704 syntmp-y-1705)))) (syntmp-quasivector-1686 (lambda (syntmp-x-1713) ((lambda (syntmp-tmp-1714) ((lambda (syntmp-x-1715) ((lambda (syntmp-tmp-1716) ((lambda (syntmp-tmp-1717) (if syntmp-tmp-1717 (apply (lambda (syntmp-x-1718) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) (list->vector syntmp-x-1718))) syntmp-tmp-1717) ((lambda (syntmp-tmp-1720) (if syntmp-tmp-1720 (apply (lambda (syntmp-x-1721) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) syntmp-x-1721)) syntmp-tmp-1720) ((lambda (syntmp-_-1723) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) syntmp-x-1715)) syntmp-tmp-1716))) (syntax-dispatch syntmp-tmp-1716 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) . each-any)))))) (syntax-dispatch syntmp-tmp-1716 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) each-any))))) syntmp-x-1715)) syntmp-tmp-1714)) syntmp-x-1713))) (syntmp-quasi-1687 (lambda (syntmp-p-1724 syntmp-lev-1725) ((lambda (syntmp-tmp-1726) ((lambda (syntmp-tmp-1727) (if syntmp-tmp-1727 (apply (lambda (syntmp-p-1728) (if (= syntmp-lev-1725 0) syntmp-p-1728 (syntmp-quasicons-1684 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase)))) (syntmp-quasi-1687 (list syntmp-p-1728) (- syntmp-lev-1725 1))))) syntmp-tmp-1727) ((lambda (syntmp-tmp-1729) (if syntmp-tmp-1729 (apply (lambda (syntmp-p-1730 syntmp-q-1731) (if (= syntmp-lev-1725 0) (syntmp-quasiappend-1685 syntmp-p-1730 (syntmp-quasi-1687 syntmp-q-1731 syntmp-lev-1725)) (syntmp-quasicons-1684 (syntmp-quasicons-1684 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase)))) (syntmp-quasi-1687 (list syntmp-p-1730) (- syntmp-lev-1725 1))) (syntmp-quasi-1687 syntmp-q-1731 syntmp-lev-1725)))) syntmp-tmp-1729) ((lambda (syntmp-tmp-1732) (if syntmp-tmp-1732 (apply (lambda (syntmp-p-1733) (syntmp-quasicons-1684 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase)))) (syntmp-quasi-1687 (list syntmp-p-1733) (+ syntmp-lev-1725 1)))) syntmp-tmp-1732) ((lambda (syntmp-tmp-1734) (if syntmp-tmp-1734 (apply (lambda (syntmp-p-1735 syntmp-q-1736) (syntmp-quasicons-1684 (syntmp-quasi-1687 syntmp-p-1735 syntmp-lev-1725) (syntmp-quasi-1687 syntmp-q-1736 syntmp-lev-1725))) syntmp-tmp-1734) ((lambda (syntmp-tmp-1737) (if syntmp-tmp-1737 (apply (lambda (syntmp-x-1738) (syntmp-quasivector-1686 (syntmp-quasi-1687 syntmp-x-1738 syntmp-lev-1725))) syntmp-tmp-1737) ((lambda (syntmp-p-1740) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) syntmp-p-1740)) syntmp-tmp-1726))) (syntax-dispatch syntmp-tmp-1726 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1726 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1726 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) any)))))) (syntax-dispatch syntmp-tmp-1726 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) any) . any)))))) (syntax-dispatch syntmp-tmp-1726 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (ice-9 syncase))) any))))) syntmp-p-1724)))) (lambda (syntmp-x-1741) ((lambda (syntmp-tmp-1742) ((lambda (syntmp-tmp-1743) (if syntmp-tmp-1743 (apply (lambda (syntmp-_-1744 syntmp-e-1745) (syntmp-quasi-1687 syntmp-e-1745 0)) syntmp-tmp-1743) (syntax-error syntmp-tmp-1742))) (syntax-dispatch syntmp-tmp-1742 (quote (any any))))) syntmp-x-1741))))
-(install-global-transformer (quote include) (lambda (syntmp-x-1805) (letrec ((syntmp-read-file-1806 (lambda (syntmp-fn-1807 syntmp-k-1808) (let ((syntmp-p-1809 (open-input-file syntmp-fn-1807))) (let syntmp-f-1810 ((syntmp-x-1811 (read syntmp-p-1809))) (if (eof-object? syntmp-x-1811) (begin (close-input-port syntmp-p-1809) (quote ())) (cons (datum->syntax-object syntmp-k-1808 syntmp-x-1811) (syntmp-f-1810 (read syntmp-p-1809))))))))) ((lambda (syntmp-tmp-1812) ((lambda (syntmp-tmp-1813) (if syntmp-tmp-1813 (apply (lambda (syntmp-k-1814 syntmp-filename-1815) (let ((syntmp-fn-1816 (syntax-object->datum syntmp-filename-1815))) ((lambda (syntmp-tmp-1817) ((lambda (syntmp-tmp-1818) (if syntmp-tmp-1818 (apply (lambda (syntmp-exp-1819) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) syntmp-exp-1819)) syntmp-tmp-1818) (syntax-error syntmp-tmp-1817))) (syntax-dispatch syntmp-tmp-1817 (quote each-any)))) (syntmp-read-file-1806 syntmp-fn-1816 syntmp-k-1814)))) syntmp-tmp-1813) (syntax-error syntmp-tmp-1812))) (syntax-dispatch syntmp-tmp-1812 (quote (any any))))) syntmp-x-1805))))
-(install-global-transformer (quote unquote) (lambda (syntmp-x-1836) ((lambda (syntmp-tmp-1837) ((lambda (syntmp-tmp-1838) (if syntmp-tmp-1838 (apply (lambda (syntmp-_-1839 syntmp-e-1840) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1840))) syntmp-tmp-1838) (syntax-error syntmp-tmp-1837))) (syntax-dispatch syntmp-tmp-1837 (quote (any any))))) syntmp-x-1836)))
-(install-global-transformer (quote unquote-splicing) (lambda (syntmp-x-1846) ((lambda (syntmp-tmp-1847) ((lambda (syntmp-tmp-1848) (if syntmp-tmp-1848 (apply (lambda (syntmp-_-1849 syntmp-e-1850) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1850))) syntmp-tmp-1848) (syntax-error syntmp-tmp-1847))) (syntax-dispatch syntmp-tmp-1847 (quote (any any))))) syntmp-x-1846)))
-(install-global-transformer (quote case) (lambda (syntmp-x-1856) ((lambda (syntmp-tmp-1857) ((lambda (syntmp-tmp-1858) (if syntmp-tmp-1858 (apply (lambda (syntmp-_-1859 syntmp-e-1860 syntmp-m1-1861 syntmp-m2-1862) ((lambda (syntmp-tmp-1863) ((lambda (syntmp-body-1864) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) syntmp-e-1860)) syntmp-body-1864)) syntmp-tmp-1863)) (let syntmp-f-1865 ((syntmp-clause-1866 syntmp-m1-1861) (syntmp-clauses-1867 syntmp-m2-1862)) (if (null? syntmp-clauses-1867) ((lambda (syntmp-tmp-1869) ((lambda (syntmp-tmp-1870) (if syntmp-tmp-1870 (apply (lambda (syntmp-e1-1871 syntmp-e2-1872) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (cons syntmp-e1-1871 syntmp-e2-1872))) syntmp-tmp-1870) ((lambda (syntmp-tmp-1874) (if syntmp-tmp-1874 (apply (lambda (syntmp-k-1875 syntmp-e1-1876 syntmp-e2-1877) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) syntmp-k-1875)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (cons syntmp-e1-1876 syntmp-e2-1877)))) syntmp-tmp-1874) ((lambda (syntmp-_-1880) (syntax-error syntmp-x-1856)) syntmp-tmp-1869))) (syntax-dispatch syntmp-tmp-1869 (quote (each-any any . each-any)))))) (syntax-dispatch syntmp-tmp-1869 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) any . each-any))))) syntmp-clause-1866) ((lambda (syntmp-tmp-1881) ((lambda (syntmp-rest-1882) ((lambda (syntmp-tmp-1883) ((lambda (syntmp-tmp-1884) (if syntmp-tmp-1884 (apply (lambda (syntmp-k-1885 syntmp-e1-1886 syntmp-e2-1887) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) syntmp-k-1885)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (cons syntmp-e1-1886 syntmp-e2-1887)) syntmp-rest-1882)) syntmp-tmp-1884) ((lambda (syntmp-_-1890) (syntax-error syntmp-x-1856)) syntmp-tmp-1883))) (syntax-dispatch syntmp-tmp-1883 (quote (each-any any . each-any))))) syntmp-clause-1866)) syntmp-tmp-1881)) (syntmp-f-1865 (car syntmp-clauses-1867) (cdr syntmp-clauses-1867))))))) syntmp-tmp-1858) (syntax-error syntmp-tmp-1857))) (syntax-dispatch syntmp-tmp-1857 (quote (any any any . each-any))))) syntmp-x-1856)))
-(install-global-transformer (quote identifier-syntax) (lambda (syntmp-x-1920) ((lambda (syntmp-tmp-1921) ((lambda (syntmp-tmp-1922) (if syntmp-tmp-1922 (apply (lambda (syntmp-_-1923 syntmp-e-1924) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) syntmp-e-1924)) (list (cons syntmp-_-1923 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase))) (cons syntmp-e-1924 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (ice-9 syncase)))))))))) syntmp-tmp-1922) (syntax-error syntmp-tmp-1921))) (syntax-dispatch syntmp-tmp-1921 (quote (any any))))) syntmp-x-1920)))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(if #f #f)
+(letrec ((and-map*2008 (lambda (f2048 first2047 . rest2046) (let ((t2049 (null? first2047))) (if t2049 t2049 (if (null? rest2046) (letrec ((andmap2050 (lambda (first2051) (let ((x2052 (car first2051)) (first2053 (cdr first2051))) (if (null? first2053) (f2048 x2052) (if (f2048 x2052) (andmap2050 first2053) #f)))))) (andmap2050 first2047)) (letrec ((andmap2054 (lambda (first2055 rest2056) (let ((x2057 (car first2055)) (xr2058 (map car rest2056)) (first2059 (cdr first2055)) (rest2060 (map cdr rest2056))) (if (null? first2059) (apply f2048 (cons x2057 xr2058)) (if (apply f2048 (cons x2057 xr2058)) (andmap2054 first2059 rest2060) #f)))))) (andmap2054 first2047 rest2046)))))))) (letrec ((lambda-var-list2153 (lambda (vars2282) (letrec ((lvl2283 (lambda (vars2284 ls2285 w2286) (if (pair? vars2284) (lvl2283 (cdr vars2284) (cons (wrap2132 (car vars2284) w2286 #f) ls2285) w2286) (if (id?2104 vars2284) (cons (wrap2132 vars2284 w2286 #f) ls2285) (if (null? vars2284) ls2285 (if (syntax-object?2088 vars2284) (lvl2283 (syntax-object-expression2089 vars2284) ls2285 (join-wraps2123 w2286 (syntax-object-wrap2090 vars2284))) (if (annotation? vars2284) (lvl2283 (annotation-expression vars2284) ls2285 w2286) (cons vars2284 ls2285))))))))) (lvl2283 vars2282 (quote ()) (quote (())))))) (gen-var2152 (lambda (id2287) (let ((id2288 (if (syntax-object?2088 id2287) (syntax-object-expression2089 id2287) id2287))) (if (annotation? id2288) (gensym (symbol->string (annotation-expression id2288))) (gensym (symbol->string id2288)))))) (strip2151 (lambda (x2289 w2290) (if (memq (quote top) (wrap-marks2107 w2290)) (if (let ((t2291 (annotation? x2289))) (if t2291 t2291 (if (pair? x2289) (annotation? (car x2289)) #f))) (strip-annotation2150 x2289 #f) x2289) (letrec ((f2292 (lambda (x2293) (if (syntax-object?2088 x2293) (strip2151 (syntax-object-expression2089 x2293) (syntax-object-wrap2090 x2293)) (if (pair? x2293) (let ((a2294 (f2292 (car x2293))) (d2295 (f2292 (cdr x2293)))) (if (if (eq? a2294 (car x2293)) (eq? d2295 (cdr x2293)) #f) x2293 (cons a2294 d2295))) (if (vector? x2293) (let ((old2296 (vector->list x2293))) (let ((new2297 (map f2292 old2296))) (if (and-map*2008 eq? old2296 new2297) x2293 (list->vector new2297)))) x2293)))))) (f2292 x2289))))) (strip-annotation2150 (lambda (x2298 parent2299) (if (pair? x2298) (let ((new2300 (cons #f #f))) (begin (if parent2299 (set-annotation-stripped! parent2299 new2300) (if #f #f)) (set-car! new2300 (strip-annotation2150 (car x2298) #f)) (set-cdr! new2300 (strip-annotation2150 (cdr x2298) #f)) new2300)) (if (annotation? x2298) (let ((t2301 (annotation-stripped x2298))) (if t2301 t2301 (strip-annotation2150 (annotation-expression x2298) x2298))) (if (vector? x2298) (let ((new2302 (make-vector (vector-length x2298)))) (begin (if parent2299 (set-annotation-stripped! parent2299 new2302) (if #f #f)) (letrec ((loop2303 (lambda (i2304) (unless (fx<2066 i2304 0) (vector-set! new2302 i2304 (strip-annotation2150 (vector-ref x2298 i2304) #f)) (loop2303 (fx-2064 i2304 1)))))) (loop2303 (- (vector-length x2298) 1))) new2302)) x2298))))) (ellipsis?2149 (lambda (x2305) (if (nonsymbol-id?2103 x2305) (free-id=?2127 x2305 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void2148 (lambda () (build-void2071 #f))) (eval-local-transformer2147 (lambda (expanded2306 mod2307) (let ((p2308 (local-eval-hook2068 expanded2306 mod2307))) (if (procedure? p2308) p2308 (syntax-violation #f "nonprocedure transformer" p2308))))) (chi-local-syntax2146 (lambda (rec?2309 e2310 r2311 w2312 s2313 mod2314 k2315) ((lambda (tmp2316) ((lambda (tmp2317) (if tmp2317 (apply (lambda (_2318 id2319 val2320 e12321 e22322) (let ((ids2323 id2319)) (if (not (valid-bound-ids?2129 ids2323)) (syntax-violation #f "duplicate bound keyword" e2310) (let ((labels2325 (gen-labels2110 ids2323))) (let ((new-w2326 (make-binding-wrap2121 ids2323 labels2325 w2312))) (k2315 (cons e12321 e22322) (extend-env2098 labels2325 (let ((w2328 (if rec?2309 new-w2326 w2312)) (trans-r2329 (macros-only-env2100 r2311))) (map (lambda (x2330) (cons (quote macro) (eval-local-transformer2147 (chi2140 x2330 trans-r2329 w2328 mod2314) mod2314))) val2320)) r2311) new-w2326 s2313 mod2314)))))) tmp2317) ((lambda (_2332) (syntax-violation #f "bad local syntax definition" (source-wrap2133 e2310 w2312 s2313 mod2314))) tmp2316))) ($sc-dispatch tmp2316 (quote (any #(each (any any)) any . each-any))))) e2310))) (chi-lambda-clause2145 (lambda (e2333 docstring2334 c2335 r2336 w2337 mod2338 k2339) ((lambda (tmp2340) ((lambda (tmp2341) (if (if tmp2341 (apply (lambda (args2342 doc2343 e12344 e22345) (if (string? (syntax->datum doc2343)) (not docstring2334) #f)) tmp2341) #f) (apply (lambda (args2346 doc2347 e12348 e22349) (chi-lambda-clause2145 e2333 doc2347 (cons args2346 (cons e12348 e22349)) r2336 w2337 mod2338 k2339)) tmp2341) ((lambda (tmp2351) (if tmp2351 (apply (lambda (id2352 e12353 e22354) (let ((ids2355 id2352)) (if (not (valid-bound-ids?2129 ids2355)) (syntax-violation (quote lambda) "invalid parameter list" e2333) (let ((labels2357 (gen-labels2110 ids2355)) (new-vars2358 (map gen-var2152 ids2355))) (k2339 (map syntax->datum ids2355) new-vars2358 docstring2334 (chi-body2144 (cons e12353 e22354) e2333 (extend-var-env2099 labels2357 new-vars2358 r2336) (make-binding-wrap2121 ids2355 labels2357 w2337) mod2338)))))) tmp2351) ((lambda (tmp2360) (if tmp2360 (apply (lambda (ids2361 e12362 e22363) (let ((old-ids2364 (lambda-var-list2153 ids2361))) (if (not (valid-bound-ids?2129 old-ids2364)) (syntax-violation (quote lambda) "invalid parameter list" e2333) (let ((labels2365 (gen-labels2110 old-ids2364)) (new-vars2366 (map gen-var2152 old-ids2364))) (k2339 (letrec ((f2367 (lambda (ls12368 ls22369) (if (null? ls12368) (syntax->datum ls22369) (f2367 (cdr ls12368) (cons (syntax->datum (car ls12368)) ls22369)))))) (f2367 (cdr old-ids2364) (car old-ids2364))) (letrec ((f2370 (lambda (ls12371 ls22372) (if (null? ls12371) ls22372 (f2370 (cdr ls12371) (cons (car ls12371) ls22372)))))) (f2370 (cdr new-vars2366) (car new-vars2366))) docstring2334 (chi-body2144 (cons e12362 e22363) e2333 (extend-var-env2099 labels2365 new-vars2366 r2336) (make-binding-wrap2121 old-ids2364 labels2365 w2337) mod2338)))))) tmp2360) ((lambda (_2374) (syntax-violation (quote lambda) "bad lambda" e2333)) tmp2340))) ($sc-dispatch tmp2340 (quote (any any . each-any)))))) ($sc-dispatch tmp2340 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2340 (quote (any any any . each-any))))) c2335))) (chi-body2144 (lambda (body2375 outer-form2376 r2377 w2378 mod2379) (let ((r2380 (cons (quote ("placeholder" placeholder)) r2377))) (let ((ribcage2381 (make-ribcage2111 (quote ()) (quote ()) (quote ())))) (let ((w2382 (make-wrap2106 (wrap-marks2107 w2378) (cons ribcage2381 (wrap-subst2108 w2378))))) (letrec ((parse2383 (lambda (body2384 ids2385 labels2386 vars2387 vals2388 bindings2389) (if (null? body2384) (syntax-violation #f "no expressions in body" outer-form2376) (let ((e2391 (cdar body2384)) (er2392 (caar body2384))) (call-with-values (lambda () (syntax-type2138 e2391 er2392 (quote (())) #f ribcage2381 mod2379)) (lambda (type2393 value2394 e2395 w2396 s2397 mod2398) (if (memv type2393 (quote (define-form))) (let ((id2399 (wrap2132 value2394 w2396 mod2398)) (label2400 (gen-label2109))) (let ((var2401 (gen-var2152 id2399))) (begin (extend-ribcage!2120 ribcage2381 id2399 label2400) (parse2383 (cdr body2384) (cons id2399 ids2385) (cons label2400 labels2386) (cons var2401 vars2387) (cons (cons er2392 (wrap2132 e2395 w2396 mod2398)) vals2388) (cons (cons (quote lexical) var2401) bindings2389))))) (if (memv type2393 (quote (define-syntax-form))) (let ((id2402 (wrap2132 value2394 w2396 mod2398)) (label2403 (gen-label2109))) (begin (extend-ribcage!2120 ribcage2381 id2402 label2403) (parse2383 (cdr body2384) (cons id2402 ids2385) (cons label2403 labels2386) vars2387 vals2388 (cons (cons (quote macro) (cons er2392 (wrap2132 e2395 w2396 mod2398))) bindings2389)))) (if (memv type2393 (quote (begin-form))) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda (_2406 e12407) (parse2383 (letrec ((f2408 (lambda (forms2409) (if (null? forms2409) (cdr body2384) (cons (cons er2392 (wrap2132 (car forms2409) w2396 mod2398)) (f2408 (cdr forms2409))))))) (f2408 e12407)) ids2385 labels2386 vars2387 vals2388 bindings2389)) tmp2405) (syntax-violation #f "source expression failed to match any pattern" tmp2404))) ($sc-dispatch tmp2404 (quote (any . each-any))))) e2395) (if (memv type2393 (quote (local-syntax-form))) (chi-local-syntax2146 value2394 e2395 er2392 w2396 s2397 mod2398 (lambda (forms2411 er2412 w2413 s2414 mod2415) (parse2383 (letrec ((f2416 (lambda (forms2417) (if (null? forms2417) (cdr body2384) (cons (cons er2412 (wrap2132 (car forms2417) w2413 mod2415)) (f2416 (cdr forms2417))))))) (f2416 forms2411)) ids2385 labels2386 vars2387 vals2388 bindings2389))) (if (null? ids2385) (build-sequence2083 #f (map (lambda (x2418) (chi2140 (cdr x2418) (car x2418) (quote (())) mod2398)) (cons (cons er2392 (source-wrap2133 e2395 w2396 s2397 mod2398)) (cdr body2384)))) (begin (if (not (valid-bound-ids?2129 ids2385)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form2376) (if #f #f)) (letrec ((loop2419 (lambda (bs2420 er-cache2421 r-cache2422) (if (not (null? bs2420)) (let ((b2423 (car bs2420))) (if (eq? (car b2423) (quote macro)) (let ((er2424 (cadr b2423))) (let ((r-cache2425 (if (eq? er2424 er-cache2421) r-cache2422 (macros-only-env2100 er2424)))) (begin (set-cdr! b2423 (eval-local-transformer2147 (chi2140 (cddr b2423) r-cache2425 (quote (())) mod2398) mod2398)) (loop2419 (cdr bs2420) er2424 r-cache2425)))) (loop2419 (cdr bs2420) er-cache2421 r-cache2422))) (if #f #f))))) (loop2419 bindings2389 #f #f)) (set-cdr! r2380 (extend-env2098 labels2386 bindings2389 (cdr r2380))) (build-letrec2086 #f (map syntax->datum ids2385) vars2387 (map (lambda (x2426) (chi2140 (cdr x2426) (car x2426) (quote (())) mod2398)) vals2388) (build-sequence2083 #f (map (lambda (x2427) (chi2140 (cdr x2427) (car x2427) (quote (())) mod2398)) (cons (cons er2392 (source-wrap2133 e2395 w2396 s2397 mod2398)) (cdr body2384)))))))))))))))))) (parse2383 (map (lambda (x2390) (cons r2380 (wrap2132 x2390 w2382 mod2379))) body2375) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro2143 (lambda (p2428 e2429 r2430 w2431 rib2432 mod2433) (letrec ((rebuild-macro-output2434 (lambda (x2435 m2436) (if (pair? x2435) (cons (rebuild-macro-output2434 (car x2435) m2436) (rebuild-macro-output2434 (cdr x2435) m2436)) (if (syntax-object?2088 x2435) (let ((w2437 (syntax-object-wrap2090 x2435))) (let ((ms2438 (wrap-marks2107 w2437)) (s2439 (wrap-subst2108 w2437))) (if (if (pair? ms2438) (eq? (car ms2438) #f) #f) (make-syntax-object2087 (syntax-object-expression2089 x2435) (make-wrap2106 (cdr ms2438) (if rib2432 (cons rib2432 (cdr s2439)) (cdr s2439))) (syntax-object-module2091 x2435)) (make-syntax-object2087 (syntax-object-expression2089 x2435) (make-wrap2106 (cons m2436 ms2438) (if rib2432 (cons rib2432 (cons (quote shift) s2439)) (cons (quote shift) s2439))) (let ((pmod2440 (procedure-module p2428))) (if pmod2440 (cons (quote hygiene) (module-name pmod2440)) (quote (hygiene guile)))))))) (if (vector? x2435) (let ((n2441 (vector-length x2435))) (let ((v2442 (make-vector n2441))) (letrec ((loop2443 (lambda (i2444) (if (fx=2065 i2444 n2441) (begin (if #f #f (if #f #f)) v2442) (begin (vector-set! v2442 i2444 (rebuild-macro-output2434 (vector-ref x2435 i2444) m2436)) (loop2443 (fx+2063 i2444 1))))))) (loop2443 0)))) (if (symbol? x2435) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap2133 e2429 w2431 s mod2433) x2435) x2435))))))) (rebuild-macro-output2434 (p2428 (wrap2132 e2429 (anti-mark2119 w2431) mod2433)) (string #\m))))) (chi-application2142 (lambda (x2445 e2446 r2447 w2448 s2449 mod2450) ((lambda (tmp2451) ((lambda (tmp2452) (if tmp2452 (apply (lambda (e02453 e12454) (build-application2072 s2449 x2445 (map (lambda (e2455) (chi2140 e2455 r2447 w2448 mod2450)) e12454))) tmp2452) (syntax-violation #f "source expression failed to match any pattern" tmp2451))) ($sc-dispatch tmp2451 (quote (any . each-any))))) e2446))) (chi-expr2141 (lambda (type2457 value2458 e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (lexical))) (build-lexical-reference2074 (quote value) s2462 e2459 value2458) (if (memv type2457 (quote (core external-macro))) (value2458 e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (module-ref))) (call-with-values (lambda () (value2458 e2459)) (lambda (id2464 mod2465) (build-global-reference2077 s2462 id2464 mod2465))) (if (memv type2457 (quote (lexical-call))) (chi-application2142 (build-lexical-reference2074 (quote fun) (source-annotation2095 (car e2459)) (car e2459) value2458) e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (global-call))) (chi-application2142 (build-global-reference2077 (source-annotation2095 (car e2459)) value2458 (if (syntax-object?2088 (car e2459)) (syntax-object-module2091 (car e2459)) mod2463)) e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (constant))) (build-data2082 s2462 (strip2151 (source-wrap2133 e2459 w2461 s2462 mod2463) (quote (())))) (if (memv type2457 (quote (global))) (build-global-reference2077 s2462 value2458 mod2463) (if (memv type2457 (quote (call))) (chi-application2142 (chi2140 (car e2459) r2460 w2461 mod2463) e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (begin-form))) ((lambda (tmp2466) ((lambda (tmp2467) (if tmp2467 (apply (lambda (_2468 e12469 e22470) (chi-sequence2134 (cons e12469 e22470) r2460 w2461 s2462 mod2463)) tmp2467) (syntax-violation #f "source expression failed to match any pattern" tmp2466))) ($sc-dispatch tmp2466 (quote (any any . each-any))))) e2459) (if (memv type2457 (quote (local-syntax-form))) (chi-local-syntax2146 value2458 e2459 r2460 w2461 s2462 mod2463 chi-sequence2134) (if (memv type2457 (quote (eval-when-form))) ((lambda (tmp2472) ((lambda (tmp2473) (if tmp2473 (apply (lambda (_2474 x2475 e12476 e22477) (let ((when-list2478 (chi-when-list2137 e2459 x2475 w2461))) (if (memq (quote eval) when-list2478) (chi-sequence2134 (cons e12476 e22477) r2460 w2461 s2462 mod2463) (chi-void2148)))) tmp2473) (syntax-violation #f "source expression failed to match any pattern" tmp2472))) ($sc-dispatch tmp2472 (quote (any each-any any . each-any))))) e2459) (if (memv type2457 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e2459 (wrap2132 value2458 w2461 mod2463)) (if (memv type2457 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap2133 e2459 w2461 s2462 mod2463)) (if (memv type2457 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap2133 e2459 w2461 s2462 mod2463)) (syntax-violation #f "unexpected syntax" (source-wrap2133 e2459 w2461 s2462 mod2463)))))))))))))))))) (chi2140 (lambda (e2481 r2482 w2483 mod2484) (call-with-values (lambda () (syntax-type2138 e2481 r2482 w2483 #f #f mod2484)) (lambda (type2485 value2486 e2487 w2488 s2489 mod2490) (chi-expr2141 type2485 value2486 e2487 r2482 w2488 s2489 mod2490))))) (chi-top2139 (lambda (e2491 r2492 w2493 m2494 esew2495 mod2496) (call-with-values (lambda () (syntax-type2138 e2491 r2492 w2493 #f #f mod2496)) (lambda (type2504 value2505 e2506 w2507 s2508 mod2509) (if (memv type2504 (quote (begin-form))) ((lambda (tmp2510) ((lambda (tmp2511) (if tmp2511 (apply (lambda (_2512) (chi-void2148)) tmp2511) ((lambda (tmp2513) (if tmp2513 (apply (lambda (_2514 e12515 e22516) (chi-top-sequence2135 (cons e12515 e22516) r2492 w2507 s2508 m2494 esew2495 mod2509)) tmp2513) (syntax-violation #f "source expression failed to match any pattern" tmp2510))) ($sc-dispatch tmp2510 (quote (any any . each-any)))))) ($sc-dispatch tmp2510 (quote (any))))) e2506) (if (memv type2504 (quote (local-syntax-form))) (chi-local-syntax2146 value2505 e2506 r2492 w2507 s2508 mod2509 (lambda (body2518 r2519 w2520 s2521 mod2522) (chi-top-sequence2135 body2518 r2519 w2520 s2521 m2494 esew2495 mod2522))) (if (memv type2504 (quote (eval-when-form))) ((lambda (tmp2523) ((lambda (tmp2524) (if tmp2524 (apply (lambda (_2525 x2526 e12527 e22528) (let ((when-list2529 (chi-when-list2137 e2506 x2526 w2507)) (body2530 (cons e12527 e22528))) (if (eq? m2494 (quote e)) (if (memq (quote eval) when-list2529) (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote e) (quote (eval)) mod2509) (chi-void2148)) (if (memq (quote load) when-list2529) (if (let ((t2533 (memq (quote compile) when-list2529))) (if t2533 t2533 (if (eq? m2494 (quote c&e)) (memq (quote eval) when-list2529) #f))) (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote c&e) (quote (compile load)) mod2509) (if (memq m2494 (quote (c c&e))) (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote c) (quote (load)) mod2509) (chi-void2148))) (if (let ((t2534 (memq (quote compile) when-list2529))) (if t2534 t2534 (if (eq? m2494 (quote c&e)) (memq (quote eval) when-list2529) #f))) (begin (top-level-eval-hook2067 (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote e) (quote (eval)) mod2509) mod2509) (chi-void2148)) (chi-void2148)))))) tmp2524) (syntax-violation #f "source expression failed to match any pattern" tmp2523))) ($sc-dispatch tmp2523 (quote (any each-any any . each-any))))) e2506) (if (memv type2504 (quote (define-syntax-form))) (let ((n2535 (id-var-name2126 value2505 w2507)) (r2536 (macros-only-env2100 r2492))) (if (memv m2494 (quote (c))) (if (memq (quote compile) esew2495) (let ((e2537 (chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)))) (begin (top-level-eval-hook2067 e2537 mod2509) (if (memq (quote load) esew2495) e2537 (chi-void2148)))) (if (memq (quote load) esew2495) (chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)) (chi-void2148))) (if (memv m2494 (quote (c&e))) (let ((e2538 (chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)))) (begin (top-level-eval-hook2067 e2538 mod2509) e2538)) (begin (if (memq (quote eval) esew2495) (top-level-eval-hook2067 (chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)) mod2509) (if #f #f)) (chi-void2148))))) (if (memv type2504 (quote (define-form))) (let ((n2539 (id-var-name2126 value2505 w2507))) (let ((type2540 (binding-type2096 (lookup2101 n2539 r2492 mod2509)))) (if (memv type2540 (quote (global core macro module-ref))) (let ((x2541 (build-global-definition2079 s2508 n2539 (chi2140 e2506 r2492 w2507 mod2509)))) (begin (if (eq? m2494 (quote c&e)) (top-level-eval-hook2067 x2541 mod2509) (if #f #f)) x2541)) (if (memv type2540 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e2506 (wrap2132 value2505 w2507 mod2509)) (syntax-violation #f "cannot define keyword at top level" e2506 (wrap2132 value2505 w2507 mod2509)))))) (let ((x2542 (chi-expr2141 type2504 value2505 e2506 r2492 w2507 s2508 mod2509))) (begin (if (eq? m2494 (quote c&e)) (top-level-eval-hook2067 x2542 mod2509) (if #f #f)) x2542))))))))))) (syntax-type2138 (lambda (e2543 r2544 w2545 s2546 rib2547 mod2548) (if (symbol? e2543) (let ((n2549 (id-var-name2126 e2543 w2545))) (let ((b2550 (lookup2101 n2549 r2544 mod2548))) (let ((type2551 (binding-type2096 b2550))) (if (memv type2551 (quote (lexical))) (values type2551 (binding-value2097 b2550) e2543 w2545 s2546 mod2548) (if (memv type2551 (quote (global))) (values type2551 n2549 e2543 w2545 s2546 mod2548) (if (memv type2551 (quote (macro))) (syntax-type2138 (chi-macro2143 (binding-value2097 b2550) e2543 r2544 w2545 rib2547 mod2548) r2544 (quote (())) s2546 rib2547 mod2548) (values type2551 (binding-value2097 b2550) e2543 w2545 s2546 mod2548))))))) (if (pair? e2543) (let ((first2552 (car e2543))) (if (id?2104 first2552) (let ((n2553 (id-var-name2126 first2552 w2545))) (let ((b2554 (lookup2101 n2553 r2544 (let ((t2555 (if (syntax-object?2088 first2552) (syntax-object-module2091 first2552) #f))) (if t2555 t2555 mod2548))))) (let ((type2556 (binding-type2096 b2554))) (if (memv type2556 (quote (lexical))) (values (quote lexical-call) (binding-value2097 b2554) e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (global))) (values (quote global-call) n2553 e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (macro))) (syntax-type2138 (chi-macro2143 (binding-value2097 b2554) e2543 r2544 w2545 rib2547 mod2548) r2544 (quote (())) s2546 rib2547 mod2548) (if (memv type2556 (quote (core external-macro module-ref))) (values type2556 (binding-value2097 b2554) e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value2097 b2554) e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (begin))) (values (quote begin-form) #f e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (eval-when))) (values (quote eval-when-form) #f e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (define))) ((lambda (tmp2557) ((lambda (tmp2558) (if (if tmp2558 (apply (lambda (_2559 name2560 val2561) (id?2104 name2560)) tmp2558) #f) (apply (lambda (_2562 name2563 val2564) (values (quote define-form) name2563 val2564 w2545 s2546 mod2548)) tmp2558) ((lambda (tmp2565) (if (if tmp2565 (apply (lambda (_2566 name2567 args2568 e12569 e22570) (if (id?2104 name2567) (valid-bound-ids?2129 (lambda-var-list2153 args2568)) #f)) tmp2565) #f) (apply (lambda (_2571 name2572 args2573 e12574 e22575) (values (quote define-form) (wrap2132 name2572 w2545 mod2548) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "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 () () ()) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap2132 (cons args2573 (cons e12574 e22575)) w2545 mod2548)) (quote (())) s2546 mod2548)) tmp2565) ((lambda (tmp2577) (if (if tmp2577 (apply (lambda (_2578 name2579) (id?2104 name2579)) tmp2577) #f) (apply (lambda (_2580 name2581) (values (quote define-form) (wrap2132 name2581 w2545 mod2548) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "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 () () ()) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "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 () () ()) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "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 () () ()) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s2546 mod2548)) tmp2577) (syntax-violation #f "source expression failed to match any pattern" tmp2557))) ($sc-dispatch tmp2557 (quote (any any)))))) ($sc-dispatch tmp2557 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp2557 (quote (any any any))))) e2543) (if (memv type2556 (quote (define-syntax))) ((lambda (tmp2582) ((lambda (tmp2583) (if (if tmp2583 (apply (lambda (_2584 name2585 val2586) (id?2104 name2585)) tmp2583) #f) (apply (lambda (_2587 name2588 val2589) (values (quote define-syntax-form) name2588 val2589 w2545 s2546 mod2548)) tmp2583) (syntax-violation #f "source expression failed to match any pattern" tmp2582))) ($sc-dispatch tmp2582 (quote (any any any))))) e2543) (values (quote call) #f e2543 w2545 s2546 mod2548))))))))))))) (values (quote call) #f e2543 w2545 s2546 mod2548))) (if (syntax-object?2088 e2543) (syntax-type2138 (syntax-object-expression2089 e2543) r2544 (join-wraps2123 w2545 (syntax-object-wrap2090 e2543)) #f rib2547 (let ((t2590 (syntax-object-module2091 e2543))) (if t2590 t2590 mod2548))) (if (annotation? e2543) (syntax-type2138 (annotation-expression e2543) r2544 w2545 (annotation-source e2543) rib2547 mod2548) (if (self-evaluating? e2543) (values (quote constant) #f e2543 w2545 s2546 mod2548) (values (quote other) #f e2543 w2545 s2546 mod2548)))))))) (chi-when-list2137 (lambda (e2591 when-list2592 w2593) (letrec ((f2594 (lambda (when-list2595 situations2596) (if (null? when-list2595) situations2596 (f2594 (cdr when-list2595) (cons (let ((x2597 (car when-list2595))) (if (free-id=?2127 x2597 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?2127 x2597 (quote #(syntax-object load ((top) #(ribcage () () ()) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?2127 x2597 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e2591 (wrap2132 x2597 w2593 #f)))))) situations2596)))))) (f2594 when-list2592 (quote ()))))) (chi-install-global2136 (lambda (name2598 e2599) (build-global-definition2079 #f name2598 (if (let ((v2600 (module-variable (current-module) name2598))) (if v2600 (if (variable-bound? v2600) (if (macro? (variable-ref v2600)) (not (eq? (macro-type (variable-ref v2600)) (quote syncase-macro))) #f) #f) #f)) (build-application2072 #f (build-primref2081 #f (quote make-extended-syncase-macro)) (list (build-application2072 #f (build-primref2081 #f (quote module-ref)) (list (build-application2072 #f (build-primref2081 #f (quote current-module)) (quote ())) (build-data2082 #f name2598))) (build-data2082 #f (quote macro)) e2599)) (build-application2072 #f (build-primref2081 #f (quote make-syncase-macro)) (list (build-data2082 #f (quote macro)) e2599)))))) (chi-top-sequence2135 (lambda (body2601 r2602 w2603 s2604 m2605 esew2606 mod2607) (build-sequence2083 s2604 (letrec ((dobody2608 (lambda (body2609 r2610 w2611 m2612 esew2613 mod2614) (if (null? body2609) (quote ()) (let ((first2615 (chi-top2139 (car body2609) r2610 w2611 m2612 esew2613 mod2614))) (cons first2615 (dobody2608 (cdr body2609) r2610 w2611 m2612 esew2613 mod2614))))))) (dobody2608 body2601 r2602 w2603 m2605 esew2606 mod2607))))) (chi-sequence2134 (lambda (body2616 r2617 w2618 s2619 mod2620) (build-sequence2083 s2619 (letrec ((dobody2621 (lambda (body2622 r2623 w2624 mod2625) (if (null? body2622) (quote ()) (let ((first2626 (chi2140 (car body2622) r2623 w2624 mod2625))) (cons first2626 (dobody2621 (cdr body2622) r2623 w2624 mod2625))))))) (dobody2621 body2616 r2617 w2618 mod2620))))) (source-wrap2133 (lambda (x2627 w2628 s2629 defmod2630) (wrap2132 (if s2629 (make-annotation x2627 s2629 #f) x2627) w2628 defmod2630))) (wrap2132 (lambda (x2631 w2632 defmod2633) (if (if (null? (wrap-marks2107 w2632)) (null? (wrap-subst2108 w2632)) #f) x2631 (if (syntax-object?2088 x2631) (make-syntax-object2087 (syntax-object-expression2089 x2631) (join-wraps2123 w2632 (syntax-object-wrap2090 x2631)) (syntax-object-module2091 x2631)) (if (null? x2631) x2631 (make-syntax-object2087 x2631 w2632 defmod2633)))))) (bound-id-member?2131 (lambda (x2634 list2635) (if (not (null? list2635)) (let ((t2636 (bound-id=?2128 x2634 (car list2635)))) (if t2636 t2636 (bound-id-member?2131 x2634 (cdr list2635)))) #f))) (distinct-bound-ids?2130 (lambda (ids2637) (letrec ((distinct?2638 (lambda (ids2639) (let ((t2640 (null? ids2639))) (if t2640 t2640 (if (not (bound-id-member?2131 (car ids2639) (cdr ids2639))) (distinct?2638 (cdr ids2639)) #f)))))) (distinct?2638 ids2637)))) (valid-bound-ids?2129 (lambda (ids2641) (if (letrec ((all-ids?2642 (lambda (ids2643) (let ((t2644 (null? ids2643))) (if t2644 t2644 (if (id?2104 (car ids2643)) (all-ids?2642 (cdr ids2643)) #f)))))) (all-ids?2642 ids2641)) (distinct-bound-ids?2130 ids2641) #f))) (bound-id=?2128 (lambda (i2645 j2646) (if (if (syntax-object?2088 i2645) (syntax-object?2088 j2646) #f) (if (eq? (let ((e2647 (syntax-object-expression2089 i2645))) (if (annotation? e2647) (annotation-expression e2647) e2647)) (let ((e2648 (syntax-object-expression2089 j2646))) (if (annotation? e2648) (annotation-expression e2648) e2648))) (same-marks?2125 (wrap-marks2107 (syntax-object-wrap2090 i2645)) (wrap-marks2107 (syntax-object-wrap2090 j2646))) #f) (eq? (let ((e2649 i2645)) (if (annotation? e2649) (annotation-expression e2649) e2649)) (let ((e2650 j2646)) (if (annotation? e2650) (annotation-expression e2650) e2650)))))) (free-id=?2127 (lambda (i2651 j2652) (if (eq? (let ((x2653 i2651)) (let ((e2654 (if (syntax-object?2088 x2653) (syntax-object-expression2089 x2653) x2653))) (if (annotation? e2654) (annotation-expression e2654) e2654))) (let ((x2655 j2652)) (let ((e2656 (if (syntax-object?2088 x2655) (syntax-object-expression2089 x2655) x2655))) (if (annotation? e2656) (annotation-expression e2656) e2656)))) (eq? (id-var-name2126 i2651 (quote (()))) (id-var-name2126 j2652 (quote (())))) #f))) (id-var-name2126 (lambda (id2657 w2658) (letrec ((search-vector-rib2661 (lambda (sym2667 subst2668 marks2669 symnames2670 ribcage2671) (let ((n2672 (vector-length symnames2670))) (letrec ((f2673 (lambda (i2674) (if (fx=2065 i2674 n2672) (search2659 sym2667 (cdr subst2668) marks2669) (if (if (eq? (vector-ref symnames2670 i2674) sym2667) (same-marks?2125 marks2669 (vector-ref (ribcage-marks2114 ribcage2671) i2674)) #f) (values (vector-ref (ribcage-labels2115 ribcage2671) i2674) marks2669) (f2673 (fx+2063 i2674 1))))))) (f2673 0))))) (search-list-rib2660 (lambda (sym2675 subst2676 marks2677 symnames2678 ribcage2679) (letrec ((f2680 (lambda (symnames2681 i2682) (if (null? symnames2681) (search2659 sym2675 (cdr subst2676) marks2677) (if (if (eq? (car symnames2681) sym2675) (same-marks?2125 marks2677 (list-ref (ribcage-marks2114 ribcage2679) i2682)) #f) (values (list-ref (ribcage-labels2115 ribcage2679) i2682) marks2677) (f2680 (cdr symnames2681) (fx+2063 i2682 1))))))) (f2680 symnames2678 0)))) (search2659 (lambda (sym2683 subst2684 marks2685) (if (null? subst2684) (values #f marks2685) (let ((fst2686 (car subst2684))) (if (eq? fst2686 (quote shift)) (search2659 sym2683 (cdr subst2684) (cdr marks2685)) (let ((symnames2687 (ribcage-symnames2113 fst2686))) (if (vector? symnames2687) (search-vector-rib2661 sym2683 subst2684 marks2685 symnames2687 fst2686) (search-list-rib2660 sym2683 subst2684 marks2685 symnames2687 fst2686))))))))) (if (symbol? id2657) (let ((t2688 (call-with-values (lambda () (search2659 id2657 (wrap-subst2108 w2658) (wrap-marks2107 w2658))) (lambda (x2690 . ignore2689) x2690)))) (if t2688 t2688 id2657)) (if (syntax-object?2088 id2657) (let ((id2691 (let ((e2693 (syntax-object-expression2089 id2657))) (if (annotation? e2693) (annotation-expression e2693) e2693))) (w12692 (syntax-object-wrap2090 id2657))) (let ((marks2694 (join-marks2124 (wrap-marks2107 w2658) (wrap-marks2107 w12692)))) (call-with-values (lambda () (search2659 id2691 (wrap-subst2108 w2658) marks2694)) (lambda (new-id2695 marks2696) (let ((t2697 new-id2695)) (if t2697 t2697 (let ((t2698 (call-with-values (lambda () (search2659 id2691 (wrap-subst2108 w12692) marks2696)) (lambda (x2700 . ignore2699) x2700)))) (if t2698 t2698 id2691)))))))) (if (annotation? id2657) (let ((id2701 (let ((e2702 id2657)) (if (annotation? e2702) (annotation-expression e2702) e2702)))) (let ((t2703 (call-with-values (lambda () (search2659 id2701 (wrap-subst2108 w2658) (wrap-marks2107 w2658))) (lambda (x2705 . ignore2704) x2705)))) (if t2703 t2703 id2701))) (syntax-violation (quote id-var-name) "invalid id" id2657))))))) (same-marks?2125 (lambda (x2706 y2707) (let ((t2708 (eq? x2706 y2707))) (if t2708 t2708 (if (not (null? x2706)) (if (not (null? y2707)) (if (eq? (car x2706) (car y2707)) (same-marks?2125 (cdr x2706) (cdr y2707)) #f) #f) #f))))) (join-marks2124 (lambda (m12709 m22710) (smart-append2122 m12709 m22710))) (join-wraps2123 (lambda (w12711 w22712) (let ((m12713 (wrap-marks2107 w12711)) (s12714 (wrap-subst2108 w12711))) (if (null? m12713) (if (null? s12714) w22712 (make-wrap2106 (wrap-marks2107 w22712) (smart-append2122 s12714 (wrap-subst2108 w22712)))) (make-wrap2106 (smart-append2122 m12713 (wrap-marks2107 w22712)) (smart-append2122 s12714 (wrap-subst2108 w22712))))))) (smart-append2122 (lambda (m12715 m22716) (if (null? m22716) m12715 (append m12715 m22716)))) (make-binding-wrap2121 (lambda (ids2717 labels2718 w2719) (if (null? ids2717) w2719 (make-wrap2106 (wrap-marks2107 w2719) (cons (let ((labelvec2720 (list->vector labels2718))) (let ((n2721 (vector-length labelvec2720))) (let ((symnamevec2722 (make-vector n2721)) (marksvec2723 (make-vector n2721))) (begin (letrec ((f2724 (lambda (ids2725 i2726) (if (not (null? ids2725)) (call-with-values (lambda () (id-sym-name&marks2105 (car ids2725) w2719)) (lambda (symname2727 marks2728) (begin (vector-set! symnamevec2722 i2726 symname2727) (vector-set! marksvec2723 i2726 marks2728) (f2724 (cdr ids2725) (fx+2063 i2726 1))))) (if #f #f))))) (f2724 ids2717 0)) (make-ribcage2111 symnamevec2722 marksvec2723 labelvec2720))))) (wrap-subst2108 w2719)))))) (extend-ribcage!2120 (lambda (ribcage2729 id2730 label2731) (begin (set-ribcage-symnames!2116 ribcage2729 (cons (let ((e2732 (syntax-object-expression2089 id2730))) (if (annotation? e2732) (annotation-expression e2732) e2732)) (ribcage-symnames2113 ribcage2729))) (set-ribcage-marks!2117 ribcage2729 (cons (wrap-marks2107 (syntax-object-wrap2090 id2730)) (ribcage-marks2114 ribcage2729))) (set-ribcage-labels!2118 ribcage2729 (cons label2731 (ribcage-labels2115 ribcage2729)))))) (anti-mark2119 (lambda (w2733) (make-wrap2106 (cons #f (wrap-marks2107 w2733)) (cons (quote shift) (wrap-subst2108 w2733))))) (set-ribcage-labels!2118 (lambda (x2734 update2735) (vector-set! x2734 3 update2735))) (set-ribcage-marks!2117 (lambda (x2736 update2737) (vector-set! x2736 2 update2737))) (set-ribcage-symnames!2116 (lambda (x2738 update2739) (vector-set! x2738 1 update2739))) (ribcage-labels2115 (lambda (x2740) (vector-ref x2740 3))) (ribcage-marks2114 (lambda (x2741) (vector-ref x2741 2))) (ribcage-symnames2113 (lambda (x2742) (vector-ref x2742 1))) (ribcage?2112 (lambda (x2743) (if (vector? x2743) (if (= (vector-length x2743) 4) (eq? (vector-ref x2743 0) (quote ribcage)) #f) #f))) (make-ribcage2111 (lambda (symnames2744 marks2745 labels2746) (vector (quote ribcage) symnames2744 marks2745 labels2746))) (gen-labels2110 (lambda (ls2747) (if (null? ls2747) (quote ()) (cons (gen-label2109) (gen-labels2110 (cdr ls2747)))))) (gen-label2109 (lambda () (string #\i))) (wrap-subst2108 cdr) (wrap-marks2107 car) (make-wrap2106 cons) (id-sym-name&marks2105 (lambda (x2748 w2749) (if (syntax-object?2088 x2748) (values (let ((e2750 (syntax-object-expression2089 x2748))) (if (annotation? e2750) (annotation-expression e2750) e2750)) (join-marks2124 (wrap-marks2107 w2749) (wrap-marks2107 (syntax-object-wrap2090 x2748)))) (values (let ((e2751 x2748)) (if (annotation? e2751) (annotation-expression e2751) e2751)) (wrap-marks2107 w2749))))) (id?2104 (lambda (x2752) (if (symbol? x2752) #t (if (syntax-object?2088 x2752) (symbol? (let ((e2753 (syntax-object-expression2089 x2752))) (if (annotation? e2753) (annotation-expression e2753) e2753))) (if (annotation? x2752) (symbol? (annotation-expression x2752)) #f))))) (nonsymbol-id?2103 (lambda (x2754) (if (syntax-object?2088 x2754) (symbol? (let ((e2755 (syntax-object-expression2089 x2754))) (if (annotation? e2755) (annotation-expression e2755) e2755))) #f))) (global-extend2102 (lambda (type2756 sym2757 val2758) (put-global-definition-hook2069 sym2757 type2756 val2758))) (lookup2101 (lambda (x2759 r2760 mod2761) (let ((temp2762 (assq x2759 r2760))) (if temp2762 (cdr temp2762) (if (symbol? x2759) (let ((t2763 (get-global-definition-hook2070 x2759 mod2761))) (if t2763 t2763 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env2100 (lambda (r2764) (if (null? r2764) (quote ()) (let ((a2765 (car r2764))) (if (eq? (cadr a2765) (quote macro)) (cons a2765 (macros-only-env2100 (cdr r2764))) (macros-only-env2100 (cdr r2764))))))) (extend-var-env2099 (lambda (labels2766 vars2767 r2768) (if (null? labels2766) r2768 (extend-var-env2099 (cdr labels2766) (cdr vars2767) (cons (cons (car labels2766) (cons (quote lexical) (car vars2767))) r2768))))) (extend-env2098 (lambda (labels2769 bindings2770 r2771) (if (null? labels2769) r2771 (extend-env2098 (cdr labels2769) (cdr bindings2770) (cons (cons (car labels2769) (car bindings2770)) r2771))))) (binding-value2097 cdr) (binding-type2096 car) (source-annotation2095 (lambda (x2772) (if (annotation? x2772) (annotation-source x2772) (if (syntax-object?2088 x2772) (source-annotation2095 (syntax-object-expression2089 x2772)) #f)))) (set-syntax-object-module!2094 (lambda (x2773 update2774) (vector-set! x2773 3 update2774))) (set-syntax-object-wrap!2093 (lambda (x2775 update2776) (vector-set! x2775 2 update2776))) (set-syntax-object-expression!2092 (lambda (x2777 update2778) (vector-set! x2777 1 update2778))) (syntax-object-module2091 (lambda (x2779) (vector-ref x2779 3))) (syntax-object-wrap2090 (lambda (x2780) (vector-ref x2780 2))) (syntax-object-expression2089 (lambda (x2781) (vector-ref x2781 1))) (syntax-object?2088 (lambda (x2782) (if (vector? x2782) (if (= (vector-length x2782) 4) (eq? (vector-ref x2782 0) (quote syntax-object)) #f) #f))) (make-syntax-object2087 (lambda (expression2783 wrap2784 module2785) (vector (quote syntax-object) expression2783 wrap2784 module2785))) (build-letrec2086 (lambda (src2786 ids2787 vars2788 val-exps2789 body-exp2790) (if (null? vars2788) body-exp2790 (let ((atom-key2791 (fluid-ref *mode*2062))) (if (memv atom-key2791 (quote (c))) ((@ (language tree-il) make-letrec) src2786 ids2787 vars2788 val-exps2789 body-exp2790) (list (quote letrec) (map list vars2788 val-exps2789) body-exp2790)))))) (build-named-let2085 (lambda (src2792 ids2793 vars2794 val-exps2795 body-exp2796) (let ((f2797 (car vars2794)) (f-name2798 (car ids2793)) (vars2799 (cdr vars2794)) (ids2800 (cdr ids2793))) (let ((atom-key2801 (fluid-ref *mode*2062))) (if (memv atom-key2801 (quote (c))) ((@ (language tree-il) make-letrec) src2792 (list f-name2798) (list f2797) (list (build-lambda2080 src2792 ids2800 vars2799 #f body-exp2796)) (build-application2072 src2792 (build-lexical-reference2074 (quote fun) src2792 f-name2798 f2797) val-exps2795)) (list (quote let) f2797 (map list vars2799 val-exps2795) body-exp2796)))))) (build-let2084 (lambda (src2802 ids2803 vars2804 val-exps2805 body-exp2806) (if (null? vars2804) body-exp2806 (let ((atom-key2807 (fluid-ref *mode*2062))) (if (memv atom-key2807 (quote (c))) ((@ (language tree-il) make-let) src2802 ids2803 vars2804 val-exps2805 body-exp2806) (list (quote let) (map list vars2804 val-exps2805) body-exp2806)))))) (build-sequence2083 (lambda (src2808 exps2809) (if (null? (cdr exps2809)) (car exps2809) (let ((atom-key2810 (fluid-ref *mode*2062))) (if (memv atom-key2810 (quote (c))) ((@ (language tree-il) make-sequence) src2808 exps2809) (cons (quote begin) exps2809)))))) (build-data2082 (lambda (src2811 exp2812) (let ((atom-key2813 (fluid-ref *mode*2062))) (if (memv atom-key2813 (quote (c))) ((@ (language tree-il) make-const) src2811 exp2812) (if (if (self-evaluating? exp2812) (not (vector? exp2812)) #f) exp2812 (list (quote quote) exp2812)))))) (build-primref2081 (lambda (src2814 name2815) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key2816 (fluid-ref *mode*2062))) (if (memv atom-key2816 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src2814 name2815) name2815)) (let ((atom-key2817 (fluid-ref *mode*2062))) (if (memv atom-key2817 (quote (c))) ((@ (language tree-il) make-module-ref) src2814 (quote (guile)) name2815 #f) (list (quote @@) (quote (guile)) name2815)))))) (build-lambda2080 (lambda (src2818 ids2819 vars2820 docstring2821 exp2822) (let ((atom-key2823 (fluid-ref *mode*2062))) (if (memv atom-key2823 (quote (c))) ((@ (language tree-il) make-lambda) src2818 ids2819 vars2820 (if docstring2821 (list (cons (quote documentation) docstring2821)) (quote ())) exp2822) (cons (quote lambda) (cons vars2820 (append (if docstring2821 (list docstring2821) (quote ())) (list exp2822)))))))) (build-global-definition2079 (lambda (source2824 var2825 exp2826) (let ((atom-key2827 (fluid-ref *mode*2062))) (if (memv atom-key2827 (quote (c))) ((@ (language tree-il) make-toplevel-define) source2824 var2825 exp2826) (list (quote define) var2825 exp2826))))) (build-global-assignment2078 (lambda (source2828 var2829 exp2830 mod2831) (analyze-variable2076 mod2831 var2829 (lambda (mod2832 var2833 public?2834) (let ((atom-key2835 (fluid-ref *mode*2062))) (if (memv atom-key2835 (quote (c))) ((@ (language tree-il) make-module-set) source2828 mod2832 var2833 public?2834 exp2830) (list (quote set!) (list (if public?2834 (quote @) (quote @@)) mod2832 var2833) exp2830)))) (lambda (var2836) (let ((atom-key2837 (fluid-ref *mode*2062))) (if (memv atom-key2837 (quote (c))) ((@ (language tree-il) make-toplevel-set) source2828 var2836 exp2830) (list (quote set!) var2836 exp2830))))))) (build-global-reference2077 (lambda (source2838 var2839 mod2840) (analyze-variable2076 mod2840 var2839 (lambda (mod2841 var2842 public?2843) (let ((atom-key2844 (fluid-ref *mode*2062))) (if (memv atom-key2844 (quote (c))) ((@ (language tree-il) make-module-ref) source2838 mod2841 var2842 public?2843) (list (if public?2843 (quote @) (quote @@)) mod2841 var2842)))) (lambda (var2845) (let ((atom-key2846 (fluid-ref *mode*2062))) (if (memv atom-key2846 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source2838 var2845) var2845)))))) (analyze-variable2076 (lambda (mod2847 var2848 modref-cont2849 bare-cont2850) (if (not mod2847) (bare-cont2850 var2848) (let ((kind2851 (car mod2847)) (mod2852 (cdr mod2847))) (if (memv kind2851 (quote (public))) (modref-cont2849 mod2852 var2848 #t) (if (memv kind2851 (quote (private))) (if (not (equal? mod2852 (module-name (current-module)))) (modref-cont2849 mod2852 var2848 #f) (bare-cont2850 var2848)) (if (memv kind2851 (quote (bare))) (bare-cont2850 var2848) (if (memv kind2851 (quote (hygiene))) (if (if (not (equal? mod2852 (module-name (current-module)))) (module-variable (resolve-module mod2852) var2848) #f) (modref-cont2849 mod2852 var2848 #f) (bare-cont2850 var2848)) (syntax-violation #f "bad module kind" var2848 mod2852))))))))) (build-lexical-assignment2075 (lambda (source2853 name2854 var2855 exp2856) (let ((atom-key2857 (fluid-ref *mode*2062))) (if (memv atom-key2857 (quote (c))) ((@ (language tree-il) make-lexical-set) source2853 name2854 var2855 exp2856) (list (quote set!) var2855 exp2856))))) (build-lexical-reference2074 (lambda (type2858 source2859 name2860 var2861) (let ((atom-key2862 (fluid-ref *mode*2062))) (if (memv atom-key2862 (quote (c))) ((@ (language tree-il) make-lexical-ref) source2859 name2860 var2861) var2861)))) (build-conditional2073 (lambda (source2863 test-exp2864 then-exp2865 else-exp2866) (let ((atom-key2867 (fluid-ref *mode*2062))) (if (memv atom-key2867 (quote (c))) ((@ (language tree-il) make-conditional) source2863 test-exp2864 then-exp2865 else-exp2866) (list (quote if) test-exp2864 then-exp2865 else-exp2866))))) (build-application2072 (lambda (source2868 fun-exp2869 arg-exps2870) (let ((atom-key2871 (fluid-ref *mode*2062))) (if (memv atom-key2871 (quote (c))) ((@ (language tree-il) make-application) source2868 fun-exp2869 arg-exps2870) (cons fun-exp2869 arg-exps2870))))) (build-void2071 (lambda (source2872) (let ((atom-key2873 (fluid-ref *mode*2062))) (if (memv atom-key2873 (quote (c))) ((@ (language tree-il) make-void) source2872) (quote (if #f #f)))))) (get-global-definition-hook2070 (lambda (symbol2874 module2875) (begin (if (if (not module2875) (current-module) #f) (warn "module system is booted, we should have a module" symbol2874) (if #f #f)) (let ((v2876 (module-variable (if module2875 (resolve-module (cdr module2875)) (current-module)) symbol2874))) (if v2876 (if (variable-bound? v2876) (let ((val2877 (variable-ref v2876))) (if (macro? val2877) (if (syncase-macro-type val2877) (cons (syncase-macro-type val2877) (syncase-macro-binding val2877)) #f) #f)) #f) #f))))) (put-global-definition-hook2069 (lambda (symbol2878 type2879 val2880) (let ((existing2881 (let ((v2882 (module-variable (current-module) symbol2878))) (if v2882 (if (variable-bound? v2882) (let ((val2883 (variable-ref v2882))) (if (macro? val2883) (if (not (syncase-macro-type val2883)) val2883 #f) #f)) #f) #f)))) (module-define! (current-module) symbol2878 (if existing2881 (make-extended-syncase-macro existing2881 type2879 val2880) (make-syncase-macro type2879 val2880)))))) (local-eval-hook2068 (lambda (x2884 mod2885) (primitive-eval (list noexpand2061 (let ((atom-key2886 (fluid-ref *mode*2062))) (if (memv atom-key2886 (quote (c))) ((@ (language tree-il) tree-il->scheme) x2884) x2884)))))) (top-level-eval-hook2067 (lambda (x2887 mod2888) (primitive-eval (list noexpand2061 (let ((atom-key2889 (fluid-ref *mode*2062))) (if (memv atom-key2889 (quote (c))) ((@ (language tree-il) tree-il->scheme) x2887) x2887)))))) (fx<2066 <) (fx=2065 =) (fx-2064 -) (fx+2063 +) (*mode*2062 (make-fluid)) (noexpand2061 "noexpand")) (begin (global-extend2102 (quote local-syntax) (quote letrec-syntax) #t) (global-extend2102 (quote local-syntax) (quote let-syntax) #f) (global-extend2102 (quote core) (quote fluid-let-syntax) (lambda (e2890 r2891 w2892 s2893 mod2894) ((lambda (tmp2895) ((lambda (tmp2896) (if (if tmp2896 (apply (lambda (_2897 var2898 val2899 e12900 e22901) (valid-bound-ids?2129 var2898)) tmp2896) #f) (apply (lambda (_2903 var2904 val2905 e12906 e22907) (let ((names2908 (map (lambda (x2909) (id-var-name2126 x2909 w2892)) var2904))) (begin (for-each (lambda (id2911 n2912) (let ((atom-key2913 (binding-type2096 (lookup2101 n2912 r2891 mod2894)))) (if (memv atom-key2913 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e2890 (source-wrap2133 id2911 w2892 s2893 mod2894)) (if #f #f)))) var2904 names2908) (chi-body2144 (cons e12906 e22907) (source-wrap2133 e2890 w2892 s2893 mod2894) (extend-env2098 names2908 (let ((trans-r2916 (macros-only-env2100 r2891))) (map (lambda (x2917) (cons (quote macro) (eval-local-transformer2147 (chi2140 x2917 trans-r2916 w2892 mod2894) mod2894))) val2905)) r2891) w2892 mod2894)))) tmp2896) ((lambda (_2919) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap2133 e2890 w2892 s2893 mod2894))) tmp2895))) ($sc-dispatch tmp2895 (quote (any #(each (any any)) any . each-any))))) e2890))) (global-extend2102 (quote core) (quote quote) (lambda (e2920 r2921 w2922 s2923 mod2924) ((lambda (tmp2925) ((lambda (tmp2926) (if tmp2926 (apply (lambda (_2927 e2928) (build-data2082 s2923 (strip2151 e2928 w2922))) tmp2926) ((lambda (_2929) (syntax-violation (quote quote) "bad syntax" (source-wrap2133 e2920 w2922 s2923 mod2924))) tmp2925))) ($sc-dispatch tmp2925 (quote (any any))))) e2920))) (global-extend2102 (quote core) (quote syntax) (letrec ((regen2937 (lambda (x2938) (let ((atom-key2939 (car x2938))) (if (memv atom-key2939 (quote (ref))) (build-lexical-reference2074 (quote value) #f (cadr x2938) (cadr x2938)) (if (memv atom-key2939 (quote (primitive))) (build-primref2081 #f (cadr x2938)) (if (memv atom-key2939 (quote (quote))) (build-data2082 #f (cadr x2938)) (if (memv atom-key2939 (quote (lambda))) (build-lambda2080 #f (cadr x2938) (cadr x2938) #f (regen2937 (caddr x2938))) (if (memv atom-key2939 (quote (map))) (let ((ls2940 (map regen2937 (cdr x2938)))) (build-application2072 #f (build-primref2081 #f (quote map)) ls2940)) (build-application2072 #f (build-primref2081 #f (car x2938)) (map regen2937 (cdr x2938))))))))))) (gen-vector2936 (lambda (x2941) (if (eq? (car x2941) (quote list)) (cons (quote vector) (cdr x2941)) (if (eq? (car x2941) (quote quote)) (list (quote quote) (list->vector (cadr x2941))) (list (quote list->vector) x2941))))) (gen-append2935 (lambda (x2942 y2943) (if (equal? y2943 (quote (quote ()))) x2942 (list (quote append) x2942 y2943)))) (gen-cons2934 (lambda (x2944 y2945) (let ((atom-key2946 (car y2945))) (if (memv atom-key2946 (quote (quote))) (if (eq? (car x2944) (quote quote)) (list (quote quote) (cons (cadr x2944) (cadr y2945))) (if (eq? (cadr y2945) (quote ())) (list (quote list) x2944) (list (quote cons) x2944 y2945))) (if (memv atom-key2946 (quote (list))) (cons (quote list) (cons x2944 (cdr y2945))) (list (quote cons) x2944 y2945)))))) (gen-map2933 (lambda (e2947 map-env2948) (let ((formals2949 (map cdr map-env2948)) (actuals2950 (map (lambda (x2951) (list (quote ref) (car x2951))) map-env2948))) (if (eq? (car e2947) (quote ref)) (car actuals2950) (if (and-map (lambda (x2952) (if (eq? (car x2952) (quote ref)) (memq (cadr x2952) formals2949) #f)) (cdr e2947)) (cons (quote map) (cons (list (quote primitive) (car e2947)) (map (let ((r2953 (map cons formals2949 actuals2950))) (lambda (x2954) (cdr (assq (cadr x2954) r2953)))) (cdr e2947)))) (cons (quote map) (cons (list (quote lambda) formals2949 e2947) actuals2950))))))) (gen-mappend2932 (lambda (e2955 map-env2956) (list (quote apply) (quote (primitive append)) (gen-map2933 e2955 map-env2956)))) (gen-ref2931 (lambda (src2957 var2958 level2959 maps2960) (if (fx=2065 level2959 0) (values var2958 maps2960) (if (null? maps2960) (syntax-violation (quote syntax) "missing ellipsis" src2957) (call-with-values (lambda () (gen-ref2931 src2957 var2958 (fx-2064 level2959 1) (cdr maps2960))) (lambda (outer-var2961 outer-maps2962) (let ((b2963 (assq outer-var2961 (car maps2960)))) (if b2963 (values (cdr b2963) maps2960) (let ((inner-var2964 (gen-var2152 (quote tmp)))) (values inner-var2964 (cons (cons (cons outer-var2961 inner-var2964) (car maps2960)) outer-maps2962))))))))))) (gen-syntax2930 (lambda (src2965 e2966 r2967 maps2968 ellipsis?2969 mod2970) (if (id?2104 e2966) (let ((label2971 (id-var-name2126 e2966 (quote (()))))) (let ((b2972 (lookup2101 label2971 r2967 mod2970))) (if (eq? (binding-type2096 b2972) (quote syntax)) (call-with-values (lambda () (let ((var.lev2973 (binding-value2097 b2972))) (gen-ref2931 src2965 (car var.lev2973) (cdr var.lev2973) maps2968))) (lambda (var2974 maps2975) (values (list (quote ref) var2974) maps2975))) (if (ellipsis?2969 e2966) (syntax-violation (quote syntax) "misplaced ellipsis" src2965) (values (list (quote quote) e2966) maps2968))))) ((lambda (tmp2976) ((lambda (tmp2977) (if (if tmp2977 (apply (lambda (dots2978 e2979) (ellipsis?2969 dots2978)) tmp2977) #f) (apply (lambda (dots2980 e2981) (gen-syntax2930 src2965 e2981 r2967 maps2968 (lambda (x2982) #f) mod2970)) tmp2977) ((lambda (tmp2983) (if (if tmp2983 (apply (lambda (x2984 dots2985 y2986) (ellipsis?2969 dots2985)) tmp2983) #f) (apply (lambda (x2987 dots2988 y2989) (letrec ((f2990 (lambda (y2991 k2992) ((lambda (tmp2996) ((lambda (tmp2997) (if (if tmp2997 (apply (lambda (dots2998 y2999) (ellipsis?2969 dots2998)) tmp2997) #f) (apply (lambda (dots3000 y3001) (f2990 y3001 (lambda (maps3002) (call-with-values (lambda () (k2992 (cons (quote ()) maps3002))) (lambda (x3003 maps3004) (if (null? (car maps3004)) (syntax-violation (quote syntax) "extra ellipsis" src2965) (values (gen-mappend2932 x3003 (car maps3004)) (cdr maps3004)))))))) tmp2997) ((lambda (_3005) (call-with-values (lambda () (gen-syntax2930 src2965 y2991 r2967 maps2968 ellipsis?2969 mod2970)) (lambda (y3006 maps3007) (call-with-values (lambda () (k2992 maps3007)) (lambda (x3008 maps3009) (values (gen-append2935 x3008 y3006) maps3009)))))) tmp2996))) ($sc-dispatch tmp2996 (quote (any . any))))) y2991)))) (f2990 y2989 (lambda (maps2993) (call-with-values (lambda () (gen-syntax2930 src2965 x2987 r2967 (cons (quote ()) maps2993) ellipsis?2969 mod2970)) (lambda (x2994 maps2995) (if (null? (car maps2995)) (syntax-violation (quote syntax) "extra ellipsis" src2965) (values (gen-map2933 x2994 (car maps2995)) (cdr maps2995))))))))) tmp2983) ((lambda (tmp3010) (if tmp3010 (apply (lambda (x3011 y3012) (call-with-values (lambda () (gen-syntax2930 src2965 x3011 r2967 maps2968 ellipsis?2969 mod2970)) (lambda (x3013 maps3014) (call-with-values (lambda () (gen-syntax2930 src2965 y3012 r2967 maps3014 ellipsis?2969 mod2970)) (lambda (y3015 maps3016) (values (gen-cons2934 x3013 y3015) maps3016)))))) tmp3010) ((lambda (tmp3017) (if tmp3017 (apply (lambda (e13018 e23019) (call-with-values (lambda () (gen-syntax2930 src2965 (cons e13018 e23019) r2967 maps2968 ellipsis?2969 mod2970)) (lambda (e3021 maps3022) (values (gen-vector2936 e3021) maps3022)))) tmp3017) ((lambda (_3023) (values (list (quote quote) e2966) maps2968)) tmp2976))) ($sc-dispatch tmp2976 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2976 (quote (any . any)))))) ($sc-dispatch tmp2976 (quote (any any . any)))))) ($sc-dispatch tmp2976 (quote (any any))))) e2966))))) (lambda (e3024 r3025 w3026 s3027 mod3028) (let ((e3029 (source-wrap2133 e3024 w3026 s3027 mod3028))) ((lambda (tmp3030) ((lambda (tmp3031) (if tmp3031 (apply (lambda (_3032 x3033) (call-with-values (lambda () (gen-syntax2930 e3029 x3033 r3025 (quote ()) ellipsis?2149 mod3028)) (lambda (e3034 maps3035) (regen2937 e3034)))) tmp3031) ((lambda (_3036) (syntax-violation (quote syntax) "bad `syntax' form" e3029)) tmp3030))) ($sc-dispatch tmp3030 (quote (any any))))) e3029))))) (global-extend2102 (quote core) (quote lambda) (lambda (e3037 r3038 w3039 s3040 mod3041) ((lambda (tmp3042) ((lambda (tmp3043) (if tmp3043 (apply (lambda (_3044 c3045) (chi-lambda-clause2145 (source-wrap2133 e3037 w3039 s3040 mod3041) #f c3045 r3038 w3039 mod3041 (lambda (names3046 vars3047 docstring3048 body3049) (build-lambda2080 s3040 names3046 vars3047 docstring3048 body3049)))) tmp3043) (syntax-violation #f "source expression failed to match any pattern" tmp3042))) ($sc-dispatch tmp3042 (quote (any . any))))) e3037))) (global-extend2102 (quote core) (quote let) (letrec ((chi-let3050 (lambda (e3051 r3052 w3053 s3054 mod3055 constructor3056 ids3057 vals3058 exps3059) (if (not (valid-bound-ids?2129 ids3057)) (syntax-violation (quote let) "duplicate bound variable" e3051) (let ((labels3060 (gen-labels2110 ids3057)) (new-vars3061 (map gen-var2152 ids3057))) (let ((nw3062 (make-binding-wrap2121 ids3057 labels3060 w3053)) (nr3063 (extend-var-env2099 labels3060 new-vars3061 r3052))) (constructor3056 s3054 (map syntax->datum ids3057) new-vars3061 (map (lambda (x3064) (chi2140 x3064 r3052 w3053 mod3055)) vals3058) (chi-body2144 exps3059 (source-wrap2133 e3051 nw3062 s3054 mod3055) nr3063 nw3062 mod3055)))))))) (lambda (e3065 r3066 w3067 s3068 mod3069) ((lambda (tmp3070) ((lambda (tmp3071) (if tmp3071 (apply (lambda (_3072 id3073 val3074 e13075 e23076) (chi-let3050 e3065 r3066 w3067 s3068 mod3069 build-let2084 id3073 val3074 (cons e13075 e23076))) tmp3071) ((lambda (tmp3080) (if (if tmp3080 (apply (lambda (_3081 f3082 id3083 val3084 e13085 e23086) (id?2104 f3082)) tmp3080) #f) (apply (lambda (_3087 f3088 id3089 val3090 e13091 e23092) (chi-let3050 e3065 r3066 w3067 s3068 mod3069 build-named-let2085 (cons f3088 id3089) val3090 (cons e13091 e23092))) tmp3080) ((lambda (_3096) (syntax-violation (quote let) "bad let" (source-wrap2133 e3065 w3067 s3068 mod3069))) tmp3070))) ($sc-dispatch tmp3070 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp3070 (quote (any #(each (any any)) any . each-any))))) e3065)))) (global-extend2102 (quote core) (quote letrec) (lambda (e3097 r3098 w3099 s3100 mod3101) ((lambda (tmp3102) ((lambda (tmp3103) (if tmp3103 (apply (lambda (_3104 id3105 val3106 e13107 e23108) (let ((ids3109 id3105)) (if (not (valid-bound-ids?2129 ids3109)) (syntax-violation (quote letrec) "duplicate bound variable" e3097) (let ((labels3111 (gen-labels2110 ids3109)) (new-vars3112 (map gen-var2152 ids3109))) (let ((w3113 (make-binding-wrap2121 ids3109 labels3111 w3099)) (r3114 (extend-var-env2099 labels3111 new-vars3112 r3098))) (build-letrec2086 s3100 (map syntax->datum ids3109) new-vars3112 (map (lambda (x3115) (chi2140 x3115 r3114 w3113 mod3101)) val3106) (chi-body2144 (cons e13107 e23108) (source-wrap2133 e3097 w3113 s3100 mod3101) r3114 w3113 mod3101))))))) tmp3103) ((lambda (_3118) (syntax-violation (quote letrec) "bad letrec" (source-wrap2133 e3097 w3099 s3100 mod3101))) tmp3102))) ($sc-dispatch tmp3102 (quote (any #(each (any any)) any . each-any))))) e3097))) (global-extend2102 (quote core) (quote set!) (lambda (e3119 r3120 w3121 s3122 mod3123) ((lambda (tmp3124) ((lambda (tmp3125) (if (if tmp3125 (apply (lambda (_3126 id3127 val3128) (id?2104 id3127)) tmp3125) #f) (apply (lambda (_3129 id3130 val3131) (let ((val3132 (chi2140 val3131 r3120 w3121 mod3123)) (n3133 (id-var-name2126 id3130 w3121))) (let ((b3134 (lookup2101 n3133 r3120 mod3123))) (let ((atom-key3135 (binding-type2096 b3134))) (if (memv atom-key3135 (quote (lexical))) (build-lexical-assignment2075 s3122 (syntax->datum id3130) (binding-value2097 b3134) val3132) (if (memv atom-key3135 (quote (global))) (build-global-assignment2078 s3122 n3133 val3132 mod3123) (if (memv atom-key3135 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap2132 id3130 w3121 mod3123)) (syntax-violation (quote set!) "bad set!" (source-wrap2133 e3119 w3121 s3122 mod3123))))))))) tmp3125) ((lambda (tmp3136) (if tmp3136 (apply (lambda (_3137 head3138 tail3139 val3140) (call-with-values (lambda () (syntax-type2138 head3138 r3120 (quote (())) #f #f mod3123)) (lambda (type3141 value3142 ee3143 ww3144 ss3145 modmod3146) (if (memv type3141 (quote (module-ref))) (let ((val3147 (chi2140 val3140 r3120 w3121 mod3123))) (call-with-values (lambda () (value3142 (cons head3138 tail3139))) (lambda (id3149 mod3150) (build-global-assignment2078 s3122 id3149 val3147 mod3150)))) (build-application2072 s3122 (chi2140 (list (quote #(syntax-object setter ((top) #(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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head3138) r3120 w3121 mod3123) (map (lambda (e3151) (chi2140 e3151 r3120 w3121 mod3123)) (append tail3139 (list val3140)))))))) tmp3136) ((lambda (_3153) (syntax-violation (quote set!) "bad set!" (source-wrap2133 e3119 w3121 s3122 mod3123))) tmp3124))) ($sc-dispatch tmp3124 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp3124 (quote (any any any))))) e3119))) (global-extend2102 (quote module-ref) (quote @) (lambda (e3154) ((lambda (tmp3155) ((lambda (tmp3156) (if (if tmp3156 (apply (lambda (_3157 mod3158 id3159) (if (and-map id?2104 mod3158) (id?2104 id3159) #f)) tmp3156) #f) (apply (lambda (_3161 mod3162 id3163) (values (syntax->datum id3163) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod3162)))) tmp3156) (syntax-violation #f "source expression failed to match any pattern" tmp3155))) ($sc-dispatch tmp3155 (quote (any each-any any))))) e3154))) (global-extend2102 (quote module-ref) (quote @@) (lambda (e3165) ((lambda (tmp3166) ((lambda (tmp3167) (if (if tmp3167 (apply (lambda (_3168 mod3169 id3170) (if (and-map id?2104 mod3169) (id?2104 id3170) #f)) tmp3167) #f) (apply (lambda (_3172 mod3173 id3174) (values (syntax->datum id3174) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod3173)))) tmp3167) (syntax-violation #f "source expression failed to match any pattern" tmp3166))) ($sc-dispatch tmp3166 (quote (any each-any any))))) e3165))) (global-extend2102 (quote core) (quote if) (lambda (e3176 r3177 w3178 s3179 mod3180) ((lambda (tmp3181) ((lambda (tmp3182) (if tmp3182 (apply (lambda (_3183 test3184 then3185) (build-conditional2073 s3179 (chi2140 test3184 r3177 w3178 mod3180) (chi2140 then3185 r3177 w3178 mod3180) (build-void2071 #f))) tmp3182) ((lambda (tmp3186) (if tmp3186 (apply (lambda (_3187 test3188 then3189 else3190) (build-conditional2073 s3179 (chi2140 test3188 r3177 w3178 mod3180) (chi2140 then3189 r3177 w3178 mod3180) (chi2140 else3190 r3177 w3178 mod3180))) tmp3186) (syntax-violation #f "source expression failed to match any pattern" tmp3181))) ($sc-dispatch tmp3181 (quote (any any any any)))))) ($sc-dispatch tmp3181 (quote (any any any))))) e3176))) (global-extend2102 (quote begin) (quote begin) (quote ())) (global-extend2102 (quote define) (quote define) (quote ())) (global-extend2102 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend2102 (quote eval-when) (quote eval-when) (quote ())) (global-extend2102 (quote core) (quote syntax-case) (letrec ((gen-syntax-case3194 (lambda (x3195 keys3196 clauses3197 r3198 mod3199) (if (null? clauses3197) (build-application2072 #f (build-primref2081 #f (quote syntax-violation)) (list (build-data2082 #f #f) (build-data2082 #f "source expression failed to match any pattern") x3195)) ((lambda (tmp3200) ((lambda (tmp3201) (if tmp3201 (apply (lambda (pat3202 exp3203) (if (if (id?2104 pat3202) (and-map (lambda (x3204) (not (free-id=?2127 pat3202 x3204))) (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 analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* 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) (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" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys3196)) #f) (let ((labels3205 (list (gen-label2109))) (var3206 (gen-var2152 pat3202))) (build-application2072 #f (build-lambda2080 #f (list (syntax->datum pat3202)) (list var3206) #f (chi2140 exp3203 (extend-env2098 labels3205 (list (cons (quote syntax) (cons var3206 0))) r3198) (make-binding-wrap2121 (list pat3202) labels3205 (quote (()))) mod3199)) (list x3195))) (gen-clause3193 x3195 keys3196 (cdr clauses3197) r3198 pat3202 #t exp3203 mod3199))) tmp3201) ((lambda (tmp3207) (if tmp3207 (apply (lambda (pat3208 fender3209 exp3210) (gen-clause3193 x3195 keys3196 (cdr clauses3197) r3198 pat3208 fender3209 exp3210 mod3199)) tmp3207) ((lambda (_3211) (syntax-violation (quote syntax-case) "invalid clause" (car clauses3197))) tmp3200))) ($sc-dispatch tmp3200 (quote (any any any)))))) ($sc-dispatch tmp3200 (quote (any any))))) (car clauses3197))))) (gen-clause3193 (lambda (x3212 keys3213 clauses3214 r3215 pat3216 fender3217 exp3218 mod3219) (call-with-values (lambda () (convert-pattern3191 pat3216 keys3213)) (lambda (p3220 pvars3221) (if (not (distinct-bound-ids?2130 (map car pvars3221))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat3216) (if (not (and-map (lambda (x3222) (not (ellipsis?2149 (car x3222)))) pvars3221)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat3216) (let ((y3223 (gen-var2152 (quote tmp)))) (build-application2072 #f (build-lambda2080 #f (list (quote tmp)) (list y3223) #f (let ((y3224 (build-lexical-reference2074 (quote value) #f (quote tmp) y3223))) (build-conditional2073 #f ((lambda (tmp3225) ((lambda (tmp3226) (if tmp3226 (apply (lambda () y3224) tmp3226) ((lambda (_3227) (build-conditional2073 #f y3224 (build-dispatch-call3192 pvars3221 fender3217 y3224 r3215 mod3219) (build-data2082 #f #f))) tmp3225))) ($sc-dispatch tmp3225 (quote #(atom #t))))) fender3217) (build-dispatch-call3192 pvars3221 exp3218 y3224 r3215 mod3219) (gen-syntax-case3194 x3212 keys3213 clauses3214 r3215 mod3219)))) (list (if (eq? p3220 (quote any)) (build-application2072 #f (build-primref2081 #f (quote list)) (list x3212)) (build-application2072 #f (build-primref2081 #f (quote $sc-dispatch)) (list x3212 (build-data2082 #f p3220))))))))))))) (build-dispatch-call3192 (lambda (pvars3228 exp3229 y3230 r3231 mod3232) (let ((ids3233 (map car pvars3228)) (levels3234 (map cdr pvars3228))) (let ((labels3235 (gen-labels2110 ids3233)) (new-vars3236 (map gen-var2152 ids3233))) (build-application2072 #f (build-primref2081 #f (quote apply)) (list (build-lambda2080 #f (map syntax->datum ids3233) new-vars3236 #f (chi2140 exp3229 (extend-env2098 labels3235 (map (lambda (var3237 level3238) (cons (quote syntax) (cons var3237 level3238))) new-vars3236 (map cdr pvars3228)) r3231) (make-binding-wrap2121 ids3233 labels3235 (quote (()))) mod3232)) y3230)))))) (convert-pattern3191 (lambda (pattern3239 keys3240) (letrec ((cvt3241 (lambda (p3242 n3243 ids3244) (if (id?2104 p3242) (if (bound-id-member?2131 p3242 keys3240) (values (vector (quote free-id) p3242) ids3244) (values (quote any) (cons (cons p3242 n3243) ids3244))) ((lambda (tmp3245) ((lambda (tmp3246) (if (if tmp3246 (apply (lambda (x3247 dots3248) (ellipsis?2149 dots3248)) tmp3246) #f) (apply (lambda (x3249 dots3250) (call-with-values (lambda () (cvt3241 x3249 (fx+2063 n3243 1) ids3244)) (lambda (p3251 ids3252) (values (if (eq? p3251 (quote any)) (quote each-any) (vector (quote each) p3251)) ids3252)))) tmp3246) ((lambda (tmp3253) (if tmp3253 (apply (lambda (x3254 y3255) (call-with-values (lambda () (cvt3241 y3255 n3243 ids3244)) (lambda (y3256 ids3257) (call-with-values (lambda () (cvt3241 x3254 n3243 ids3257)) (lambda (x3258 ids3259) (values (cons x3258 y3256) ids3259)))))) tmp3253) ((lambda (tmp3260) (if tmp3260 (apply (lambda () (values (quote ()) ids3244)) tmp3260) ((lambda (tmp3261) (if tmp3261 (apply (lambda (x3262) (call-with-values (lambda () (cvt3241 x3262 n3243 ids3244)) (lambda (p3264 ids3265) (values (vector (quote vector) p3264) ids3265)))) tmp3261) ((lambda (x3266) (values (vector (quote atom) (strip2151 p3242 (quote (())))) ids3244)) tmp3245))) ($sc-dispatch tmp3245 (quote #(vector each-any)))))) ($sc-dispatch tmp3245 (quote ()))))) ($sc-dispatch tmp3245 (quote (any . any)))))) ($sc-dispatch tmp3245 (quote (any any))))) p3242))))) (cvt3241 pattern3239 0 (quote ())))))) (lambda (e3267 r3268 w3269 s3270 mod3271) (let ((e3272 (source-wrap2133 e3267 w3269 s3270 mod3271))) ((lambda (tmp3273) ((lambda (tmp3274) (if tmp3274 (apply (lambda (_3275 val3276 key3277 m3278) (if (and-map (lambda (x3279) (if (id?2104 x3279) (not (ellipsis?2149 x3279)) #f)) key3277) (let ((x3281 (gen-var2152 (quote tmp)))) (build-application2072 s3270 (build-lambda2080 #f (list (quote tmp)) (list x3281) #f (gen-syntax-case3194 (build-lexical-reference2074 (quote value) #f (quote tmp) x3281) key3277 m3278 r3268 mod3271)) (list (chi2140 val3276 r3268 (quote (())) mod3271)))) (syntax-violation (quote syntax-case) "invalid literals list" e3272))) tmp3274) (syntax-violation #f "source expression failed to match any pattern" tmp3273))) ($sc-dispatch tmp3273 (quote (any any each-any . each-any))))) e3272))))) (set! sc-expand (lambda (x3285 . rest3284) (if (if (pair? x3285) (equal? (car x3285) noexpand2061) #f) (cadr x3285) (let ((m3286 (if (null? rest3284) (quote e) (car rest3284))) (esew3287 (if (let ((t3288 (null? rest3284))) (if t3288 t3288 (null? (cdr rest3284)))) (quote (eval)) (cadr rest3284)))) (with-fluid* *mode*2062 m3286 (lambda () (chi-top2139 x3285 (quote ()) (quote ((top))) m3286 esew3287 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x3289) (nonsymbol-id?2103 x3289))) (set! datum->syntax (lambda (id3290 datum3291) (make-syntax-object2087 datum3291 (syntax-object-wrap2090 id3290) #f))) (set! syntax->datum (lambda (x3292) (strip2151 x3292 (quote (()))))) (set! generate-temporaries (lambda (ls3293) (begin (let ((x3294 ls3293)) (if (not (list? x3294)) (syntax-violation (quote generate-temporaries) "invalid argument" x3294) (if #f #f))) (map (lambda (x3295) (wrap2132 (gensym) (quote ((top))) #f)) ls3293)))) (set! free-identifier=? (lambda (x3296 y3297) (begin (let ((x3298 x3296)) (if (not (nonsymbol-id?2103 x3298)) (syntax-violation (quote free-identifier=?) "invalid argument" x3298) (if #f #f))) (let ((x3299 y3297)) (if (not (nonsymbol-id?2103 x3299)) (syntax-violation (quote free-identifier=?) "invalid argument" x3299) (if #f #f))) (free-id=?2127 x3296 y3297)))) (set! bound-identifier=? (lambda (x3300 y3301) (begin (let ((x3302 x3300)) (if (not (nonsymbol-id?2103 x3302)) (syntax-violation (quote bound-identifier=?) "invalid argument" x3302) (if #f #f))) (let ((x3303 y3301)) (if (not (nonsymbol-id?2103 x3303)) (syntax-violation (quote bound-identifier=?) "invalid argument" x3303) (if #f #f))) (bound-id=?2128 x3300 y3301)))) (set! syntax-violation (lambda (who3307 message3306 form3305 . subform3304) (begin (let ((x3308 who3307)) (if (not ((lambda (x3309) (let ((t3310 (not x3309))) (if t3310 t3310 (let ((t3311 (string? x3309))) (if t3311 t3311 (symbol? x3309)))))) x3308)) (syntax-violation (quote syntax-violation) "invalid argument" x3308) (if #f #f))) (let ((x3312 message3306)) (if (not (string? x3312)) (syntax-violation (quote syntax-violation) "invalid argument" x3312) (if #f #f))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who3307 "~a: " "") "~a " (if (null? subform3304) "in ~a" "in subform `~s' of `~s'")) (let ((tail3313 (cons message3306 (map (lambda (x3314) (strip2151 x3314 (quote (())))) (append subform3304 (list form3305)))))) (if who3307 (cons who3307 tail3313) tail3313)) #f)))) (letrec ((match3319 (lambda (e3320 p3321 w3322 r3323 mod3324) (if (not r3323) #f (if (eq? p3321 (quote any)) (cons (wrap2132 e3320 w3322 mod3324) r3323) (if (syntax-object?2088 e3320) (match*3318 (let ((e3325 (syntax-object-expression2089 e3320))) (if (annotation? e3325) (annotation-expression e3325) e3325)) p3321 (join-wraps2123 w3322 (syntax-object-wrap2090 e3320)) r3323 (syntax-object-module2091 e3320)) (match*3318 (let ((e3326 e3320)) (if (annotation? e3326) (annotation-expression e3326) e3326)) p3321 w3322 r3323 mod3324)))))) (match*3318 (lambda (e3327 p3328 w3329 r3330 mod3331) (if (null? p3328) (if (null? e3327) r3330 #f) (if (pair? p3328) (if (pair? e3327) (match3319 (car e3327) (car p3328) w3329 (match3319 (cdr e3327) (cdr p3328) w3329 r3330 mod3331) mod3331) #f) (if (eq? p3328 (quote each-any)) (let ((l3332 (match-each-any3316 e3327 w3329 mod3331))) (if l3332 (cons l3332 r3330) #f)) (let ((atom-key3333 (vector-ref p3328 0))) (if (memv atom-key3333 (quote (each))) (if (null? e3327) (match-empty3317 (vector-ref p3328 1) r3330) (let ((l3334 (match-each3315 e3327 (vector-ref p3328 1) w3329 mod3331))) (if l3334 (letrec ((collect3335 (lambda (l3336) (if (null? (car l3336)) r3330 (cons (map car l3336) (collect3335 (map cdr l3336))))))) (collect3335 l3334)) #f))) (if (memv atom-key3333 (quote (free-id))) (if (id?2104 e3327) (if (free-id=?2127 (wrap2132 e3327 w3329 mod3331) (vector-ref p3328 1)) r3330 #f) #f) (if (memv atom-key3333 (quote (atom))) (if (equal? (vector-ref p3328 1) (strip2151 e3327 w3329)) r3330 #f) (if (memv atom-key3333 (quote (vector))) (if (vector? e3327) (match3319 (vector->list e3327) (vector-ref p3328 1) w3329 r3330 mod3331) #f) (if #f #f))))))))))) (match-empty3317 (lambda (p3337 r3338) (if (null? p3337) r3338 (if (eq? p3337 (quote any)) (cons (quote ()) r3338) (if (pair? p3337) (match-empty3317 (car p3337) (match-empty3317 (cdr p3337) r3338)) (if (eq? p3337 (quote each-any)) (cons (quote ()) r3338) (let ((atom-key3339 (vector-ref p3337 0))) (if (memv atom-key3339 (quote (each))) (match-empty3317 (vector-ref p3337 1) r3338) (if (memv atom-key3339 (quote (free-id atom))) r3338 (if (memv atom-key3339 (quote (vector))) (match-empty3317 (vector-ref p3337 1) r3338) (if #f #f))))))))))) (match-each-any3316 (lambda (e3340 w3341 mod3342) (if (annotation? e3340) (match-each-any3316 (annotation-expression e3340) w3341 mod3342) (if (pair? e3340) (let ((l3343 (match-each-any3316 (cdr e3340) w3341 mod3342))) (if l3343 (cons (wrap2132 (car e3340) w3341 mod3342) l3343) #f)) (if (null? e3340) (quote ()) (if (syntax-object?2088 e3340) (match-each-any3316 (syntax-object-expression2089 e3340) (join-wraps2123 w3341 (syntax-object-wrap2090 e3340)) mod3342) #f)))))) (match-each3315 (lambda (e3344 p3345 w3346 mod3347) (if (annotation? e3344) (match-each3315 (annotation-expression e3344) p3345 w3346 mod3347) (if (pair? e3344) (let ((first3348 (match3319 (car e3344) p3345 w3346 (quote ()) mod3347))) (if first3348 (let ((rest3349 (match-each3315 (cdr e3344) p3345 w3346 mod3347))) (if rest3349 (cons first3348 rest3349) #f)) #f)) (if (null? e3344) (quote ()) (if (syntax-object?2088 e3344) (match-each3315 (syntax-object-expression2089 e3344) p3345 (join-wraps2123 w3346 (syntax-object-wrap2090 e3344)) (syntax-object-module2091 e3344)) #f))))))) (set! $sc-dispatch (lambda (e3350 p3351) (if (eq? p3351 (quote any)) (list e3350) (if (syntax-object?2088 e3350) (match*3318 (let ((e3352 (syntax-object-expression2089 e3350))) (if (annotation? e3352) (annotation-expression e3352) e3352)) p3351 (syntax-object-wrap2090 e3350) (quote ()) (syntax-object-module2091 e3350)) (match*3318 (let ((e3353 e3350)) (if (annotation? e3353) (annotation-expression e3353) e3353)) p3351 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x3354) ((lambda (tmp3355) ((lambda (tmp3356) (if tmp3356 (apply (lambda (_3357 e13358 e23359) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13358 e23359))) tmp3356) ((lambda (tmp3361) (if tmp3361 (apply (lambda (_3362 out3363 in3364 e13365 e23366) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in3364 (quote ()) (list out3363 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13365 e23366))))) tmp3361) ((lambda (tmp3368) (if tmp3368 (apply (lambda (_3369 out3370 in3371 e13372 e23373) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in3371) (quote ()) (list out3370 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13372 e23373))))) tmp3368) (syntax-violation #f "source expression failed to match any pattern" tmp3355))) ($sc-dispatch tmp3355 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp3355 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp3355 (quote (any () any . each-any))))) x3354))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x3377) ((lambda (tmp3378) ((lambda (tmp3379) (if tmp3379 (apply (lambda (_3380 k3381 keyword3382 pattern3383 template3384) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k3381 (map (lambda (tmp3387 tmp3386) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp3386) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp3387))) template3384 pattern3383)))))) tmp3379) (syntax-violation #f "source expression failed to match any pattern" tmp3378))) ($sc-dispatch tmp3378 (quote (any each-any . #(each ((any . any) any))))))) x3377))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x3388) ((lambda (tmp3389) ((lambda (tmp3390) (if (if tmp3390 (apply (lambda (let*3391 x3392 v3393 e13394 e23395) (and-map identifier? x3392)) tmp3390) #f) (apply (lambda (let*3397 x3398 v3399 e13400 e23401) (letrec ((f3402 (lambda (bindings3403) (if (null? bindings3403) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e13400 e23401))) ((lambda (tmp3407) ((lambda (tmp3408) (if tmp3408 (apply (lambda (body3409 binding3410) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding3410) body3409)) tmp3408) (syntax-violation #f "source expression failed to match any pattern" tmp3407))) ($sc-dispatch tmp3407 (quote (any any))))) (list (f3402 (cdr bindings3403)) (car bindings3403))))))) (f3402 (map list x3398 v3399)))) tmp3390) (syntax-violation #f "source expression failed to match any pattern" tmp3389))) ($sc-dispatch tmp3389 (quote (any #(each (any any)) any . each-any))))) x3388))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x3411) ((lambda (tmp3412) ((lambda (tmp3413) (if tmp3413 (apply (lambda (_3414 var3415 init3416 step3417 e03418 e13419 c3420) ((lambda (tmp3421) ((lambda (tmp3422) (if tmp3422 (apply (lambda (step3423) ((lambda (tmp3424) ((lambda (tmp3425) (if tmp3425 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var3415 init3416) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e03418) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c3420 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step3423))))))) tmp3425) ((lambda (tmp3430) (if tmp3430 (apply (lambda (e13431 e23432) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var3415 init3416) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e03418 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e13431 e23432)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c3420 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step3423))))))) tmp3430) (syntax-violation #f "source expression failed to match any pattern" tmp3424))) ($sc-dispatch tmp3424 (quote (any . each-any)))))) ($sc-dispatch tmp3424 (quote ())))) e13419)) tmp3422) (syntax-violation #f "source expression failed to match any pattern" tmp3421))) ($sc-dispatch tmp3421 (quote each-any)))) (map (lambda (v3439 s3440) ((lambda (tmp3441) ((lambda (tmp3442) (if tmp3442 (apply (lambda () v3439) tmp3442) ((lambda (tmp3443) (if tmp3443 (apply (lambda (e3444) e3444) tmp3443) ((lambda (_3445) (syntax-violation (quote do) "bad step expression" orig-x3411 s3440)) tmp3441))) ($sc-dispatch tmp3441 (quote (any)))))) ($sc-dispatch tmp3441 (quote ())))) s3440)) var3415 step3417))) tmp3413) (syntax-violation #f "source expression failed to match any pattern" tmp3412))) ($sc-dispatch tmp3412 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x3411))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons3448 (lambda (x3452 y3453) ((lambda (tmp3454) ((lambda (tmp3455) (if tmp3455 (apply (lambda (x3456 y3457) ((lambda (tmp3458) ((lambda (tmp3459) (if tmp3459 (apply (lambda (dy3460) ((lambda (tmp3461) ((lambda (tmp3462) (if tmp3462 (apply (lambda (dx3463) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx3463 dy3460))) tmp3462) ((lambda (_3464) (if (null? dy3460) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3456) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3456 y3457))) tmp3461))) ($sc-dispatch tmp3461 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x3456)) tmp3459) ((lambda (tmp3465) (if tmp3465 (apply (lambda (stuff3466) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x3456 stuff3466))) tmp3465) ((lambda (else3467) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3456 y3457)) tmp3458))) ($sc-dispatch tmp3458 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp3458 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y3457)) tmp3455) (syntax-violation #f "source expression failed to match any pattern" tmp3454))) ($sc-dispatch tmp3454 (quote (any any))))) (list x3452 y3453)))) (quasiappend3449 (lambda (x3468 y3469) ((lambda (tmp3470) ((lambda (tmp3471) (if tmp3471 (apply (lambda (x3472 y3473) ((lambda (tmp3474) ((lambda (tmp3475) (if tmp3475 (apply (lambda () x3472) tmp3475) ((lambda (_3476) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3472 y3473)) tmp3474))) ($sc-dispatch tmp3474 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y3473)) tmp3471) (syntax-violation #f "source expression failed to match any pattern" tmp3470))) ($sc-dispatch tmp3470 (quote (any any))))) (list x3468 y3469)))) (quasivector3450 (lambda (x3477) ((lambda (tmp3478) ((lambda (x3479) ((lambda (tmp3480) ((lambda (tmp3481) (if tmp3481 (apply (lambda (x3482) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x3482))) tmp3481) ((lambda (tmp3484) (if tmp3484 (apply (lambda (x3485) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3485)) tmp3484) ((lambda (_3487) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3479)) tmp3480))) ($sc-dispatch tmp3480 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp3480 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x3479)) tmp3478)) x3477))) (quasi3451 (lambda (p3488 lev3489) ((lambda (tmp3490) ((lambda (tmp3491) (if tmp3491 (apply (lambda (p3492) (if (= lev3489 0) p3492 (quasicons3448 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi3451 (list p3492) (- lev3489 1))))) tmp3491) ((lambda (tmp3493) (if tmp3493 (apply (lambda (p3494 q3495) (if (= lev3489 0) (quasiappend3449 p3494 (quasi3451 q3495 lev3489)) (quasicons3448 (quasicons3448 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi3451 (list p3494) (- lev3489 1))) (quasi3451 q3495 lev3489)))) tmp3493) ((lambda (tmp3496) (if tmp3496 (apply (lambda (p3497) (quasicons3448 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi3451 (list p3497) (+ lev3489 1)))) tmp3496) ((lambda (tmp3498) (if tmp3498 (apply (lambda (p3499 q3500) (quasicons3448 (quasi3451 p3499 lev3489) (quasi3451 q3500 lev3489))) tmp3498) ((lambda (tmp3501) (if tmp3501 (apply (lambda (x3502) (quasivector3450 (quasi3451 x3502 lev3489))) tmp3501) ((lambda (p3504) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p3504)) tmp3490))) ($sc-dispatch tmp3490 (quote #(vector each-any)))))) ($sc-dispatch tmp3490 (quote (any . any)))))) ($sc-dispatch tmp3490 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp3490 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp3490 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p3488)))) (lambda (x3505) ((lambda (tmp3506) ((lambda (tmp3507) (if tmp3507 (apply (lambda (_3508 e3509) (quasi3451 e3509 0)) tmp3507) (syntax-violation #f "source expression failed to match any pattern" tmp3506))) ($sc-dispatch tmp3506 (quote (any any))))) x3505)))))
+(define include (make-syncase-macro (quote macro) (lambda (x3510) (letrec ((read-file3511 (lambda (fn3512 k3513) (let ((p3514 (open-input-file fn3512))) (letrec ((f3515 (lambda (x3516) (if (eof-object? x3516) (begin (close-input-port p3514) (quote ())) (cons (datum->syntax k3513 x3516) (f3515 (read p3514))))))) (f3515 (read p3514))))))) ((lambda (tmp3517) ((lambda (tmp3518) (if tmp3518 (apply (lambda (k3519 filename3520) (let ((fn3521 (syntax->datum filename3520))) ((lambda (tmp3522) ((lambda (tmp3523) (if tmp3523 (apply (lambda (exp3524) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp3524)) tmp3523) (syntax-violation #f "source expression failed to match any pattern" tmp3522))) ($sc-dispatch tmp3522 (quote each-any)))) (read-file3511 fn3521 k3519)))) tmp3518) (syntax-violation #f "source expression failed to match any pattern" tmp3517))) ($sc-dispatch tmp3517 (quote (any any))))) x3510)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x3526) ((lambda (tmp3527) ((lambda (tmp3528) (if tmp3528 (apply (lambda (_3529 e3530) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x3526)) tmp3528) (syntax-violation #f "source expression failed to match any pattern" tmp3527))) ($sc-dispatch tmp3527 (quote (any any))))) x3526))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x3531) ((lambda (tmp3532) ((lambda (tmp3533) (if tmp3533 (apply (lambda (_3534 e3535) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x3531)) tmp3533) (syntax-violation #f "source expression failed to match any pattern" tmp3532))) ($sc-dispatch tmp3532 (quote (any any))))) x3531))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x3536) ((lambda (tmp3537) ((lambda (tmp3538) (if tmp3538 (apply (lambda (_3539 e3540 m13541 m23542) ((lambda (tmp3543) ((lambda (body3544) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e3540)) body3544)) tmp3543)) (letrec ((f3545 (lambda (clause3546 clauses3547) (if (null? clauses3547) ((lambda (tmp3549) ((lambda (tmp3550) (if tmp3550 (apply (lambda (e13551 e23552) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13551 e23552))) tmp3550) ((lambda (tmp3554) (if tmp3554 (apply (lambda (k3555 e13556 e23557) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k3555)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13556 e23557)))) tmp3554) ((lambda (_3560) (syntax-violation (quote case) "bad clause" x3536 clause3546)) tmp3549))) ($sc-dispatch tmp3549 (quote (each-any any . each-any)))))) ($sc-dispatch tmp3549 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause3546) ((lambda (tmp3561) ((lambda (rest3562) ((lambda (tmp3563) ((lambda (tmp3564) (if tmp3564 (apply (lambda (k3565 e13566 e23567) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k3565)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13566 e23567)) rest3562)) tmp3564) ((lambda (_3570) (syntax-violation (quote case) "bad clause" x3536 clause3546)) tmp3563))) ($sc-dispatch tmp3563 (quote (each-any any . each-any))))) clause3546)) tmp3561)) (f3545 (car clauses3547) (cdr clauses3547))))))) (f3545 m13541 m23542)))) tmp3538) (syntax-violation #f "source expression failed to match any pattern" tmp3537))) ($sc-dispatch tmp3537 (quote (any any any . each-any))))) x3536))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x3571) ((lambda (tmp3572) ((lambda (tmp3573) (if tmp3573 (apply (lambda (_3574 e3575) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e3575)) (list (cons _3574 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e3575 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp3573) (syntax-violation #f "source expression failed to match any pattern" tmp3572))) ($sc-dispatch tmp3572 (quote (any any))))) x3571))))