(start-stack 'load-stack
(primitive-load-path name)))
+(define %load-verbosely #f)
+(define (assert-load-verbosity v) (set! %load-verbosely v))
+
+(define (%load-announce file)
+ (if %load-verbosely
+ (with-output-to-port (current-error-port)
+ (lambda ()
+ (display ";;; ")
+ (display "loading ")
+ (display file)
+ (newline)
+ (force-output)))))
+
+(set! %load-hook %load-announce)
+
+(define (load name . reader)
+ (with-fluid* current-reader (and (pair? reader) (car reader))
+ (lambda ()
+ (start-stack 'load-stack
+ (primitive-load name)))))
\f
-(use-modules (ice-9 syncase))
-
-;; XXX - We need to be inside (ice-9 syncase) since psyntax.ss calls
+;; XXX - We need to be inside (guile) since psyntax.ss calls
;; `eval' int he `interaction-environment' aka the current module and
;; it expects to have `andmap' there. The reason for this escapes me
;; at the moment.
;;
-(define-module (ice-9 syncase))
+(define-module (guile))
(define source (list-ref (command-line) 1))
(define target (list-ref (command-line) 2))
(close-port out)
(close-port in))
(begin
- (write (strip-expansion-structures
- (sc-expand3 x 'c '(compile load eval)))
+ (write (sc-expand3 x 'c '(compile load eval))
out)
(newline out)
(loop (read in))))))
-(letrec ((syntmp-lambda-var-list-166 (lambda (syntmp-vars-557) (let syntmp-lvl-558 ((syntmp-vars-559 syntmp-vars-557) (syntmp-ls-560 (quote ())) (syntmp-w-561 (quote (())))) (cond ((pair? syntmp-vars-559) (syntmp-lvl-558 (cdr syntmp-vars-559) (cons (syntmp-wrap-145 (car syntmp-vars-559) syntmp-w-561 #f) syntmp-ls-560) syntmp-w-561)) ((syntmp-id?-117 syntmp-vars-559) (cons (syntmp-wrap-145 syntmp-vars-559 syntmp-w-561 #f) syntmp-ls-560)) ((null? syntmp-vars-559) syntmp-ls-560) ((syntmp-syntax-object?-101 syntmp-vars-559) (syntmp-lvl-558 (syntmp-syntax-object-expression-102 syntmp-vars-559) syntmp-ls-560 (syntmp-join-wraps-136 syntmp-w-561 (syntmp-syntax-object-wrap-103 syntmp-vars-559)))) ((annotation? syntmp-vars-559) (syntmp-lvl-558 (annotation-expression syntmp-vars-559) syntmp-ls-560 syntmp-w-561)) (else (cons syntmp-vars-559 syntmp-ls-560)))))) (syntmp-gen-var-165 (lambda (syntmp-id-562) (let ((syntmp-id-563 (if (syntmp-syntax-object?-101 syntmp-id-562) (syntmp-syntax-object-expression-102 syntmp-id-562) syntmp-id-562))) (if (annotation? syntmp-id-563) (syntmp-build-annotated-94 (annotation-source syntmp-id-563) (gensym (symbol->string (annotation-expression syntmp-id-563)))) (syntmp-build-annotated-94 #f (gensym (symbol->string syntmp-id-563))))))) (syntmp-strip-164 (lambda (syntmp-x-564 syntmp-w-565) (if (memq (quote top) (syntmp-wrap-marks-120 syntmp-w-565)) (if (or (annotation? syntmp-x-564) (and (pair? syntmp-x-564) (annotation? (car syntmp-x-564)))) (syntmp-strip-annotation-163 syntmp-x-564 #f) syntmp-x-564) (let syntmp-f-566 ((syntmp-x-567 syntmp-x-564)) (cond ((syntmp-syntax-object?-101 syntmp-x-567) (syntmp-strip-164 (syntmp-syntax-object-expression-102 syntmp-x-567) (syntmp-syntax-object-wrap-103 syntmp-x-567))) ((pair? syntmp-x-567) (let ((syntmp-a-568 (syntmp-f-566 (car syntmp-x-567))) (syntmp-d-569 (syntmp-f-566 (cdr syntmp-x-567)))) (if (and (eq? syntmp-a-568 (car syntmp-x-567)) (eq? syntmp-d-569 (cdr syntmp-x-567))) syntmp-x-567 (cons syntmp-a-568 syntmp-d-569)))) ((vector? syntmp-x-567) (let ((syntmp-old-570 (vector->list syntmp-x-567))) (let ((syntmp-new-571 (map syntmp-f-566 syntmp-old-570))) (if (andmap eq? syntmp-old-570 syntmp-new-571) syntmp-x-567 (list->vector syntmp-new-571))))) (else syntmp-x-567)))))) (syntmp-strip-annotation-163 (lambda (syntmp-x-572 syntmp-parent-573) (cond ((pair? syntmp-x-572) (let ((syntmp-new-574 (cons #f #f))) (begin (if syntmp-parent-573 (set-annotation-stripped! syntmp-parent-573 syntmp-new-574)) (set-car! syntmp-new-574 (syntmp-strip-annotation-163 (car syntmp-x-572) #f)) (set-cdr! syntmp-new-574 (syntmp-strip-annotation-163 (cdr syntmp-x-572) #f)) syntmp-new-574))) ((annotation? syntmp-x-572) (or (annotation-stripped syntmp-x-572) (syntmp-strip-annotation-163 (annotation-expression syntmp-x-572) syntmp-x-572))) ((vector? syntmp-x-572) (let ((syntmp-new-575 (make-vector (vector-length syntmp-x-572)))) (begin (if syntmp-parent-573 (set-annotation-stripped! syntmp-parent-573 syntmp-new-575)) (let syntmp-loop-576 ((syntmp-i-577 (- (vector-length syntmp-x-572) 1))) (unless (syntmp-fx<-88 syntmp-i-577 0) (vector-set! syntmp-new-575 syntmp-i-577 (syntmp-strip-annotation-163 (vector-ref syntmp-x-572 syntmp-i-577) #f)) (syntmp-loop-576 (syntmp-fx--86 syntmp-i-577 1)))) syntmp-new-575))) (else syntmp-x-572)))) (syntmp-ellipsis?-162 (lambda (syntmp-x-578) (and (syntmp-nonsymbol-id?-116 syntmp-x-578) (syntmp-free-id=?-140 syntmp-x-578 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))))))) (syntmp-chi-void-161 (lambda () (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote void)))))) (syntmp-eval-local-transformer-160 (lambda (syntmp-expanded-579 syntmp-mod-580) (let ((syntmp-p-581 (syntmp-local-eval-hook-90 syntmp-expanded-579 syntmp-mod-580))) (if (procedure? syntmp-p-581) syntmp-p-581 (syntax-error syntmp-p-581 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-159 (lambda (syntmp-rec?-582 syntmp-e-583 syntmp-r-584 syntmp-w-585 syntmp-s-586 syntmp-mod-587 syntmp-k-588) ((lambda (syntmp-tmp-589) ((lambda (syntmp-tmp-590) (if syntmp-tmp-590 (apply (lambda (syntmp-_-591 syntmp-id-592 syntmp-val-593 syntmp-e1-594 syntmp-e2-595) (let ((syntmp-ids-596 syntmp-id-592)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-596)) (syntax-error syntmp-e-583 "duplicate bound keyword in") (let ((syntmp-labels-598 (syntmp-gen-labels-123 syntmp-ids-596))) (let ((syntmp-new-w-599 (syntmp-make-binding-wrap-134 syntmp-ids-596 syntmp-labels-598 syntmp-w-585))) (syntmp-k-588 (cons syntmp-e1-594 syntmp-e2-595) (syntmp-extend-env-111 syntmp-labels-598 (let ((syntmp-w-601 (if syntmp-rec?-582 syntmp-new-w-599 syntmp-w-585)) (syntmp-trans-r-602 (syntmp-macros-only-env-113 syntmp-r-584))) (map (lambda (syntmp-x-603) (cons (quote macro) (syntmp-eval-local-transformer-160 (syntmp-chi-153 syntmp-x-603 syntmp-trans-r-602 syntmp-w-601 syntmp-mod-587) syntmp-mod-587))) syntmp-val-593)) syntmp-r-584) syntmp-new-w-599 syntmp-s-586 syntmp-mod-587)))))) syntmp-tmp-590) ((lambda (syntmp-_-605) (syntax-error (syntmp-source-wrap-146 syntmp-e-583 syntmp-w-585 syntmp-s-586 syntmp-mod-587))) syntmp-tmp-589))) (syntax-dispatch syntmp-tmp-589 (quote (any #(each (any any)) any . each-any))))) syntmp-e-583))) (syntmp-chi-lambda-clause-158 (lambda (syntmp-e-606 syntmp-c-607 syntmp-r-608 syntmp-w-609 syntmp-mod-610 syntmp-k-611) ((lambda (syntmp-tmp-612) ((lambda (syntmp-tmp-613) (if syntmp-tmp-613 (apply (lambda (syntmp-id-614 syntmp-e1-615 syntmp-e2-616) (let ((syntmp-ids-617 syntmp-id-614)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-617)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-619 (syntmp-gen-labels-123 syntmp-ids-617)) (syntmp-new-vars-620 (map syntmp-gen-var-165 syntmp-ids-617))) (syntmp-k-611 syntmp-new-vars-620 (syntmp-chi-body-157 (cons syntmp-e1-615 syntmp-e2-616) syntmp-e-606 (syntmp-extend-var-env-112 syntmp-labels-619 syntmp-new-vars-620 syntmp-r-608) (syntmp-make-binding-wrap-134 syntmp-ids-617 syntmp-labels-619 syntmp-w-609) syntmp-mod-610)))))) syntmp-tmp-613) ((lambda (syntmp-tmp-622) (if syntmp-tmp-622 (apply (lambda (syntmp-ids-623 syntmp-e1-624 syntmp-e2-625) (let ((syntmp-old-ids-626 (syntmp-lambda-var-list-166 syntmp-ids-623))) (if (not (syntmp-valid-bound-ids?-142 syntmp-old-ids-626)) (syntax-error syntmp-e-606 "invalid parameter list in") (let ((syntmp-labels-627 (syntmp-gen-labels-123 syntmp-old-ids-626)) (syntmp-new-vars-628 (map syntmp-gen-var-165 syntmp-old-ids-626))) (syntmp-k-611 (let syntmp-f-629 ((syntmp-ls1-630 (cdr syntmp-new-vars-628)) (syntmp-ls2-631 (car syntmp-new-vars-628))) (if (null? syntmp-ls1-630) syntmp-ls2-631 (syntmp-f-629 (cdr syntmp-ls1-630) (cons (car syntmp-ls1-630) syntmp-ls2-631)))) (syntmp-chi-body-157 (cons syntmp-e1-624 syntmp-e2-625) syntmp-e-606 (syntmp-extend-var-env-112 syntmp-labels-627 syntmp-new-vars-628 syntmp-r-608) (syntmp-make-binding-wrap-134 syntmp-old-ids-626 syntmp-labels-627 syntmp-w-609) syntmp-mod-610)))))) syntmp-tmp-622) ((lambda (syntmp-_-633) (syntax-error syntmp-e-606)) syntmp-tmp-612))) (syntax-dispatch syntmp-tmp-612 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-612 (quote (each-any any . each-any))))) syntmp-c-607))) (syntmp-chi-body-157 (lambda (syntmp-body-634 syntmp-outer-form-635 syntmp-r-636 syntmp-w-637 syntmp-mod-638) (let ((syntmp-r-639 (cons (quote ("placeholder" placeholder)) syntmp-r-636))) (let ((syntmp-ribcage-640 (syntmp-make-ribcage-124 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-641 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w-637) (cons syntmp-ribcage-640 (syntmp-wrap-subst-121 syntmp-w-637))))) (let syntmp-parse-642 ((syntmp-body-643 (map (lambda (syntmp-x-649) (cons syntmp-r-639 (syntmp-wrap-145 syntmp-x-649 syntmp-w-641 syntmp-mod-638))) syntmp-body-634)) (syntmp-ids-644 (quote ())) (syntmp-labels-645 (quote ())) (syntmp-vars-646 (quote ())) (syntmp-vals-647 (quote ())) (syntmp-bindings-648 (quote ()))) (if (null? syntmp-body-643) (syntax-error syntmp-outer-form-635 "no expressions in body") (let ((syntmp-e-650 (cdar syntmp-body-643)) (syntmp-er-651 (caar syntmp-body-643))) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-650 syntmp-er-651 (quote (())) #f syntmp-ribcage-640 syntmp-mod-638)) (lambda (syntmp-type-652 syntmp-value-653 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657) (let ((syntmp-t-658 syntmp-type-652)) (if (memv syntmp-t-658 (quote (define-form))) (let ((syntmp-id-659 (syntmp-wrap-145 syntmp-value-653 syntmp-w-655 syntmp-mod-657)) (syntmp-label-660 (syntmp-gen-label-122))) (let ((syntmp-var-661 (syntmp-gen-var-165 syntmp-id-659))) (begin (syntmp-extend-ribcage!-133 syntmp-ribcage-640 syntmp-id-659 syntmp-label-660) (syntmp-parse-642 (cdr syntmp-body-643) (cons syntmp-id-659 syntmp-ids-644) (cons syntmp-label-660 syntmp-labels-645) (cons syntmp-var-661 syntmp-vars-646) (cons (cons syntmp-er-651 (syntmp-wrap-145 syntmp-e-654 syntmp-w-655 syntmp-mod-657)) syntmp-vals-647) (cons (cons (quote lexical) syntmp-var-661) syntmp-bindings-648))))) (if (memv syntmp-t-658 (quote (define-syntax-form))) (let ((syntmp-id-662 (syntmp-wrap-145 syntmp-value-653 syntmp-w-655 syntmp-mod-657)) (syntmp-label-663 (syntmp-gen-label-122))) (begin (syntmp-extend-ribcage!-133 syntmp-ribcage-640 syntmp-id-662 syntmp-label-663) (syntmp-parse-642 (cdr syntmp-body-643) (cons syntmp-id-662 syntmp-ids-644) (cons syntmp-label-663 syntmp-labels-645) syntmp-vars-646 syntmp-vals-647 (cons (cons (quote macro) (cons syntmp-er-651 (syntmp-wrap-145 syntmp-e-654 syntmp-w-655 syntmp-mod-657))) syntmp-bindings-648)))) (if (memv syntmp-t-658 (quote (begin-form))) ((lambda (syntmp-tmp-664) ((lambda (syntmp-tmp-665) (if syntmp-tmp-665 (apply (lambda (syntmp-_-666 syntmp-e1-667) (syntmp-parse-642 (let syntmp-f-668 ((syntmp-forms-669 syntmp-e1-667)) (if (null? syntmp-forms-669) (cdr syntmp-body-643) (cons (cons syntmp-er-651 (syntmp-wrap-145 (car syntmp-forms-669) syntmp-w-655 syntmp-mod-657)) (syntmp-f-668 (cdr syntmp-forms-669))))) syntmp-ids-644 syntmp-labels-645 syntmp-vars-646 syntmp-vals-647 syntmp-bindings-648)) syntmp-tmp-665) (syntax-error syntmp-tmp-664))) (syntax-dispatch syntmp-tmp-664 (quote (any . each-any))))) syntmp-e-654) (if (memv syntmp-t-658 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-653 syntmp-e-654 syntmp-er-651 syntmp-w-655 syntmp-s-656 syntmp-mod-657 (lambda (syntmp-forms-671 syntmp-er-672 syntmp-w-673 syntmp-s-674 syntmp-mod-675) (syntmp-parse-642 (let syntmp-f-676 ((syntmp-forms-677 syntmp-forms-671)) (if (null? syntmp-forms-677) (cdr syntmp-body-643) (cons (cons syntmp-er-672 (syntmp-wrap-145 (car syntmp-forms-677) syntmp-w-673 syntmp-mod-675)) (syntmp-f-676 (cdr syntmp-forms-677))))) syntmp-ids-644 syntmp-labels-645 syntmp-vars-646 syntmp-vals-647 syntmp-bindings-648))) (if (null? syntmp-ids-644) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-678) (syntmp-chi-153 (cdr syntmp-x-678) (car syntmp-x-678) (quote (())) syntmp-mod-657)) (cons (cons syntmp-er-651 (syntmp-source-wrap-146 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657)) (cdr syntmp-body-643)))) (begin (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-644)) (syntax-error syntmp-outer-form-635 "invalid or duplicate identifier in definition")) (let syntmp-loop-679 ((syntmp-bs-680 syntmp-bindings-648) (syntmp-er-cache-681 #f) (syntmp-r-cache-682 #f)) (if (not (null? syntmp-bs-680)) (let ((syntmp-b-683 (car syntmp-bs-680))) (if (eq? (car syntmp-b-683) (quote macro)) (let ((syntmp-er-684 (cadr syntmp-b-683))) (let ((syntmp-r-cache-685 (if (eq? syntmp-er-684 syntmp-er-cache-681) syntmp-r-cache-682 (syntmp-macros-only-env-113 syntmp-er-684)))) (begin (set-cdr! syntmp-b-683 (syntmp-eval-local-transformer-160 (syntmp-chi-153 (cddr syntmp-b-683) syntmp-r-cache-685 (quote (())) syntmp-mod-657) syntmp-mod-657)) (syntmp-loop-679 (cdr syntmp-bs-680) syntmp-er-684 syntmp-r-cache-685)))) (syntmp-loop-679 (cdr syntmp-bs-680) syntmp-er-cache-681 syntmp-r-cache-682))))) (set-cdr! syntmp-r-639 (syntmp-extend-env-111 syntmp-labels-645 syntmp-bindings-648 (cdr syntmp-r-639))) (syntmp-build-letrec-99 #f syntmp-vars-646 (map (lambda (syntmp-x-686) (syntmp-chi-153 (cdr syntmp-x-686) (car syntmp-x-686) (quote (())) syntmp-mod-657)) syntmp-vals-647) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-687) (syntmp-chi-153 (cdr syntmp-x-687) (car syntmp-x-687) (quote (())) syntmp-mod-657)) (cons (cons syntmp-er-651 (syntmp-source-wrap-146 syntmp-e-654 syntmp-w-655 syntmp-s-656 syntmp-mod-657)) (cdr syntmp-body-643)))))))))))))))))))))) (syntmp-chi-macro-156 (lambda (syntmp-p-688 syntmp-e-689 syntmp-r-690 syntmp-w-691 syntmp-rib-692 syntmp-mod-693) (letrec ((syntmp-rebuild-macro-output-694 (lambda (syntmp-x-695 syntmp-m-696) (cond ((pair? syntmp-x-695) (cons (syntmp-rebuild-macro-output-694 (car syntmp-x-695) syntmp-m-696) (syntmp-rebuild-macro-output-694 (cdr syntmp-x-695) syntmp-m-696))) ((syntmp-syntax-object?-101 syntmp-x-695) (let ((syntmp-w-697 (syntmp-syntax-object-wrap-103 syntmp-x-695))) (let ((syntmp-ms-698 (syntmp-wrap-marks-120 syntmp-w-697)) (syntmp-s-699 (syntmp-wrap-subst-121 syntmp-w-697))) (if (and (pair? syntmp-ms-698) (eq? (car syntmp-ms-698) #f)) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-695) (syntmp-make-wrap-119 (cdr syntmp-ms-698) (if syntmp-rib-692 (cons syntmp-rib-692 (cdr syntmp-s-699)) (cdr syntmp-s-699))) (syntmp-syntax-object-module-104 syntmp-x-695)) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-695) (syntmp-make-wrap-119 (cons syntmp-m-696 syntmp-ms-698) (if syntmp-rib-692 (cons syntmp-rib-692 (cons (quote shift) syntmp-s-699)) (cons (quote shift) syntmp-s-699))) (module-name (procedure-module syntmp-p-688))))))) ((vector? syntmp-x-695) (let ((syntmp-n-700 (vector-length syntmp-x-695))) (let ((syntmp-v-701 (make-vector syntmp-n-700))) (let syntmp-doloop-702 ((syntmp-i-703 0)) (if (syntmp-fx=-87 syntmp-i-703 syntmp-n-700) syntmp-v-701 (begin (vector-set! syntmp-v-701 syntmp-i-703 (syntmp-rebuild-macro-output-694 (vector-ref syntmp-x-695 syntmp-i-703) syntmp-m-696)) (syntmp-doloop-702 (syntmp-fx+-85 syntmp-i-703 1)))))))) ((symbol? syntmp-x-695) (syntax-error syntmp-x-695 "encountered raw symbol in macro output")) (else syntmp-x-695))))) (syntmp-rebuild-macro-output-694 (syntmp-p-688 (syntmp-wrap-145 syntmp-e-689 (syntmp-anti-mark-132 syntmp-w-691) syntmp-mod-693)) (string #\m))))) (syntmp-chi-application-155 (lambda (syntmp-x-704 syntmp-e-705 syntmp-r-706 syntmp-w-707 syntmp-s-708 syntmp-mod-709) ((lambda (syntmp-tmp-710) ((lambda (syntmp-tmp-711) (if syntmp-tmp-711 (apply (lambda (syntmp-e0-712 syntmp-e1-713) (syntmp-build-annotated-94 syntmp-s-708 (cons syntmp-x-704 (map (lambda (syntmp-e-714) (syntmp-chi-153 syntmp-e-714 syntmp-r-706 syntmp-w-707 syntmp-mod-709)) syntmp-e1-713)))) syntmp-tmp-711) (syntax-error syntmp-tmp-710))) (syntax-dispatch syntmp-tmp-710 (quote (any . each-any))))) syntmp-e-705))) (syntmp-chi-expr-154 (lambda (syntmp-type-716 syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (let ((syntmp-t-723 syntmp-type-716)) (if (memv syntmp-t-723 (quote (lexical))) (syntmp-build-annotated-94 syntmp-s-721 syntmp-value-717) (if (memv syntmp-t-723 (quote (core external-macro))) (syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (module-ref))) (call-with-values (lambda () (syntmp-value-717 syntmp-e-718)) (lambda (syntmp-id-724 syntmp-mod-725) (syntmp-build-annotated-94 syntmp-s-721 (make-module-ref syntmp-mod-725 syntmp-id-724 #f)))) (if (memv syntmp-t-723 (quote (lexical-call))) (syntmp-chi-application-155 (syntmp-build-annotated-94 (syntmp-source-annotation-108 (car syntmp-e-718)) syntmp-value-717) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (global-call))) (syntmp-chi-application-155 (syntmp-build-annotated-94 (syntmp-source-annotation-108 (car syntmp-e-718)) (make-module-ref (if (syntmp-syntax-object?-101 (car syntmp-e-718)) (syntmp-syntax-object-module-104 (car syntmp-e-718)) syntmp-mod-722) syntmp-value-717 #f)) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (constant))) (syntmp-build-data-95 syntmp-s-721 (syntmp-strip-164 (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (quote (())))) (if (memv syntmp-t-723 (quote (global))) (syntmp-build-annotated-94 syntmp-s-721 (make-module-ref syntmp-mod-722 syntmp-value-717 #f)) (if (memv syntmp-t-723 (quote (call))) (syntmp-chi-application-155 (syntmp-chi-153 (car syntmp-e-718) syntmp-r-719 syntmp-w-720 syntmp-mod-722) syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (if (memv syntmp-t-723 (quote (begin-form))) ((lambda (syntmp-tmp-726) ((lambda (syntmp-tmp-727) (if syntmp-tmp-727 (apply (lambda (syntmp-_-728 syntmp-e1-729 syntmp-e2-730) (syntmp-chi-sequence-147 (cons syntmp-e1-729 syntmp-e2-730) syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722)) syntmp-tmp-727) (syntax-error syntmp-tmp-726))) (syntax-dispatch syntmp-tmp-726 (quote (any any . each-any))))) syntmp-e-718) (if (memv syntmp-t-723 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-717 syntmp-e-718 syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722 syntmp-chi-sequence-147) (if (memv syntmp-t-723 (quote (eval-when-form))) ((lambda (syntmp-tmp-732) ((lambda (syntmp-tmp-733) (if syntmp-tmp-733 (apply (lambda (syntmp-_-734 syntmp-x-735 syntmp-e1-736 syntmp-e2-737) (let ((syntmp-when-list-738 (syntmp-chi-when-list-150 syntmp-e-718 syntmp-x-735 syntmp-w-720))) (if (memq (quote eval) syntmp-when-list-738) (syntmp-chi-sequence-147 (cons syntmp-e1-736 syntmp-e2-737) syntmp-r-719 syntmp-w-720 syntmp-s-721 syntmp-mod-722) (syntmp-chi-void-161)))) syntmp-tmp-733) (syntax-error syntmp-tmp-732))) (syntax-dispatch syntmp-tmp-732 (quote (any each-any any . each-any))))) syntmp-e-718) (if (memv syntmp-t-723 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-145 syntmp-value-717 syntmp-w-720 syntmp-mod-722) "invalid context for definition of") (if (memv syntmp-t-723 (quote (syntax))) (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) "reference to pattern variable outside syntax form") (if (memv syntmp-t-723 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-146 syntmp-e-718 syntmp-w-720 syntmp-s-721 syntmp-mod-722))))))))))))))))))) (syntmp-chi-153 (lambda (syntmp-e-741 syntmp-r-742 syntmp-w-743 syntmp-mod-744) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-741 syntmp-r-742 syntmp-w-743 #f #f syntmp-mod-744)) (lambda (syntmp-type-745 syntmp-value-746 syntmp-e-747 syntmp-w-748 syntmp-s-749 syntmp-mod-750) (syntmp-chi-expr-154 syntmp-type-745 syntmp-value-746 syntmp-e-747 syntmp-r-742 syntmp-w-748 syntmp-s-749 syntmp-mod-750))))) (syntmp-chi-top-152 (lambda (syntmp-e-751 syntmp-r-752 syntmp-w-753 syntmp-m-754 syntmp-esew-755 syntmp-mod-756) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-e-751 syntmp-r-752 syntmp-w-753 #f #f syntmp-mod-756)) (lambda (syntmp-type-771 syntmp-value-772 syntmp-e-773 syntmp-w-774 syntmp-s-775 syntmp-mod-776) (let ((syntmp-t-777 syntmp-type-771)) (if (memv syntmp-t-777 (quote (begin-form))) ((lambda (syntmp-tmp-778) ((lambda (syntmp-tmp-779) (if syntmp-tmp-779 (apply (lambda (syntmp-_-780) (syntmp-chi-void-161)) syntmp-tmp-779) ((lambda (syntmp-tmp-781) (if syntmp-tmp-781 (apply (lambda (syntmp-_-782 syntmp-e1-783 syntmp-e2-784) (syntmp-chi-top-sequence-148 (cons syntmp-e1-783 syntmp-e2-784) syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-m-754 syntmp-esew-755 syntmp-mod-776)) syntmp-tmp-781) (syntax-error syntmp-tmp-778))) (syntax-dispatch syntmp-tmp-778 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-778 (quote (any))))) syntmp-e-773) (if (memv syntmp-t-777 (quote (local-syntax-form))) (syntmp-chi-local-syntax-159 syntmp-value-772 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-mod-776 (lambda (syntmp-body-786 syntmp-r-787 syntmp-w-788 syntmp-s-789 syntmp-mod-790) (syntmp-chi-top-sequence-148 syntmp-body-786 syntmp-r-787 syntmp-w-788 syntmp-s-789 syntmp-m-754 syntmp-esew-755 syntmp-mod-790))) (if (memv syntmp-t-777 (quote (eval-when-form))) ((lambda (syntmp-tmp-791) ((lambda (syntmp-tmp-792) (if syntmp-tmp-792 (apply (lambda (syntmp-_-793 syntmp-x-794 syntmp-e1-795 syntmp-e2-796) (let ((syntmp-when-list-797 (syntmp-chi-when-list-150 syntmp-e-773 syntmp-x-794 syntmp-w-774)) (syntmp-body-798 (cons syntmp-e1-795 syntmp-e2-796))) (cond ((eq? syntmp-m-754 (quote e)) (if (memq (quote eval) syntmp-when-list-797) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote e) (quote (eval)) syntmp-mod-776) (syntmp-chi-void-161))) ((memq (quote load) syntmp-when-list-797) (if (or (memq (quote compile) syntmp-when-list-797) (and (eq? syntmp-m-754 (quote c&e)) (memq (quote eval) syntmp-when-list-797))) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote c&e) (quote (compile load)) syntmp-mod-776) (if (memq syntmp-m-754 (quote (c c&e))) (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote c) (quote (load)) syntmp-mod-776) (syntmp-chi-void-161)))) ((or (memq (quote compile) syntmp-when-list-797) (and (eq? syntmp-m-754 (quote c&e)) (memq (quote eval) syntmp-when-list-797))) (syntmp-top-level-eval-hook-89 (syntmp-chi-top-sequence-148 syntmp-body-798 syntmp-r-752 syntmp-w-774 syntmp-s-775 (quote e) (quote (eval)) syntmp-mod-776) syntmp-mod-776) (syntmp-chi-void-161)) (else (syntmp-chi-void-161))))) syntmp-tmp-792) (syntax-error syntmp-tmp-791))) (syntax-dispatch syntmp-tmp-791 (quote (any each-any any . each-any))))) syntmp-e-773) (if (memv syntmp-t-777 (quote (define-syntax-form))) (let ((syntmp-n-801 (syntmp-id-var-name-139 syntmp-value-772 syntmp-w-774)) (syntmp-r-802 (syntmp-macros-only-env-113 syntmp-r-752))) (let ((syntmp-t-803 syntmp-m-754)) (if (memv syntmp-t-803 (quote (c))) (if (memq (quote compile) syntmp-esew-755) (let ((syntmp-e-804 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)))) (begin (syntmp-top-level-eval-hook-89 syntmp-e-804 syntmp-mod-776) (if (memq (quote load) syntmp-esew-755) syntmp-e-804 (syntmp-chi-void-161)))) (if (memq (quote load) syntmp-esew-755) (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)) (syntmp-chi-void-161))) (if (memv syntmp-t-803 (quote (c&e))) (let ((syntmp-e-805 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)))) (begin (syntmp-top-level-eval-hook-89 syntmp-e-805 syntmp-mod-776) syntmp-e-805)) (begin (if (memq (quote eval) syntmp-esew-755) (syntmp-top-level-eval-hook-89 (syntmp-chi-install-global-149 syntmp-n-801 (syntmp-chi-153 syntmp-e-773 syntmp-r-802 syntmp-w-774 syntmp-mod-776)) syntmp-mod-776)) (syntmp-chi-void-161)))))) (if (memv syntmp-t-777 (quote (define-form))) (let ((syntmp-n-806 (syntmp-id-var-name-139 syntmp-value-772 syntmp-w-774))) (let ((syntmp-type-807 (syntmp-binding-type-109 (syntmp-lookup-114 syntmp-n-806 syntmp-r-752 syntmp-mod-776)))) (let ((syntmp-t-808 syntmp-type-807)) (if (memv syntmp-t-808 (quote (global))) (let ((syntmp-x-809 (syntmp-build-annotated-94 syntmp-s-775 (list (quote define) syntmp-n-806 (syntmp-chi-153 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-mod-776))))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-809 syntmp-mod-776)) syntmp-x-809)) (if (memv syntmp-t-808 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-145 syntmp-value-772 syntmp-w-774 syntmp-mod-776) "identifier out of context") (if (eq? syntmp-type-807 (quote external-macro)) (let ((syntmp-x-810 (syntmp-build-annotated-94 syntmp-s-775 (list (quote define) syntmp-n-806 (syntmp-chi-153 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-mod-776))))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-810 syntmp-mod-776)) syntmp-x-810)) (syntax-error (syntmp-wrap-145 syntmp-value-772 syntmp-w-774 syntmp-mod-776) "cannot define keyword at top level"))))))) (let ((syntmp-x-811 (syntmp-chi-expr-154 syntmp-type-771 syntmp-value-772 syntmp-e-773 syntmp-r-752 syntmp-w-774 syntmp-s-775 syntmp-mod-776))) (begin (if (eq? syntmp-m-754 (quote c&e)) (syntmp-top-level-eval-hook-89 syntmp-x-811 syntmp-mod-776)) syntmp-x-811)))))))))))) (syntmp-syntax-type-151 (lambda (syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (cond ((symbol? syntmp-e-812) (let ((syntmp-n-818 (syntmp-id-var-name-139 syntmp-e-812 syntmp-w-814))) (let ((syntmp-b-819 (syntmp-lookup-114 syntmp-n-818 syntmp-r-813 syntmp-mod-817))) (let ((syntmp-type-820 (syntmp-binding-type-109 syntmp-b-819))) (let ((syntmp-t-821 syntmp-type-820)) (if (memv syntmp-t-821 (quote (lexical))) (values syntmp-type-820 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-821 (quote (global))) (values syntmp-type-820 syntmp-n-818 syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-821 (quote (macro))) (syntmp-syntax-type-151 (syntmp-chi-macro-156 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-rib-816 syntmp-mod-817) syntmp-r-813 (quote (())) syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (values syntmp-type-820 (syntmp-binding-value-110 syntmp-b-819) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817))))))))) ((pair? syntmp-e-812) (let ((syntmp-first-822 (car syntmp-e-812))) (if (syntmp-id?-117 syntmp-first-822) (let ((syntmp-n-823 (syntmp-id-var-name-139 syntmp-first-822 syntmp-w-814))) (let ((syntmp-b-824 (syntmp-lookup-114 syntmp-n-823 syntmp-r-813 (or (and (syntmp-syntax-object?-101 syntmp-first-822) (syntmp-syntax-object-module-104 syntmp-first-822)) syntmp-mod-817)))) (let ((syntmp-type-825 (syntmp-binding-type-109 syntmp-b-824))) (let ((syntmp-t-826 syntmp-type-825)) (if (memv syntmp-t-826 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (global))) (values (quote global-call) syntmp-n-823 syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (macro))) (syntmp-syntax-type-151 (syntmp-chi-macro-156 (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-r-813 syntmp-w-814 syntmp-rib-816 syntmp-mod-817) syntmp-r-813 (quote (())) syntmp-s-815 syntmp-rib-816 syntmp-mod-817) (if (memv syntmp-t-826 (quote (core external-macro module-ref))) (values syntmp-type-825 (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-110 syntmp-b-824) syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (begin))) (values (quote begin-form) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817) (if (memv syntmp-t-826 (quote (define))) ((lambda (syntmp-tmp-827) ((lambda (syntmp-tmp-828) (if (if syntmp-tmp-828 (apply (lambda (syntmp-_-829 syntmp-name-830 syntmp-val-831) (syntmp-id?-117 syntmp-name-830)) syntmp-tmp-828) #f) (apply (lambda (syntmp-_-832 syntmp-name-833 syntmp-val-834) (values (quote define-form) syntmp-name-833 syntmp-val-834 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) syntmp-tmp-828) ((lambda (syntmp-tmp-835) (if (if syntmp-tmp-835 (apply (lambda (syntmp-_-836 syntmp-name-837 syntmp-args-838 syntmp-e1-839 syntmp-e2-840) (and (syntmp-id?-117 syntmp-name-837) (syntmp-valid-bound-ids?-142 (syntmp-lambda-var-list-166 syntmp-args-838)))) syntmp-tmp-835) #f) (apply (lambda (syntmp-_-841 syntmp-name-842 syntmp-args-843 syntmp-e1-844 syntmp-e2-845) (values (quote define-form) (syntmp-wrap-145 syntmp-name-842 syntmp-w-814 syntmp-mod-817) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) (syntmp-wrap-145 (cons syntmp-args-843 (cons syntmp-e1-844 syntmp-e2-845)) syntmp-w-814 syntmp-mod-817)) (quote (())) syntmp-s-815 syntmp-mod-817)) syntmp-tmp-835) ((lambda (syntmp-tmp-847) (if (if syntmp-tmp-847 (apply (lambda (syntmp-_-848 syntmp-name-849) (syntmp-id?-117 syntmp-name-849)) syntmp-tmp-847) #f) (apply (lambda (syntmp-_-850 syntmp-name-851) (values (quote define-form) (syntmp-wrap-145 syntmp-name-851 syntmp-w-814 syntmp-mod-817) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote (())) syntmp-s-815 syntmp-mod-817)) syntmp-tmp-847) (syntax-error syntmp-tmp-827))) (syntax-dispatch syntmp-tmp-827 (quote (any any)))))) (syntax-dispatch syntmp-tmp-827 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-827 (quote (any any any))))) syntmp-e-812) (if (memv syntmp-t-826 (quote (define-syntax))) ((lambda (syntmp-tmp-852) ((lambda (syntmp-tmp-853) (if (if syntmp-tmp-853 (apply (lambda (syntmp-_-854 syntmp-name-855 syntmp-val-856) (syntmp-id?-117 syntmp-name-855)) syntmp-tmp-853) #f) (apply (lambda (syntmp-_-857 syntmp-name-858 syntmp-val-859) (values (quote define-syntax-form) syntmp-name-858 syntmp-val-859 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) syntmp-tmp-853) (syntax-error syntmp-tmp-852))) (syntax-dispatch syntmp-tmp-852 (quote (any any any))))) syntmp-e-812) (values (quote call) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)))))))))))))) (values (quote call) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)))) ((syntmp-syntax-object?-101 syntmp-e-812) (syntmp-syntax-type-151 (syntmp-syntax-object-expression-102 syntmp-e-812) syntmp-r-813 (syntmp-join-wraps-136 syntmp-w-814 (syntmp-syntax-object-wrap-103 syntmp-e-812)) #f syntmp-rib-816 (or (syntmp-syntax-object-module-104 syntmp-e-812) syntmp-mod-817))) ((annotation? syntmp-e-812) (syntmp-syntax-type-151 (annotation-expression syntmp-e-812) syntmp-r-813 syntmp-w-814 (annotation-source syntmp-e-812) syntmp-rib-816 syntmp-mod-817)) ((self-evaluating? syntmp-e-812) (values (quote constant) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817)) (else (values (quote other) #f syntmp-e-812 syntmp-w-814 syntmp-s-815 syntmp-mod-817))))) (syntmp-chi-when-list-150 (lambda (syntmp-e-860 syntmp-when-list-861 syntmp-w-862) (let syntmp-f-863 ((syntmp-when-list-864 syntmp-when-list-861) (syntmp-situations-865 (quote ()))) (if (null? syntmp-when-list-864) syntmp-situations-865 (syntmp-f-863 (cdr syntmp-when-list-864) (cons (let ((syntmp-x-866 (car syntmp-when-list-864))) (cond ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote compile)) ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote load)) ((syntmp-free-id=?-140 syntmp-x-866 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))) (quote eval)) (else (syntax-error (syntmp-wrap-145 syntmp-x-866 syntmp-w-862 #f) "invalid eval-when situation")))) syntmp-situations-865)))))) (syntmp-chi-install-global-149 (lambda (syntmp-name-878 syntmp-e-879) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote install-global-transformer)) (syntmp-build-data-95 #f syntmp-name-878) syntmp-e-879)))) (syntmp-chi-top-sequence-148 (lambda (syntmp-body-880 syntmp-r-881 syntmp-w-882 syntmp-s-883 syntmp-m-884 syntmp-esew-885 syntmp-mod-886) (syntmp-build-sequence-96 syntmp-s-883 (let syntmp-dobody-887 ((syntmp-body-888 syntmp-body-880) (syntmp-r-889 syntmp-r-881) (syntmp-w-890 syntmp-w-882) (syntmp-m-891 syntmp-m-884) (syntmp-esew-892 syntmp-esew-885) (syntmp-mod-893 syntmp-mod-886)) (if (null? syntmp-body-888) (quote ()) (let ((syntmp-first-894 (syntmp-chi-top-152 (car syntmp-body-888) syntmp-r-889 syntmp-w-890 syntmp-m-891 syntmp-esew-892 syntmp-mod-893))) (cons syntmp-first-894 (syntmp-dobody-887 (cdr syntmp-body-888) syntmp-r-889 syntmp-w-890 syntmp-m-891 syntmp-esew-892 syntmp-mod-893)))))))) (syntmp-chi-sequence-147 (lambda (syntmp-body-895 syntmp-r-896 syntmp-w-897 syntmp-s-898 syntmp-mod-899) (syntmp-build-sequence-96 syntmp-s-898 (let syntmp-dobody-900 ((syntmp-body-901 syntmp-body-895) (syntmp-r-902 syntmp-r-896) (syntmp-w-903 syntmp-w-897) (syntmp-mod-904 syntmp-mod-899)) (if (null? syntmp-body-901) (quote ()) (let ((syntmp-first-905 (syntmp-chi-153 (car syntmp-body-901) syntmp-r-902 syntmp-w-903 syntmp-mod-904))) (cons syntmp-first-905 (syntmp-dobody-900 (cdr syntmp-body-901) syntmp-r-902 syntmp-w-903 syntmp-mod-904)))))))) (syntmp-source-wrap-146 (lambda (syntmp-x-906 syntmp-w-907 syntmp-s-908 syntmp-defmod-909) (syntmp-wrap-145 (if syntmp-s-908 (make-annotation syntmp-x-906 syntmp-s-908 #f) syntmp-x-906) syntmp-w-907 syntmp-defmod-909))) (syntmp-wrap-145 (lambda (syntmp-x-910 syntmp-w-911 syntmp-defmod-912) (cond ((and (null? (syntmp-wrap-marks-120 syntmp-w-911)) (null? (syntmp-wrap-subst-121 syntmp-w-911))) syntmp-x-910) ((syntmp-syntax-object?-101 syntmp-x-910) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-910) (syntmp-join-wraps-136 syntmp-w-911 (syntmp-syntax-object-wrap-103 syntmp-x-910)) (syntmp-syntax-object-module-104 syntmp-x-910))) ((null? syntmp-x-910) syntmp-x-910) (else (syntmp-make-syntax-object-100 syntmp-x-910 syntmp-w-911 syntmp-defmod-912))))) (syntmp-bound-id-member?-144 (lambda (syntmp-x-913 syntmp-list-914) (and (not (null? syntmp-list-914)) (or (syntmp-bound-id=?-141 syntmp-x-913 (car syntmp-list-914)) (syntmp-bound-id-member?-144 syntmp-x-913 (cdr syntmp-list-914)))))) (syntmp-distinct-bound-ids?-143 (lambda (syntmp-ids-915) (let syntmp-distinct?-916 ((syntmp-ids-917 syntmp-ids-915)) (or (null? syntmp-ids-917) (and (not (syntmp-bound-id-member?-144 (car syntmp-ids-917) (cdr syntmp-ids-917))) (syntmp-distinct?-916 (cdr syntmp-ids-917))))))) (syntmp-valid-bound-ids?-142 (lambda (syntmp-ids-918) (and (let syntmp-all-ids?-919 ((syntmp-ids-920 syntmp-ids-918)) (or (null? syntmp-ids-920) (and (syntmp-id?-117 (car syntmp-ids-920)) (syntmp-all-ids?-919 (cdr syntmp-ids-920))))) (syntmp-distinct-bound-ids?-143 syntmp-ids-918)))) (syntmp-bound-id=?-141 (lambda (syntmp-i-921 syntmp-j-922) (if (and (syntmp-syntax-object?-101 syntmp-i-921) (syntmp-syntax-object?-101 syntmp-j-922)) (and (eq? (let ((syntmp-e-923 (syntmp-syntax-object-expression-102 syntmp-i-921))) (if (annotation? syntmp-e-923) (annotation-expression syntmp-e-923) syntmp-e-923)) (let ((syntmp-e-924 (syntmp-syntax-object-expression-102 syntmp-j-922))) (if (annotation? syntmp-e-924) (annotation-expression syntmp-e-924) syntmp-e-924))) (syntmp-same-marks?-138 (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-i-921)) (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-j-922)))) (eq? (let ((syntmp-e-925 syntmp-i-921)) (if (annotation? syntmp-e-925) (annotation-expression syntmp-e-925) syntmp-e-925)) (let ((syntmp-e-926 syntmp-j-922)) (if (annotation? syntmp-e-926) (annotation-expression syntmp-e-926) syntmp-e-926)))))) (syntmp-free-id=?-140 (lambda (syntmp-i-927 syntmp-j-928) (and (eq? (let ((syntmp-x-929 syntmp-i-927)) (let ((syntmp-e-930 (if (syntmp-syntax-object?-101 syntmp-x-929) (syntmp-syntax-object-expression-102 syntmp-x-929) syntmp-x-929))) (if (annotation? syntmp-e-930) (annotation-expression syntmp-e-930) syntmp-e-930))) (let ((syntmp-x-931 syntmp-j-928)) (let ((syntmp-e-932 (if (syntmp-syntax-object?-101 syntmp-x-931) (syntmp-syntax-object-expression-102 syntmp-x-931) syntmp-x-931))) (if (annotation? syntmp-e-932) (annotation-expression syntmp-e-932) syntmp-e-932)))) (eq? (syntmp-id-var-name-139 syntmp-i-927 (quote (()))) (syntmp-id-var-name-139 syntmp-j-928 (quote (()))))))) (syntmp-id-var-name-139 (lambda (syntmp-id-933 syntmp-w-934) (letrec ((syntmp-search-vector-rib-937 (lambda (syntmp-sym-948 syntmp-subst-949 syntmp-marks-950 syntmp-symnames-951 syntmp-ribcage-952) (let ((syntmp-n-953 (vector-length syntmp-symnames-951))) (let syntmp-f-954 ((syntmp-i-955 0)) (cond ((syntmp-fx=-87 syntmp-i-955 syntmp-n-953) (syntmp-search-935 syntmp-sym-948 (cdr syntmp-subst-949) syntmp-marks-950)) ((and (eq? (vector-ref syntmp-symnames-951 syntmp-i-955) syntmp-sym-948) (syntmp-same-marks?-138 syntmp-marks-950 (vector-ref (syntmp-ribcage-marks-127 syntmp-ribcage-952) syntmp-i-955))) (values (vector-ref (syntmp-ribcage-labels-128 syntmp-ribcage-952) syntmp-i-955) syntmp-marks-950)) (else (syntmp-f-954 (syntmp-fx+-85 syntmp-i-955 1)))))))) (syntmp-search-list-rib-936 (lambda (syntmp-sym-956 syntmp-subst-957 syntmp-marks-958 syntmp-symnames-959 syntmp-ribcage-960) (let syntmp-f-961 ((syntmp-symnames-962 syntmp-symnames-959) (syntmp-i-963 0)) (cond ((null? syntmp-symnames-962) (syntmp-search-935 syntmp-sym-956 (cdr syntmp-subst-957) syntmp-marks-958)) ((and (eq? (car syntmp-symnames-962) syntmp-sym-956) (syntmp-same-marks?-138 syntmp-marks-958 (list-ref (syntmp-ribcage-marks-127 syntmp-ribcage-960) syntmp-i-963))) (values (list-ref (syntmp-ribcage-labels-128 syntmp-ribcage-960) syntmp-i-963) syntmp-marks-958)) (else (syntmp-f-961 (cdr syntmp-symnames-962) (syntmp-fx+-85 syntmp-i-963 1))))))) (syntmp-search-935 (lambda (syntmp-sym-964 syntmp-subst-965 syntmp-marks-966) (if (null? syntmp-subst-965) (values #f syntmp-marks-966) (let ((syntmp-fst-967 (car syntmp-subst-965))) (if (eq? syntmp-fst-967 (quote shift)) (syntmp-search-935 syntmp-sym-964 (cdr syntmp-subst-965) (cdr syntmp-marks-966)) (let ((syntmp-symnames-968 (syntmp-ribcage-symnames-126 syntmp-fst-967))) (if (vector? syntmp-symnames-968) (syntmp-search-vector-rib-937 syntmp-sym-964 syntmp-subst-965 syntmp-marks-966 syntmp-symnames-968 syntmp-fst-967) (syntmp-search-list-rib-936 syntmp-sym-964 syntmp-subst-965 syntmp-marks-966 syntmp-symnames-968 syntmp-fst-967))))))))) (cond ((symbol? syntmp-id-933) (or (call-with-values (lambda () (syntmp-search-935 syntmp-id-933 (syntmp-wrap-subst-121 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w-934))) (lambda (syntmp-x-970 . syntmp-ignore-969) syntmp-x-970)) syntmp-id-933)) ((syntmp-syntax-object?-101 syntmp-id-933) (let ((syntmp-id-971 (let ((syntmp-e-973 (syntmp-syntax-object-expression-102 syntmp-id-933))) (if (annotation? syntmp-e-973) (annotation-expression syntmp-e-973) syntmp-e-973))) (syntmp-w1-972 (syntmp-syntax-object-wrap-103 syntmp-id-933))) (let ((syntmp-marks-974 (syntmp-join-marks-137 (syntmp-wrap-marks-120 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w1-972)))) (call-with-values (lambda () (syntmp-search-935 syntmp-id-971 (syntmp-wrap-subst-121 syntmp-w-934) syntmp-marks-974)) (lambda (syntmp-new-id-975 syntmp-marks-976) (or syntmp-new-id-975 (call-with-values (lambda () (syntmp-search-935 syntmp-id-971 (syntmp-wrap-subst-121 syntmp-w1-972) syntmp-marks-976)) (lambda (syntmp-x-978 . syntmp-ignore-977) syntmp-x-978)) syntmp-id-971)))))) ((annotation? syntmp-id-933) (let ((syntmp-id-979 (let ((syntmp-e-980 syntmp-id-933)) (if (annotation? syntmp-e-980) (annotation-expression syntmp-e-980) syntmp-e-980)))) (or (call-with-values (lambda () (syntmp-search-935 syntmp-id-979 (syntmp-wrap-subst-121 syntmp-w-934) (syntmp-wrap-marks-120 syntmp-w-934))) (lambda (syntmp-x-982 . syntmp-ignore-981) syntmp-x-982)) syntmp-id-979))) (else (syntmp-error-hook-91 (quote id-var-name) "invalid id" syntmp-id-933)))))) (syntmp-same-marks?-138 (lambda (syntmp-x-983 syntmp-y-984) (or (eq? syntmp-x-983 syntmp-y-984) (and (not (null? syntmp-x-983)) (not (null? syntmp-y-984)) (eq? (car syntmp-x-983) (car syntmp-y-984)) (syntmp-same-marks?-138 (cdr syntmp-x-983) (cdr syntmp-y-984)))))) (syntmp-join-marks-137 (lambda (syntmp-m1-985 syntmp-m2-986) (syntmp-smart-append-135 syntmp-m1-985 syntmp-m2-986))) (syntmp-join-wraps-136 (lambda (syntmp-w1-987 syntmp-w2-988) (let ((syntmp-m1-989 (syntmp-wrap-marks-120 syntmp-w1-987)) (syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w1-987))) (if (null? syntmp-m1-989) (if (null? syntmp-s1-990) syntmp-w2-988 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w2-988) (syntmp-smart-append-135 syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w2-988)))) (syntmp-make-wrap-119 (syntmp-smart-append-135 syntmp-m1-989 (syntmp-wrap-marks-120 syntmp-w2-988)) (syntmp-smart-append-135 syntmp-s1-990 (syntmp-wrap-subst-121 syntmp-w2-988))))))) (syntmp-smart-append-135 (lambda (syntmp-m1-991 syntmp-m2-992) (if (null? syntmp-m2-992) syntmp-m1-991 (append syntmp-m1-991 syntmp-m2-992)))) (syntmp-make-binding-wrap-134 (lambda (syntmp-ids-993 syntmp-labels-994 syntmp-w-995) (if (null? syntmp-ids-993) syntmp-w-995 (syntmp-make-wrap-119 (syntmp-wrap-marks-120 syntmp-w-995) (cons (let ((syntmp-labelvec-996 (list->vector syntmp-labels-994))) (let ((syntmp-n-997 (vector-length syntmp-labelvec-996))) (let ((syntmp-symnamevec-998 (make-vector syntmp-n-997)) (syntmp-marksvec-999 (make-vector syntmp-n-997))) (begin (let syntmp-f-1000 ((syntmp-ids-1001 syntmp-ids-993) (syntmp-i-1002 0)) (if (not (null? syntmp-ids-1001)) (call-with-values (lambda () (syntmp-id-sym-name&marks-118 (car syntmp-ids-1001) syntmp-w-995)) (lambda (syntmp-symname-1003 syntmp-marks-1004) (begin (vector-set! syntmp-symnamevec-998 syntmp-i-1002 syntmp-symname-1003) (vector-set! syntmp-marksvec-999 syntmp-i-1002 syntmp-marks-1004) (syntmp-f-1000 (cdr syntmp-ids-1001) (syntmp-fx+-85 syntmp-i-1002 1))))))) (syntmp-make-ribcage-124 syntmp-symnamevec-998 syntmp-marksvec-999 syntmp-labelvec-996))))) (syntmp-wrap-subst-121 syntmp-w-995)))))) (syntmp-extend-ribcage!-133 (lambda (syntmp-ribcage-1005 syntmp-id-1006 syntmp-label-1007) (begin (syntmp-set-ribcage-symnames!-129 syntmp-ribcage-1005 (cons (let ((syntmp-e-1008 (syntmp-syntax-object-expression-102 syntmp-id-1006))) (if (annotation? syntmp-e-1008) (annotation-expression syntmp-e-1008) syntmp-e-1008)) (syntmp-ribcage-symnames-126 syntmp-ribcage-1005))) (syntmp-set-ribcage-marks!-130 syntmp-ribcage-1005 (cons (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-id-1006)) (syntmp-ribcage-marks-127 syntmp-ribcage-1005))) (syntmp-set-ribcage-labels!-131 syntmp-ribcage-1005 (cons syntmp-label-1007 (syntmp-ribcage-labels-128 syntmp-ribcage-1005)))))) (syntmp-anti-mark-132 (lambda (syntmp-w-1009) (syntmp-make-wrap-119 (cons #f (syntmp-wrap-marks-120 syntmp-w-1009)) (cons (quote shift) (syntmp-wrap-subst-121 syntmp-w-1009))))) (syntmp-set-ribcage-labels!-131 (lambda (syntmp-x-1010 syntmp-update-1011) (vector-set! syntmp-x-1010 3 syntmp-update-1011))) (syntmp-set-ribcage-marks!-130 (lambda (syntmp-x-1012 syntmp-update-1013) (vector-set! syntmp-x-1012 2 syntmp-update-1013))) (syntmp-set-ribcage-symnames!-129 (lambda (syntmp-x-1014 syntmp-update-1015) (vector-set! syntmp-x-1014 1 syntmp-update-1015))) (syntmp-ribcage-labels-128 (lambda (syntmp-x-1016) (vector-ref syntmp-x-1016 3))) (syntmp-ribcage-marks-127 (lambda (syntmp-x-1017) (vector-ref syntmp-x-1017 2))) (syntmp-ribcage-symnames-126 (lambda (syntmp-x-1018) (vector-ref syntmp-x-1018 1))) (syntmp-ribcage?-125 (lambda (syntmp-x-1019) (and (vector? syntmp-x-1019) (= (vector-length syntmp-x-1019) 4) (eq? (vector-ref syntmp-x-1019 0) (quote ribcage))))) (syntmp-make-ribcage-124 (lambda (syntmp-symnames-1020 syntmp-marks-1021 syntmp-labels-1022) (vector (quote ribcage) syntmp-symnames-1020 syntmp-marks-1021 syntmp-labels-1022))) (syntmp-gen-labels-123 (lambda (syntmp-ls-1023) (if (null? syntmp-ls-1023) (quote ()) (cons (syntmp-gen-label-122) (syntmp-gen-labels-123 (cdr syntmp-ls-1023)))))) (syntmp-gen-label-122 (lambda () (string #\i))) (syntmp-wrap-subst-121 cdr) (syntmp-wrap-marks-120 car) (syntmp-make-wrap-119 cons) (syntmp-id-sym-name&marks-118 (lambda (syntmp-x-1024 syntmp-w-1025) (if (syntmp-syntax-object?-101 syntmp-x-1024) (values (let ((syntmp-e-1026 (syntmp-syntax-object-expression-102 syntmp-x-1024))) (if (annotation? syntmp-e-1026) (annotation-expression syntmp-e-1026) syntmp-e-1026)) (syntmp-join-marks-137 (syntmp-wrap-marks-120 syntmp-w-1025) (syntmp-wrap-marks-120 (syntmp-syntax-object-wrap-103 syntmp-x-1024)))) (values (let ((syntmp-e-1027 syntmp-x-1024)) (if (annotation? syntmp-e-1027) (annotation-expression syntmp-e-1027) syntmp-e-1027)) (syntmp-wrap-marks-120 syntmp-w-1025))))) (syntmp-id?-117 (lambda (syntmp-x-1028) (cond ((symbol? syntmp-x-1028) #t) ((syntmp-syntax-object?-101 syntmp-x-1028) (symbol? (let ((syntmp-e-1029 (syntmp-syntax-object-expression-102 syntmp-x-1028))) (if (annotation? syntmp-e-1029) (annotation-expression syntmp-e-1029) syntmp-e-1029)))) ((annotation? syntmp-x-1028) (symbol? (annotation-expression syntmp-x-1028))) (else #f)))) (syntmp-nonsymbol-id?-116 (lambda (syntmp-x-1030) (and (syntmp-syntax-object?-101 syntmp-x-1030) (symbol? (let ((syntmp-e-1031 (syntmp-syntax-object-expression-102 syntmp-x-1030))) (if (annotation? syntmp-e-1031) (annotation-expression syntmp-e-1031) syntmp-e-1031)))))) (syntmp-global-extend-115 (lambda (syntmp-type-1032 syntmp-sym-1033 syntmp-val-1034) (syntmp-put-global-definition-hook-92 syntmp-sym-1033 (cons syntmp-type-1032 syntmp-val-1034) (module-name (current-module))))) (syntmp-lookup-114 (lambda (syntmp-x-1035 syntmp-r-1036 syntmp-mod-1037) (cond ((assq syntmp-x-1035 syntmp-r-1036) => cdr) ((symbol? syntmp-x-1035) (or (syntmp-get-global-definition-hook-93 syntmp-x-1035 syntmp-mod-1037) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-113 (lambda (syntmp-r-1038) (if (null? syntmp-r-1038) (quote ()) (let ((syntmp-a-1039 (car syntmp-r-1038))) (if (eq? (cadr syntmp-a-1039) (quote macro)) (cons syntmp-a-1039 (syntmp-macros-only-env-113 (cdr syntmp-r-1038))) (syntmp-macros-only-env-113 (cdr syntmp-r-1038))))))) (syntmp-extend-var-env-112 (lambda (syntmp-labels-1040 syntmp-vars-1041 syntmp-r-1042) (if (null? syntmp-labels-1040) syntmp-r-1042 (syntmp-extend-var-env-112 (cdr syntmp-labels-1040) (cdr syntmp-vars-1041) (cons (cons (car syntmp-labels-1040) (cons (quote lexical) (car syntmp-vars-1041))) syntmp-r-1042))))) (syntmp-extend-env-111 (lambda (syntmp-labels-1043 syntmp-bindings-1044 syntmp-r-1045) (if (null? syntmp-labels-1043) syntmp-r-1045 (syntmp-extend-env-111 (cdr syntmp-labels-1043) (cdr syntmp-bindings-1044) (cons (cons (car syntmp-labels-1043) (car syntmp-bindings-1044)) syntmp-r-1045))))) (syntmp-binding-value-110 cdr) (syntmp-binding-type-109 car) (syntmp-source-annotation-108 (lambda (syntmp-x-1046) (cond ((annotation? syntmp-x-1046) (annotation-source syntmp-x-1046)) ((syntmp-syntax-object?-101 syntmp-x-1046) (syntmp-source-annotation-108 (syntmp-syntax-object-expression-102 syntmp-x-1046))) (else #f)))) (syntmp-set-syntax-object-module!-107 (lambda (syntmp-x-1047 syntmp-update-1048) (vector-set! syntmp-x-1047 3 syntmp-update-1048))) (syntmp-set-syntax-object-wrap!-106 (lambda (syntmp-x-1049 syntmp-update-1050) (vector-set! syntmp-x-1049 2 syntmp-update-1050))) (syntmp-set-syntax-object-expression!-105 (lambda (syntmp-x-1051 syntmp-update-1052) (vector-set! syntmp-x-1051 1 syntmp-update-1052))) (syntmp-syntax-object-module-104 (lambda (syntmp-x-1053) (vector-ref syntmp-x-1053 3))) (syntmp-syntax-object-wrap-103 (lambda (syntmp-x-1054) (vector-ref syntmp-x-1054 2))) (syntmp-syntax-object-expression-102 (lambda (syntmp-x-1055) (vector-ref syntmp-x-1055 1))) (syntmp-syntax-object?-101 (lambda (syntmp-x-1056) (and (vector? syntmp-x-1056) (= (vector-length syntmp-x-1056) 4) (eq? (vector-ref syntmp-x-1056 0) (quote syntax-object))))) (syntmp-make-syntax-object-100 (lambda (syntmp-expression-1057 syntmp-wrap-1058 syntmp-module-1059) (vector (quote syntax-object) syntmp-expression-1057 syntmp-wrap-1058 syntmp-module-1059))) (syntmp-build-letrec-99 (lambda (syntmp-src-1060 syntmp-vars-1061 syntmp-val-exps-1062 syntmp-body-exp-1063) (if (null? syntmp-vars-1061) (syntmp-build-annotated-94 syntmp-src-1060 syntmp-body-exp-1063) (syntmp-build-annotated-94 syntmp-src-1060 (list (quote letrec) (map list syntmp-vars-1061 syntmp-val-exps-1062) syntmp-body-exp-1063))))) (syntmp-build-named-let-98 (lambda (syntmp-src-1064 syntmp-vars-1065 syntmp-val-exps-1066 syntmp-body-exp-1067) (if (null? syntmp-vars-1065) (syntmp-build-annotated-94 syntmp-src-1064 syntmp-body-exp-1067) (syntmp-build-annotated-94 syntmp-src-1064 (list (quote let) (car syntmp-vars-1065) (map list (cdr syntmp-vars-1065) syntmp-val-exps-1066) syntmp-body-exp-1067))))) (syntmp-build-let-97 (lambda (syntmp-src-1068 syntmp-vars-1069 syntmp-val-exps-1070 syntmp-body-exp-1071) (if (null? syntmp-vars-1069) (syntmp-build-annotated-94 syntmp-src-1068 syntmp-body-exp-1071) (syntmp-build-annotated-94 syntmp-src-1068 (list (quote let) (map list syntmp-vars-1069 syntmp-val-exps-1070) syntmp-body-exp-1071))))) (syntmp-build-sequence-96 (lambda (syntmp-src-1072 syntmp-exps-1073) (if (null? (cdr syntmp-exps-1073)) (syntmp-build-annotated-94 syntmp-src-1072 (car syntmp-exps-1073)) (syntmp-build-annotated-94 syntmp-src-1072 (cons (quote begin) syntmp-exps-1073))))) (syntmp-build-data-95 (lambda (syntmp-src-1074 syntmp-exp-1075) (if (and (self-evaluating? syntmp-exp-1075) (not (vector? syntmp-exp-1075))) (syntmp-build-annotated-94 syntmp-src-1074 syntmp-exp-1075) (syntmp-build-annotated-94 syntmp-src-1074 (list (quote quote) syntmp-exp-1075))))) (syntmp-build-annotated-94 (lambda (syntmp-src-1076 syntmp-exp-1077) (if (and syntmp-src-1076 (not (annotation? syntmp-exp-1077))) (make-annotation syntmp-exp-1077 syntmp-src-1076 #t) syntmp-exp-1077))) (syntmp-get-global-definition-hook-93 (lambda (syntmp-symbol-1078 syntmp-module-1079) (let ((syntmp-module-1080 (if syntmp-module-1079 (resolve-module syntmp-module-1079) (warn "wha" syntmp-symbol-1078 (current-module))))) (let ((syntmp-v-1081 (module-variable syntmp-module-1080 syntmp-symbol-1078))) (and syntmp-v-1081 (or (object-property syntmp-v-1081 (quote *sc-expander*)) (and (variable-bound? syntmp-v-1081) (macro? (variable-ref syntmp-v-1081)) (macro-transformer (variable-ref syntmp-v-1081)) guile-macro))))))) (syntmp-put-global-definition-hook-92 (lambda (syntmp-symbol-1082 syntmp-binding-1083 syntmp-modname-1084) (let ((syntmp-module-1085 (if syntmp-modname-1084 (resolve-module syntmp-modname-1084) (current-module)))) (let ((syntmp-v-1086 (or (module-variable syntmp-module-1085 syntmp-symbol-1082) (let ((syntmp-v-1087 (make-variable (quote sc-macro)))) (begin (module-add! syntmp-module-1085 syntmp-symbol-1082 syntmp-v-1087) syntmp-v-1087))))) (begin (if (not (variable-bound? syntmp-v-1086)) (variable-set! syntmp-v-1086 (gensym))) (set-object-property! syntmp-v-1086 (quote *sc-expander*) syntmp-binding-1083)))))) (syntmp-error-hook-91 (lambda (syntmp-who-1088 syntmp-why-1089 syntmp-what-1090) (error syntmp-who-1088 "~a ~s" syntmp-why-1089 syntmp-what-1090))) (syntmp-local-eval-hook-90 (lambda (syntmp-x-1091 syntmp-mod-1092) (eval (list syntmp-noexpand-84 syntmp-x-1091) (if syntmp-mod-1092 (resolve-module syntmp-mod-1092) (interaction-environment))))) (syntmp-top-level-eval-hook-89 (lambda (syntmp-x-1093 syntmp-mod-1094) (eval (list syntmp-noexpand-84 syntmp-x-1093) (if syntmp-mod-1094 (resolve-module syntmp-mod-1094) (interaction-environment))))) (syntmp-fx<-88 <) (syntmp-fx=-87 =) (syntmp-fx--86 -) (syntmp-fx+-85 +) (syntmp-noexpand-84 "noexpand")) (begin (syntmp-global-extend-115 (quote local-syntax) (quote letrec-syntax) #t) (syntmp-global-extend-115 (quote local-syntax) (quote let-syntax) #f) (syntmp-global-extend-115 (quote core) (quote fluid-let-syntax) (lambda (syntmp-e-1095 syntmp-r-1096 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) ((lambda (syntmp-tmp-1100) ((lambda (syntmp-tmp-1101) (if (if syntmp-tmp-1101 (apply (lambda (syntmp-_-1102 syntmp-var-1103 syntmp-val-1104 syntmp-e1-1105 syntmp-e2-1106) (syntmp-valid-bound-ids?-142 syntmp-var-1103)) syntmp-tmp-1101) #f) (apply (lambda (syntmp-_-1108 syntmp-var-1109 syntmp-val-1110 syntmp-e1-1111 syntmp-e2-1112) (let ((syntmp-names-1113 (map (lambda (syntmp-x-1114) (syntmp-id-var-name-139 syntmp-x-1114 syntmp-w-1097)) syntmp-var-1109))) (begin (for-each (lambda (syntmp-id-1116 syntmp-n-1117) (let ((syntmp-t-1118 (syntmp-binding-type-109 (syntmp-lookup-114 syntmp-n-1117 syntmp-r-1096 syntmp-mod-1099)))) (if (memv syntmp-t-1118 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-146 syntmp-id-1116 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) "identifier out of context")))) syntmp-var-1109 syntmp-names-1113) (syntmp-chi-body-157 (cons syntmp-e1-1111 syntmp-e2-1112) (syntmp-source-wrap-146 syntmp-e-1095 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099) (syntmp-extend-env-111 syntmp-names-1113 (let ((syntmp-trans-r-1121 (syntmp-macros-only-env-113 syntmp-r-1096))) (map (lambda (syntmp-x-1122) (cons (quote macro) (syntmp-eval-local-transformer-160 (syntmp-chi-153 syntmp-x-1122 syntmp-trans-r-1121 syntmp-w-1097 syntmp-mod-1099) syntmp-mod-1099))) syntmp-val-1110)) syntmp-r-1096) syntmp-w-1097 syntmp-mod-1099)))) syntmp-tmp-1101) ((lambda (syntmp-_-1124) (syntax-error (syntmp-source-wrap-146 syntmp-e-1095 syntmp-w-1097 syntmp-s-1098 syntmp-mod-1099))) syntmp-tmp-1100))) (syntax-dispatch syntmp-tmp-1100 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1095))) (syntmp-global-extend-115 (quote core) (quote quote) (lambda (syntmp-e-1125 syntmp-r-1126 syntmp-w-1127 syntmp-s-1128 syntmp-mod-1129) ((lambda (syntmp-tmp-1130) ((lambda (syntmp-tmp-1131) (if syntmp-tmp-1131 (apply (lambda (syntmp-_-1132 syntmp-e-1133) (syntmp-build-data-95 syntmp-s-1128 (syntmp-strip-164 syntmp-e-1133 syntmp-w-1127))) syntmp-tmp-1131) ((lambda (syntmp-_-1134) (syntax-error (syntmp-source-wrap-146 syntmp-e-1125 syntmp-w-1127 syntmp-s-1128 syntmp-mod-1129))) syntmp-tmp-1130))) (syntax-dispatch syntmp-tmp-1130 (quote (any any))))) syntmp-e-1125))) (syntmp-global-extend-115 (quote core) (quote syntax) (letrec ((syntmp-regen-1142 (lambda (syntmp-x-1143) (let ((syntmp-t-1144 (car syntmp-x-1143))) (if (memv syntmp-t-1144 (quote (ref))) (syntmp-build-annotated-94 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (primitive))) (syntmp-build-annotated-94 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (quote))) (syntmp-build-data-95 #f (cadr syntmp-x-1143)) (if (memv syntmp-t-1144 (quote (lambda))) (syntmp-build-annotated-94 #f (list (quote lambda) (cadr syntmp-x-1143) (syntmp-regen-1142 (caddr syntmp-x-1143)))) (if (memv syntmp-t-1144 (quote (map))) (let ((syntmp-ls-1145 (map syntmp-regen-1142 (cdr syntmp-x-1143)))) (syntmp-build-annotated-94 #f (cons (if (syntmp-fx=-87 (length syntmp-ls-1145) 2) (syntmp-build-annotated-94 #f (quote map)) (syntmp-build-annotated-94 #f (quote map))) syntmp-ls-1145))) (syntmp-build-annotated-94 #f (cons (syntmp-build-annotated-94 #f (car syntmp-x-1143)) (map syntmp-regen-1142 (cdr syntmp-x-1143)))))))))))) (syntmp-gen-vector-1141 (lambda (syntmp-x-1146) (cond ((eq? (car syntmp-x-1146) (quote list)) (cons (quote vector) (cdr syntmp-x-1146))) ((eq? (car syntmp-x-1146) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1146)))) (else (list (quote list->vector) syntmp-x-1146))))) (syntmp-gen-append-1140 (lambda (syntmp-x-1147 syntmp-y-1148) (if (equal? syntmp-y-1148 (quote (quote ()))) syntmp-x-1147 (list (quote append) syntmp-x-1147 syntmp-y-1148)))) (syntmp-gen-cons-1139 (lambda (syntmp-x-1149 syntmp-y-1150) (let ((syntmp-t-1151 (car syntmp-y-1150))) (if (memv syntmp-t-1151 (quote (quote))) (if (eq? (car syntmp-x-1149) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1149) (cadr syntmp-y-1150))) (if (eq? (cadr syntmp-y-1150) (quote ())) (list (quote list) syntmp-x-1149) (list (quote cons) syntmp-x-1149 syntmp-y-1150))) (if (memv syntmp-t-1151 (quote (list))) (cons (quote list) (cons syntmp-x-1149 (cdr syntmp-y-1150))) (list (quote cons) syntmp-x-1149 syntmp-y-1150)))))) (syntmp-gen-map-1138 (lambda (syntmp-e-1152 syntmp-map-env-1153) (let ((syntmp-formals-1154 (map cdr syntmp-map-env-1153)) (syntmp-actuals-1155 (map (lambda (syntmp-x-1156) (list (quote ref) (car syntmp-x-1156))) syntmp-map-env-1153))) (cond ((eq? (car syntmp-e-1152) (quote ref)) (car syntmp-actuals-1155)) ((andmap (lambda (syntmp-x-1157) (and (eq? (car syntmp-x-1157) (quote ref)) (memq (cadr syntmp-x-1157) syntmp-formals-1154))) (cdr syntmp-e-1152)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1152)) (map (let ((syntmp-r-1158 (map cons syntmp-formals-1154 syntmp-actuals-1155))) (lambda (syntmp-x-1159) (cdr (assq (cadr syntmp-x-1159) syntmp-r-1158)))) (cdr syntmp-e-1152))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1154 syntmp-e-1152) syntmp-actuals-1155))))))) (syntmp-gen-mappend-1137 (lambda (syntmp-e-1160 syntmp-map-env-1161) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1138 syntmp-e-1160 syntmp-map-env-1161)))) (syntmp-gen-ref-1136 (lambda (syntmp-src-1162 syntmp-var-1163 syntmp-level-1164 syntmp-maps-1165) (if (syntmp-fx=-87 syntmp-level-1164 0) (values syntmp-var-1163 syntmp-maps-1165) (if (null? syntmp-maps-1165) (syntax-error syntmp-src-1162 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1136 syntmp-src-1162 syntmp-var-1163 (syntmp-fx--86 syntmp-level-1164 1) (cdr syntmp-maps-1165))) (lambda (syntmp-outer-var-1166 syntmp-outer-maps-1167) (let ((syntmp-b-1168 (assq syntmp-outer-var-1166 (car syntmp-maps-1165)))) (if syntmp-b-1168 (values (cdr syntmp-b-1168) syntmp-maps-1165) (let ((syntmp-inner-var-1169 (syntmp-gen-var-165 (quote tmp)))) (values syntmp-inner-var-1169 (cons (cons (cons syntmp-outer-var-1166 syntmp-inner-var-1169) (car syntmp-maps-1165)) syntmp-outer-maps-1167))))))))))) (syntmp-gen-syntax-1135 (lambda (syntmp-src-1170 syntmp-e-1171 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175) (if (syntmp-id?-117 syntmp-e-1171) (let ((syntmp-label-1176 (syntmp-id-var-name-139 syntmp-e-1171 (quote (()))))) (let ((syntmp-b-1177 (syntmp-lookup-114 syntmp-label-1176 syntmp-r-1172 syntmp-mod-1175))) (if (eq? (syntmp-binding-type-109 syntmp-b-1177) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1178 (syntmp-binding-value-110 syntmp-b-1177))) (syntmp-gen-ref-1136 syntmp-src-1170 (car syntmp-var.lev-1178) (cdr syntmp-var.lev-1178) syntmp-maps-1173))) (lambda (syntmp-var-1179 syntmp-maps-1180) (values (list (quote ref) syntmp-var-1179) syntmp-maps-1180))) (if (syntmp-ellipsis?-1174 syntmp-e-1171) (syntax-error syntmp-src-1170 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1171) syntmp-maps-1173))))) ((lambda (syntmp-tmp-1181) ((lambda (syntmp-tmp-1182) (if (if syntmp-tmp-1182 (apply (lambda (syntmp-dots-1183 syntmp-e-1184) (syntmp-ellipsis?-1174 syntmp-dots-1183)) syntmp-tmp-1182) #f) (apply (lambda (syntmp-dots-1185 syntmp-e-1186) (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-e-1186 syntmp-r-1172 syntmp-maps-1173 (lambda (syntmp-x-1187) #f) syntmp-mod-1175)) syntmp-tmp-1182) ((lambda (syntmp-tmp-1188) (if (if syntmp-tmp-1188 (apply (lambda (syntmp-x-1189 syntmp-dots-1190 syntmp-y-1191) (syntmp-ellipsis?-1174 syntmp-dots-1190)) syntmp-tmp-1188) #f) (apply (lambda (syntmp-x-1192 syntmp-dots-1193 syntmp-y-1194) (let syntmp-f-1195 ((syntmp-y-1196 syntmp-y-1194) (syntmp-k-1197 (lambda (syntmp-maps-1198) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-x-1192 syntmp-r-1172 (cons (quote ()) syntmp-maps-1198) syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-x-1199 syntmp-maps-1200) (if (null? (car syntmp-maps-1200)) (syntax-error syntmp-src-1170 "extra ellipsis in syntax form") (values (syntmp-gen-map-1138 syntmp-x-1199 (car syntmp-maps-1200)) (cdr syntmp-maps-1200)))))))) ((lambda (syntmp-tmp-1201) ((lambda (syntmp-tmp-1202) (if (if syntmp-tmp-1202 (apply (lambda (syntmp-dots-1203 syntmp-y-1204) (syntmp-ellipsis?-1174 syntmp-dots-1203)) syntmp-tmp-1202) #f) (apply (lambda (syntmp-dots-1205 syntmp-y-1206) (syntmp-f-1195 syntmp-y-1206 (lambda (syntmp-maps-1207) (call-with-values (lambda () (syntmp-k-1197 (cons (quote ()) syntmp-maps-1207))) (lambda (syntmp-x-1208 syntmp-maps-1209) (if (null? (car syntmp-maps-1209)) (syntax-error syntmp-src-1170 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1137 syntmp-x-1208 (car syntmp-maps-1209)) (cdr syntmp-maps-1209)))))))) syntmp-tmp-1202) ((lambda (syntmp-_-1210) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-y-1196 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-y-1211 syntmp-maps-1212) (call-with-values (lambda () (syntmp-k-1197 syntmp-maps-1212)) (lambda (syntmp-x-1213 syntmp-maps-1214) (values (syntmp-gen-append-1140 syntmp-x-1213 syntmp-y-1211) syntmp-maps-1214)))))) syntmp-tmp-1201))) (syntax-dispatch syntmp-tmp-1201 (quote (any . any))))) syntmp-y-1196))) syntmp-tmp-1188) ((lambda (syntmp-tmp-1215) (if syntmp-tmp-1215 (apply (lambda (syntmp-x-1216 syntmp-y-1217) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-x-1216 syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-x-1218 syntmp-maps-1219) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 syntmp-y-1217 syntmp-r-1172 syntmp-maps-1219 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-y-1220 syntmp-maps-1221) (values (syntmp-gen-cons-1139 syntmp-x-1218 syntmp-y-1220) syntmp-maps-1221)))))) syntmp-tmp-1215) ((lambda (syntmp-tmp-1222) (if syntmp-tmp-1222 (apply (lambda (syntmp-e1-1223 syntmp-e2-1224) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-src-1170 (cons syntmp-e1-1223 syntmp-e2-1224) syntmp-r-1172 syntmp-maps-1173 syntmp-ellipsis?-1174 syntmp-mod-1175)) (lambda (syntmp-e-1226 syntmp-maps-1227) (values (syntmp-gen-vector-1141 syntmp-e-1226) syntmp-maps-1227)))) syntmp-tmp-1222) ((lambda (syntmp-_-1228) (values (list (quote quote) syntmp-e-1171) syntmp-maps-1173)) syntmp-tmp-1181))) (syntax-dispatch syntmp-tmp-1181 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1181 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1181 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1181 (quote (any any))))) syntmp-e-1171))))) (lambda (syntmp-e-1229 syntmp-r-1230 syntmp-w-1231 syntmp-s-1232 syntmp-mod-1233) (let ((syntmp-e-1234 (syntmp-source-wrap-146 syntmp-e-1229 syntmp-w-1231 syntmp-s-1232 syntmp-mod-1233))) ((lambda (syntmp-tmp-1235) ((lambda (syntmp-tmp-1236) (if syntmp-tmp-1236 (apply (lambda (syntmp-_-1237 syntmp-x-1238) (call-with-values (lambda () (syntmp-gen-syntax-1135 syntmp-e-1234 syntmp-x-1238 syntmp-r-1230 (quote ()) syntmp-ellipsis?-162 syntmp-mod-1233)) (lambda (syntmp-e-1239 syntmp-maps-1240) (syntmp-regen-1142 syntmp-e-1239)))) syntmp-tmp-1236) ((lambda (syntmp-_-1241) (syntax-error syntmp-e-1234)) syntmp-tmp-1235))) (syntax-dispatch syntmp-tmp-1235 (quote (any any))))) syntmp-e-1234))))) (syntmp-global-extend-115 (quote core) (quote lambda) (lambda (syntmp-e-1242 syntmp-r-1243 syntmp-w-1244 syntmp-s-1245 syntmp-mod-1246) ((lambda (syntmp-tmp-1247) ((lambda (syntmp-tmp-1248) (if syntmp-tmp-1248 (apply (lambda (syntmp-_-1249 syntmp-c-1250) (syntmp-chi-lambda-clause-158 (syntmp-source-wrap-146 syntmp-e-1242 syntmp-w-1244 syntmp-s-1245 syntmp-mod-1246) syntmp-c-1250 syntmp-r-1243 syntmp-w-1244 syntmp-mod-1246 (lambda (syntmp-vars-1251 syntmp-body-1252) (syntmp-build-annotated-94 syntmp-s-1245 (list (quote lambda) syntmp-vars-1251 syntmp-body-1252))))) syntmp-tmp-1248) (syntax-error syntmp-tmp-1247))) (syntax-dispatch syntmp-tmp-1247 (quote (any . any))))) syntmp-e-1242))) (syntmp-global-extend-115 (quote core) (quote let) (letrec ((syntmp-chi-let-1253 (lambda (syntmp-e-1254 syntmp-r-1255 syntmp-w-1256 syntmp-s-1257 syntmp-mod-1258 syntmp-constructor-1259 syntmp-ids-1260 syntmp-vals-1261 syntmp-exps-1262) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-1260)) (syntax-error syntmp-e-1254 "duplicate bound variable in") (let ((syntmp-labels-1263 (syntmp-gen-labels-123 syntmp-ids-1260)) (syntmp-new-vars-1264 (map syntmp-gen-var-165 syntmp-ids-1260))) (let ((syntmp-nw-1265 (syntmp-make-binding-wrap-134 syntmp-ids-1260 syntmp-labels-1263 syntmp-w-1256)) (syntmp-nr-1266 (syntmp-extend-var-env-112 syntmp-labels-1263 syntmp-new-vars-1264 syntmp-r-1255))) (syntmp-constructor-1259 syntmp-s-1257 syntmp-new-vars-1264 (map (lambda (syntmp-x-1267) (syntmp-chi-153 syntmp-x-1267 syntmp-r-1255 syntmp-w-1256 syntmp-mod-1258)) syntmp-vals-1261) (syntmp-chi-body-157 syntmp-exps-1262 (syntmp-source-wrap-146 syntmp-e-1254 syntmp-nw-1265 syntmp-s-1257 syntmp-mod-1258) syntmp-nr-1266 syntmp-nw-1265 syntmp-mod-1258)))))))) (lambda (syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272) ((lambda (syntmp-tmp-1273) ((lambda (syntmp-tmp-1274) (if syntmp-tmp-1274 (apply (lambda (syntmp-_-1275 syntmp-id-1276 syntmp-val-1277 syntmp-e1-1278 syntmp-e2-1279) (syntmp-chi-let-1253 syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272 syntmp-build-let-97 syntmp-id-1276 syntmp-val-1277 (cons syntmp-e1-1278 syntmp-e2-1279))) syntmp-tmp-1274) ((lambda (syntmp-tmp-1283) (if (if syntmp-tmp-1283 (apply (lambda (syntmp-_-1284 syntmp-f-1285 syntmp-id-1286 syntmp-val-1287 syntmp-e1-1288 syntmp-e2-1289) (syntmp-id?-117 syntmp-f-1285)) syntmp-tmp-1283) #f) (apply (lambda (syntmp-_-1290 syntmp-f-1291 syntmp-id-1292 syntmp-val-1293 syntmp-e1-1294 syntmp-e2-1295) (syntmp-chi-let-1253 syntmp-e-1268 syntmp-r-1269 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272 syntmp-build-named-let-98 (cons syntmp-f-1291 syntmp-id-1292) syntmp-val-1293 (cons syntmp-e1-1294 syntmp-e2-1295))) syntmp-tmp-1283) ((lambda (syntmp-_-1299) (syntax-error (syntmp-source-wrap-146 syntmp-e-1268 syntmp-w-1270 syntmp-s-1271 syntmp-mod-1272))) syntmp-tmp-1273))) (syntax-dispatch syntmp-tmp-1273 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1273 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1268)))) (syntmp-global-extend-115 (quote core) (quote letrec) (lambda (syntmp-e-1300 syntmp-r-1301 syntmp-w-1302 syntmp-s-1303 syntmp-mod-1304) ((lambda (syntmp-tmp-1305) ((lambda (syntmp-tmp-1306) (if syntmp-tmp-1306 (apply (lambda (syntmp-_-1307 syntmp-id-1308 syntmp-val-1309 syntmp-e1-1310 syntmp-e2-1311) (let ((syntmp-ids-1312 syntmp-id-1308)) (if (not (syntmp-valid-bound-ids?-142 syntmp-ids-1312)) (syntax-error syntmp-e-1300 "duplicate bound variable in") (let ((syntmp-labels-1314 (syntmp-gen-labels-123 syntmp-ids-1312)) (syntmp-new-vars-1315 (map syntmp-gen-var-165 syntmp-ids-1312))) (let ((syntmp-w-1316 (syntmp-make-binding-wrap-134 syntmp-ids-1312 syntmp-labels-1314 syntmp-w-1302)) (syntmp-r-1317 (syntmp-extend-var-env-112 syntmp-labels-1314 syntmp-new-vars-1315 syntmp-r-1301))) (syntmp-build-letrec-99 syntmp-s-1303 syntmp-new-vars-1315 (map (lambda (syntmp-x-1318) (syntmp-chi-153 syntmp-x-1318 syntmp-r-1317 syntmp-w-1316 syntmp-mod-1304)) syntmp-val-1309) (syntmp-chi-body-157 (cons syntmp-e1-1310 syntmp-e2-1311) (syntmp-source-wrap-146 syntmp-e-1300 syntmp-w-1316 syntmp-s-1303 syntmp-mod-1304) syntmp-r-1317 syntmp-w-1316 syntmp-mod-1304))))))) syntmp-tmp-1306) ((lambda (syntmp-_-1321) (syntax-error (syntmp-source-wrap-146 syntmp-e-1300 syntmp-w-1302 syntmp-s-1303 syntmp-mod-1304))) syntmp-tmp-1305))) (syntax-dispatch syntmp-tmp-1305 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1300))) (syntmp-global-extend-115 (quote core) (quote set!) (lambda (syntmp-e-1322 syntmp-r-1323 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326) ((lambda (syntmp-tmp-1327) ((lambda (syntmp-tmp-1328) (if (if syntmp-tmp-1328 (apply (lambda (syntmp-_-1329 syntmp-id-1330 syntmp-val-1331) (syntmp-id?-117 syntmp-id-1330)) syntmp-tmp-1328) #f) (apply (lambda (syntmp-_-1332 syntmp-id-1333 syntmp-val-1334) (let ((syntmp-val-1335 (syntmp-chi-153 syntmp-val-1334 syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326)) (syntmp-n-1336 (syntmp-id-var-name-139 syntmp-id-1333 syntmp-w-1324))) (let ((syntmp-b-1337 (syntmp-lookup-114 syntmp-n-1336 syntmp-r-1323 syntmp-mod-1326))) (let ((syntmp-t-1338 (syntmp-binding-type-109 syntmp-b-1337))) (if (memv syntmp-t-1338 (quote (lexical))) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (syntmp-binding-value-110 syntmp-b-1337) syntmp-val-1335)) (if (memv syntmp-t-1338 (quote (global))) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (make-module-ref syntmp-mod-1326 syntmp-n-1336 #f) syntmp-val-1335)) (if (memv syntmp-t-1338 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-145 syntmp-id-1333 syntmp-w-1324 syntmp-mod-1326) "identifier out of context") (syntax-error (syntmp-source-wrap-146 syntmp-e-1322 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326))))))))) syntmp-tmp-1328) ((lambda (syntmp-tmp-1339) (if syntmp-tmp-1339 (apply (lambda (syntmp-_-1340 syntmp-head-1341 syntmp-tail-1342 syntmp-val-1343) (call-with-values (lambda () (syntmp-syntax-type-151 syntmp-head-1341 syntmp-r-1323 (quote (())) #f #f syntmp-mod-1326)) (lambda (syntmp-type-1344 syntmp-value-1345 syntmp-ee-1346 syntmp-ww-1347 syntmp-ss-1348 syntmp-modmod-1349) (let ((syntmp-t-1350 syntmp-type-1344)) (if (memv syntmp-t-1350 (quote (module-ref))) (call-with-values (lambda () (syntmp-value-1345 (cons syntmp-head-1341 syntmp-tail-1342))) (lambda (syntmp-id-1352 syntmp-mod-1353) (syntmp-build-annotated-94 syntmp-s-1325 (list (quote set!) (make-module-ref syntmp-mod-1353 syntmp-id-1352 #f) syntmp-val-1343)))) (syntmp-build-annotated-94 syntmp-s-1325 (cons (syntmp-chi-153 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) syntmp-head-1341) syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326) (map (lambda (syntmp-e-1354) (syntmp-chi-153 syntmp-e-1354 syntmp-r-1323 syntmp-w-1324 syntmp-mod-1326)) (append syntmp-tail-1342 (list syntmp-val-1343)))))))))) syntmp-tmp-1339) ((lambda (syntmp-_-1356) (syntax-error (syntmp-source-wrap-146 syntmp-e-1322 syntmp-w-1324 syntmp-s-1325 syntmp-mod-1326))) syntmp-tmp-1327))) (syntax-dispatch syntmp-tmp-1327 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1327 (quote (any any any))))) syntmp-e-1322))) (syntmp-global-extend-115 (quote module-ref) (quote @) (lambda (syntmp-e-1357) ((lambda (syntmp-tmp-1358) ((lambda (syntmp-tmp-1359) (if (if syntmp-tmp-1359 (apply (lambda (syntmp-_-1360 syntmp-mod-1361 syntmp-id-1362) (and (andmap syntmp-id?-117 syntmp-mod-1361) (syntmp-id?-117 syntmp-id-1362))) syntmp-tmp-1359) #f) (apply (lambda (syntmp-_-1364 syntmp-mod-1365 syntmp-id-1366) (values (syntax-object->datum syntmp-id-1366) (syntax-object->datum (append syntmp-mod-1365 (quote (#(syntax-object %module-public-interface ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile)))))))) syntmp-tmp-1359) (syntax-error syntmp-tmp-1358))) (syntax-dispatch syntmp-tmp-1358 (quote (any each-any any))))) syntmp-e-1357))) (syntmp-global-extend-115 (quote module-ref) (quote @@) (lambda (syntmp-e-1368) ((lambda (syntmp-tmp-1369) ((lambda (syntmp-tmp-1370) (if (if syntmp-tmp-1370 (apply (lambda (syntmp-_-1371 syntmp-mod-1372 syntmp-id-1373) (and (andmap syntmp-id?-117 syntmp-mod-1372) (syntmp-id?-117 syntmp-id-1373))) syntmp-tmp-1370) #f) (apply (lambda (syntmp-_-1375 syntmp-mod-1376 syntmp-id-1377) (values (syntax-object->datum syntmp-id-1377) (syntax-object->datum syntmp-mod-1376))) syntmp-tmp-1370) (syntax-error syntmp-tmp-1369))) (syntax-dispatch syntmp-tmp-1369 (quote (any each-any any))))) syntmp-e-1368))) (syntmp-global-extend-115 (quote begin) (quote begin) (quote ())) (syntmp-global-extend-115 (quote define) (quote define) (quote ())) (syntmp-global-extend-115 (quote define-syntax) (quote define-syntax) (quote ())) (syntmp-global-extend-115 (quote eval-when) (quote eval-when) (quote ())) (syntmp-global-extend-115 (quote core) (quote syntax-case) (letrec ((syntmp-gen-syntax-case-1382 (lambda (syntmp-x-1383 syntmp-keys-1384 syntmp-clauses-1385 syntmp-r-1386 syntmp-mod-1387) (if (null? syntmp-clauses-1385) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote syntax-error)) syntmp-x-1383)) ((lambda (syntmp-tmp-1388) ((lambda (syntmp-tmp-1389) (if syntmp-tmp-1389 (apply (lambda (syntmp-pat-1390 syntmp-exp-1391) (if (and (syntmp-id?-117 syntmp-pat-1390) (andmap (lambda (syntmp-x-1392) (not (syntmp-free-id=?-140 syntmp-pat-1390 syntmp-x-1392))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (guile))) syntmp-keys-1384))) (let ((syntmp-labels-1393 (list (syntmp-gen-label-122))) (syntmp-var-1394 (syntmp-gen-var-165 syntmp-pat-1390))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-var-1394) (syntmp-chi-153 syntmp-exp-1391 (syntmp-extend-env-111 syntmp-labels-1393 (list (cons (quote syntax) (cons syntmp-var-1394 0))) syntmp-r-1386) (syntmp-make-binding-wrap-134 (list syntmp-pat-1390) syntmp-labels-1393 (quote (()))) syntmp-mod-1387))) syntmp-x-1383))) (syntmp-gen-clause-1381 syntmp-x-1383 syntmp-keys-1384 (cdr syntmp-clauses-1385) syntmp-r-1386 syntmp-pat-1390 #t syntmp-exp-1391 syntmp-mod-1387))) syntmp-tmp-1389) ((lambda (syntmp-tmp-1395) (if syntmp-tmp-1395 (apply (lambda (syntmp-pat-1396 syntmp-fender-1397 syntmp-exp-1398) (syntmp-gen-clause-1381 syntmp-x-1383 syntmp-keys-1384 (cdr syntmp-clauses-1385) syntmp-r-1386 syntmp-pat-1396 syntmp-fender-1397 syntmp-exp-1398 syntmp-mod-1387)) syntmp-tmp-1395) ((lambda (syntmp-_-1399) (syntax-error (car syntmp-clauses-1385) "invalid syntax-case clause")) syntmp-tmp-1388))) (syntax-dispatch syntmp-tmp-1388 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1388 (quote (any any))))) (car syntmp-clauses-1385))))) (syntmp-gen-clause-1381 (lambda (syntmp-x-1400 syntmp-keys-1401 syntmp-clauses-1402 syntmp-r-1403 syntmp-pat-1404 syntmp-fender-1405 syntmp-exp-1406 syntmp-mod-1407) (call-with-values (lambda () (syntmp-convert-pattern-1379 syntmp-pat-1404 syntmp-keys-1401)) (lambda (syntmp-p-1408 syntmp-pvars-1409) (cond ((not (syntmp-distinct-bound-ids?-143 (map car syntmp-pvars-1409))) (syntax-error syntmp-pat-1404 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1410) (not (syntmp-ellipsis?-162 (car syntmp-x-1410)))) syntmp-pvars-1409)) (syntax-error syntmp-pat-1404 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1411 (syntmp-gen-var-165 (quote tmp)))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-y-1411) (let ((syntmp-y-1412 (syntmp-build-annotated-94 #f syntmp-y-1411))) (syntmp-build-annotated-94 #f (list (quote if) ((lambda (syntmp-tmp-1413) ((lambda (syntmp-tmp-1414) (if syntmp-tmp-1414 (apply (lambda () syntmp-y-1412) syntmp-tmp-1414) ((lambda (syntmp-_-1415) (syntmp-build-annotated-94 #f (list (quote if) syntmp-y-1412 (syntmp-build-dispatch-call-1380 syntmp-pvars-1409 syntmp-fender-1405 syntmp-y-1412 syntmp-r-1403 syntmp-mod-1407) (syntmp-build-data-95 #f #f)))) syntmp-tmp-1413))) (syntax-dispatch syntmp-tmp-1413 (quote #(atom #t))))) syntmp-fender-1405) (syntmp-build-dispatch-call-1380 syntmp-pvars-1409 syntmp-exp-1406 syntmp-y-1412 syntmp-r-1403 syntmp-mod-1407) (syntmp-gen-syntax-case-1382 syntmp-x-1400 syntmp-keys-1401 syntmp-clauses-1402 syntmp-r-1403 syntmp-mod-1407)))))) (if (eq? syntmp-p-1408 (quote any)) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote list)) syntmp-x-1400)) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote syntax-dispatch)) syntmp-x-1400 (syntmp-build-data-95 #f syntmp-p-1408))))))))))))) (syntmp-build-dispatch-call-1380 (lambda (syntmp-pvars-1416 syntmp-exp-1417 syntmp-y-1418 syntmp-r-1419 syntmp-mod-1420) (let ((syntmp-ids-1421 (map car syntmp-pvars-1416)) (syntmp-levels-1422 (map cdr syntmp-pvars-1416))) (let ((syntmp-labels-1423 (syntmp-gen-labels-123 syntmp-ids-1421)) (syntmp-new-vars-1424 (map syntmp-gen-var-165 syntmp-ids-1421))) (syntmp-build-annotated-94 #f (list (syntmp-build-annotated-94 #f (quote apply)) (syntmp-build-annotated-94 #f (list (quote lambda) syntmp-new-vars-1424 (syntmp-chi-153 syntmp-exp-1417 (syntmp-extend-env-111 syntmp-labels-1423 (map (lambda (syntmp-var-1425 syntmp-level-1426) (cons (quote syntax) (cons syntmp-var-1425 syntmp-level-1426))) syntmp-new-vars-1424 (map cdr syntmp-pvars-1416)) syntmp-r-1419) (syntmp-make-binding-wrap-134 syntmp-ids-1421 syntmp-labels-1423 (quote (()))) syntmp-mod-1420))) syntmp-y-1418)))))) (syntmp-convert-pattern-1379 (lambda (syntmp-pattern-1427 syntmp-keys-1428) (let syntmp-cvt-1429 ((syntmp-p-1430 syntmp-pattern-1427) (syntmp-n-1431 0) (syntmp-ids-1432 (quote ()))) (if (syntmp-id?-117 syntmp-p-1430) (if (syntmp-bound-id-member?-144 syntmp-p-1430 syntmp-keys-1428) (values (vector (quote free-id) syntmp-p-1430) syntmp-ids-1432) (values (quote any) (cons (cons syntmp-p-1430 syntmp-n-1431) syntmp-ids-1432))) ((lambda (syntmp-tmp-1433) ((lambda (syntmp-tmp-1434) (if (if syntmp-tmp-1434 (apply (lambda (syntmp-x-1435 syntmp-dots-1436) (syntmp-ellipsis?-162 syntmp-dots-1436)) syntmp-tmp-1434) #f) (apply (lambda (syntmp-x-1437 syntmp-dots-1438) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1437 (syntmp-fx+-85 syntmp-n-1431 1) syntmp-ids-1432)) (lambda (syntmp-p-1439 syntmp-ids-1440) (values (if (eq? syntmp-p-1439 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1439)) syntmp-ids-1440)))) syntmp-tmp-1434) ((lambda (syntmp-tmp-1441) (if syntmp-tmp-1441 (apply (lambda (syntmp-x-1442 syntmp-y-1443) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-y-1443 syntmp-n-1431 syntmp-ids-1432)) (lambda (syntmp-y-1444 syntmp-ids-1445) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1442 syntmp-n-1431 syntmp-ids-1445)) (lambda (syntmp-x-1446 syntmp-ids-1447) (values (cons syntmp-x-1446 syntmp-y-1444) syntmp-ids-1447)))))) syntmp-tmp-1441) ((lambda (syntmp-tmp-1448) (if syntmp-tmp-1448 (apply (lambda () (values (quote ()) syntmp-ids-1432)) syntmp-tmp-1448) ((lambda (syntmp-tmp-1449) (if syntmp-tmp-1449 (apply (lambda (syntmp-x-1450) (call-with-values (lambda () (syntmp-cvt-1429 syntmp-x-1450 syntmp-n-1431 syntmp-ids-1432)) (lambda (syntmp-p-1452 syntmp-ids-1453) (values (vector (quote vector) syntmp-p-1452) syntmp-ids-1453)))) syntmp-tmp-1449) ((lambda (syntmp-x-1454) (values (vector (quote atom) (syntmp-strip-164 syntmp-p-1430 (quote (())))) syntmp-ids-1432)) syntmp-tmp-1433))) (syntax-dispatch syntmp-tmp-1433 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1433 (quote ()))))) (syntax-dispatch syntmp-tmp-1433 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1433 (quote (any any))))) syntmp-p-1430)))))) (lambda (syntmp-e-1455 syntmp-r-1456 syntmp-w-1457 syntmp-s-1458 syntmp-mod-1459) (let ((syntmp-e-1460 (syntmp-source-wrap-146 syntmp-e-1455 syntmp-w-1457 syntmp-s-1458 syntmp-mod-1459))) ((lambda (syntmp-tmp-1461) ((lambda (syntmp-tmp-1462) (if syntmp-tmp-1462 (apply (lambda (syntmp-_-1463 syntmp-val-1464 syntmp-key-1465 syntmp-m-1466) (if (andmap (lambda (syntmp-x-1467) (and (syntmp-id?-117 syntmp-x-1467) (not (syntmp-ellipsis?-162 syntmp-x-1467)))) syntmp-key-1465) (let ((syntmp-x-1469 (syntmp-gen-var-165 (quote tmp)))) (syntmp-build-annotated-94 syntmp-s-1458 (list (syntmp-build-annotated-94 #f (list (quote lambda) (list syntmp-x-1469) (syntmp-gen-syntax-case-1382 (syntmp-build-annotated-94 #f syntmp-x-1469) syntmp-key-1465 syntmp-m-1466 syntmp-r-1456 syntmp-mod-1459))) (syntmp-chi-153 syntmp-val-1464 syntmp-r-1456 (quote (())) syntmp-mod-1459)))) (syntax-error syntmp-e-1460 "invalid literals list in"))) syntmp-tmp-1462) (syntax-error syntmp-tmp-1461))) (syntax-dispatch syntmp-tmp-1461 (quote (any any each-any . each-any))))) syntmp-e-1460))))) (set! sc-expand (let ((syntmp-m-1472 (quote e)) (syntmp-esew-1473 (quote (eval)))) (lambda (syntmp-x-1474) (if (and (pair? syntmp-x-1474) (equal? (car syntmp-x-1474) syntmp-noexpand-84)) (cadr syntmp-x-1474) (syntmp-chi-top-152 syntmp-x-1474 (quote ()) (quote ((top))) syntmp-m-1472 syntmp-esew-1473 (module-name (current-module))))))) (set! sc-expand3 (let ((syntmp-m-1475 (quote e)) (syntmp-esew-1476 (quote (eval)))) (lambda (syntmp-x-1478 . syntmp-rest-1477) (if (and (pair? syntmp-x-1478) (equal? (car syntmp-x-1478) syntmp-noexpand-84)) (cadr syntmp-x-1478) (syntmp-chi-top-152 syntmp-x-1478 (quote ()) (quote ((top))) (if (null? syntmp-rest-1477) syntmp-m-1475 (car syntmp-rest-1477)) (if (or (null? syntmp-rest-1477) (null? (cdr syntmp-rest-1477))) syntmp-esew-1476 (cadr syntmp-rest-1477)) (module-name (current-module))))))) (set! identifier? (lambda (syntmp-x-1479) (syntmp-nonsymbol-id?-116 syntmp-x-1479))) (set! datum->syntax-object (lambda (syntmp-id-1480 syntmp-datum-1481) (syntmp-make-syntax-object-100 syntmp-datum-1481 (syntmp-syntax-object-wrap-103 syntmp-id-1480) #f))) (set! syntax-object->datum (lambda (syntmp-x-1482) (syntmp-strip-164 syntmp-x-1482 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1483) (begin (let ((syntmp-x-1484 syntmp-ls-1483)) (if (not (list? syntmp-x-1484)) (syntmp-error-hook-91 (quote generate-temporaries) "invalid argument" syntmp-x-1484))) (map (lambda (syntmp-x-1485) (syntmp-wrap-145 (gensym) (quote ((top))) #f)) syntmp-ls-1483)))) (set! free-identifier=? (lambda (syntmp-x-1486 syntmp-y-1487) (begin (let ((syntmp-x-1488 syntmp-x-1486)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1488)) (syntmp-error-hook-91 (quote free-identifier=?) "invalid argument" syntmp-x-1488))) (let ((syntmp-x-1489 syntmp-y-1487)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1489)) (syntmp-error-hook-91 (quote free-identifier=?) "invalid argument" syntmp-x-1489))) (syntmp-free-id=?-140 syntmp-x-1486 syntmp-y-1487)))) (set! bound-identifier=? (lambda (syntmp-x-1490 syntmp-y-1491) (begin (let ((syntmp-x-1492 syntmp-x-1490)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1492)) (syntmp-error-hook-91 (quote bound-identifier=?) "invalid argument" syntmp-x-1492))) (let ((syntmp-x-1493 syntmp-y-1491)) (if (not (syntmp-nonsymbol-id?-116 syntmp-x-1493)) (syntmp-error-hook-91 (quote bound-identifier=?) "invalid argument" syntmp-x-1493))) (syntmp-bound-id=?-141 syntmp-x-1490 syntmp-y-1491)))) (set! syntax-error (lambda (syntmp-object-1495 . syntmp-messages-1494) (begin (for-each (lambda (syntmp-x-1496) (let ((syntmp-x-1497 syntmp-x-1496)) (if (not (string? syntmp-x-1497)) (syntmp-error-hook-91 (quote syntax-error) "invalid argument" syntmp-x-1497)))) syntmp-messages-1494) (let ((syntmp-message-1498 (if (null? syntmp-messages-1494) "invalid syntax" (apply string-append syntmp-messages-1494)))) (syntmp-error-hook-91 #f syntmp-message-1498 (syntmp-strip-164 syntmp-object-1495 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1499 syntmp-v-1500) (begin (let ((syntmp-x-1501 syntmp-sym-1499)) (if (not (symbol? syntmp-x-1501)) (syntmp-error-hook-91 (quote define-syntax) "invalid argument" syntmp-x-1501))) (let ((syntmp-x-1502 syntmp-v-1500)) (if (not (procedure? syntmp-x-1502)) (syntmp-error-hook-91 (quote define-syntax) "invalid argument" syntmp-x-1502))) (syntmp-global-extend-115 (quote macro) syntmp-sym-1499 syntmp-v-1500)))) (letrec ((syntmp-match-1507 (lambda (syntmp-e-1508 syntmp-p-1509 syntmp-w-1510 syntmp-r-1511 syntmp-mod-1512) (cond ((not syntmp-r-1511) #f) ((eq? syntmp-p-1509 (quote any)) (cons (syntmp-wrap-145 syntmp-e-1508 syntmp-w-1510 syntmp-mod-1512) syntmp-r-1511)) ((syntmp-syntax-object?-101 syntmp-e-1508) (syntmp-match*-1506 (let ((syntmp-e-1513 (syntmp-syntax-object-expression-102 syntmp-e-1508))) (if (annotation? syntmp-e-1513) (annotation-expression syntmp-e-1513) syntmp-e-1513)) syntmp-p-1509 (syntmp-join-wraps-136 syntmp-w-1510 (syntmp-syntax-object-wrap-103 syntmp-e-1508)) syntmp-r-1511 (syntmp-syntax-object-module-104 syntmp-e-1508))) (else (syntmp-match*-1506 (let ((syntmp-e-1514 syntmp-e-1508)) (if (annotation? syntmp-e-1514) (annotation-expression syntmp-e-1514) syntmp-e-1514)) syntmp-p-1509 syntmp-w-1510 syntmp-r-1511 syntmp-mod-1512))))) (syntmp-match*-1506 (lambda (syntmp-e-1515 syntmp-p-1516 syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519) (cond ((null? syntmp-p-1516) (and (null? syntmp-e-1515) syntmp-r-1518)) ((pair? syntmp-p-1516) (and (pair? syntmp-e-1515) (syntmp-match-1507 (car syntmp-e-1515) (car syntmp-p-1516) syntmp-w-1517 (syntmp-match-1507 (cdr syntmp-e-1515) (cdr syntmp-p-1516) syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519) syntmp-mod-1519))) ((eq? syntmp-p-1516 (quote each-any)) (let ((syntmp-l-1520 (syntmp-match-each-any-1504 syntmp-e-1515 syntmp-w-1517 syntmp-mod-1519))) (and syntmp-l-1520 (cons syntmp-l-1520 syntmp-r-1518)))) (else (let ((syntmp-t-1521 (vector-ref syntmp-p-1516 0))) (if (memv syntmp-t-1521 (quote (each))) (if (null? syntmp-e-1515) (syntmp-match-empty-1505 (vector-ref syntmp-p-1516 1) syntmp-r-1518) (let ((syntmp-l-1522 (syntmp-match-each-1503 syntmp-e-1515 (vector-ref syntmp-p-1516 1) syntmp-w-1517 syntmp-mod-1519))) (and syntmp-l-1522 (let syntmp-collect-1523 ((syntmp-l-1524 syntmp-l-1522)) (if (null? (car syntmp-l-1524)) syntmp-r-1518 (cons (map car syntmp-l-1524) (syntmp-collect-1523 (map cdr syntmp-l-1524)))))))) (if (memv syntmp-t-1521 (quote (free-id))) (and (syntmp-id?-117 syntmp-e-1515) (syntmp-free-id=?-140 (syntmp-wrap-145 syntmp-e-1515 syntmp-w-1517 syntmp-mod-1519) (vector-ref syntmp-p-1516 1)) syntmp-r-1518) (if (memv syntmp-t-1521 (quote (atom))) (and (equal? (vector-ref syntmp-p-1516 1) (syntmp-strip-164 syntmp-e-1515 syntmp-w-1517)) syntmp-r-1518) (if (memv syntmp-t-1521 (quote (vector))) (and (vector? syntmp-e-1515) (syntmp-match-1507 (vector->list syntmp-e-1515) (vector-ref syntmp-p-1516 1) syntmp-w-1517 syntmp-r-1518 syntmp-mod-1519))))))))))) (syntmp-match-empty-1505 (lambda (syntmp-p-1525 syntmp-r-1526) (cond ((null? syntmp-p-1525) syntmp-r-1526) ((eq? syntmp-p-1525 (quote any)) (cons (quote ()) syntmp-r-1526)) ((pair? syntmp-p-1525) (syntmp-match-empty-1505 (car syntmp-p-1525) (syntmp-match-empty-1505 (cdr syntmp-p-1525) syntmp-r-1526))) ((eq? syntmp-p-1525 (quote each-any)) (cons (quote ()) syntmp-r-1526)) (else (let ((syntmp-t-1527 (vector-ref syntmp-p-1525 0))) (if (memv syntmp-t-1527 (quote (each))) (syntmp-match-empty-1505 (vector-ref syntmp-p-1525 1) syntmp-r-1526) (if (memv syntmp-t-1527 (quote (free-id atom))) syntmp-r-1526 (if (memv syntmp-t-1527 (quote (vector))) (syntmp-match-empty-1505 (vector-ref syntmp-p-1525 1) syntmp-r-1526))))))))) (syntmp-match-each-any-1504 (lambda (syntmp-e-1528 syntmp-w-1529 syntmp-mod-1530) (cond ((annotation? syntmp-e-1528) (syntmp-match-each-any-1504 (annotation-expression syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530)) ((pair? syntmp-e-1528) (let ((syntmp-l-1531 (syntmp-match-each-any-1504 (cdr syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530))) (and syntmp-l-1531 (cons (syntmp-wrap-145 (car syntmp-e-1528) syntmp-w-1529 syntmp-mod-1530) syntmp-l-1531)))) ((null? syntmp-e-1528) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1528) (syntmp-match-each-any-1504 (syntmp-syntax-object-expression-102 syntmp-e-1528) (syntmp-join-wraps-136 syntmp-w-1529 (syntmp-syntax-object-wrap-103 syntmp-e-1528)) syntmp-mod-1530)) (else #f)))) (syntmp-match-each-1503 (lambda (syntmp-e-1532 syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535) (cond ((annotation? syntmp-e-1532) (syntmp-match-each-1503 (annotation-expression syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535)) ((pair? syntmp-e-1532) (let ((syntmp-first-1536 (syntmp-match-1507 (car syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 (quote ()) syntmp-mod-1535))) (and syntmp-first-1536 (let ((syntmp-rest-1537 (syntmp-match-each-1503 (cdr syntmp-e-1532) syntmp-p-1533 syntmp-w-1534 syntmp-mod-1535))) (and syntmp-rest-1537 (cons syntmp-first-1536 syntmp-rest-1537)))))) ((null? syntmp-e-1532) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1532) (syntmp-match-each-1503 (syntmp-syntax-object-expression-102 syntmp-e-1532) syntmp-p-1533 (syntmp-join-wraps-136 syntmp-w-1534 (syntmp-syntax-object-wrap-103 syntmp-e-1532)) (syntmp-syntax-object-module-104 syntmp-e-1532))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1538 syntmp-p-1539) (cond ((eq? syntmp-p-1539 (quote any)) (list syntmp-e-1538)) ((syntmp-syntax-object?-101 syntmp-e-1538) (syntmp-match*-1506 (let ((syntmp-e-1540 (syntmp-syntax-object-expression-102 syntmp-e-1538))) (if (annotation? syntmp-e-1540) (annotation-expression syntmp-e-1540) syntmp-e-1540)) syntmp-p-1539 (syntmp-syntax-object-wrap-103 syntmp-e-1538) (quote ()) (syntmp-syntax-object-module-104 syntmp-e-1538))) (else (syntmp-match*-1506 (let ((syntmp-e-1541 syntmp-e-1538)) (if (annotation? syntmp-e-1541) (annotation-expression syntmp-e-1541) syntmp-e-1541)) syntmp-p-1539 (quote (())) (quote ()) #f))))) (set! sc-chi syntmp-chi-153)))))
-(install-global-transformer (quote with-syntax) (lambda (syntmp-x-1542) ((lambda (syntmp-tmp-1543) ((lambda (syntmp-tmp-1544) (if syntmp-tmp-1544 (apply (lambda (syntmp-_-1545 syntmp-e1-1546 syntmp-e2-1547) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons syntmp-e1-1546 syntmp-e2-1547))) syntmp-tmp-1544) ((lambda (syntmp-tmp-1549) (if syntmp-tmp-1549 (apply (lambda (syntmp-_-1550 syntmp-out-1551 syntmp-in-1552 syntmp-e1-1553 syntmp-e2-1554) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) syntmp-in-1552 (quote ()) (list syntmp-out-1551 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons syntmp-e1-1553 syntmp-e2-1554))))) syntmp-tmp-1549) ((lambda (syntmp-tmp-1556) (if syntmp-tmp-1556 (apply (lambda (syntmp-_-1557 syntmp-out-1558 syntmp-in-1559 syntmp-e1-1560 syntmp-e2-1561) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (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"))) (guile))) syntmp-in-1559) (quote ()) (list syntmp-out-1558 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons syntmp-e1-1560 syntmp-e2-1561))))) syntmp-tmp-1556) (syntax-error syntmp-tmp-1543))) (syntax-dispatch syntmp-tmp-1543 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1543 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1543 (quote (any () any . each-any))))) syntmp-x-1542)))
-(install-global-transformer (quote syntax-rules) (lambda (syntmp-x-1583) ((lambda (syntmp-tmp-1584) ((lambda (syntmp-tmp-1585) (if syntmp-tmp-1585 (apply (lambda (syntmp-_-1586 syntmp-k-1587 syntmp-keyword-1588 syntmp-pattern-1589 syntmp-template-1590) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (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"))) (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"))) (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"))) (guile))) (cons syntmp-k-1587 (map (lambda (syntmp-tmp-1593 syntmp-tmp-1592) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) syntmp-tmp-1592) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) syntmp-tmp-1593))) syntmp-template-1590 syntmp-pattern-1589)))))) syntmp-tmp-1585) (syntax-error syntmp-tmp-1584))) (syntax-dispatch syntmp-tmp-1584 (quote (any each-any . #(each ((any . any) any))))))) syntmp-x-1583)))
-(install-global-transformer (quote let*) (lambda (syntmp-x-1604) ((lambda (syntmp-tmp-1605) ((lambda (syntmp-tmp-1606) (if (if syntmp-tmp-1606 (apply (lambda (syntmp-let*-1607 syntmp-x-1608 syntmp-v-1609 syntmp-e1-1610 syntmp-e2-1611) (andmap identifier? syntmp-x-1608)) syntmp-tmp-1606) #f) (apply (lambda (syntmp-let*-1613 syntmp-x-1614 syntmp-v-1615 syntmp-e1-1616 syntmp-e2-1617) (let syntmp-f-1618 ((syntmp-bindings-1619 (map list syntmp-x-1614 syntmp-v-1615))) (if (null? syntmp-bindings-1619) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons (quote ()) (cons syntmp-e1-1616 syntmp-e2-1617))) ((lambda (syntmp-tmp-1623) ((lambda (syntmp-tmp-1624) (if syntmp-tmp-1624 (apply (lambda (syntmp-body-1625 syntmp-binding-1626) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (list syntmp-binding-1626) syntmp-body-1625)) syntmp-tmp-1624) (syntax-error syntmp-tmp-1623))) (syntax-dispatch syntmp-tmp-1623 (quote (any any))))) (list (syntmp-f-1618 (cdr syntmp-bindings-1619)) (car syntmp-bindings-1619)))))) syntmp-tmp-1606) (syntax-error syntmp-tmp-1605))) (syntax-dispatch syntmp-tmp-1605 (quote (any #(each (any any)) any . each-any))))) syntmp-x-1604)))
-(install-global-transformer (quote do) (lambda (syntmp-orig-x-1646) ((lambda (syntmp-tmp-1647) ((lambda (syntmp-tmp-1648) (if syntmp-tmp-1648 (apply (lambda (syntmp-_-1649 syntmp-var-1650 syntmp-init-1651 syntmp-step-1652 syntmp-e0-1653 syntmp-e1-1654 syntmp-c-1655) ((lambda (syntmp-tmp-1656) ((lambda (syntmp-tmp-1657) (if syntmp-tmp-1657 (apply (lambda (syntmp-step-1658) ((lambda (syntmp-tmp-1659) ((lambda (syntmp-tmp-1660) (if syntmp-tmp-1660 (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"))) (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"))) (guile))) (map list syntmp-var-1650 syntmp-init-1651) (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"))) (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"))) (guile))) syntmp-e0-1653) (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"))) (guile))) (append syntmp-c-1655 (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"))) (guile))) syntmp-step-1658))))))) syntmp-tmp-1660) ((lambda (syntmp-tmp-1665) (if syntmp-tmp-1665 (apply (lambda (syntmp-e1-1666 syntmp-e2-1667) (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"))) (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"))) (guile))) (map list syntmp-var-1650 syntmp-init-1651) (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"))) (guile))) syntmp-e0-1653 (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"))) (guile))) (cons syntmp-e1-1666 syntmp-e2-1667)) (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"))) (guile))) (append syntmp-c-1655 (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"))) (guile))) syntmp-step-1658))))))) syntmp-tmp-1665) (syntax-error syntmp-tmp-1659))) (syntax-dispatch syntmp-tmp-1659 (quote (any . each-any)))))) (syntax-dispatch syntmp-tmp-1659 (quote ())))) syntmp-e1-1654)) syntmp-tmp-1657) (syntax-error syntmp-tmp-1656))) (syntax-dispatch syntmp-tmp-1656 (quote each-any)))) (map (lambda (syntmp-v-1674 syntmp-s-1675) ((lambda (syntmp-tmp-1676) ((lambda (syntmp-tmp-1677) (if syntmp-tmp-1677 (apply (lambda () syntmp-v-1674) syntmp-tmp-1677) ((lambda (syntmp-tmp-1678) (if syntmp-tmp-1678 (apply (lambda (syntmp-e-1679) syntmp-e-1679) syntmp-tmp-1678) ((lambda (syntmp-_-1680) (syntax-error syntmp-orig-x-1646)) syntmp-tmp-1676))) (syntax-dispatch syntmp-tmp-1676 (quote (any)))))) (syntax-dispatch syntmp-tmp-1676 (quote ())))) syntmp-s-1675)) syntmp-var-1650 syntmp-step-1652))) syntmp-tmp-1648) (syntax-error syntmp-tmp-1647))) (syntax-dispatch syntmp-tmp-1647 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) syntmp-orig-x-1646)))
-(install-global-transformer (quote quasiquote) (letrec ((syntmp-quasicons-1708 (lambda (syntmp-x-1712 syntmp-y-1713) ((lambda (syntmp-tmp-1714) ((lambda (syntmp-tmp-1715) (if syntmp-tmp-1715 (apply (lambda (syntmp-x-1716 syntmp-y-1717) ((lambda (syntmp-tmp-1718) ((lambda (syntmp-tmp-1719) (if syntmp-tmp-1719 (apply (lambda (syntmp-dy-1720) ((lambda (syntmp-tmp-1721) ((lambda (syntmp-tmp-1722) (if syntmp-tmp-1722 (apply (lambda (syntmp-dx-1723) (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"))) (guile))) (cons syntmp-dx-1723 syntmp-dy-1720))) syntmp-tmp-1722) ((lambda (syntmp-_-1724) (if (null? syntmp-dy-1720) (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"))) (guile))) syntmp-x-1716) (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"))) (guile))) syntmp-x-1716 syntmp-y-1717))) syntmp-tmp-1721))) (syntax-dispatch syntmp-tmp-1721 (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"))) (guile))) any))))) syntmp-x-1716)) syntmp-tmp-1719) ((lambda (syntmp-tmp-1725) (if syntmp-tmp-1725 (apply (lambda (syntmp-stuff-1726) (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"))) (guile))) (cons syntmp-x-1716 syntmp-stuff-1726))) syntmp-tmp-1725) ((lambda (syntmp-else-1727) (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"))) (guile))) syntmp-x-1716 syntmp-y-1717)) syntmp-tmp-1718))) (syntax-dispatch syntmp-tmp-1718 (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"))) (guile))) . any)))))) (syntax-dispatch syntmp-tmp-1718 (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"))) (guile))) any))))) syntmp-y-1717)) syntmp-tmp-1715) (syntax-error syntmp-tmp-1714))) (syntax-dispatch syntmp-tmp-1714 (quote (any any))))) (list syntmp-x-1712 syntmp-y-1713)))) (syntmp-quasiappend-1709 (lambda (syntmp-x-1728 syntmp-y-1729) ((lambda (syntmp-tmp-1730) ((lambda (syntmp-tmp-1731) (if syntmp-tmp-1731 (apply (lambda (syntmp-x-1732 syntmp-y-1733) ((lambda (syntmp-tmp-1734) ((lambda (syntmp-tmp-1735) (if syntmp-tmp-1735 (apply (lambda () syntmp-x-1732) syntmp-tmp-1735) ((lambda (syntmp-_-1736) (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"))) (guile))) syntmp-x-1732 syntmp-y-1733)) syntmp-tmp-1734))) (syntax-dispatch syntmp-tmp-1734 (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"))) (guile))) ()))))) syntmp-y-1733)) syntmp-tmp-1731) (syntax-error syntmp-tmp-1730))) (syntax-dispatch syntmp-tmp-1730 (quote (any any))))) (list syntmp-x-1728 syntmp-y-1729)))) (syntmp-quasivector-1710 (lambda (syntmp-x-1737) ((lambda (syntmp-tmp-1738) ((lambda (syntmp-x-1739) ((lambda (syntmp-tmp-1740) ((lambda (syntmp-tmp-1741) (if syntmp-tmp-1741 (apply (lambda (syntmp-x-1742) (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"))) (guile))) (list->vector syntmp-x-1742))) syntmp-tmp-1741) ((lambda (syntmp-tmp-1744) (if syntmp-tmp-1744 (apply (lambda (syntmp-x-1745) (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"))) (guile))) syntmp-x-1745)) syntmp-tmp-1744) ((lambda (syntmp-_-1747) (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"))) (guile))) syntmp-x-1739)) syntmp-tmp-1740))) (syntax-dispatch syntmp-tmp-1740 (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"))) (guile))) . each-any)))))) (syntax-dispatch syntmp-tmp-1740 (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"))) (guile))) each-any))))) syntmp-x-1739)) syntmp-tmp-1738)) syntmp-x-1737))) (syntmp-quasi-1711 (lambda (syntmp-p-1748 syntmp-lev-1749) ((lambda (syntmp-tmp-1750) ((lambda (syntmp-tmp-1751) (if syntmp-tmp-1751 (apply (lambda (syntmp-p-1752) (if (= syntmp-lev-1749 0) syntmp-p-1752 (syntmp-quasicons-1708 (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"))) (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"))) (guile)))) (syntmp-quasi-1711 (list syntmp-p-1752) (- syntmp-lev-1749 1))))) syntmp-tmp-1751) ((lambda (syntmp-tmp-1753) (if syntmp-tmp-1753 (apply (lambda (syntmp-p-1754 syntmp-q-1755) (if (= syntmp-lev-1749 0) (syntmp-quasiappend-1709 syntmp-p-1754 (syntmp-quasi-1711 syntmp-q-1755 syntmp-lev-1749)) (syntmp-quasicons-1708 (syntmp-quasicons-1708 (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"))) (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"))) (guile)))) (syntmp-quasi-1711 (list syntmp-p-1754) (- syntmp-lev-1749 1))) (syntmp-quasi-1711 syntmp-q-1755 syntmp-lev-1749)))) syntmp-tmp-1753) ((lambda (syntmp-tmp-1756) (if syntmp-tmp-1756 (apply (lambda (syntmp-p-1757) (syntmp-quasicons-1708 (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"))) (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"))) (guile)))) (syntmp-quasi-1711 (list syntmp-p-1757) (+ syntmp-lev-1749 1)))) syntmp-tmp-1756) ((lambda (syntmp-tmp-1758) (if syntmp-tmp-1758 (apply (lambda (syntmp-p-1759 syntmp-q-1760) (syntmp-quasicons-1708 (syntmp-quasi-1711 syntmp-p-1759 syntmp-lev-1749) (syntmp-quasi-1711 syntmp-q-1760 syntmp-lev-1749))) syntmp-tmp-1758) ((lambda (syntmp-tmp-1761) (if syntmp-tmp-1761 (apply (lambda (syntmp-x-1762) (syntmp-quasivector-1710 (syntmp-quasi-1711 syntmp-x-1762 syntmp-lev-1749))) syntmp-tmp-1761) ((lambda (syntmp-p-1764) (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"))) (guile))) syntmp-p-1764)) syntmp-tmp-1750))) (syntax-dispatch syntmp-tmp-1750 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1750 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1750 (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"))) (guile))) any)))))) (syntax-dispatch syntmp-tmp-1750 (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"))) (guile))) any) . any)))))) (syntax-dispatch syntmp-tmp-1750 (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"))) (guile))) any))))) syntmp-p-1748)))) (lambda (syntmp-x-1765) ((lambda (syntmp-tmp-1766) ((lambda (syntmp-tmp-1767) (if syntmp-tmp-1767 (apply (lambda (syntmp-_-1768 syntmp-e-1769) (syntmp-quasi-1711 syntmp-e-1769 0)) syntmp-tmp-1767) (syntax-error syntmp-tmp-1766))) (syntax-dispatch syntmp-tmp-1766 (quote (any any))))) syntmp-x-1765))))
-(install-global-transformer (quote include) (lambda (syntmp-x-1829) (letrec ((syntmp-read-file-1830 (lambda (syntmp-fn-1831 syntmp-k-1832) (let ((syntmp-p-1833 (open-input-file syntmp-fn-1831))) (let syntmp-f-1834 ((syntmp-x-1835 (read syntmp-p-1833))) (if (eof-object? syntmp-x-1835) (begin (close-input-port syntmp-p-1833) (quote ())) (cons (datum->syntax-object syntmp-k-1832 syntmp-x-1835) (syntmp-f-1834 (read syntmp-p-1833))))))))) ((lambda (syntmp-tmp-1836) ((lambda (syntmp-tmp-1837) (if syntmp-tmp-1837 (apply (lambda (syntmp-k-1838 syntmp-filename-1839) (let ((syntmp-fn-1840 (syntax-object->datum syntmp-filename-1839))) ((lambda (syntmp-tmp-1841) ((lambda (syntmp-tmp-1842) (if syntmp-tmp-1842 (apply (lambda (syntmp-exp-1843) (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"))) (guile))) syntmp-exp-1843)) syntmp-tmp-1842) (syntax-error syntmp-tmp-1841))) (syntax-dispatch syntmp-tmp-1841 (quote each-any)))) (syntmp-read-file-1830 syntmp-fn-1840 syntmp-k-1838)))) syntmp-tmp-1837) (syntax-error syntmp-tmp-1836))) (syntax-dispatch syntmp-tmp-1836 (quote (any any))))) syntmp-x-1829))))
-(install-global-transformer (quote unquote) (lambda (syntmp-x-1860) ((lambda (syntmp-tmp-1861) ((lambda (syntmp-tmp-1862) (if syntmp-tmp-1862 (apply (lambda (syntmp-_-1863 syntmp-e-1864) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1864))) syntmp-tmp-1862) (syntax-error syntmp-tmp-1861))) (syntax-dispatch syntmp-tmp-1861 (quote (any any))))) syntmp-x-1860)))
-(install-global-transformer (quote unquote-splicing) (lambda (syntmp-x-1870) ((lambda (syntmp-tmp-1871) ((lambda (syntmp-tmp-1872) (if syntmp-tmp-1872 (apply (lambda (syntmp-_-1873 syntmp-e-1874) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1874))) syntmp-tmp-1872) (syntax-error syntmp-tmp-1871))) (syntax-dispatch syntmp-tmp-1871 (quote (any any))))) syntmp-x-1870)))
-(install-global-transformer (quote case) (lambda (syntmp-x-1880) ((lambda (syntmp-tmp-1881) ((lambda (syntmp-tmp-1882) (if syntmp-tmp-1882 (apply (lambda (syntmp-_-1883 syntmp-e-1884 syntmp-m1-1885 syntmp-m2-1886) ((lambda (syntmp-tmp-1887) ((lambda (syntmp-body-1888) (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"))) (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"))) (guile))) syntmp-e-1884)) syntmp-body-1888)) syntmp-tmp-1887)) (let syntmp-f-1889 ((syntmp-clause-1890 syntmp-m1-1885) (syntmp-clauses-1891 syntmp-m2-1886)) (if (null? syntmp-clauses-1891) ((lambda (syntmp-tmp-1893) ((lambda (syntmp-tmp-1894) (if syntmp-tmp-1894 (apply (lambda (syntmp-e1-1895 syntmp-e2-1896) (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"))) (guile))) (cons syntmp-e1-1895 syntmp-e2-1896))) syntmp-tmp-1894) ((lambda (syntmp-tmp-1898) (if syntmp-tmp-1898 (apply (lambda (syntmp-k-1899 syntmp-e1-1900 syntmp-e2-1901) (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"))) (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"))) (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"))) (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"))) (guile))) syntmp-k-1899)) (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"))) (guile))) (cons syntmp-e1-1900 syntmp-e2-1901)))) syntmp-tmp-1898) ((lambda (syntmp-_-1904) (syntax-error syntmp-x-1880)) syntmp-tmp-1893))) (syntax-dispatch syntmp-tmp-1893 (quote (each-any any . each-any)))))) (syntax-dispatch syntmp-tmp-1893 (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"))) (guile))) any . each-any))))) syntmp-clause-1890) ((lambda (syntmp-tmp-1905) ((lambda (syntmp-rest-1906) ((lambda (syntmp-tmp-1907) ((lambda (syntmp-tmp-1908) (if syntmp-tmp-1908 (apply (lambda (syntmp-k-1909 syntmp-e1-1910 syntmp-e2-1911) (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"))) (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"))) (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"))) (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"))) (guile))) syntmp-k-1909)) (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"))) (guile))) (cons syntmp-e1-1910 syntmp-e2-1911)) syntmp-rest-1906)) syntmp-tmp-1908) ((lambda (syntmp-_-1914) (syntax-error syntmp-x-1880)) syntmp-tmp-1907))) (syntax-dispatch syntmp-tmp-1907 (quote (each-any any . each-any))))) syntmp-clause-1890)) syntmp-tmp-1905)) (syntmp-f-1889 (car syntmp-clauses-1891) (cdr syntmp-clauses-1891))))))) syntmp-tmp-1882) (syntax-error syntmp-tmp-1881))) (syntax-dispatch syntmp-tmp-1881 (quote (any any any . each-any))))) syntmp-x-1880)))
-(install-global-transformer (quote identifier-syntax) (lambda (syntmp-x-1944) ((lambda (syntmp-tmp-1945) ((lambda (syntmp-tmp-1946) (if syntmp-tmp-1946 (apply (lambda (syntmp-_-1947 syntmp-e-1948) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) syntmp-e-1948)) (list (cons syntmp-_-1947 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons syntmp-e-1948 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))))))))) syntmp-tmp-1946) (syntax-error syntmp-tmp-1945))) (syntax-dispatch syntmp-tmp-1945 (quote (any any))))) syntmp-x-1944)))
+(letrec ((lambda-var-list1140 (lambda (vars1339) (let lvl1340 ((vars1341 vars1339) (ls1342 (quote ())) (w1343 (quote (())))) (cond ((pair? vars1341) (lvl1340 (cdr vars1341) (cons (wrap1119 (car vars1341) w1343 #f) ls1342) w1343)) ((id?1091 vars1341) (cons (wrap1119 vars1341 w1343 #f) ls1342)) ((null? vars1341) ls1342) ((syntax-object?1075 vars1341) (lvl1340 (syntax-object-expression1076 vars1341) ls1342 (join-wraps1110 w1343 (syntax-object-wrap1077 vars1341)))) ((annotation? vars1341) (lvl1340 (annotation-expression vars1341) ls1342 w1343)) (else (cons vars1341 ls1342)))))) (gen-var1139 (lambda (id1344) (let ((id1345 (if (syntax-object?1075 id1344) (syntax-object-expression1076 id1344) id1344))) (if (annotation? id1345) (build-annotated1068 (annotation-source id1345) (gensym (symbol->string (annotation-expression id1345)))) (build-annotated1068 #f (gensym (symbol->string id1345))))))) (strip1138 (lambda (x1346 w1347) (if (memq (quote top) (wrap-marks1094 w1347)) (if (or (annotation? x1346) (and (pair? x1346) (annotation? (car x1346)))) (strip-annotation1137 x1346 #f) x1346) (let f1348 ((x1349 x1346)) (cond ((syntax-object?1075 x1349) (strip1138 (syntax-object-expression1076 x1349) (syntax-object-wrap1077 x1349))) ((pair? x1349) (let ((a1350 (f1348 (car x1349))) (d1351 (f1348 (cdr x1349)))) (if (and (eq? a1350 (car x1349)) (eq? d1351 (cdr x1349))) x1349 (cons a1350 d1351)))) ((vector? x1349) (let ((old1352 (vector->list x1349))) (let ((new1353 (map f1348 old1352))) (if (andmap eq? old1352 new1353) x1349 (list->vector new1353))))) (else x1349)))))) (strip-annotation1137 (lambda (x1354 parent1355) (cond ((pair? x1354) (let ((new1356 (cons #f #f))) (begin (if parent1355 (set-annotation-stripped! parent1355 new1356)) (set-car! new1356 (strip-annotation1137 (car x1354) #f)) (set-cdr! new1356 (strip-annotation1137 (cdr x1354) #f)) new1356))) ((annotation? x1354) (or (annotation-stripped x1354) (strip-annotation1137 (annotation-expression x1354) x1354))) ((vector? x1354) (let ((new1357 (make-vector (vector-length x1354)))) (begin (if parent1355 (set-annotation-stripped! parent1355 new1357)) (let loop1358 ((i1359 (- (vector-length x1354) 1))) (unless (fx<1062 i1359 0) (vector-set! new1357 i1359 (strip-annotation1137 (vector-ref x1354 i1359) #f)) (loop1358 (fx-1060 i1359 1)))) new1357))) (else x1354)))) (ellipsis?1136 (lambda (x1360) (and (nonsymbol-id?1090 x1360) (free-id=?1114 x1360 (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"))) (guile))))))) (chi-void1135 (lambda () (build-annotated1068 #f (list (build-annotated1068 #f (quote void)))))) (eval-local-transformer1134 (lambda (expanded1361 mod1362) (let ((p1363 (local-eval-hook1064 expanded1361 mod1362))) (if (procedure? p1363) p1363 (syntax-error p1363 "nonprocedure transformer"))))) (chi-local-syntax1133 (lambda (rec?1364 e1365 r1366 w1367 s1368 mod1369 k1370) ((lambda (tmp1371) ((lambda (tmp1372) (if tmp1372 (apply (lambda (_1373 id1374 val1375 e11376 e21377) (let ((ids1378 id1374)) (if (not (valid-bound-ids?1116 ids1378)) (syntax-error e1365 "duplicate bound keyword in") (let ((labels1380 (gen-labels1097 ids1378))) (let ((new-w1381 (make-binding-wrap1108 ids1378 labels1380 w1367))) (k1370 (cons e11376 e21377) (extend-env1085 labels1380 (let ((w1383 (if rec?1364 new-w1381 w1367)) (trans-r1384 (macros-only-env1087 r1366))) (map (lambda (x1385) (cons (quote macro) (eval-local-transformer1134 (chi1127 x1385 trans-r1384 w1383 mod1369) mod1369))) val1375)) r1366) new-w1381 s1368 mod1369)))))) tmp1372) ((lambda (_1387) (syntax-error (source-wrap1120 e1365 w1367 s1368 mod1369))) tmp1371))) (syntax-dispatch tmp1371 (quote (any #(each (any any)) any . each-any))))) e1365))) (chi-lambda-clause1132 (lambda (e1388 c1389 r1390 w1391 mod1392 k1393) ((lambda (tmp1394) ((lambda (tmp1395) (if tmp1395 (apply (lambda (id1396 e11397 e21398) (let ((ids1399 id1396)) (if (not (valid-bound-ids?1116 ids1399)) (syntax-error e1388 "invalid parameter list in") (let ((labels1401 (gen-labels1097 ids1399)) (new-vars1402 (map gen-var1139 ids1399))) (k1393 new-vars1402 (chi-body1131 (cons e11397 e21398) e1388 (extend-var-env1086 labels1401 new-vars1402 r1390) (make-binding-wrap1108 ids1399 labels1401 w1391) mod1392)))))) tmp1395) ((lambda (tmp1404) (if tmp1404 (apply (lambda (ids1405 e11406 e21407) (let ((old-ids1408 (lambda-var-list1140 ids1405))) (if (not (valid-bound-ids?1116 old-ids1408)) (syntax-error e1388 "invalid parameter list in") (let ((labels1409 (gen-labels1097 old-ids1408)) (new-vars1410 (map gen-var1139 old-ids1408))) (k1393 (let f1411 ((ls11412 (cdr new-vars1410)) (ls21413 (car new-vars1410))) (if (null? ls11412) ls21413 (f1411 (cdr ls11412) (cons (car ls11412) ls21413)))) (chi-body1131 (cons e11406 e21407) e1388 (extend-var-env1086 labels1409 new-vars1410 r1390) (make-binding-wrap1108 old-ids1408 labels1409 w1391) mod1392)))))) tmp1404) ((lambda (_1415) (syntax-error e1388)) tmp1394))) (syntax-dispatch tmp1394 (quote (any any . each-any)))))) (syntax-dispatch tmp1394 (quote (each-any any . each-any))))) c1389))) (chi-body1131 (lambda (body1416 outer-form1417 r1418 w1419 mod1420) (let ((r1421 (cons (quote ("placeholder" placeholder)) r1418))) (let ((ribcage1422 (make-ribcage1098 (quote ()) (quote ()) (quote ())))) (let ((w1423 (make-wrap1093 (wrap-marks1094 w1419) (cons ribcage1422 (wrap-subst1095 w1419))))) (let parse1424 ((body1425 (map (lambda (x1431) (cons r1421 (wrap1119 x1431 w1423 mod1420))) body1416)) (ids1426 (quote ())) (labels1427 (quote ())) (vars1428 (quote ())) (vals1429 (quote ())) (bindings1430 (quote ()))) (if (null? body1425) (syntax-error outer-form1417 "no expressions in body") (let ((e1432 (cdar body1425)) (er1433 (caar body1425))) (call-with-values (lambda () (syntax-type1125 e1432 er1433 (quote (())) #f ribcage1422 mod1420)) (lambda (type1434 value1435 e1436 w1437 s1438 mod1439) (let ((t1440 type1434)) (if (memv t1440 (quote (define-form))) (let ((id1441 (wrap1119 value1435 w1437 mod1439)) (label1442 (gen-label1096))) (let ((var1443 (gen-var1139 id1441))) (begin (extend-ribcage!1107 ribcage1422 id1441 label1442) (parse1424 (cdr body1425) (cons id1441 ids1426) (cons label1442 labels1427) (cons var1443 vars1428) (cons (cons er1433 (wrap1119 e1436 w1437 mod1439)) vals1429) (cons (cons (quote lexical) var1443) bindings1430))))) (if (memv t1440 (quote (define-syntax-form))) (let ((id1444 (wrap1119 value1435 w1437 mod1439)) (label1445 (gen-label1096))) (begin (extend-ribcage!1107 ribcage1422 id1444 label1445) (parse1424 (cdr body1425) (cons id1444 ids1426) (cons label1445 labels1427) vars1428 vals1429 (cons (cons (quote macro) (cons er1433 (wrap1119 e1436 w1437 mod1439))) bindings1430)))) (if (memv t1440 (quote (begin-form))) ((lambda (tmp1446) ((lambda (tmp1447) (if tmp1447 (apply (lambda (_1448 e11449) (parse1424 (let f1450 ((forms1451 e11449)) (if (null? forms1451) (cdr body1425) (cons (cons er1433 (wrap1119 (car forms1451) w1437 mod1439)) (f1450 (cdr forms1451))))) ids1426 labels1427 vars1428 vals1429 bindings1430)) tmp1447) (syntax-error tmp1446))) (syntax-dispatch tmp1446 (quote (any . each-any))))) e1436) (if (memv t1440 (quote (local-syntax-form))) (chi-local-syntax1133 value1435 e1436 er1433 w1437 s1438 mod1439 (lambda (forms1453 er1454 w1455 s1456 mod1457) (parse1424 (let f1458 ((forms1459 forms1453)) (if (null? forms1459) (cdr body1425) (cons (cons er1454 (wrap1119 (car forms1459) w1455 mod1457)) (f1458 (cdr forms1459))))) ids1426 labels1427 vars1428 vals1429 bindings1430))) (if (null? ids1426) (build-sequence1070 #f (map (lambda (x1460) (chi1127 (cdr x1460) (car x1460) (quote (())) mod1439)) (cons (cons er1433 (source-wrap1120 e1436 w1437 s1438 mod1439)) (cdr body1425)))) (begin (if (not (valid-bound-ids?1116 ids1426)) (syntax-error outer-form1417 "invalid or duplicate identifier in definition")) (let loop1461 ((bs1462 bindings1430) (er-cache1463 #f) (r-cache1464 #f)) (if (not (null? bs1462)) (let ((b1465 (car bs1462))) (if (eq? (car b1465) (quote macro)) (let ((er1466 (cadr b1465))) (let ((r-cache1467 (if (eq? er1466 er-cache1463) r-cache1464 (macros-only-env1087 er1466)))) (begin (set-cdr! b1465 (eval-local-transformer1134 (chi1127 (cddr b1465) r-cache1467 (quote (())) mod1439) mod1439)) (loop1461 (cdr bs1462) er1466 r-cache1467)))) (loop1461 (cdr bs1462) er-cache1463 r-cache1464))))) (set-cdr! r1421 (extend-env1085 labels1427 bindings1430 (cdr r1421))) (build-letrec1073 #f vars1428 (map (lambda (x1468) (chi1127 (cdr x1468) (car x1468) (quote (())) mod1439)) vals1429) (build-sequence1070 #f (map (lambda (x1469) (chi1127 (cdr x1469) (car x1469) (quote (())) mod1439)) (cons (cons er1433 (source-wrap1120 e1436 w1437 s1438 mod1439)) (cdr body1425)))))))))))))))))))))) (chi-macro1130 (lambda (p1470 e1471 r1472 w1473 rib1474 mod1475) (letrec ((rebuild-macro-output1476 (lambda (x1477 m1478) (cond ((pair? x1477) (cons (rebuild-macro-output1476 (car x1477) m1478) (rebuild-macro-output1476 (cdr x1477) m1478))) ((syntax-object?1075 x1477) (let ((w1479 (syntax-object-wrap1077 x1477))) (let ((ms1480 (wrap-marks1094 w1479)) (s1481 (wrap-subst1095 w1479))) (if (and (pair? ms1480) (eq? (car ms1480) #f)) (make-syntax-object1074 (syntax-object-expression1076 x1477) (make-wrap1093 (cdr ms1480) (if rib1474 (cons rib1474 (cdr s1481)) (cdr s1481))) (syntax-object-module1078 x1477)) (make-syntax-object1074 (syntax-object-expression1076 x1477) (make-wrap1093 (cons m1478 ms1480) (if rib1474 (cons rib1474 (cons (quote shift) s1481)) (cons (quote shift) s1481))) (module-name (procedure-module p1470))))))) ((vector? x1477) (let ((n1482 (vector-length x1477))) (let ((v1483 (make-vector n1482))) (let doloop1484 ((i1485 0)) (if (fx=1061 i1485 n1482) v1483 (begin (vector-set! v1483 i1485 (rebuild-macro-output1476 (vector-ref x1477 i1485) m1478)) (doloop1484 (fx+1059 i1485 1)))))))) ((symbol? x1477) (syntax-error x1477 "encountered raw symbol in macro output")) (else x1477))))) (rebuild-macro-output1476 (p1470 (wrap1119 e1471 (anti-mark1106 w1473) mod1475)) (string #\m))))) (chi-application1129 (lambda (x1486 e1487 r1488 w1489 s1490 mod1491) ((lambda (tmp1492) ((lambda (tmp1493) (if tmp1493 (apply (lambda (e01494 e11495) (build-annotated1068 s1490 (cons x1486 (map (lambda (e1496) (chi1127 e1496 r1488 w1489 mod1491)) e11495)))) tmp1493) (syntax-error tmp1492))) (syntax-dispatch tmp1492 (quote (any . each-any))))) e1487))) (chi-expr1128 (lambda (type1498 value1499 e1500 r1501 w1502 s1503 mod1504) (let ((t1505 type1498)) (if (memv t1505 (quote (lexical))) (build-annotated1068 s1503 value1499) (if (memv t1505 (quote (core external-macro))) (value1499 e1500 r1501 w1502 s1503 mod1504) (if (memv t1505 (quote (module-ref))) (call-with-values (lambda () (value1499 e1500)) (lambda (id1506 mod1507) (build-annotated1068 s1503 (make-module-ref mod1507 id1506 #f)))) (if (memv t1505 (quote (lexical-call))) (chi-application1129 (build-annotated1068 (source-annotation1082 (car e1500)) value1499) e1500 r1501 w1502 s1503 mod1504) (if (memv t1505 (quote (global-call))) (chi-application1129 (build-annotated1068 (source-annotation1082 (car e1500)) (make-module-ref (if (syntax-object?1075 (car e1500)) (syntax-object-module1078 (car e1500)) mod1504) value1499 #f)) e1500 r1501 w1502 s1503 mod1504) (if (memv t1505 (quote (constant))) (build-data1069 s1503 (strip1138 (source-wrap1120 e1500 w1502 s1503 mod1504) (quote (())))) (if (memv t1505 (quote (global))) (build-annotated1068 s1503 (make-module-ref mod1504 value1499 #f)) (if (memv t1505 (quote (call))) (chi-application1129 (chi1127 (car e1500) r1501 w1502 mod1504) e1500 r1501 w1502 s1503 mod1504) (if (memv t1505 (quote (begin-form))) ((lambda (tmp1508) ((lambda (tmp1509) (if tmp1509 (apply (lambda (_1510 e11511 e21512) (chi-sequence1121 (cons e11511 e21512) r1501 w1502 s1503 mod1504)) tmp1509) (syntax-error tmp1508))) (syntax-dispatch tmp1508 (quote (any any . each-any))))) e1500) (if (memv t1505 (quote (local-syntax-form))) (chi-local-syntax1133 value1499 e1500 r1501 w1502 s1503 mod1504 chi-sequence1121) (if (memv t1505 (quote (eval-when-form))) ((lambda (tmp1514) ((lambda (tmp1515) (if tmp1515 (apply (lambda (_1516 x1517 e11518 e21519) (let ((when-list1520 (chi-when-list1124 e1500 x1517 w1502))) (if (memq (quote eval) when-list1520) (chi-sequence1121 (cons e11518 e21519) r1501 w1502 s1503 mod1504) (chi-void1135)))) tmp1515) (syntax-error tmp1514))) (syntax-dispatch tmp1514 (quote (any each-any any . each-any))))) e1500) (if (memv t1505 (quote (define-form define-syntax-form))) (syntax-error (wrap1119 value1499 w1502 mod1504) "invalid context for definition of") (if (memv t1505 (quote (syntax))) (syntax-error (source-wrap1120 e1500 w1502 s1503 mod1504) "reference to pattern variable outside syntax form") (if (memv t1505 (quote (displaced-lexical))) (syntax-error (source-wrap1120 e1500 w1502 s1503 mod1504) "reference to identifier outside its scope") (syntax-error (source-wrap1120 e1500 w1502 s1503 mod1504))))))))))))))))))) (chi1127 (lambda (e1523 r1524 w1525 mod1526) (call-with-values (lambda () (syntax-type1125 e1523 r1524 w1525 #f #f mod1526)) (lambda (type1527 value1528 e1529 w1530 s1531 mod1532) (chi-expr1128 type1527 value1528 e1529 r1524 w1530 s1531 mod1532))))) (chi-top1126 (lambda (e1533 r1534 w1535 m1536 esew1537 mod1538) (call-with-values (lambda () (syntax-type1125 e1533 r1534 w1535 #f #f mod1538)) (lambda (type1546 value1547 e1548 w1549 s1550 mod1551) (let ((t1552 type1546)) (if (memv t1552 (quote (begin-form))) ((lambda (tmp1553) ((lambda (tmp1554) (if tmp1554 (apply (lambda (_1555) (chi-void1135)) tmp1554) ((lambda (tmp1556) (if tmp1556 (apply (lambda (_1557 e11558 e21559) (chi-top-sequence1122 (cons e11558 e21559) r1534 w1549 s1550 m1536 esew1537 mod1551)) tmp1556) (syntax-error tmp1553))) (syntax-dispatch tmp1553 (quote (any any . each-any)))))) (syntax-dispatch tmp1553 (quote (any))))) e1548) (if (memv t1552 (quote (local-syntax-form))) (chi-local-syntax1133 value1547 e1548 r1534 w1549 s1550 mod1551 (lambda (body1561 r1562 w1563 s1564 mod1565) (chi-top-sequence1122 body1561 r1562 w1563 s1564 m1536 esew1537 mod1565))) (if (memv t1552 (quote (eval-when-form))) ((lambda (tmp1566) ((lambda (tmp1567) (if tmp1567 (apply (lambda (_1568 x1569 e11570 e21571) (let ((when-list1572 (chi-when-list1124 e1548 x1569 w1549)) (body1573 (cons e11570 e21571))) (cond ((eq? m1536 (quote e)) (if (memq (quote eval) when-list1572) (chi-top-sequence1122 body1573 r1534 w1549 s1550 (quote e) (quote (eval)) mod1551) (chi-void1135))) ((memq (quote load) when-list1572) (if (or (memq (quote compile) when-list1572) (and (eq? m1536 (quote c&e)) (memq (quote eval) when-list1572))) (chi-top-sequence1122 body1573 r1534 w1549 s1550 (quote c&e) (quote (compile load)) mod1551) (if (memq m1536 (quote (c c&e))) (chi-top-sequence1122 body1573 r1534 w1549 s1550 (quote c) (quote (load)) mod1551) (chi-void1135)))) ((or (memq (quote compile) when-list1572) (and (eq? m1536 (quote c&e)) (memq (quote eval) when-list1572))) (top-level-eval-hook1063 (chi-top-sequence1122 body1573 r1534 w1549 s1550 (quote e) (quote (eval)) mod1551) mod1551) (chi-void1135)) (else (chi-void1135))))) tmp1567) (syntax-error tmp1566))) (syntax-dispatch tmp1566 (quote (any each-any any . each-any))))) e1548) (if (memv t1552 (quote (define-syntax-form))) (let ((n1576 (id-var-name1113 value1547 w1549)) (r1577 (macros-only-env1087 r1534))) (let ((t1578 m1536)) (if (memv t1578 (quote (c))) (if (memq (quote compile) esew1537) (let ((e1579 (chi-install-global1123 n1576 (chi1127 e1548 r1577 w1549 mod1551)))) (begin (top-level-eval-hook1063 e1579 mod1551) (if (memq (quote load) esew1537) e1579 (chi-void1135)))) (if (memq (quote load) esew1537) (chi-install-global1123 n1576 (chi1127 e1548 r1577 w1549 mod1551)) (chi-void1135))) (if (memv t1578 (quote (c&e))) (let ((e1580 (chi-install-global1123 n1576 (chi1127 e1548 r1577 w1549 mod1551)))) (begin (top-level-eval-hook1063 e1580 mod1551) e1580)) (begin (if (memq (quote eval) esew1537) (top-level-eval-hook1063 (chi-install-global1123 n1576 (chi1127 e1548 r1577 w1549 mod1551)) mod1551)) (chi-void1135)))))) (if (memv t1552 (quote (define-form))) (let ((n1581 (id-var-name1113 value1547 w1549))) (let ((type1582 (binding-type1083 (lookup1088 n1581 r1534 mod1551)))) (let ((t1583 type1582)) (if (memv t1583 (quote (global))) (let ((x1584 (build-annotated1068 s1550 (list (quote define) n1581 (chi1127 e1548 r1534 w1549 mod1551))))) (begin (if (eq? m1536 (quote c&e)) (top-level-eval-hook1063 x1584 mod1551)) x1584)) (if (memv t1583 (quote (displaced-lexical))) (syntax-error (wrap1119 value1547 w1549 mod1551) "identifier out of context") (if (eq? type1582 (quote external-macro)) (let ((x1585 (build-annotated1068 s1550 (list (quote define) n1581 (chi1127 e1548 r1534 w1549 mod1551))))) (begin (if (eq? m1536 (quote c&e)) (top-level-eval-hook1063 x1585 mod1551)) x1585)) (syntax-error (wrap1119 value1547 w1549 mod1551) "cannot define keyword at top level"))))))) (let ((x1586 (chi-expr1128 type1546 value1547 e1548 r1534 w1549 s1550 mod1551))) (begin (if (eq? m1536 (quote c&e)) (top-level-eval-hook1063 x1586 mod1551)) x1586)))))))))))) (syntax-type1125 (lambda (e1587 r1588 w1589 s1590 rib1591 mod1592) (cond ((symbol? e1587) (let ((n1593 (id-var-name1113 e1587 w1589))) (let ((b1594 (lookup1088 n1593 r1588 mod1592))) (let ((type1595 (binding-type1083 b1594))) (let ((t1596 type1595)) (if (memv t1596 (quote (lexical))) (values type1595 (binding-value1084 b1594) e1587 w1589 s1590 mod1592) (if (memv t1596 (quote (global))) (values type1595 n1593 e1587 w1589 s1590 mod1592) (if (memv t1596 (quote (macro))) (syntax-type1125 (chi-macro1130 (binding-value1084 b1594) e1587 r1588 w1589 rib1591 mod1592) r1588 (quote (())) s1590 rib1591 mod1592) (values type1595 (binding-value1084 b1594) e1587 w1589 s1590 mod1592))))))))) ((pair? e1587) (let ((first1597 (car e1587))) (if (id?1091 first1597) (let ((n1598 (id-var-name1113 first1597 w1589))) (let ((b1599 (lookup1088 n1598 r1588 (or (and (syntax-object?1075 first1597) (syntax-object-module1078 first1597)) mod1592)))) (let ((type1600 (binding-type1083 b1599))) (let ((t1601 type1600)) (if (memv t1601 (quote (lexical))) (values (quote lexical-call) (binding-value1084 b1599) e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (global))) (values (quote global-call) n1598 e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (macro))) (syntax-type1125 (chi-macro1130 (binding-value1084 b1599) e1587 r1588 w1589 rib1591 mod1592) r1588 (quote (())) s1590 rib1591 mod1592) (if (memv t1601 (quote (core external-macro module-ref))) (values type1600 (binding-value1084 b1599) e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1084 b1599) e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (begin))) (values (quote begin-form) #f e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (eval-when))) (values (quote eval-when-form) #f e1587 w1589 s1590 mod1592) (if (memv t1601 (quote (define))) ((lambda (tmp1602) ((lambda (tmp1603) (if (if tmp1603 (apply (lambda (_1604 name1605 val1606) (id?1091 name1605)) tmp1603) #f) (apply (lambda (_1607 name1608 val1609) (values (quote define-form) name1608 val1609 w1589 s1590 mod1592)) tmp1603) ((lambda (tmp1610) (if (if tmp1610 (apply (lambda (_1611 name1612 args1613 e11614 e21615) (and (id?1091 name1612) (valid-bound-ids?1116 (lambda-var-list1140 args1613)))) tmp1610) #f) (apply (lambda (_1616 name1617 args1618 e11619 e21620) (values (quote define-form) (wrap1119 name1617 w1589 mod1592) (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"))) (guile))) (wrap1119 (cons args1618 (cons e11619 e21620)) w1589 mod1592)) (quote (())) s1590 mod1592)) tmp1610) ((lambda (tmp1622) (if (if tmp1622 (apply (lambda (_1623 name1624) (id?1091 name1624)) tmp1622) #f) (apply (lambda (_1625 name1626) (values (quote define-form) (wrap1119 name1626 w1589 mod1592) (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"))) (guile)))) (quote (())) s1590 mod1592)) tmp1622) (syntax-error tmp1602))) (syntax-dispatch tmp1602 (quote (any any)))))) (syntax-dispatch tmp1602 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1602 (quote (any any any))))) e1587) (if (memv t1601 (quote (define-syntax))) ((lambda (tmp1627) ((lambda (tmp1628) (if (if tmp1628 (apply (lambda (_1629 name1630 val1631) (id?1091 name1630)) tmp1628) #f) (apply (lambda (_1632 name1633 val1634) (values (quote define-syntax-form) name1633 val1634 w1589 s1590 mod1592)) tmp1628) (syntax-error tmp1627))) (syntax-dispatch tmp1627 (quote (any any any))))) e1587) (values (quote call) #f e1587 w1589 s1590 mod1592)))))))))))))) (values (quote call) #f e1587 w1589 s1590 mod1592)))) ((syntax-object?1075 e1587) (syntax-type1125 (syntax-object-expression1076 e1587) r1588 (join-wraps1110 w1589 (syntax-object-wrap1077 e1587)) #f rib1591 (or (syntax-object-module1078 e1587) mod1592))) ((annotation? e1587) (syntax-type1125 (annotation-expression e1587) r1588 w1589 (annotation-source e1587) rib1591 mod1592)) ((self-evaluating? e1587) (values (quote constant) #f e1587 w1589 s1590 mod1592)) (else (values (quote other) #f e1587 w1589 s1590 mod1592))))) (chi-when-list1124 (lambda (e1635 when-list1636 w1637) (let f1638 ((when-list1639 when-list1636) (situations1640 (quote ()))) (if (null? when-list1639) situations1640 (f1638 (cdr when-list1639) (cons (let ((x1641 (car when-list1639))) (cond ((free-id=?1114 x1641 (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"))) (guile)))) (quote compile)) ((free-id=?1114 x1641 (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"))) (guile)))) (quote load)) ((free-id=?1114 x1641 (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"))) (guile)))) (quote eval)) (else (syntax-error (wrap1119 x1641 w1637 #f) "invalid eval-when situation")))) situations1640)))))) (chi-install-global1123 (lambda (name1642 e1643) (build-annotated1068 #f (list (build-annotated1068 #f (quote install-global-transformer)) (build-data1069 #f name1642) e1643)))) (chi-top-sequence1122 (lambda (body1644 r1645 w1646 s1647 m1648 esew1649 mod1650) (build-sequence1070 s1647 (let dobody1651 ((body1652 body1644) (r1653 r1645) (w1654 w1646) (m1655 m1648) (esew1656 esew1649) (mod1657 mod1650)) (if (null? body1652) (quote ()) (let ((first1658 (chi-top1126 (car body1652) r1653 w1654 m1655 esew1656 mod1657))) (cons first1658 (dobody1651 (cdr body1652) r1653 w1654 m1655 esew1656 mod1657)))))))) (chi-sequence1121 (lambda (body1659 r1660 w1661 s1662 mod1663) (build-sequence1070 s1662 (let dobody1664 ((body1665 body1659) (r1666 r1660) (w1667 w1661) (mod1668 mod1663)) (if (null? body1665) (quote ()) (let ((first1669 (chi1127 (car body1665) r1666 w1667 mod1668))) (cons first1669 (dobody1664 (cdr body1665) r1666 w1667 mod1668)))))))) (source-wrap1120 (lambda (x1670 w1671 s1672 defmod1673) (wrap1119 (if s1672 (make-annotation x1670 s1672 #f) x1670) w1671 defmod1673))) (wrap1119 (lambda (x1674 w1675 defmod1676) (cond ((and (null? (wrap-marks1094 w1675)) (null? (wrap-subst1095 w1675))) x1674) ((syntax-object?1075 x1674) (make-syntax-object1074 (syntax-object-expression1076 x1674) (join-wraps1110 w1675 (syntax-object-wrap1077 x1674)) (syntax-object-module1078 x1674))) ((null? x1674) x1674) (else (make-syntax-object1074 x1674 w1675 defmod1676))))) (bound-id-member?1118 (lambda (x1677 list1678) (and (not (null? list1678)) (or (bound-id=?1115 x1677 (car list1678)) (bound-id-member?1118 x1677 (cdr list1678)))))) (distinct-bound-ids?1117 (lambda (ids1679) (let distinct?1680 ((ids1681 ids1679)) (or (null? ids1681) (and (not (bound-id-member?1118 (car ids1681) (cdr ids1681))) (distinct?1680 (cdr ids1681))))))) (valid-bound-ids?1116 (lambda (ids1682) (and (let all-ids?1683 ((ids1684 ids1682)) (or (null? ids1684) (and (id?1091 (car ids1684)) (all-ids?1683 (cdr ids1684))))) (distinct-bound-ids?1117 ids1682)))) (bound-id=?1115 (lambda (i1685 j1686) (if (and (syntax-object?1075 i1685) (syntax-object?1075 j1686)) (and (eq? (let ((e1687 (syntax-object-expression1076 i1685))) (if (annotation? e1687) (annotation-expression e1687) e1687)) (let ((e1688 (syntax-object-expression1076 j1686))) (if (annotation? e1688) (annotation-expression e1688) e1688))) (same-marks?1112 (wrap-marks1094 (syntax-object-wrap1077 i1685)) (wrap-marks1094 (syntax-object-wrap1077 j1686)))) (eq? (let ((e1689 i1685)) (if (annotation? e1689) (annotation-expression e1689) e1689)) (let ((e1690 j1686)) (if (annotation? e1690) (annotation-expression e1690) e1690)))))) (free-id=?1114 (lambda (i1691 j1692) (and (eq? (let ((x1693 i1691)) (let ((e1694 (if (syntax-object?1075 x1693) (syntax-object-expression1076 x1693) x1693))) (if (annotation? e1694) (annotation-expression e1694) e1694))) (let ((x1695 j1692)) (let ((e1696 (if (syntax-object?1075 x1695) (syntax-object-expression1076 x1695) x1695))) (if (annotation? e1696) (annotation-expression e1696) e1696)))) (eq? (id-var-name1113 i1691 (quote (()))) (id-var-name1113 j1692 (quote (()))))))) (id-var-name1113 (lambda (id1697 w1698) (letrec ((search-vector-rib1701 (lambda (sym1707 subst1708 marks1709 symnames1710 ribcage1711) (let ((n1712 (vector-length symnames1710))) (let f1713 ((i1714 0)) (cond ((fx=1061 i1714 n1712) (search1699 sym1707 (cdr subst1708) marks1709)) ((and (eq? (vector-ref symnames1710 i1714) sym1707) (same-marks?1112 marks1709 (vector-ref (ribcage-marks1101 ribcage1711) i1714))) (values (vector-ref (ribcage-labels1102 ribcage1711) i1714) marks1709)) (else (f1713 (fx+1059 i1714 1)))))))) (search-list-rib1700 (lambda (sym1715 subst1716 marks1717 symnames1718 ribcage1719) (let f1720 ((symnames1721 symnames1718) (i1722 0)) (cond ((null? symnames1721) (search1699 sym1715 (cdr subst1716) marks1717)) ((and (eq? (car symnames1721) sym1715) (same-marks?1112 marks1717 (list-ref (ribcage-marks1101 ribcage1719) i1722))) (values (list-ref (ribcage-labels1102 ribcage1719) i1722) marks1717)) (else (f1720 (cdr symnames1721) (fx+1059 i1722 1))))))) (search1699 (lambda (sym1723 subst1724 marks1725) (if (null? subst1724) (values #f marks1725) (let ((fst1726 (car subst1724))) (if (eq? fst1726 (quote shift)) (search1699 sym1723 (cdr subst1724) (cdr marks1725)) (let ((symnames1727 (ribcage-symnames1100 fst1726))) (if (vector? symnames1727) (search-vector-rib1701 sym1723 subst1724 marks1725 symnames1727 fst1726) (search-list-rib1700 sym1723 subst1724 marks1725 symnames1727 fst1726))))))))) (cond ((symbol? id1697) (or (call-with-values (lambda () (search1699 id1697 (wrap-subst1095 w1698) (wrap-marks1094 w1698))) (lambda (x1729 . ignore1728) x1729)) id1697)) ((syntax-object?1075 id1697) (let ((id1730 (let ((e1732 (syntax-object-expression1076 id1697))) (if (annotation? e1732) (annotation-expression e1732) e1732))) (w11731 (syntax-object-wrap1077 id1697))) (let ((marks1733 (join-marks1111 (wrap-marks1094 w1698) (wrap-marks1094 w11731)))) (call-with-values (lambda () (search1699 id1730 (wrap-subst1095 w1698) marks1733)) (lambda (new-id1734 marks1735) (or new-id1734 (call-with-values (lambda () (search1699 id1730 (wrap-subst1095 w11731) marks1735)) (lambda (x1737 . ignore1736) x1737)) id1730)))))) ((annotation? id1697) (let ((id1738 (let ((e1739 id1697)) (if (annotation? e1739) (annotation-expression e1739) e1739)))) (or (call-with-values (lambda () (search1699 id1738 (wrap-subst1095 w1698) (wrap-marks1094 w1698))) (lambda (x1741 . ignore1740) x1741)) id1738))) (else (error-hook1065 (quote id-var-name) "invalid id" id1697)))))) (same-marks?1112 (lambda (x1742 y1743) (or (eq? x1742 y1743) (and (not (null? x1742)) (not (null? y1743)) (eq? (car x1742) (car y1743)) (same-marks?1112 (cdr x1742) (cdr y1743)))))) (join-marks1111 (lambda (m11744 m21745) (smart-append1109 m11744 m21745))) (join-wraps1110 (lambda (w11746 w21747) (let ((m11748 (wrap-marks1094 w11746)) (s11749 (wrap-subst1095 w11746))) (if (null? m11748) (if (null? s11749) w21747 (make-wrap1093 (wrap-marks1094 w21747) (smart-append1109 s11749 (wrap-subst1095 w21747)))) (make-wrap1093 (smart-append1109 m11748 (wrap-marks1094 w21747)) (smart-append1109 s11749 (wrap-subst1095 w21747))))))) (smart-append1109 (lambda (m11750 m21751) (if (null? m21751) m11750 (append m11750 m21751)))) (make-binding-wrap1108 (lambda (ids1752 labels1753 w1754) (if (null? ids1752) w1754 (make-wrap1093 (wrap-marks1094 w1754) (cons (let ((labelvec1755 (list->vector labels1753))) (let ((n1756 (vector-length labelvec1755))) (let ((symnamevec1757 (make-vector n1756)) (marksvec1758 (make-vector n1756))) (begin (let f1759 ((ids1760 ids1752) (i1761 0)) (if (not (null? ids1760)) (call-with-values (lambda () (id-sym-name&marks1092 (car ids1760) w1754)) (lambda (symname1762 marks1763) (begin (vector-set! symnamevec1757 i1761 symname1762) (vector-set! marksvec1758 i1761 marks1763) (f1759 (cdr ids1760) (fx+1059 i1761 1))))))) (make-ribcage1098 symnamevec1757 marksvec1758 labelvec1755))))) (wrap-subst1095 w1754)))))) (extend-ribcage!1107 (lambda (ribcage1764 id1765 label1766) (begin (set-ribcage-symnames!1103 ribcage1764 (cons (let ((e1767 (syntax-object-expression1076 id1765))) (if (annotation? e1767) (annotation-expression e1767) e1767)) (ribcage-symnames1100 ribcage1764))) (set-ribcage-marks!1104 ribcage1764 (cons (wrap-marks1094 (syntax-object-wrap1077 id1765)) (ribcage-marks1101 ribcage1764))) (set-ribcage-labels!1105 ribcage1764 (cons label1766 (ribcage-labels1102 ribcage1764)))))) (anti-mark1106 (lambda (w1768) (make-wrap1093 (cons #f (wrap-marks1094 w1768)) (cons (quote shift) (wrap-subst1095 w1768))))) (set-ribcage-labels!1105 (lambda (x1769 update1770) (vector-set! x1769 3 update1770))) (set-ribcage-marks!1104 (lambda (x1771 update1772) (vector-set! x1771 2 update1772))) (set-ribcage-symnames!1103 (lambda (x1773 update1774) (vector-set! x1773 1 update1774))) (ribcage-labels1102 (lambda (x1775) (vector-ref x1775 3))) (ribcage-marks1101 (lambda (x1776) (vector-ref x1776 2))) (ribcage-symnames1100 (lambda (x1777) (vector-ref x1777 1))) (ribcage?1099 (lambda (x1778) (and (vector? x1778) (= (vector-length x1778) 4) (eq? (vector-ref x1778 0) (quote ribcage))))) (make-ribcage1098 (lambda (symnames1779 marks1780 labels1781) (vector (quote ribcage) symnames1779 marks1780 labels1781))) (gen-labels1097 (lambda (ls1782) (if (null? ls1782) (quote ()) (cons (gen-label1096) (gen-labels1097 (cdr ls1782)))))) (gen-label1096 (lambda () (string #\i))) (wrap-subst1095 cdr) (wrap-marks1094 car) (make-wrap1093 cons) (id-sym-name&marks1092 (lambda (x1783 w1784) (if (syntax-object?1075 x1783) (values (let ((e1785 (syntax-object-expression1076 x1783))) (if (annotation? e1785) (annotation-expression e1785) e1785)) (join-marks1111 (wrap-marks1094 w1784) (wrap-marks1094 (syntax-object-wrap1077 x1783)))) (values (let ((e1786 x1783)) (if (annotation? e1786) (annotation-expression e1786) e1786)) (wrap-marks1094 w1784))))) (id?1091 (lambda (x1787) (cond ((symbol? x1787) #t) ((syntax-object?1075 x1787) (symbol? (let ((e1788 (syntax-object-expression1076 x1787))) (if (annotation? e1788) (annotation-expression e1788) e1788)))) ((annotation? x1787) (symbol? (annotation-expression x1787))) (else #f)))) (nonsymbol-id?1090 (lambda (x1789) (and (syntax-object?1075 x1789) (symbol? (let ((e1790 (syntax-object-expression1076 x1789))) (if (annotation? e1790) (annotation-expression e1790) e1790)))))) (global-extend1089 (lambda (type1791 sym1792 val1793) (put-global-definition-hook1066 sym1792 (cons type1791 val1793) (module-name (current-module))))) (lookup1088 (lambda (x1794 r1795 mod1796) (cond ((assq x1794 r1795) => cdr) ((symbol? x1794) (or (get-global-definition-hook1067 x1794 mod1796) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1087 (lambda (r1797) (if (null? r1797) (quote ()) (let ((a1798 (car r1797))) (if (eq? (cadr a1798) (quote macro)) (cons a1798 (macros-only-env1087 (cdr r1797))) (macros-only-env1087 (cdr r1797))))))) (extend-var-env1086 (lambda (labels1799 vars1800 r1801) (if (null? labels1799) r1801 (extend-var-env1086 (cdr labels1799) (cdr vars1800) (cons (cons (car labels1799) (cons (quote lexical) (car vars1800))) r1801))))) (extend-env1085 (lambda (labels1802 bindings1803 r1804) (if (null? labels1802) r1804 (extend-env1085 (cdr labels1802) (cdr bindings1803) (cons (cons (car labels1802) (car bindings1803)) r1804))))) (binding-value1084 cdr) (binding-type1083 car) (source-annotation1082 (lambda (x1805) (cond ((annotation? x1805) (annotation-source x1805)) ((syntax-object?1075 x1805) (source-annotation1082 (syntax-object-expression1076 x1805))) (else #f)))) (set-syntax-object-module!1081 (lambda (x1806 update1807) (vector-set! x1806 3 update1807))) (set-syntax-object-wrap!1080 (lambda (x1808 update1809) (vector-set! x1808 2 update1809))) (set-syntax-object-expression!1079 (lambda (x1810 update1811) (vector-set! x1810 1 update1811))) (syntax-object-module1078 (lambda (x1812) (vector-ref x1812 3))) (syntax-object-wrap1077 (lambda (x1813) (vector-ref x1813 2))) (syntax-object-expression1076 (lambda (x1814) (vector-ref x1814 1))) (syntax-object?1075 (lambda (x1815) (and (vector? x1815) (= (vector-length x1815) 4) (eq? (vector-ref x1815 0) (quote syntax-object))))) (make-syntax-object1074 (lambda (expression1816 wrap1817 module1818) (vector (quote syntax-object) expression1816 wrap1817 module1818))) (build-letrec1073 (lambda (src1819 vars1820 val-exps1821 body-exp1822) (if (null? vars1820) (build-annotated1068 src1819 body-exp1822) (build-annotated1068 src1819 (list (quote letrec) (map list vars1820 val-exps1821) body-exp1822))))) (build-named-let1072 (lambda (src1823 vars1824 val-exps1825 body-exp1826) (if (null? vars1824) (build-annotated1068 src1823 body-exp1826) (build-annotated1068 src1823 (list (quote let) (car vars1824) (map list (cdr vars1824) val-exps1825) body-exp1826))))) (build-let1071 (lambda (src1827 vars1828 val-exps1829 body-exp1830) (if (null? vars1828) (build-annotated1068 src1827 body-exp1830) (build-annotated1068 src1827 (list (quote let) (map list vars1828 val-exps1829) body-exp1830))))) (build-sequence1070 (lambda (src1831 exps1832) (if (null? (cdr exps1832)) (build-annotated1068 src1831 (car exps1832)) (build-annotated1068 src1831 (cons (quote begin) exps1832))))) (build-data1069 (lambda (src1833 exp1834) (if (and (self-evaluating? exp1834) (not (vector? exp1834))) (build-annotated1068 src1833 exp1834) (build-annotated1068 src1833 (list (quote quote) exp1834))))) (build-annotated1068 (lambda (src1835 exp1836) (if (and src1835 (not (annotation? exp1836))) (make-annotation exp1836 src1835 #t) exp1836))) (get-global-definition-hook1067 (lambda (symbol1837 module1838) (let ((module1839 (if module1838 (resolve-module module1838) (warn "wha" symbol1837 (current-module))))) (let ((v1840 (module-variable module1839 symbol1837))) (and v1840 (or (object-property v1840 (quote *sc-expander*)) (and (variable-bound? v1840) (macro? (variable-ref v1840)) (macro-transformer (variable-ref v1840)) guile-macro))))))) (put-global-definition-hook1066 (lambda (symbol1841 binding1842 modname1843) (let ((module1844 (if modname1843 (resolve-module modname1843) (current-module)))) (let ((v1845 (or (module-variable module1844 symbol1841) (let ((v1846 (make-variable (quote sc-macro)))) (begin (module-add! module1844 symbol1841 v1846) v1846))))) (begin (if (not (variable-bound? v1845)) (variable-set! v1845 (gensym))) (set-object-property! v1845 (quote *sc-expander*) binding1842)))))) (error-hook1065 (lambda (who1847 why1848 what1849) (error who1847 "~a ~s" why1848 what1849))) (local-eval-hook1064 (lambda (x1850 mod1851) (eval (list noexpand1058 x1850) (if mod1851 (resolve-module mod1851) (interaction-environment))))) (top-level-eval-hook1063 (lambda (x1852 mod1853) (eval (list noexpand1058 x1852) (if mod1853 (resolve-module mod1853) (interaction-environment))))) (fx<1062 <) (fx=1061 =) (fx-1060 -) (fx+1059 +) (noexpand1058 "noexpand")) (begin (global-extend1089 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1089 (quote local-syntax) (quote let-syntax) #f) (global-extend1089 (quote core) (quote fluid-let-syntax) (lambda (e1854 r1855 w1856 s1857 mod1858) ((lambda (tmp1859) ((lambda (tmp1860) (if (if tmp1860 (apply (lambda (_1861 var1862 val1863 e11864 e21865) (valid-bound-ids?1116 var1862)) tmp1860) #f) (apply (lambda (_1867 var1868 val1869 e11870 e21871) (let ((names1872 (map (lambda (x1873) (id-var-name1113 x1873 w1856)) var1868))) (begin (for-each (lambda (id1875 n1876) (let ((t1877 (binding-type1083 (lookup1088 n1876 r1855 mod1858)))) (if (memv t1877 (quote (displaced-lexical))) (syntax-error (source-wrap1120 id1875 w1856 s1857 mod1858) "identifier out of context")))) var1868 names1872) (chi-body1131 (cons e11870 e21871) (source-wrap1120 e1854 w1856 s1857 mod1858) (extend-env1085 names1872 (let ((trans-r1880 (macros-only-env1087 r1855))) (map (lambda (x1881) (cons (quote macro) (eval-local-transformer1134 (chi1127 x1881 trans-r1880 w1856 mod1858) mod1858))) val1869)) r1855) w1856 mod1858)))) tmp1860) ((lambda (_1883) (syntax-error (source-wrap1120 e1854 w1856 s1857 mod1858))) tmp1859))) (syntax-dispatch tmp1859 (quote (any #(each (any any)) any . each-any))))) e1854))) (global-extend1089 (quote core) (quote quote) (lambda (e1884 r1885 w1886 s1887 mod1888) ((lambda (tmp1889) ((lambda (tmp1890) (if tmp1890 (apply (lambda (_1891 e1892) (build-data1069 s1887 (strip1138 e1892 w1886))) tmp1890) ((lambda (_1893) (syntax-error (source-wrap1120 e1884 w1886 s1887 mod1888))) tmp1889))) (syntax-dispatch tmp1889 (quote (any any))))) e1884))) (global-extend1089 (quote core) (quote syntax) (letrec ((regen1901 (lambda (x1902) (let ((t1903 (car x1902))) (if (memv t1903 (quote (ref))) (build-annotated1068 #f (cadr x1902)) (if (memv t1903 (quote (primitive))) (build-annotated1068 #f (cadr x1902)) (if (memv t1903 (quote (quote))) (build-data1069 #f (cadr x1902)) (if (memv t1903 (quote (lambda))) (build-annotated1068 #f (list (quote lambda) (cadr x1902) (regen1901 (caddr x1902)))) (if (memv t1903 (quote (map))) (let ((ls1904 (map regen1901 (cdr x1902)))) (build-annotated1068 #f (cons (if (fx=1061 (length ls1904) 2) (build-annotated1068 #f (quote map)) (build-annotated1068 #f (quote map))) ls1904))) (build-annotated1068 #f (cons (build-annotated1068 #f (car x1902)) (map regen1901 (cdr x1902)))))))))))) (gen-vector1900 (lambda (x1905) (cond ((eq? (car x1905) (quote list)) (cons (quote vector) (cdr x1905))) ((eq? (car x1905) (quote quote)) (list (quote quote) (list->vector (cadr x1905)))) (else (list (quote list->vector) x1905))))) (gen-append1899 (lambda (x1906 y1907) (if (equal? y1907 (quote (quote ()))) x1906 (list (quote append) x1906 y1907)))) (gen-cons1898 (lambda (x1908 y1909) (let ((t1910 (car y1909))) (if (memv t1910 (quote (quote))) (if (eq? (car x1908) (quote quote)) (list (quote quote) (cons (cadr x1908) (cadr y1909))) (if (eq? (cadr y1909) (quote ())) (list (quote list) x1908) (list (quote cons) x1908 y1909))) (if (memv t1910 (quote (list))) (cons (quote list) (cons x1908 (cdr y1909))) (list (quote cons) x1908 y1909)))))) (gen-map1897 (lambda (e1911 map-env1912) (let ((formals1913 (map cdr map-env1912)) (actuals1914 (map (lambda (x1915) (list (quote ref) (car x1915))) map-env1912))) (cond ((eq? (car e1911) (quote ref)) (car actuals1914)) ((andmap (lambda (x1916) (and (eq? (car x1916) (quote ref)) (memq (cadr x1916) formals1913))) (cdr e1911)) (cons (quote map) (cons (list (quote primitive) (car e1911)) (map (let ((r1917 (map cons formals1913 actuals1914))) (lambda (x1918) (cdr (assq (cadr x1918) r1917)))) (cdr e1911))))) (else (cons (quote map) (cons (list (quote lambda) formals1913 e1911) actuals1914))))))) (gen-mappend1896 (lambda (e1919 map-env1920) (list (quote apply) (quote (primitive append)) (gen-map1897 e1919 map-env1920)))) (gen-ref1895 (lambda (src1921 var1922 level1923 maps1924) (if (fx=1061 level1923 0) (values var1922 maps1924) (if (null? maps1924) (syntax-error src1921 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1895 src1921 var1922 (fx-1060 level1923 1) (cdr maps1924))) (lambda (outer-var1925 outer-maps1926) (let ((b1927 (assq outer-var1925 (car maps1924)))) (if b1927 (values (cdr b1927) maps1924) (let ((inner-var1928 (gen-var1139 (quote tmp)))) (values inner-var1928 (cons (cons (cons outer-var1925 inner-var1928) (car maps1924)) outer-maps1926))))))))))) (gen-syntax1894 (lambda (src1929 e1930 r1931 maps1932 ellipsis?1933 mod1934) (if (id?1091 e1930) (let ((label1935 (id-var-name1113 e1930 (quote (()))))) (let ((b1936 (lookup1088 label1935 r1931 mod1934))) (if (eq? (binding-type1083 b1936) (quote syntax)) (call-with-values (lambda () (let ((var.lev1937 (binding-value1084 b1936))) (gen-ref1895 src1929 (car var.lev1937) (cdr var.lev1937) maps1932))) (lambda (var1938 maps1939) (values (list (quote ref) var1938) maps1939))) (if (ellipsis?1933 e1930) (syntax-error src1929 "misplaced ellipsis in syntax form") (values (list (quote quote) e1930) maps1932))))) ((lambda (tmp1940) ((lambda (tmp1941) (if (if tmp1941 (apply (lambda (dots1942 e1943) (ellipsis?1933 dots1942)) tmp1941) #f) (apply (lambda (dots1944 e1945) (gen-syntax1894 src1929 e1945 r1931 maps1932 (lambda (x1946) #f) mod1934)) tmp1941) ((lambda (tmp1947) (if (if tmp1947 (apply (lambda (x1948 dots1949 y1950) (ellipsis?1933 dots1949)) tmp1947) #f) (apply (lambda (x1951 dots1952 y1953) (let f1954 ((y1955 y1953) (k1956 (lambda (maps1957) (call-with-values (lambda () (gen-syntax1894 src1929 x1951 r1931 (cons (quote ()) maps1957) ellipsis?1933 mod1934)) (lambda (x1958 maps1959) (if (null? (car maps1959)) (syntax-error src1929 "extra ellipsis in syntax form") (values (gen-map1897 x1958 (car maps1959)) (cdr maps1959)))))))) ((lambda (tmp1960) ((lambda (tmp1961) (if (if tmp1961 (apply (lambda (dots1962 y1963) (ellipsis?1933 dots1962)) tmp1961) #f) (apply (lambda (dots1964 y1965) (f1954 y1965 (lambda (maps1966) (call-with-values (lambda () (k1956 (cons (quote ()) maps1966))) (lambda (x1967 maps1968) (if (null? (car maps1968)) (syntax-error src1929 "extra ellipsis in syntax form") (values (gen-mappend1896 x1967 (car maps1968)) (cdr maps1968)))))))) tmp1961) ((lambda (_1969) (call-with-values (lambda () (gen-syntax1894 src1929 y1955 r1931 maps1932 ellipsis?1933 mod1934)) (lambda (y1970 maps1971) (call-with-values (lambda () (k1956 maps1971)) (lambda (x1972 maps1973) (values (gen-append1899 x1972 y1970) maps1973)))))) tmp1960))) (syntax-dispatch tmp1960 (quote (any . any))))) y1955))) tmp1947) ((lambda (tmp1974) (if tmp1974 (apply (lambda (x1975 y1976) (call-with-values (lambda () (gen-syntax1894 src1929 x1975 r1931 maps1932 ellipsis?1933 mod1934)) (lambda (x1977 maps1978) (call-with-values (lambda () (gen-syntax1894 src1929 y1976 r1931 maps1978 ellipsis?1933 mod1934)) (lambda (y1979 maps1980) (values (gen-cons1898 x1977 y1979) maps1980)))))) tmp1974) ((lambda (tmp1981) (if tmp1981 (apply (lambda (e11982 e21983) (call-with-values (lambda () (gen-syntax1894 src1929 (cons e11982 e21983) r1931 maps1932 ellipsis?1933 mod1934)) (lambda (e1985 maps1986) (values (gen-vector1900 e1985) maps1986)))) tmp1981) ((lambda (_1987) (values (list (quote quote) e1930) maps1932)) tmp1940))) (syntax-dispatch tmp1940 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1940 (quote (any . any)))))) (syntax-dispatch tmp1940 (quote (any any . any)))))) (syntax-dispatch tmp1940 (quote (any any))))) e1930))))) (lambda (e1988 r1989 w1990 s1991 mod1992) (let ((e1993 (source-wrap1120 e1988 w1990 s1991 mod1992))) ((lambda (tmp1994) ((lambda (tmp1995) (if tmp1995 (apply (lambda (_1996 x1997) (call-with-values (lambda () (gen-syntax1894 e1993 x1997 r1989 (quote ()) ellipsis?1136 mod1992)) (lambda (e1998 maps1999) (regen1901 e1998)))) tmp1995) ((lambda (_2000) (syntax-error e1993)) tmp1994))) (syntax-dispatch tmp1994 (quote (any any))))) e1993))))) (global-extend1089 (quote core) (quote lambda) (lambda (e2001 r2002 w2003 s2004 mod2005) ((lambda (tmp2006) ((lambda (tmp2007) (if tmp2007 (apply (lambda (_2008 c2009) (chi-lambda-clause1132 (source-wrap1120 e2001 w2003 s2004 mod2005) c2009 r2002 w2003 mod2005 (lambda (vars2010 body2011) (build-annotated1068 s2004 (list (quote lambda) vars2010 body2011))))) tmp2007) (syntax-error tmp2006))) (syntax-dispatch tmp2006 (quote (any . any))))) e2001))) (global-extend1089 (quote core) (quote let) (letrec ((chi-let2012 (lambda (e2013 r2014 w2015 s2016 mod2017 constructor2018 ids2019 vals2020 exps2021) (if (not (valid-bound-ids?1116 ids2019)) (syntax-error e2013 "duplicate bound variable in") (let ((labels2022 (gen-labels1097 ids2019)) (new-vars2023 (map gen-var1139 ids2019))) (let ((nw2024 (make-binding-wrap1108 ids2019 labels2022 w2015)) (nr2025 (extend-var-env1086 labels2022 new-vars2023 r2014))) (constructor2018 s2016 new-vars2023 (map (lambda (x2026) (chi1127 x2026 r2014 w2015 mod2017)) vals2020) (chi-body1131 exps2021 (source-wrap1120 e2013 nw2024 s2016 mod2017) nr2025 nw2024 mod2017)))))))) (lambda (e2027 r2028 w2029 s2030 mod2031) ((lambda (tmp2032) ((lambda (tmp2033) (if tmp2033 (apply (lambda (_2034 id2035 val2036 e12037 e22038) (chi-let2012 e2027 r2028 w2029 s2030 mod2031 build-let1071 id2035 val2036 (cons e12037 e22038))) tmp2033) ((lambda (tmp2042) (if (if tmp2042 (apply (lambda (_2043 f2044 id2045 val2046 e12047 e22048) (id?1091 f2044)) tmp2042) #f) (apply (lambda (_2049 f2050 id2051 val2052 e12053 e22054) (chi-let2012 e2027 r2028 w2029 s2030 mod2031 build-named-let1072 (cons f2050 id2051) val2052 (cons e12053 e22054))) tmp2042) ((lambda (_2058) (syntax-error (source-wrap1120 e2027 w2029 s2030 mod2031))) tmp2032))) (syntax-dispatch tmp2032 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2032 (quote (any #(each (any any)) any . each-any))))) e2027)))) (global-extend1089 (quote core) (quote letrec) (lambda (e2059 r2060 w2061 s2062 mod2063) ((lambda (tmp2064) ((lambda (tmp2065) (if tmp2065 (apply (lambda (_2066 id2067 val2068 e12069 e22070) (let ((ids2071 id2067)) (if (not (valid-bound-ids?1116 ids2071)) (syntax-error e2059 "duplicate bound variable in") (let ((labels2073 (gen-labels1097 ids2071)) (new-vars2074 (map gen-var1139 ids2071))) (let ((w2075 (make-binding-wrap1108 ids2071 labels2073 w2061)) (r2076 (extend-var-env1086 labels2073 new-vars2074 r2060))) (build-letrec1073 s2062 new-vars2074 (map (lambda (x2077) (chi1127 x2077 r2076 w2075 mod2063)) val2068) (chi-body1131 (cons e12069 e22070) (source-wrap1120 e2059 w2075 s2062 mod2063) r2076 w2075 mod2063))))))) tmp2065) ((lambda (_2080) (syntax-error (source-wrap1120 e2059 w2061 s2062 mod2063))) tmp2064))) (syntax-dispatch tmp2064 (quote (any #(each (any any)) any . each-any))))) e2059))) (global-extend1089 (quote core) (quote set!) (lambda (e2081 r2082 w2083 s2084 mod2085) ((lambda (tmp2086) ((lambda (tmp2087) (if (if tmp2087 (apply (lambda (_2088 id2089 val2090) (id?1091 id2089)) tmp2087) #f) (apply (lambda (_2091 id2092 val2093) (let ((val2094 (chi1127 val2093 r2082 w2083 mod2085)) (n2095 (id-var-name1113 id2092 w2083))) (let ((b2096 (lookup1088 n2095 r2082 mod2085))) (let ((t2097 (binding-type1083 b2096))) (if (memv t2097 (quote (lexical))) (build-annotated1068 s2084 (list (quote set!) (binding-value1084 b2096) val2094)) (if (memv t2097 (quote (global))) (build-annotated1068 s2084 (list (quote set!) (make-module-ref mod2085 n2095 #f) val2094)) (if (memv t2097 (quote (displaced-lexical))) (syntax-error (wrap1119 id2092 w2083 mod2085) "identifier out of context") (syntax-error (source-wrap1120 e2081 w2083 s2084 mod2085))))))))) tmp2087) ((lambda (tmp2098) (if tmp2098 (apply (lambda (_2099 head2100 tail2101 val2102) (call-with-values (lambda () (syntax-type1125 head2100 r2082 (quote (())) #f #f mod2085)) (lambda (type2103 value2104 ee2105 ww2106 ss2107 modmod2108) (let ((t2109 type2103)) (if (memv t2109 (quote (module-ref))) (call-with-values (lambda () (value2104 (cons head2100 tail2101))) (lambda (id2111 mod2112) (build-annotated1068 s2084 (list (quote set!) (make-module-ref mod2112 id2111 #f) val2102)))) (build-annotated1068 s2084 (cons (chi1127 (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"))) (guile))) head2100) r2082 w2083 mod2085) (map (lambda (e2113) (chi1127 e2113 r2082 w2083 mod2085)) (append tail2101 (list val2102)))))))))) tmp2098) ((lambda (_2115) (syntax-error (source-wrap1120 e2081 w2083 s2084 mod2085))) tmp2086))) (syntax-dispatch tmp2086 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2086 (quote (any any any))))) e2081))) (global-extend1089 (quote module-ref) (quote @) (lambda (e2116) ((lambda (tmp2117) ((lambda (tmp2118) (if (if tmp2118 (apply (lambda (_2119 mod2120 id2121) (and (andmap id?1091 mod2120) (id?1091 id2121))) tmp2118) #f) (apply (lambda (_2123 mod2124 id2125) (values (syntax-object->datum id2125) (syntax-object->datum (append mod2124 (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"))) (guile)))))))) tmp2118) (syntax-error tmp2117))) (syntax-dispatch tmp2117 (quote (any each-any any))))) e2116))) (global-extend1089 (quote module-ref) (quote @@) (lambda (e2127) ((lambda (tmp2128) ((lambda (tmp2129) (if (if tmp2129 (apply (lambda (_2130 mod2131 id2132) (and (andmap id?1091 mod2131) (id?1091 id2132))) tmp2129) #f) (apply (lambda (_2134 mod2135 id2136) (values (syntax-object->datum id2136) (syntax-object->datum mod2135))) tmp2129) (syntax-error tmp2128))) (syntax-dispatch tmp2128 (quote (any each-any any))))) e2127))) (global-extend1089 (quote begin) (quote begin) (quote ())) (global-extend1089 (quote define) (quote define) (quote ())) (global-extend1089 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1089 (quote eval-when) (quote eval-when) (quote ())) (global-extend1089 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2141 (lambda (x2142 keys2143 clauses2144 r2145 mod2146) (if (null? clauses2144) (build-annotated1068 #f (list (build-annotated1068 #f (quote syntax-error)) x2142)) ((lambda (tmp2147) ((lambda (tmp2148) (if tmp2148 (apply (lambda (pat2149 exp2150) (if (and (id?1091 pat2149) (andmap (lambda (x2151) (not (free-id=?1114 pat2149 x2151))) (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"))) (guile))) keys2143))) (let ((labels2152 (list (gen-label1096))) (var2153 (gen-var1139 pat2149))) (build-annotated1068 #f (list (build-annotated1068 #f (list (quote lambda) (list var2153) (chi1127 exp2150 (extend-env1085 labels2152 (list (cons (quote syntax) (cons var2153 0))) r2145) (make-binding-wrap1108 (list pat2149) labels2152 (quote (()))) mod2146))) x2142))) (gen-clause2140 x2142 keys2143 (cdr clauses2144) r2145 pat2149 #t exp2150 mod2146))) tmp2148) ((lambda (tmp2154) (if tmp2154 (apply (lambda (pat2155 fender2156 exp2157) (gen-clause2140 x2142 keys2143 (cdr clauses2144) r2145 pat2155 fender2156 exp2157 mod2146)) tmp2154) ((lambda (_2158) (syntax-error (car clauses2144) "invalid syntax-case clause")) tmp2147))) (syntax-dispatch tmp2147 (quote (any any any)))))) (syntax-dispatch tmp2147 (quote (any any))))) (car clauses2144))))) (gen-clause2140 (lambda (x2159 keys2160 clauses2161 r2162 pat2163 fender2164 exp2165 mod2166) (call-with-values (lambda () (convert-pattern2138 pat2163 keys2160)) (lambda (p2167 pvars2168) (cond ((not (distinct-bound-ids?1117 (map car pvars2168))) (syntax-error pat2163 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2169) (not (ellipsis?1136 (car x2169)))) pvars2168)) (syntax-error pat2163 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2170 (gen-var1139 (quote tmp)))) (build-annotated1068 #f (list (build-annotated1068 #f (list (quote lambda) (list y2170) (let ((y2171 (build-annotated1068 #f y2170))) (build-annotated1068 #f (list (quote if) ((lambda (tmp2172) ((lambda (tmp2173) (if tmp2173 (apply (lambda () y2171) tmp2173) ((lambda (_2174) (build-annotated1068 #f (list (quote if) y2171 (build-dispatch-call2139 pvars2168 fender2164 y2171 r2162 mod2166) (build-data1069 #f #f)))) tmp2172))) (syntax-dispatch tmp2172 (quote #(atom #t))))) fender2164) (build-dispatch-call2139 pvars2168 exp2165 y2171 r2162 mod2166) (gen-syntax-case2141 x2159 keys2160 clauses2161 r2162 mod2166)))))) (if (eq? p2167 (quote any)) (build-annotated1068 #f (list (build-annotated1068 #f (quote list)) x2159)) (build-annotated1068 #f (list (build-annotated1068 #f (quote syntax-dispatch)) x2159 (build-data1069 #f p2167))))))))))))) (build-dispatch-call2139 (lambda (pvars2175 exp2176 y2177 r2178 mod2179) (let ((ids2180 (map car pvars2175)) (levels2181 (map cdr pvars2175))) (let ((labels2182 (gen-labels1097 ids2180)) (new-vars2183 (map gen-var1139 ids2180))) (build-annotated1068 #f (list (build-annotated1068 #f (quote apply)) (build-annotated1068 #f (list (quote lambda) new-vars2183 (chi1127 exp2176 (extend-env1085 labels2182 (map (lambda (var2184 level2185) (cons (quote syntax) (cons var2184 level2185))) new-vars2183 (map cdr pvars2175)) r2178) (make-binding-wrap1108 ids2180 labels2182 (quote (()))) mod2179))) y2177)))))) (convert-pattern2138 (lambda (pattern2186 keys2187) (let cvt2188 ((p2189 pattern2186) (n2190 0) (ids2191 (quote ()))) (if (id?1091 p2189) (if (bound-id-member?1118 p2189 keys2187) (values (vector (quote free-id) p2189) ids2191) (values (quote any) (cons (cons p2189 n2190) ids2191))) ((lambda (tmp2192) ((lambda (tmp2193) (if (if tmp2193 (apply (lambda (x2194 dots2195) (ellipsis?1136 dots2195)) tmp2193) #f) (apply (lambda (x2196 dots2197) (call-with-values (lambda () (cvt2188 x2196 (fx+1059 n2190 1) ids2191)) (lambda (p2198 ids2199) (values (if (eq? p2198 (quote any)) (quote each-any) (vector (quote each) p2198)) ids2199)))) tmp2193) ((lambda (tmp2200) (if tmp2200 (apply (lambda (x2201 y2202) (call-with-values (lambda () (cvt2188 y2202 n2190 ids2191)) (lambda (y2203 ids2204) (call-with-values (lambda () (cvt2188 x2201 n2190 ids2204)) (lambda (x2205 ids2206) (values (cons x2205 y2203) ids2206)))))) tmp2200) ((lambda (tmp2207) (if tmp2207 (apply (lambda () (values (quote ()) ids2191)) tmp2207) ((lambda (tmp2208) (if tmp2208 (apply (lambda (x2209) (call-with-values (lambda () (cvt2188 x2209 n2190 ids2191)) (lambda (p2211 ids2212) (values (vector (quote vector) p2211) ids2212)))) tmp2208) ((lambda (x2213) (values (vector (quote atom) (strip1138 p2189 (quote (())))) ids2191)) tmp2192))) (syntax-dispatch tmp2192 (quote #(vector each-any)))))) (syntax-dispatch tmp2192 (quote ()))))) (syntax-dispatch tmp2192 (quote (any . any)))))) (syntax-dispatch tmp2192 (quote (any any))))) p2189)))))) (lambda (e2214 r2215 w2216 s2217 mod2218) (let ((e2219 (source-wrap1120 e2214 w2216 s2217 mod2218))) ((lambda (tmp2220) ((lambda (tmp2221) (if tmp2221 (apply (lambda (_2222 val2223 key2224 m2225) (if (andmap (lambda (x2226) (and (id?1091 x2226) (not (ellipsis?1136 x2226)))) key2224) (let ((x2228 (gen-var1139 (quote tmp)))) (build-annotated1068 s2217 (list (build-annotated1068 #f (list (quote lambda) (list x2228) (gen-syntax-case2141 (build-annotated1068 #f x2228) key2224 m2225 r2215 mod2218))) (chi1127 val2223 r2215 (quote (())) mod2218)))) (syntax-error e2219 "invalid literals list in"))) tmp2221) (syntax-error tmp2220))) (syntax-dispatch tmp2220 (quote (any any each-any . each-any))))) e2219))))) (set! sc-expand (let ((m2231 (quote e)) (esew2232 (quote (eval)))) (lambda (x2233) (if (and (pair? x2233) (equal? (car x2233) noexpand1058)) (cadr x2233) (chi-top1126 x2233 (quote ()) (quote ((top))) m2231 esew2232 (module-name (current-module))))))) (set! sc-expand3 (let ((m2234 (quote e)) (esew2235 (quote (eval)))) (lambda (x2237 . rest2236) (if (and (pair? x2237) (equal? (car x2237) noexpand1058)) (cadr x2237) (chi-top1126 x2237 (quote ()) (quote ((top))) (if (null? rest2236) m2234 (car rest2236)) (if (or (null? rest2236) (null? (cdr rest2236))) esew2235 (cadr rest2236)) (module-name (current-module))))))) (set! identifier? (lambda (x2238) (nonsymbol-id?1090 x2238))) (set! datum->syntax-object (lambda (id2239 datum2240) (make-syntax-object1074 datum2240 (syntax-object-wrap1077 id2239) #f))) (set! syntax-object->datum (lambda (x2241) (strip1138 x2241 (quote (()))))) (set! generate-temporaries (lambda (ls2242) (begin (let ((x2243 ls2242)) (if (not (list? x2243)) (error-hook1065 (quote generate-temporaries) "invalid argument" x2243))) (map (lambda (x2244) (wrap1119 (gensym) (quote ((top))) #f)) ls2242)))) (set! free-identifier=? (lambda (x2245 y2246) (begin (let ((x2247 x2245)) (if (not (nonsymbol-id?1090 x2247)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2247))) (let ((x2248 y2246)) (if (not (nonsymbol-id?1090 x2248)) (error-hook1065 (quote free-identifier=?) "invalid argument" x2248))) (free-id=?1114 x2245 y2246)))) (set! bound-identifier=? (lambda (x2249 y2250) (begin (let ((x2251 x2249)) (if (not (nonsymbol-id?1090 x2251)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2251))) (let ((x2252 y2250)) (if (not (nonsymbol-id?1090 x2252)) (error-hook1065 (quote bound-identifier=?) "invalid argument" x2252))) (bound-id=?1115 x2249 y2250)))) (set! syntax-error (lambda (object2254 . messages2253) (begin (for-each (lambda (x2255) (let ((x2256 x2255)) (if (not (string? x2256)) (error-hook1065 (quote syntax-error) "invalid argument" x2256)))) messages2253) (let ((message2257 (if (null? messages2253) "invalid syntax" (apply string-append messages2253)))) (error-hook1065 #f message2257 (strip1138 object2254 (quote (())))))))) (set! install-global-transformer (lambda (sym2258 v2259) (begin (let ((x2260 sym2258)) (if (not (symbol? x2260)) (error-hook1065 (quote define-syntax) "invalid argument" x2260))) (let ((x2261 v2259)) (if (not (procedure? x2261)) (error-hook1065 (quote define-syntax) "invalid argument" x2261))) (global-extend1089 (quote macro) sym2258 v2259)))) (letrec ((match2266 (lambda (e2267 p2268 w2269 r2270 mod2271) (cond ((not r2270) #f) ((eq? p2268 (quote any)) (cons (wrap1119 e2267 w2269 mod2271) r2270)) ((syntax-object?1075 e2267) (match*2265 (let ((e2272 (syntax-object-expression1076 e2267))) (if (annotation? e2272) (annotation-expression e2272) e2272)) p2268 (join-wraps1110 w2269 (syntax-object-wrap1077 e2267)) r2270 (syntax-object-module1078 e2267))) (else (match*2265 (let ((e2273 e2267)) (if (annotation? e2273) (annotation-expression e2273) e2273)) p2268 w2269 r2270 mod2271))))) (match*2265 (lambda (e2274 p2275 w2276 r2277 mod2278) (cond ((null? p2275) (and (null? e2274) r2277)) ((pair? p2275) (and (pair? e2274) (match2266 (car e2274) (car p2275) w2276 (match2266 (cdr e2274) (cdr p2275) w2276 r2277 mod2278) mod2278))) ((eq? p2275 (quote each-any)) (let ((l2279 (match-each-any2263 e2274 w2276 mod2278))) (and l2279 (cons l2279 r2277)))) (else (let ((t2280 (vector-ref p2275 0))) (if (memv t2280 (quote (each))) (if (null? e2274) (match-empty2264 (vector-ref p2275 1) r2277) (let ((l2281 (match-each2262 e2274 (vector-ref p2275 1) w2276 mod2278))) (and l2281 (let collect2282 ((l2283 l2281)) (if (null? (car l2283)) r2277 (cons (map car l2283) (collect2282 (map cdr l2283)))))))) (if (memv t2280 (quote (free-id))) (and (id?1091 e2274) (free-id=?1114 (wrap1119 e2274 w2276 mod2278) (vector-ref p2275 1)) r2277) (if (memv t2280 (quote (atom))) (and (equal? (vector-ref p2275 1) (strip1138 e2274 w2276)) r2277) (if (memv t2280 (quote (vector))) (and (vector? e2274) (match2266 (vector->list e2274) (vector-ref p2275 1) w2276 r2277 mod2278))))))))))) (match-empty2264 (lambda (p2284 r2285) (cond ((null? p2284) r2285) ((eq? p2284 (quote any)) (cons (quote ()) r2285)) ((pair? p2284) (match-empty2264 (car p2284) (match-empty2264 (cdr p2284) r2285))) ((eq? p2284 (quote each-any)) (cons (quote ()) r2285)) (else (let ((t2286 (vector-ref p2284 0))) (if (memv t2286 (quote (each))) (match-empty2264 (vector-ref p2284 1) r2285) (if (memv t2286 (quote (free-id atom))) r2285 (if (memv t2286 (quote (vector))) (match-empty2264 (vector-ref p2284 1) r2285))))))))) (match-each-any2263 (lambda (e2287 w2288 mod2289) (cond ((annotation? e2287) (match-each-any2263 (annotation-expression e2287) w2288 mod2289)) ((pair? e2287) (let ((l2290 (match-each-any2263 (cdr e2287) w2288 mod2289))) (and l2290 (cons (wrap1119 (car e2287) w2288 mod2289) l2290)))) ((null? e2287) (quote ())) ((syntax-object?1075 e2287) (match-each-any2263 (syntax-object-expression1076 e2287) (join-wraps1110 w2288 (syntax-object-wrap1077 e2287)) mod2289)) (else #f)))) (match-each2262 (lambda (e2291 p2292 w2293 mod2294) (cond ((annotation? e2291) (match-each2262 (annotation-expression e2291) p2292 w2293 mod2294)) ((pair? e2291) (let ((first2295 (match2266 (car e2291) p2292 w2293 (quote ()) mod2294))) (and first2295 (let ((rest2296 (match-each2262 (cdr e2291) p2292 w2293 mod2294))) (and rest2296 (cons first2295 rest2296)))))) ((null? e2291) (quote ())) ((syntax-object?1075 e2291) (match-each2262 (syntax-object-expression1076 e2291) p2292 (join-wraps1110 w2293 (syntax-object-wrap1077 e2291)) (syntax-object-module1078 e2291))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2297 p2298) (cond ((eq? p2298 (quote any)) (list e2297)) ((syntax-object?1075 e2297) (match*2265 (let ((e2299 (syntax-object-expression1076 e2297))) (if (annotation? e2299) (annotation-expression e2299) e2299)) p2298 (syntax-object-wrap1077 e2297) (quote ()) (syntax-object-module1078 e2297))) (else (match*2265 (let ((e2300 e2297)) (if (annotation? e2300) (annotation-expression e2300) e2300)) p2298 (quote (())) (quote ()) #f))))) (set! sc-chi chi1127)))))
+(install-global-transformer (quote with-syntax) (lambda (x2301) ((lambda (tmp2302) ((lambda (tmp2303) (if tmp2303 (apply (lambda (_2304 e12305 e22306) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e12305 e22306))) tmp2303) ((lambda (tmp2308) (if tmp2308 (apply (lambda (_2309 out2310 in2311 e12312 e22313) (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"))) (guile))) in2311 (quote ()) (list out2310 (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"))) (guile))) (cons e12312 e22313))))) tmp2308) ((lambda (tmp2315) (if tmp2315 (apply (lambda (_2316 out2317 in2318 e12319 e22320) (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"))) (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"))) (guile))) in2318) (quote ()) (list out2317 (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"))) (guile))) (cons e12319 e22320))))) tmp2315) (syntax-error tmp2302))) (syntax-dispatch tmp2302 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2302 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2302 (quote (any () any . each-any))))) x2301)))
+(install-global-transformer (quote syntax-rules) (lambda (x2324) ((lambda (tmp2325) ((lambda (tmp2326) (if tmp2326 (apply (lambda (_2327 k2328 keyword2329 pattern2330 template2331) (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"))) (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"))) (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"))) (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"))) (guile))) (cons k2328 (map (lambda (tmp2334 tmp2333) (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"))) (guile))) tmp2333) (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"))) (guile))) tmp2334))) template2331 pattern2330)))))) tmp2326) (syntax-error tmp2325))) (syntax-dispatch tmp2325 (quote (any each-any . #(each ((any . any) any))))))) x2324)))
+(install-global-transformer (quote let*) (lambda (x2335) ((lambda (tmp2336) ((lambda (tmp2337) (if (if tmp2337 (apply (lambda (let*2338 x2339 v2340 e12341 e22342) (andmap identifier? x2339)) tmp2337) #f) (apply (lambda (let*2344 x2345 v2346 e12347 e22348) (let f2349 ((bindings2350 (map list x2345 v2346))) (if (null? bindings2350) (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"))) (guile))) (cons (quote ()) (cons e12347 e22348))) ((lambda (tmp2354) ((lambda (tmp2355) (if tmp2355 (apply (lambda (body2356 binding2357) (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"))) (guile))) (list binding2357) body2356)) tmp2355) (syntax-error tmp2354))) (syntax-dispatch tmp2354 (quote (any any))))) (list (f2349 (cdr bindings2350)) (car bindings2350)))))) tmp2337) (syntax-error tmp2336))) (syntax-dispatch tmp2336 (quote (any #(each (any any)) any . each-any))))) x2335)))
+(install-global-transformer (quote do) (lambda (orig-x2358) ((lambda (tmp2359) ((lambda (tmp2360) (if tmp2360 (apply (lambda (_2361 var2362 init2363 step2364 e02365 e12366 c2367) ((lambda (tmp2368) ((lambda (tmp2369) (if tmp2369 (apply (lambda (step2370) ((lambda (tmp2371) ((lambda (tmp2372) (if tmp2372 (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"))) (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"))) (guile))) (map list var2362 init2363) (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"))) (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"))) (guile))) e02365) (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"))) (guile))) (append c2367 (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"))) (guile))) step2370))))))) tmp2372) ((lambda (tmp2377) (if tmp2377 (apply (lambda (e12378 e22379) (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"))) (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"))) (guile))) (map list var2362 init2363) (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"))) (guile))) e02365 (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"))) (guile))) (cons e12378 e22379)) (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"))) (guile))) (append c2367 (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"))) (guile))) step2370))))))) tmp2377) (syntax-error tmp2371))) (syntax-dispatch tmp2371 (quote (any . each-any)))))) (syntax-dispatch tmp2371 (quote ())))) e12366)) tmp2369) (syntax-error tmp2368))) (syntax-dispatch tmp2368 (quote each-any)))) (map (lambda (v2386 s2387) ((lambda (tmp2388) ((lambda (tmp2389) (if tmp2389 (apply (lambda () v2386) tmp2389) ((lambda (tmp2390) (if tmp2390 (apply (lambda (e2391) e2391) tmp2390) ((lambda (_2392) (syntax-error orig-x2358)) tmp2388))) (syntax-dispatch tmp2388 (quote (any)))))) (syntax-dispatch tmp2388 (quote ())))) s2387)) var2362 step2364))) tmp2360) (syntax-error tmp2359))) (syntax-dispatch tmp2359 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2358)))
+(install-global-transformer (quote quasiquote) (letrec ((quasicons2395 (lambda (x2399 y2400) ((lambda (tmp2401) ((lambda (tmp2402) (if tmp2402 (apply (lambda (x2403 y2404) ((lambda (tmp2405) ((lambda (tmp2406) (if tmp2406 (apply (lambda (dy2407) ((lambda (tmp2408) ((lambda (tmp2409) (if tmp2409 (apply (lambda (dx2410) (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"))) (guile))) (cons dx2410 dy2407))) tmp2409) ((lambda (_2411) (if (null? dy2407) (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"))) (guile))) x2403) (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"))) (guile))) x2403 y2404))) tmp2408))) (syntax-dispatch tmp2408 (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"))) (guile))) any))))) x2403)) tmp2406) ((lambda (tmp2412) (if tmp2412 (apply (lambda (stuff2413) (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"))) (guile))) (cons x2403 stuff2413))) tmp2412) ((lambda (else2414) (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"))) (guile))) x2403 y2404)) tmp2405))) (syntax-dispatch tmp2405 (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"))) (guile))) . any)))))) (syntax-dispatch tmp2405 (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"))) (guile))) any))))) y2404)) tmp2402) (syntax-error tmp2401))) (syntax-dispatch tmp2401 (quote (any any))))) (list x2399 y2400)))) (quasiappend2396 (lambda (x2415 y2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (x2419 y2420) ((lambda (tmp2421) ((lambda (tmp2422) (if tmp2422 (apply (lambda () x2419) tmp2422) ((lambda (_2423) (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"))) (guile))) x2419 y2420)) tmp2421))) (syntax-dispatch tmp2421 (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"))) (guile))) ()))))) y2420)) tmp2418) (syntax-error tmp2417))) (syntax-dispatch tmp2417 (quote (any any))))) (list x2415 y2416)))) (quasivector2397 (lambda (x2424) ((lambda (tmp2425) ((lambda (x2426) ((lambda (tmp2427) ((lambda (tmp2428) (if tmp2428 (apply (lambda (x2429) (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"))) (guile))) (list->vector x2429))) tmp2428) ((lambda (tmp2431) (if tmp2431 (apply (lambda (x2432) (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"))) (guile))) x2432)) tmp2431) ((lambda (_2434) (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"))) (guile))) x2426)) tmp2427))) (syntax-dispatch tmp2427 (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"))) (guile))) . each-any)))))) (syntax-dispatch tmp2427 (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"))) (guile))) each-any))))) x2426)) tmp2425)) x2424))) (quasi2398 (lambda (p2435 lev2436) ((lambda (tmp2437) ((lambda (tmp2438) (if tmp2438 (apply (lambda (p2439) (if (= lev2436 0) p2439 (quasicons2395 (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"))) (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"))) (guile)))) (quasi2398 (list p2439) (- lev2436 1))))) tmp2438) ((lambda (tmp2440) (if tmp2440 (apply (lambda (p2441 q2442) (if (= lev2436 0) (quasiappend2396 p2441 (quasi2398 q2442 lev2436)) (quasicons2395 (quasicons2395 (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"))) (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"))) (guile)))) (quasi2398 (list p2441) (- lev2436 1))) (quasi2398 q2442 lev2436)))) tmp2440) ((lambda (tmp2443) (if tmp2443 (apply (lambda (p2444) (quasicons2395 (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"))) (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"))) (guile)))) (quasi2398 (list p2444) (+ lev2436 1)))) tmp2443) ((lambda (tmp2445) (if tmp2445 (apply (lambda (p2446 q2447) (quasicons2395 (quasi2398 p2446 lev2436) (quasi2398 q2447 lev2436))) tmp2445) ((lambda (tmp2448) (if tmp2448 (apply (lambda (x2449) (quasivector2397 (quasi2398 x2449 lev2436))) tmp2448) ((lambda (p2451) (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"))) (guile))) p2451)) tmp2437))) (syntax-dispatch tmp2437 (quote #(vector each-any)))))) (syntax-dispatch tmp2437 (quote (any . any)))))) (syntax-dispatch tmp2437 (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"))) (guile))) any)))))) (syntax-dispatch tmp2437 (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"))) (guile))) any) . any)))))) (syntax-dispatch tmp2437 (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"))) (guile))) any))))) p2435)))) (lambda (x2452) ((lambda (tmp2453) ((lambda (tmp2454) (if tmp2454 (apply (lambda (_2455 e2456) (quasi2398 e2456 0)) tmp2454) (syntax-error tmp2453))) (syntax-dispatch tmp2453 (quote (any any))))) x2452))))
+(install-global-transformer (quote include) (lambda (x2457) (letrec ((read-file2458 (lambda (fn2459 k2460) (let ((p2461 (open-input-file fn2459))) (let f2462 ((x2463 (read p2461))) (if (eof-object? x2463) (begin (close-input-port p2461) (quote ())) (cons (datum->syntax-object k2460 x2463) (f2462 (read p2461))))))))) ((lambda (tmp2464) ((lambda (tmp2465) (if tmp2465 (apply (lambda (k2466 filename2467) (let ((fn2468 (syntax-object->datum filename2467))) ((lambda (tmp2469) ((lambda (tmp2470) (if tmp2470 (apply (lambda (exp2471) (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"))) (guile))) exp2471)) tmp2470) (syntax-error tmp2469))) (syntax-dispatch tmp2469 (quote each-any)))) (read-file2458 fn2468 k2466)))) tmp2465) (syntax-error tmp2464))) (syntax-dispatch tmp2464 (quote (any any))))) x2457))))
+(install-global-transformer (quote unquote) (lambda (x2473) ((lambda (tmp2474) ((lambda (tmp2475) (if tmp2475 (apply (lambda (_2476 e2477) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2477))) tmp2475) (syntax-error tmp2474))) (syntax-dispatch tmp2474 (quote (any any))))) x2473)))
+(install-global-transformer (quote unquote-splicing) (lambda (x2478) ((lambda (tmp2479) ((lambda (tmp2480) (if tmp2480 (apply (lambda (_2481 e2482) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2482))) tmp2480) (syntax-error tmp2479))) (syntax-dispatch tmp2479 (quote (any any))))) x2478)))
+(install-global-transformer (quote case) (lambda (x2483) ((lambda (tmp2484) ((lambda (tmp2485) (if tmp2485 (apply (lambda (_2486 e2487 m12488 m22489) ((lambda (tmp2490) ((lambda (body2491) (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"))) (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"))) (guile))) e2487)) body2491)) tmp2490)) (let f2492 ((clause2493 m12488) (clauses2494 m22489)) (if (null? clauses2494) ((lambda (tmp2496) ((lambda (tmp2497) (if tmp2497 (apply (lambda (e12498 e22499) (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"))) (guile))) (cons e12498 e22499))) tmp2497) ((lambda (tmp2501) (if tmp2501 (apply (lambda (k2502 e12503 e22504) (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"))) (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"))) (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"))) (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"))) (guile))) k2502)) (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"))) (guile))) (cons e12503 e22504)))) tmp2501) ((lambda (_2507) (syntax-error x2483)) tmp2496))) (syntax-dispatch tmp2496 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2496 (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"))) (guile))) any . each-any))))) clause2493) ((lambda (tmp2508) ((lambda (rest2509) ((lambda (tmp2510) ((lambda (tmp2511) (if tmp2511 (apply (lambda (k2512 e12513 e22514) (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"))) (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"))) (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"))) (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"))) (guile))) k2512)) (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"))) (guile))) (cons e12513 e22514)) rest2509)) tmp2511) ((lambda (_2517) (syntax-error x2483)) tmp2510))) (syntax-dispatch tmp2510 (quote (each-any any . each-any))))) clause2493)) tmp2508)) (f2492 (car clauses2494) (cdr clauses2494))))))) tmp2485) (syntax-error tmp2484))) (syntax-dispatch tmp2484 (quote (any any any . each-any))))) x2483)))
+(install-global-transformer (quote identifier-syntax) (lambda (x2518) ((lambda (tmp2519) ((lambda (tmp2520) (if tmp2520 (apply (lambda (_2521 e2522) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2522)) (list (cons _2521 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e2522 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))))))))) tmp2520) (syntax-error tmp2519))) (syntax-dispatch tmp2519 (quote (any any))))) x2518)))
(lambda (p) (with-error-to-port p thunk))))
(define the-eof-object (call-with-input-string "" (lambda (p) (read-char p))))
-
-\f
-;;;; Loading
-
-(if (not (defined? '%load-verbosely))
- (define %load-verbosely #f))
-(define (assert-load-verbosity v) (set! %load-verbosely v))
-
-(define (%load-announce file)
- (if %load-verbosely
- (with-output-to-port (current-error-port)
- (lambda ()
- (display ";;; ")
- (display "loading ")
- (display file)
- (newline)
- (force-output)))))
-
-(set! %load-hook %load-announce)
-
-(define (load name . reader)
- (with-fluid* current-reader (and (pair? reader) (car reader))
- (lambda ()
- (start-stack 'load-stack
- (primitive-load name)))))
HCoop / bpt / guile.git / commitdiff