(define-syntax define-macro
(lambda (x)
+ "Define a defmacro."
(syntax-case x ()
- ((_ (macro . args) . body)
- (syntax (define-macro macro (lambda args . body))))
- ((_ macro transformer)
+ ((_ (macro . args) doc body1 body ...)
+ (string? (syntax-object->datum (syntax doc)))
+ (syntax (define-macro macro doc (lambda args body1 body ...))))
+ ((_ (macro . args) body ...)
+ (syntax (define-macro macro #f (lambda args body ...))))
+ ((_ macro doc transformer)
+ (or (string? (syntax-object->datum (syntax doc)))
+ (not (syntax-object->datum (syntax doc))))
(syntax
(define-syntax macro
(lambda (y)
+ doc
(syntax-case y ()
((_ . args)
(let ((v (syntax-object->datum (syntax args))))
(define-syntax defmacro
(lambda (x)
+ "Define a defmacro, with the old lispy defun syntax."
(syntax-case x ()
- ((_ macro args . body)
- (syntax (define-macro macro (lambda args . body)))))))
+ ((_ macro args doc body1 body ...)
+ (string? (syntax-object->datum (syntax doc)))
+ (syntax (define-macro macro doc (lambda args body1 body ...))))
+ ((_ macro args body ...)
+ (syntax (define-macro macro #f (lambda args body ...)))))))
(provide 'defmacro)
-(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
-(void)
-(letrec ((lambda-var-list175 (lambda (vars380) (let lvl381 ((vars382 vars380) (ls383 (quote ())) (w384 (quote (())))) (cond ((pair? vars382) (lvl381 (cdr vars382) (cons (wrap154 (car vars382) w384 #f) ls383) w384)) ((id?126 vars382) (cons (wrap154 vars382 w384 #f) ls383)) ((null? vars382) ls383) ((syntax-object?110 vars382) (lvl381 (syntax-object-expression111 vars382) ls383 (join-wraps145 w384 (syntax-object-wrap112 vars382)))) ((annotation? vars382) (lvl381 (annotation-expression vars382) ls383 w384)) (else (cons vars382 ls383)))))) (gen-var174 (lambda (id385) (let ((id386 (if (syntax-object?110 id385) (syntax-object-expression111 id385) id385))) (if (annotation? id386) (build-annotated103 (annotation-source id386) (gensym (symbol->string (annotation-expression id386)))) (build-annotated103 #f (gensym (symbol->string id386))))))) (strip173 (lambda (x387 w388) (if (memq (quote top) (wrap-marks129 w388)) (if (or (annotation? x387) (and (pair? x387) (annotation? (car x387)))) (strip-annotation172 x387 #f) x387) (let f389 ((x390 x387)) (cond ((syntax-object?110 x390) (strip173 (syntax-object-expression111 x390) (syntax-object-wrap112 x390))) ((pair? x390) (let ((a391 (f389 (car x390))) (d392 (f389 (cdr x390)))) (if (and (eq? a391 (car x390)) (eq? d392 (cdr x390))) x390 (cons a391 d392)))) ((vector? x390) (let ((old393 (vector->list x390))) (let ((new394 (map f389 old393))) (if (andmap eq? old393 new394) x390 (list->vector new394))))) (else x390)))))) (strip-annotation172 (lambda (x395 parent396) (cond ((pair? x395) (let ((new397 (cons #f #f))) (begin (if parent396 (set-annotation-stripped! parent396 new397)) (set-car! new397 (strip-annotation172 (car x395) #f)) (set-cdr! new397 (strip-annotation172 (cdr x395) #f)) new397))) ((annotation? x395) (or (annotation-stripped x395) (strip-annotation172 (annotation-expression x395) x395))) ((vector? x395) (let ((new398 (make-vector (vector-length x395)))) (begin (if parent396 (set-annotation-stripped! parent396 new398)) (let loop399 ((i400 (- (vector-length x395) 1))) (unless (fx<96 i400 0) (vector-set! new398 i400 (strip-annotation172 (vector-ref x395 i400) #f)) (loop399 (fx-94 i400 1)))) new398))) (else x395)))) (ellipsis?171 (lambda (x401) (and (nonsymbol-id?125 x401) (free-id=?149 x401 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void170 (lambda () (build-annotated103 #f (list (build-annotated103 #f (quote void)))))) (eval-local-transformer169 (lambda (expanded402 mod403) (let ((p404 (local-eval-hook98 expanded402 mod403))) (if (procedure? p404) p404 (syntax-error p404 "nonprocedure transformer"))))) (chi-local-syntax168 (lambda (rec?405 e406 r407 w408 s409 mod410 k411) ((lambda (tmp412) ((lambda (tmp413) (if tmp413 (apply (lambda (_414 id415 val416 e1417 e2418) (let ((ids419 id415)) (if (not (valid-bound-ids?151 ids419)) (syntax-error e406 "duplicate bound keyword in") (let ((labels421 (gen-labels132 ids419))) (let ((new-w422 (make-binding-wrap143 ids419 labels421 w408))) (k411 (cons e1417 e2418) (extend-env120 labels421 (let ((w424 (if rec?405 new-w422 w408)) (trans-r425 (macros-only-env122 r407))) (map (lambda (x426) (cons (quote macro) (eval-local-transformer169 (chi162 x426 trans-r425 w424 mod410) mod410))) val416)) r407) new-w422 s409 mod410)))))) tmp413) ((lambda (_428) (syntax-error (source-wrap155 e406 w408 s409 mod410))) tmp412))) (syntax-dispatch tmp412 (quote (any #(each (any any)) any . each-any))))) e406))) (chi-lambda-clause167 (lambda (e429 docstring430 c431 r432 w433 mod434 k435) ((lambda (tmp436) ((lambda (tmp437) (if (if tmp437 (apply (lambda (args438 doc439 e1440 e2441) (and (string? (syntax-object->datum doc439)) (not docstring430))) tmp437) #f) (apply (lambda (args442 doc443 e1444 e2445) (chi-lambda-clause167 e429 doc443 (cons args442 (cons e1444 e2445)) r432 w433 mod434 k435)) tmp437) ((lambda (tmp447) (if tmp447 (apply (lambda (id448 e1449 e2450) (let ((ids451 id448)) (if (not (valid-bound-ids?151 ids451)) (syntax-error e429 "invalid parameter list in") (let ((labels453 (gen-labels132 ids451)) (new-vars454 (map gen-var174 ids451))) (k435 new-vars454 docstring430 (chi-body166 (cons e1449 e2450) e429 (extend-var-env121 labels453 new-vars454 r432) (make-binding-wrap143 ids451 labels453 w433) mod434)))))) tmp447) ((lambda (tmp456) (if tmp456 (apply (lambda (ids457 e1458 e2459) (let ((old-ids460 (lambda-var-list175 ids457))) (if (not (valid-bound-ids?151 old-ids460)) (syntax-error e429 "invalid parameter list in") (let ((labels461 (gen-labels132 old-ids460)) (new-vars462 (map gen-var174 old-ids460))) (k435 (let f463 ((ls1464 (cdr new-vars462)) (ls2465 (car new-vars462))) (if (null? ls1464) ls2465 (f463 (cdr ls1464) (cons (car ls1464) ls2465)))) docstring430 (chi-body166 (cons e1458 e2459) e429 (extend-var-env121 labels461 new-vars462 r432) (make-binding-wrap143 old-ids460 labels461 w433) mod434)))))) tmp456) ((lambda (_467) (syntax-error e429)) tmp436))) (syntax-dispatch tmp436 (quote (any any . each-any)))))) (syntax-dispatch tmp436 (quote (each-any any . each-any)))))) (syntax-dispatch tmp436 (quote (any any any . each-any))))) c431))) (chi-body166 (lambda (body468 outer-form469 r470 w471 mod472) (let ((r473 (cons (quote ("placeholder" placeholder)) r470))) (let ((ribcage474 (make-ribcage133 (quote ()) (quote ()) (quote ())))) (let ((w475 (make-wrap128 (wrap-marks129 w471) (cons ribcage474 (wrap-subst130 w471))))) (let parse476 ((body477 (map (lambda (x483) (cons r473 (wrap154 x483 w475 mod472))) body468)) (ids478 (quote ())) (labels479 (quote ())) (vars480 (quote ())) (vals481 (quote ())) (bindings482 (quote ()))) (if (null? body477) (syntax-error outer-form469 "no expressions in body") (let ((e484 (cdar body477)) (er485 (caar body477))) (call-with-values (lambda () (syntax-type160 e484 er485 (quote (())) #f ribcage474 mod472)) (lambda (type486 value487 e488 w489 s490 mod491) (let ((t492 type486)) (if (memv t492 (quote (define-form))) (let ((id493 (wrap154 value487 w489 mod491)) (label494 (gen-label131))) (let ((var495 (gen-var174 id493))) (begin (extend-ribcage!142 ribcage474 id493 label494) (parse476 (cdr body477) (cons id493 ids478) (cons label494 labels479) (cons var495 vars480) (cons (cons er485 (wrap154 e488 w489 mod491)) vals481) (cons (cons (quote lexical) var495) bindings482))))) (if (memv t492 (quote (define-syntax-form))) (let ((id496 (wrap154 value487 w489 mod491)) (label497 (gen-label131))) (begin (extend-ribcage!142 ribcage474 id496 label497) (parse476 (cdr body477) (cons id496 ids478) (cons label497 labels479) vars480 vals481 (cons (cons (quote macro) (cons er485 (wrap154 e488 w489 mod491))) bindings482)))) (if (memv t492 (quote (begin-form))) ((lambda (tmp498) ((lambda (tmp499) (if tmp499 (apply (lambda (_500 e1501) (parse476 (let f502 ((forms503 e1501)) (if (null? forms503) (cdr body477) (cons (cons er485 (wrap154 (car forms503) w489 mod491)) (f502 (cdr forms503))))) ids478 labels479 vars480 vals481 bindings482)) tmp499) (syntax-error tmp498))) (syntax-dispatch tmp498 (quote (any . each-any))))) e488) (if (memv t492 (quote (local-syntax-form))) (chi-local-syntax168 value487 e488 er485 w489 s490 mod491 (lambda (forms505 er506 w507 s508 mod509) (parse476 (let f510 ((forms511 forms505)) (if (null? forms511) (cdr body477) (cons (cons er506 (wrap154 (car forms511) w507 mod509)) (f510 (cdr forms511))))) ids478 labels479 vars480 vals481 bindings482))) (if (null? ids478) (build-sequence105 #f (map (lambda (x512) (chi162 (cdr x512) (car x512) (quote (())) mod491)) (cons (cons er485 (source-wrap155 e488 w489 s490 mod491)) (cdr body477)))) (begin (if (not (valid-bound-ids?151 ids478)) (syntax-error outer-form469 "invalid or duplicate identifier in definition")) (let loop513 ((bs514 bindings482) (er-cache515 #f) (r-cache516 #f)) (if (not (null? bs514)) (let ((b517 (car bs514))) (if (eq? (car b517) (quote macro)) (let ((er518 (cadr b517))) (let ((r-cache519 (if (eq? er518 er-cache515) r-cache516 (macros-only-env122 er518)))) (begin (set-cdr! b517 (eval-local-transformer169 (chi162 (cddr b517) r-cache519 (quote (())) mod491) mod491)) (loop513 (cdr bs514) er518 r-cache519)))) (loop513 (cdr bs514) er-cache515 r-cache516))))) (set-cdr! r473 (extend-env120 labels479 bindings482 (cdr r473))) (build-letrec108 #f vars480 (map (lambda (x520) (chi162 (cdr x520) (car x520) (quote (())) mod491)) vals481) (build-sequence105 #f (map (lambda (x521) (chi162 (cdr x521) (car x521) (quote (())) mod491)) (cons (cons er485 (source-wrap155 e488 w489 s490 mod491)) (cdr body477)))))))))))))))))))))) (chi-macro165 (lambda (p522 e523 r524 w525 rib526 mod527) (letrec ((rebuild-macro-output528 (lambda (x529 m530) (cond ((pair? x529) (cons (rebuild-macro-output528 (car x529) m530) (rebuild-macro-output528 (cdr x529) m530))) ((syntax-object?110 x529) (let ((w531 (syntax-object-wrap112 x529))) (let ((ms532 (wrap-marks129 w531)) (s533 (wrap-subst130 w531))) (if (and (pair? ms532) (eq? (car ms532) #f)) (make-syntax-object109 (syntax-object-expression111 x529) (make-wrap128 (cdr ms532) (if rib526 (cons rib526 (cdr s533)) (cdr s533))) (syntax-object-module113 x529)) (make-syntax-object109 (syntax-object-expression111 x529) (make-wrap128 (cons m530 ms532) (if rib526 (cons rib526 (cons (quote shift) s533)) (cons (quote shift) s533))) (let ((pmod534 (procedure-module p522))) (if pmod534 (cons (quote hygiene) (module-name pmod534)) (quote (hygiene guile))))))))) ((vector? x529) (let ((n535 (vector-length x529))) (let ((v536 (make-vector n535))) (let doloop537 ((i538 0)) (if (fx=95 i538 n535) v536 (begin (vector-set! v536 i538 (rebuild-macro-output528 (vector-ref x529 i538) m530)) (doloop537 (fx+93 i538 1)))))))) ((symbol? x529) (syntax-error x529 "encountered raw symbol in macro output")) (else x529))))) (rebuild-macro-output528 (p522 (wrap154 e523 (anti-mark141 w525) mod527)) (string #\m))))) (chi-application164 (lambda (x539 e540 r541 w542 s543 mod544) ((lambda (tmp545) ((lambda (tmp546) (if tmp546 (apply (lambda (e0547 e1548) (build-annotated103 s543 (cons x539 (map (lambda (e549) (chi162 e549 r541 w542 mod544)) e1548)))) tmp546) (syntax-error tmp545))) (syntax-dispatch tmp545 (quote (any . each-any))))) e540))) (chi-expr163 (lambda (type551 value552 e553 r554 w555 s556 mod557) (let ((t558 type551)) (if (memv t558 (quote (lexical))) (build-annotated103 s556 value552) (if (memv t558 (quote (core external-macro))) (value552 e553 r554 w555 s556 mod557) (if (memv t558 (quote (module-ref))) (call-with-values (lambda () (value552 e553)) (lambda (id559 mod560) (build-annotated103 s556 (if mod560 (make-module-ref (cdr mod560) id559 (car mod560)) (make-module-ref mod560 id559 (quote bare)))))) (if (memv t558 (quote (lexical-call))) (chi-application164 (build-annotated103 (source-annotation117 (car e553)) value552) e553 r554 w555 s556 mod557) (if (memv t558 (quote (global-call))) (chi-application164 (build-annotated103 (source-annotation117 (car e553)) (if (if (syntax-object?110 (car e553)) (syntax-object-module113 (car e553)) mod557) (make-module-ref (cdr (if (syntax-object?110 (car e553)) (syntax-object-module113 (car e553)) mod557)) value552 (car (if (syntax-object?110 (car e553)) (syntax-object-module113 (car e553)) mod557))) (make-module-ref (if (syntax-object?110 (car e553)) (syntax-object-module113 (car e553)) mod557) value552 (quote bare)))) e553 r554 w555 s556 mod557) (if (memv t558 (quote (constant))) (build-data104 s556 (strip173 (source-wrap155 e553 w555 s556 mod557) (quote (())))) (if (memv t558 (quote (global))) (build-annotated103 s556 (if mod557 (make-module-ref (cdr mod557) value552 (car mod557)) (make-module-ref mod557 value552 (quote bare)))) (if (memv t558 (quote (call))) (chi-application164 (chi162 (car e553) r554 w555 mod557) e553 r554 w555 s556 mod557) (if (memv t558 (quote (begin-form))) ((lambda (tmp561) ((lambda (tmp562) (if tmp562 (apply (lambda (_563 e1564 e2565) (chi-sequence156 (cons e1564 e2565) r554 w555 s556 mod557)) tmp562) (syntax-error tmp561))) (syntax-dispatch tmp561 (quote (any any . each-any))))) e553) (if (memv t558 (quote (local-syntax-form))) (chi-local-syntax168 value552 e553 r554 w555 s556 mod557 chi-sequence156) (if (memv t558 (quote (eval-when-form))) ((lambda (tmp567) ((lambda (tmp568) (if tmp568 (apply (lambda (_569 x570 e1571 e2572) (let ((when-list573 (chi-when-list159 e553 x570 w555))) (if (memq (quote eval) when-list573) (chi-sequence156 (cons e1571 e2572) r554 w555 s556 mod557) (chi-void170)))) tmp568) (syntax-error tmp567))) (syntax-dispatch tmp567 (quote (any each-any any . each-any))))) e553) (if (memv t558 (quote (define-form define-syntax-form))) (syntax-error (wrap154 value552 w555 mod557) "invalid context for definition of") (if (memv t558 (quote (syntax))) (syntax-error (source-wrap155 e553 w555 s556 mod557) "reference to pattern variable outside syntax form") (if (memv t558 (quote (displaced-lexical))) (syntax-error (source-wrap155 e553 w555 s556 mod557) "reference to identifier outside its scope") (syntax-error (source-wrap155 e553 w555 s556 mod557))))))))))))))))))) (chi162 (lambda (e576 r577 w578 mod579) (call-with-values (lambda () (syntax-type160 e576 r577 w578 #f #f mod579)) (lambda (type580 value581 e582 w583 s584 mod585) (chi-expr163 type580 value581 e582 r577 w583 s584 mod585))))) (chi-top161 (lambda (e586 r587 w588 m589 esew590 mod591) (call-with-values (lambda () (syntax-type160 e586 r587 w588 #f #f mod591)) (lambda (type599 value600 e601 w602 s603 mod604) (let ((t605 type599)) (if (memv t605 (quote (begin-form))) ((lambda (tmp606) ((lambda (tmp607) (if tmp607 (apply (lambda (_608) (chi-void170)) tmp607) ((lambda (tmp609) (if tmp609 (apply (lambda (_610 e1611 e2612) (chi-top-sequence157 (cons e1611 e2612) r587 w602 s603 m589 esew590 mod604)) tmp609) (syntax-error tmp606))) (syntax-dispatch tmp606 (quote (any any . each-any)))))) (syntax-dispatch tmp606 (quote (any))))) e601) (if (memv t605 (quote (local-syntax-form))) (chi-local-syntax168 value600 e601 r587 w602 s603 mod604 (lambda (body614 r615 w616 s617 mod618) (chi-top-sequence157 body614 r615 w616 s617 m589 esew590 mod618))) (if (memv t605 (quote (eval-when-form))) ((lambda (tmp619) ((lambda (tmp620) (if tmp620 (apply (lambda (_621 x622 e1623 e2624) (let ((when-list625 (chi-when-list159 e601 x622 w602)) (body626 (cons e1623 e2624))) (cond ((eq? m589 (quote e)) (if (memq (quote eval) when-list625) (chi-top-sequence157 body626 r587 w602 s603 (quote e) (quote (eval)) mod604) (chi-void170))) ((memq (quote load) when-list625) (if (or (memq (quote compile) when-list625) (and (eq? m589 (quote c&e)) (memq (quote eval) when-list625))) (chi-top-sequence157 body626 r587 w602 s603 (quote c&e) (quote (compile load)) mod604) (if (memq m589 (quote (c c&e))) (chi-top-sequence157 body626 r587 w602 s603 (quote c) (quote (load)) mod604) (chi-void170)))) ((or (memq (quote compile) when-list625) (and (eq? m589 (quote c&e)) (memq (quote eval) when-list625))) (top-level-eval-hook97 (chi-top-sequence157 body626 r587 w602 s603 (quote e) (quote (eval)) mod604) mod604) (chi-void170)) (else (chi-void170))))) tmp620) (syntax-error tmp619))) (syntax-dispatch tmp619 (quote (any each-any any . each-any))))) e601) (if (memv t605 (quote (define-syntax-form))) (let ((n629 (id-var-name148 value600 w602)) (r630 (macros-only-env122 r587))) (let ((t631 m589)) (if (memv t631 (quote (c))) (if (memq (quote compile) esew590) (let ((e632 (chi-install-global158 n629 (chi162 e601 r630 w602 mod604)))) (begin (top-level-eval-hook97 e632 mod604) (if (memq (quote load) esew590) e632 (chi-void170)))) (if (memq (quote load) esew590) (chi-install-global158 n629 (chi162 e601 r630 w602 mod604)) (chi-void170))) (if (memv t631 (quote (c&e))) (let ((e633 (chi-install-global158 n629 (chi162 e601 r630 w602 mod604)))) (begin (top-level-eval-hook97 e633 mod604) e633)) (begin (if (memq (quote eval) esew590) (top-level-eval-hook97 (chi-install-global158 n629 (chi162 e601 r630 w602 mod604)) mod604)) (chi-void170)))))) (if (memv t605 (quote (define-form))) (let ((n634 (id-var-name148 value600 w602))) (let ((type635 (binding-type118 (lookup123 n634 r587 mod604)))) (let ((t636 type635)) (if (memv t636 (quote (global))) (let ((x637 (build-annotated103 s603 (list (quote define) n634 (chi162 e601 r587 w602 mod604))))) (begin (if (eq? m589 (quote c&e)) (top-level-eval-hook97 x637 mod604)) x637)) (if (memv t636 (quote (displaced-lexical))) (syntax-error (wrap154 value600 w602 mod604) "identifier out of context") (if (memv t636 (quote (core macro module-ref))) (begin (remove-global-definition-hook101 n634) (let ((x638 (build-annotated103 s603 (list (quote define) n634 (chi162 e601 r587 w602 mod604))))) (begin (if (eq? m589 (quote c&e)) (top-level-eval-hook97 x638 mod604)) x638))) (syntax-error (wrap154 value600 w602 mod604) "cannot define keyword at top level"))))))) (let ((x639 (chi-expr163 type599 value600 e601 r587 w602 s603 mod604))) (begin (if (eq? m589 (quote c&e)) (top-level-eval-hook97 x639 mod604)) x639)))))))))))) (syntax-type160 (lambda (e640 r641 w642 s643 rib644 mod645) (cond ((symbol? e640) (let ((n646 (id-var-name148 e640 w642))) (let ((b647 (lookup123 n646 r641 mod645))) (let ((type648 (binding-type118 b647))) (let ((t649 type648)) (if (memv t649 (quote (lexical))) (values type648 (binding-value119 b647) e640 w642 s643 mod645) (if (memv t649 (quote (global))) (values type648 n646 e640 w642 s643 mod645) (if (memv t649 (quote (macro))) (syntax-type160 (chi-macro165 (binding-value119 b647) e640 r641 w642 rib644 mod645) r641 (quote (())) s643 rib644 mod645) (values type648 (binding-value119 b647) e640 w642 s643 mod645))))))))) ((pair? e640) (let ((first650 (car e640))) (if (id?126 first650) (let ((n651 (id-var-name148 first650 w642))) (let ((b652 (lookup123 n651 r641 (or (and (syntax-object?110 first650) (syntax-object-module113 first650)) mod645)))) (let ((type653 (binding-type118 b652))) (let ((t654 type653)) (if (memv t654 (quote (lexical))) (values (quote lexical-call) (binding-value119 b652) e640 w642 s643 mod645) (if (memv t654 (quote (global))) (values (quote global-call) n651 e640 w642 s643 mod645) (if (memv t654 (quote (macro))) (syntax-type160 (chi-macro165 (binding-value119 b652) e640 r641 w642 rib644 mod645) r641 (quote (())) s643 rib644 mod645) (if (memv t654 (quote (core external-macro module-ref))) (values type653 (binding-value119 b652) e640 w642 s643 mod645) (if (memv t654 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value119 b652) e640 w642 s643 mod645) (if (memv t654 (quote (begin))) (values (quote begin-form) #f e640 w642 s643 mod645) (if (memv t654 (quote (eval-when))) (values (quote eval-when-form) #f e640 w642 s643 mod645) (if (memv t654 (quote (define))) ((lambda (tmp655) ((lambda (tmp656) (if (if tmp656 (apply (lambda (_657 name658 val659) (id?126 name658)) tmp656) #f) (apply (lambda (_660 name661 val662) (values (quote define-form) name661 val662 w642 s643 mod645)) tmp656) ((lambda (tmp663) (if (if tmp663 (apply (lambda (_664 name665 args666 e1667 e2668) (and (id?126 name665) (valid-bound-ids?151 (lambda-var-list175 args666)))) tmp663) #f) (apply (lambda (_669 name670 args671 e1672 e2673) (values (quote define-form) (wrap154 name670 w642 mod645) (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap154 (cons args671 (cons e1672 e2673)) w642 mod645)) (quote (())) s643 mod645)) tmp663) ((lambda (tmp675) (if (if tmp675 (apply (lambda (_676 name677) (id?126 name677)) tmp675) #f) (apply (lambda (_678 name679) (values (quote define-form) (wrap154 name679 w642 mod645) (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s643 mod645)) tmp675) (syntax-error tmp655))) (syntax-dispatch tmp655 (quote (any any)))))) (syntax-dispatch tmp655 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp655 (quote (any any any))))) e640) (if (memv t654 (quote (define-syntax))) ((lambda (tmp680) ((lambda (tmp681) (if (if tmp681 (apply (lambda (_682 name683 val684) (id?126 name683)) tmp681) #f) (apply (lambda (_685 name686 val687) (values (quote define-syntax-form) name686 val687 w642 s643 mod645)) tmp681) (syntax-error tmp680))) (syntax-dispatch tmp680 (quote (any any any))))) e640) (values (quote call) #f e640 w642 s643 mod645)))))))))))))) (values (quote call) #f e640 w642 s643 mod645)))) ((syntax-object?110 e640) (syntax-type160 (syntax-object-expression111 e640) r641 (join-wraps145 w642 (syntax-object-wrap112 e640)) #f rib644 (or (syntax-object-module113 e640) mod645))) ((annotation? e640) (syntax-type160 (annotation-expression e640) r641 w642 (annotation-source e640) rib644 mod645)) ((self-evaluating? e640) (values (quote constant) #f e640 w642 s643 mod645)) (else (values (quote other) #f e640 w642 s643 mod645))))) (chi-when-list159 (lambda (e688 when-list689 w690) (let f691 ((when-list692 when-list689) (situations693 (quote ()))) (if (null? when-list692) situations693 (f691 (cdr when-list692) (cons (let ((x694 (car when-list692))) (cond ((free-id=?149 x694 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?149 x694 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?149 x694 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-error (wrap154 x694 w690 #f) "invalid eval-when situation")))) situations693)))))) (chi-install-global158 (lambda (name695 e696) (build-annotated103 #f (list (build-annotated103 #f (quote install-global-transformer)) (build-data104 #f name695) e696)))) (chi-top-sequence157 (lambda (body697 r698 w699 s700 m701 esew702 mod703) (build-sequence105 s700 (let dobody704 ((body705 body697) (r706 r698) (w707 w699) (m708 m701) (esew709 esew702) (mod710 mod703)) (if (null? body705) (quote ()) (let ((first711 (chi-top161 (car body705) r706 w707 m708 esew709 mod710))) (cons first711 (dobody704 (cdr body705) r706 w707 m708 esew709 mod710)))))))) (chi-sequence156 (lambda (body712 r713 w714 s715 mod716) (build-sequence105 s715 (let dobody717 ((body718 body712) (r719 r713) (w720 w714) (mod721 mod716)) (if (null? body718) (quote ()) (let ((first722 (chi162 (car body718) r719 w720 mod721))) (cons first722 (dobody717 (cdr body718) r719 w720 mod721)))))))) (source-wrap155 (lambda (x723 w724 s725 defmod726) (wrap154 (if s725 (make-annotation x723 s725 #f) x723) w724 defmod726))) (wrap154 (lambda (x727 w728 defmod729) (cond ((and (null? (wrap-marks129 w728)) (null? (wrap-subst130 w728))) x727) ((syntax-object?110 x727) (make-syntax-object109 (syntax-object-expression111 x727) (join-wraps145 w728 (syntax-object-wrap112 x727)) (syntax-object-module113 x727))) ((null? x727) x727) (else (make-syntax-object109 x727 w728 defmod729))))) (bound-id-member?153 (lambda (x730 list731) (and (not (null? list731)) (or (bound-id=?150 x730 (car list731)) (bound-id-member?153 x730 (cdr list731)))))) (distinct-bound-ids?152 (lambda (ids732) (let distinct?733 ((ids734 ids732)) (or (null? ids734) (and (not (bound-id-member?153 (car ids734) (cdr ids734))) (distinct?733 (cdr ids734))))))) (valid-bound-ids?151 (lambda (ids735) (and (let all-ids?736 ((ids737 ids735)) (or (null? ids737) (and (id?126 (car ids737)) (all-ids?736 (cdr ids737))))) (distinct-bound-ids?152 ids735)))) (bound-id=?150 (lambda (i738 j739) (if (and (syntax-object?110 i738) (syntax-object?110 j739)) (and (eq? (let ((e740 (syntax-object-expression111 i738))) (if (annotation? e740) (annotation-expression e740) e740)) (let ((e741 (syntax-object-expression111 j739))) (if (annotation? e741) (annotation-expression e741) e741))) (same-marks?147 (wrap-marks129 (syntax-object-wrap112 i738)) (wrap-marks129 (syntax-object-wrap112 j739)))) (eq? (let ((e742 i738)) (if (annotation? e742) (annotation-expression e742) e742)) (let ((e743 j739)) (if (annotation? e743) (annotation-expression e743) e743)))))) (free-id=?149 (lambda (i744 j745) (and (eq? (let ((x746 i744)) (let ((e747 (if (syntax-object?110 x746) (syntax-object-expression111 x746) x746))) (if (annotation? e747) (annotation-expression e747) e747))) (let ((x748 j745)) (let ((e749 (if (syntax-object?110 x748) (syntax-object-expression111 x748) x748))) (if (annotation? e749) (annotation-expression e749) e749)))) (eq? (id-var-name148 i744 (quote (()))) (id-var-name148 j745 (quote (()))))))) (id-var-name148 (lambda (id750 w751) (letrec ((search-vector-rib754 (lambda (sym760 subst761 marks762 symnames763 ribcage764) (let ((n765 (vector-length symnames763))) (let f766 ((i767 0)) (cond ((fx=95 i767 n765) (search752 sym760 (cdr subst761) marks762)) ((and (eq? (vector-ref symnames763 i767) sym760) (same-marks?147 marks762 (vector-ref (ribcage-marks136 ribcage764) i767))) (values (vector-ref (ribcage-labels137 ribcage764) i767) marks762)) (else (f766 (fx+93 i767 1)))))))) (search-list-rib753 (lambda (sym768 subst769 marks770 symnames771 ribcage772) (let f773 ((symnames774 symnames771) (i775 0)) (cond ((null? symnames774) (search752 sym768 (cdr subst769) marks770)) ((and (eq? (car symnames774) sym768) (same-marks?147 marks770 (list-ref (ribcage-marks136 ribcage772) i775))) (values (list-ref (ribcage-labels137 ribcage772) i775) marks770)) (else (f773 (cdr symnames774) (fx+93 i775 1))))))) (search752 (lambda (sym776 subst777 marks778) (if (null? subst777) (values #f marks778) (let ((fst779 (car subst777))) (if (eq? fst779 (quote shift)) (search752 sym776 (cdr subst777) (cdr marks778)) (let ((symnames780 (ribcage-symnames135 fst779))) (if (vector? symnames780) (search-vector-rib754 sym776 subst777 marks778 symnames780 fst779) (search-list-rib753 sym776 subst777 marks778 symnames780 fst779))))))))) (cond ((symbol? id750) (or (call-with-values (lambda () (search752 id750 (wrap-subst130 w751) (wrap-marks129 w751))) (lambda (x782 . ignore781) x782)) id750)) ((syntax-object?110 id750) (let ((id783 (let ((e785 (syntax-object-expression111 id750))) (if (annotation? e785) (annotation-expression e785) e785))) (w1784 (syntax-object-wrap112 id750))) (let ((marks786 (join-marks146 (wrap-marks129 w751) (wrap-marks129 w1784)))) (call-with-values (lambda () (search752 id783 (wrap-subst130 w751) marks786)) (lambda (new-id787 marks788) (or new-id787 (call-with-values (lambda () (search752 id783 (wrap-subst130 w1784) marks788)) (lambda (x790 . ignore789) x790)) id783)))))) ((annotation? id750) (let ((id791 (let ((e792 id750)) (if (annotation? e792) (annotation-expression e792) e792)))) (or (call-with-values (lambda () (search752 id791 (wrap-subst130 w751) (wrap-marks129 w751))) (lambda (x794 . ignore793) x794)) id791))) (else (error-hook99 (quote id-var-name) "invalid id" id750)))))) (same-marks?147 (lambda (x795 y796) (or (eq? x795 y796) (and (not (null? x795)) (not (null? y796)) (eq? (car x795) (car y796)) (same-marks?147 (cdr x795) (cdr y796)))))) (join-marks146 (lambda (m1797 m2798) (smart-append144 m1797 m2798))) (join-wraps145 (lambda (w1799 w2800) (let ((m1801 (wrap-marks129 w1799)) (s1802 (wrap-subst130 w1799))) (if (null? m1801) (if (null? s1802) w2800 (make-wrap128 (wrap-marks129 w2800) (smart-append144 s1802 (wrap-subst130 w2800)))) (make-wrap128 (smart-append144 m1801 (wrap-marks129 w2800)) (smart-append144 s1802 (wrap-subst130 w2800))))))) (smart-append144 (lambda (m1803 m2804) (if (null? m2804) m1803 (append m1803 m2804)))) (make-binding-wrap143 (lambda (ids805 labels806 w807) (if (null? ids805) w807 (make-wrap128 (wrap-marks129 w807) (cons (let ((labelvec808 (list->vector labels806))) (let ((n809 (vector-length labelvec808))) (let ((symnamevec810 (make-vector n809)) (marksvec811 (make-vector n809))) (begin (let f812 ((ids813 ids805) (i814 0)) (if (not (null? ids813)) (call-with-values (lambda () (id-sym-name&marks127 (car ids813) w807)) (lambda (symname815 marks816) (begin (vector-set! symnamevec810 i814 symname815) (vector-set! marksvec811 i814 marks816) (f812 (cdr ids813) (fx+93 i814 1))))))) (make-ribcage133 symnamevec810 marksvec811 labelvec808))))) (wrap-subst130 w807)))))) (extend-ribcage!142 (lambda (ribcage817 id818 label819) (begin (set-ribcage-symnames!138 ribcage817 (cons (let ((e820 (syntax-object-expression111 id818))) (if (annotation? e820) (annotation-expression e820) e820)) (ribcage-symnames135 ribcage817))) (set-ribcage-marks!139 ribcage817 (cons (wrap-marks129 (syntax-object-wrap112 id818)) (ribcage-marks136 ribcage817))) (set-ribcage-labels!140 ribcage817 (cons label819 (ribcage-labels137 ribcage817)))))) (anti-mark141 (lambda (w821) (make-wrap128 (cons #f (wrap-marks129 w821)) (cons (quote shift) (wrap-subst130 w821))))) (set-ribcage-labels!140 (lambda (x822 update823) (vector-set! x822 3 update823))) (set-ribcage-marks!139 (lambda (x824 update825) (vector-set! x824 2 update825))) (set-ribcage-symnames!138 (lambda (x826 update827) (vector-set! x826 1 update827))) (ribcage-labels137 (lambda (x828) (vector-ref x828 3))) (ribcage-marks136 (lambda (x829) (vector-ref x829 2))) (ribcage-symnames135 (lambda (x830) (vector-ref x830 1))) (ribcage?134 (lambda (x831) (and (vector? x831) (= (vector-length x831) 4) (eq? (vector-ref x831 0) (quote ribcage))))) (make-ribcage133 (lambda (symnames832 marks833 labels834) (vector (quote ribcage) symnames832 marks833 labels834))) (gen-labels132 (lambda (ls835) (if (null? ls835) (quote ()) (cons (gen-label131) (gen-labels132 (cdr ls835)))))) (gen-label131 (lambda () (string #\i))) (wrap-subst130 cdr) (wrap-marks129 car) (make-wrap128 cons) (id-sym-name&marks127 (lambda (x836 w837) (if (syntax-object?110 x836) (values (let ((e838 (syntax-object-expression111 x836))) (if (annotation? e838) (annotation-expression e838) e838)) (join-marks146 (wrap-marks129 w837) (wrap-marks129 (syntax-object-wrap112 x836)))) (values (let ((e839 x836)) (if (annotation? e839) (annotation-expression e839) e839)) (wrap-marks129 w837))))) (id?126 (lambda (x840) (cond ((symbol? x840) #t) ((syntax-object?110 x840) (symbol? (let ((e841 (syntax-object-expression111 x840))) (if (annotation? e841) (annotation-expression e841) e841)))) ((annotation? x840) (symbol? (annotation-expression x840))) (else #f)))) (nonsymbol-id?125 (lambda (x842) (and (syntax-object?110 x842) (symbol? (let ((e843 (syntax-object-expression111 x842))) (if (annotation? e843) (annotation-expression e843) e843)))))) (global-extend124 (lambda (type844 sym845 val846) (put-global-definition-hook100 sym845 (cons type844 val846)))) (lookup123 (lambda (x847 r848 mod849) (cond ((assq x847 r848) => cdr) ((symbol? x847) (or (get-global-definition-hook102 x847 mod849) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env122 (lambda (r850) (if (null? r850) (quote ()) (let ((a851 (car r850))) (if (eq? (cadr a851) (quote macro)) (cons a851 (macros-only-env122 (cdr r850))) (macros-only-env122 (cdr r850))))))) (extend-var-env121 (lambda (labels852 vars853 r854) (if (null? labels852) r854 (extend-var-env121 (cdr labels852) (cdr vars853) (cons (cons (car labels852) (cons (quote lexical) (car vars853))) r854))))) (extend-env120 (lambda (labels855 bindings856 r857) (if (null? labels855) r857 (extend-env120 (cdr labels855) (cdr bindings856) (cons (cons (car labels855) (car bindings856)) r857))))) (binding-value119 cdr) (binding-type118 car) (source-annotation117 (lambda (x858) (cond ((annotation? x858) (annotation-source x858)) ((syntax-object?110 x858) (source-annotation117 (syntax-object-expression111 x858))) (else #f)))) (set-syntax-object-module!116 (lambda (x859 update860) (vector-set! x859 3 update860))) (set-syntax-object-wrap!115 (lambda (x861 update862) (vector-set! x861 2 update862))) (set-syntax-object-expression!114 (lambda (x863 update864) (vector-set! x863 1 update864))) (syntax-object-module113 (lambda (x865) (vector-ref x865 3))) (syntax-object-wrap112 (lambda (x866) (vector-ref x866 2))) (syntax-object-expression111 (lambda (x867) (vector-ref x867 1))) (syntax-object?110 (lambda (x868) (and (vector? x868) (= (vector-length x868) 4) (eq? (vector-ref x868 0) (quote syntax-object))))) (make-syntax-object109 (lambda (expression869 wrap870 module871) (vector (quote syntax-object) expression869 wrap870 module871))) (build-letrec108 (lambda (src872 vars873 val-exps874 body-exp875) (if (null? vars873) (build-annotated103 src872 body-exp875) (build-annotated103 src872 (list (quote letrec) (map list vars873 val-exps874) body-exp875))))) (build-named-let107 (lambda (src876 vars877 val-exps878 body-exp879) (if (null? vars877) (build-annotated103 src876 body-exp879) (build-annotated103 src876 (list (quote let) (car vars877) (map list (cdr vars877) val-exps878) body-exp879))))) (build-let106 (lambda (src880 vars881 val-exps882 body-exp883) (if (null? vars881) (build-annotated103 src880 body-exp883) (build-annotated103 src880 (list (quote let) (map list vars881 val-exps882) body-exp883))))) (build-sequence105 (lambda (src884 exps885) (if (null? (cdr exps885)) (build-annotated103 src884 (car exps885)) (build-annotated103 src884 (cons (quote begin) exps885))))) (build-data104 (lambda (src886 exp887) (if (and (self-evaluating? exp887) (not (vector? exp887))) (build-annotated103 src886 exp887) (build-annotated103 src886 (list (quote quote) exp887))))) (build-annotated103 (lambda (src888 exp889) (if (and src888 (not (annotation? exp889))) (make-annotation exp889 src888 #t) exp889))) (get-global-definition-hook102 (lambda (symbol890 module891) (let ((module892 (if module891 (resolve-module (cdr module891)) (let ((mod893 (current-module))) (begin (if mod893 (warn "wha" symbol890)) mod893))))) (let ((v894 (module-variable module892 symbol890))) (and v894 (object-property v894 (quote *sc-expander*))))))) (remove-global-definition-hook101 (lambda (symbol895) (let ((module896 (current-module))) (let ((v897 (module-local-variable module896 symbol895))) (if v897 (let ((p898 (assq (quote *sc-expander*) (object-properties v897)))) (set-object-properties! v897 (delq p898 (object-properties v897))))))))) (put-global-definition-hook100 (lambda (symbol899 binding900) (let ((module901 (current-module))) (let ((v902 (or (module-variable module901 symbol899) (let ((v903 (make-variable (gensym)))) (begin (module-add! module901 symbol899 v903) v903))))) (begin (if (not (variable-bound? v902)) (variable-set! v902 (gensym))) (set-object-property! v902 (quote *sc-expander*) binding900)))))) (error-hook99 (lambda (who904 why905 what906) (error who904 "~a ~s" why905 what906))) (local-eval-hook98 (lambda (x907 mod908) (primitive-eval (list noexpand92 x907)))) (top-level-eval-hook97 (lambda (x909 mod910) (primitive-eval (list noexpand92 x909)))) (fx<96 <) (fx=95 =) (fx-94 -) (fx+93 +) (noexpand92 "noexpand")) (begin (global-extend124 (quote local-syntax) (quote letrec-syntax) #t) (global-extend124 (quote local-syntax) (quote let-syntax) #f) (global-extend124 (quote core) (quote fluid-let-syntax) (lambda (e911 r912 w913 s914 mod915) ((lambda (tmp916) ((lambda (tmp917) (if (if tmp917 (apply (lambda (_918 var919 val920 e1921 e2922) (valid-bound-ids?151 var919)) tmp917) #f) (apply (lambda (_924 var925 val926 e1927 e2928) (let ((names929 (map (lambda (x930) (id-var-name148 x930 w913)) var925))) (begin (for-each (lambda (id932 n933) (let ((t934 (binding-type118 (lookup123 n933 r912 mod915)))) (if (memv t934 (quote (displaced-lexical))) (syntax-error (source-wrap155 id932 w913 s914 mod915) "identifier out of context")))) var925 names929) (chi-body166 (cons e1927 e2928) (source-wrap155 e911 w913 s914 mod915) (extend-env120 names929 (let ((trans-r937 (macros-only-env122 r912))) (map (lambda (x938) (cons (quote macro) (eval-local-transformer169 (chi162 x938 trans-r937 w913 mod915) mod915))) val926)) r912) w913 mod915)))) tmp917) ((lambda (_940) (syntax-error (source-wrap155 e911 w913 s914 mod915))) tmp916))) (syntax-dispatch tmp916 (quote (any #(each (any any)) any . each-any))))) e911))) (global-extend124 (quote core) (quote quote) (lambda (e941 r942 w943 s944 mod945) ((lambda (tmp946) ((lambda (tmp947) (if tmp947 (apply (lambda (_948 e949) (build-data104 s944 (strip173 e949 w943))) tmp947) ((lambda (_950) (syntax-error (source-wrap155 e941 w943 s944 mod945))) tmp946))) (syntax-dispatch tmp946 (quote (any any))))) e941))) (global-extend124 (quote core) (quote syntax) (letrec ((regen958 (lambda (x959) (let ((t960 (car x959))) (if (memv t960 (quote (ref))) (build-annotated103 #f (cadr x959)) (if (memv t960 (quote (primitive))) (build-annotated103 #f (cadr x959)) (if (memv t960 (quote (quote))) (build-data104 #f (cadr x959)) (if (memv t960 (quote (lambda))) (build-annotated103 #f (list (quote lambda) (cadr x959) (regen958 (caddr x959)))) (if (memv t960 (quote (map))) (let ((ls961 (map regen958 (cdr x959)))) (build-annotated103 #f (cons (if (fx=95 (length ls961) 2) (build-annotated103 #f (quote map)) (build-annotated103 #f (quote map))) ls961))) (build-annotated103 #f (cons (build-annotated103 #f (car x959)) (map regen958 (cdr x959)))))))))))) (gen-vector957 (lambda (x962) (cond ((eq? (car x962) (quote list)) (cons (quote vector) (cdr x962))) ((eq? (car x962) (quote quote)) (list (quote quote) (list->vector (cadr x962)))) (else (list (quote list->vector) x962))))) (gen-append956 (lambda (x963 y964) (if (equal? y964 (quote (quote ()))) x963 (list (quote append) x963 y964)))) (gen-cons955 (lambda (x965 y966) (let ((t967 (car y966))) (if (memv t967 (quote (quote))) (if (eq? (car x965) (quote quote)) (list (quote quote) (cons (cadr x965) (cadr y966))) (if (eq? (cadr y966) (quote ())) (list (quote list) x965) (list (quote cons) x965 y966))) (if (memv t967 (quote (list))) (cons (quote list) (cons x965 (cdr y966))) (list (quote cons) x965 y966)))))) (gen-map954 (lambda (e968 map-env969) (let ((formals970 (map cdr map-env969)) (actuals971 (map (lambda (x972) (list (quote ref) (car x972))) map-env969))) (cond ((eq? (car e968) (quote ref)) (car actuals971)) ((andmap (lambda (x973) (and (eq? (car x973) (quote ref)) (memq (cadr x973) formals970))) (cdr e968)) (cons (quote map) (cons (list (quote primitive) (car e968)) (map (let ((r974 (map cons formals970 actuals971))) (lambda (x975) (cdr (assq (cadr x975) r974)))) (cdr e968))))) (else (cons (quote map) (cons (list (quote lambda) formals970 e968) actuals971))))))) (gen-mappend953 (lambda (e976 map-env977) (list (quote apply) (quote (primitive append)) (gen-map954 e976 map-env977)))) (gen-ref952 (lambda (src978 var979 level980 maps981) (if (fx=95 level980 0) (values var979 maps981) (if (null? maps981) (syntax-error src978 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref952 src978 var979 (fx-94 level980 1) (cdr maps981))) (lambda (outer-var982 outer-maps983) (let ((b984 (assq outer-var982 (car maps981)))) (if b984 (values (cdr b984) maps981) (let ((inner-var985 (gen-var174 (quote tmp)))) (values inner-var985 (cons (cons (cons outer-var982 inner-var985) (car maps981)) outer-maps983))))))))))) (gen-syntax951 (lambda (src986 e987 r988 maps989 ellipsis?990 mod991) (if (id?126 e987) (let ((label992 (id-var-name148 e987 (quote (()))))) (let ((b993 (lookup123 label992 r988 mod991))) (if (eq? (binding-type118 b993) (quote syntax)) (call-with-values (lambda () (let ((var.lev994 (binding-value119 b993))) (gen-ref952 src986 (car var.lev994) (cdr var.lev994) maps989))) (lambda (var995 maps996) (values (list (quote ref) var995) maps996))) (if (ellipsis?990 e987) (syntax-error src986 "misplaced ellipsis in syntax form") (values (list (quote quote) e987) maps989))))) ((lambda (tmp997) ((lambda (tmp998) (if (if tmp998 (apply (lambda (dots999 e1000) (ellipsis?990 dots999)) tmp998) #f) (apply (lambda (dots1001 e1002) (gen-syntax951 src986 e1002 r988 maps989 (lambda (x1003) #f) mod991)) tmp998) ((lambda (tmp1004) (if (if tmp1004 (apply (lambda (x1005 dots1006 y1007) (ellipsis?990 dots1006)) tmp1004) #f) (apply (lambda (x1008 dots1009 y1010) (let f1011 ((y1012 y1010) (k1013 (lambda (maps1014) (call-with-values (lambda () (gen-syntax951 src986 x1008 r988 (cons (quote ()) maps1014) ellipsis?990 mod991)) (lambda (x1015 maps1016) (if (null? (car maps1016)) (syntax-error src986 "extra ellipsis in syntax form") (values (gen-map954 x1015 (car maps1016)) (cdr maps1016)))))))) ((lambda (tmp1017) ((lambda (tmp1018) (if (if tmp1018 (apply (lambda (dots1019 y1020) (ellipsis?990 dots1019)) tmp1018) #f) (apply (lambda (dots1021 y1022) (f1011 y1022 (lambda (maps1023) (call-with-values (lambda () (k1013 (cons (quote ()) maps1023))) (lambda (x1024 maps1025) (if (null? (car maps1025)) (syntax-error src986 "extra ellipsis in syntax form") (values (gen-mappend953 x1024 (car maps1025)) (cdr maps1025)))))))) tmp1018) ((lambda (_1026) (call-with-values (lambda () (gen-syntax951 src986 y1012 r988 maps989 ellipsis?990 mod991)) (lambda (y1027 maps1028) (call-with-values (lambda () (k1013 maps1028)) (lambda (x1029 maps1030) (values (gen-append956 x1029 y1027) maps1030)))))) tmp1017))) (syntax-dispatch tmp1017 (quote (any . any))))) y1012))) tmp1004) ((lambda (tmp1031) (if tmp1031 (apply (lambda (x1032 y1033) (call-with-values (lambda () (gen-syntax951 src986 x1032 r988 maps989 ellipsis?990 mod991)) (lambda (x1034 maps1035) (call-with-values (lambda () (gen-syntax951 src986 y1033 r988 maps1035 ellipsis?990 mod991)) (lambda (y1036 maps1037) (values (gen-cons955 x1034 y1036) maps1037)))))) tmp1031) ((lambda (tmp1038) (if tmp1038 (apply (lambda (e11039 e21040) (call-with-values (lambda () (gen-syntax951 src986 (cons e11039 e21040) r988 maps989 ellipsis?990 mod991)) (lambda (e1042 maps1043) (values (gen-vector957 e1042) maps1043)))) tmp1038) ((lambda (_1044) (values (list (quote quote) e987) maps989)) tmp997))) (syntax-dispatch tmp997 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp997 (quote (any . any)))))) (syntax-dispatch tmp997 (quote (any any . any)))))) (syntax-dispatch tmp997 (quote (any any))))) e987))))) (lambda (e1045 r1046 w1047 s1048 mod1049) (let ((e1050 (source-wrap155 e1045 w1047 s1048 mod1049))) ((lambda (tmp1051) ((lambda (tmp1052) (if tmp1052 (apply (lambda (_1053 x1054) (call-with-values (lambda () (gen-syntax951 e1050 x1054 r1046 (quote ()) ellipsis?171 mod1049)) (lambda (e1055 maps1056) (regen958 e1055)))) tmp1052) ((lambda (_1057) (syntax-error e1050)) tmp1051))) (syntax-dispatch tmp1051 (quote (any any))))) e1050))))) (global-extend124 (quote core) (quote lambda) (lambda (e1058 r1059 w1060 s1061 mod1062) ((lambda (tmp1063) ((lambda (tmp1064) (if tmp1064 (apply (lambda (_1065 c1066) (chi-lambda-clause167 (source-wrap155 e1058 w1060 s1061 mod1062) #f c1066 r1059 w1060 mod1062 (lambda (vars1067 docstring1068 body1069) (build-annotated103 s1061 (cons (quote lambda) (cons vars1067 (append (if docstring1068 (list docstring1068) (quote ())) (list body1069)))))))) tmp1064) (syntax-error tmp1063))) (syntax-dispatch tmp1063 (quote (any . any))))) e1058))) (global-extend124 (quote core) (quote let) (letrec ((chi-let1070 (lambda (e1071 r1072 w1073 s1074 mod1075 constructor1076 ids1077 vals1078 exps1079) (if (not (valid-bound-ids?151 ids1077)) (syntax-error e1071 "duplicate bound variable in") (let ((labels1080 (gen-labels132 ids1077)) (new-vars1081 (map gen-var174 ids1077))) (let ((nw1082 (make-binding-wrap143 ids1077 labels1080 w1073)) (nr1083 (extend-var-env121 labels1080 new-vars1081 r1072))) (constructor1076 s1074 new-vars1081 (map (lambda (x1084) (chi162 x1084 r1072 w1073 mod1075)) vals1078) (chi-body166 exps1079 (source-wrap155 e1071 nw1082 s1074 mod1075) nr1083 nw1082 mod1075)))))))) (lambda (e1085 r1086 w1087 s1088 mod1089) ((lambda (tmp1090) ((lambda (tmp1091) (if tmp1091 (apply (lambda (_1092 id1093 val1094 e11095 e21096) (chi-let1070 e1085 r1086 w1087 s1088 mod1089 build-let106 id1093 val1094 (cons e11095 e21096))) tmp1091) ((lambda (tmp1100) (if (if tmp1100 (apply (lambda (_1101 f1102 id1103 val1104 e11105 e21106) (id?126 f1102)) tmp1100) #f) (apply (lambda (_1107 f1108 id1109 val1110 e11111 e21112) (chi-let1070 e1085 r1086 w1087 s1088 mod1089 build-named-let107 (cons f1108 id1109) val1110 (cons e11111 e21112))) tmp1100) ((lambda (_1116) (syntax-error (source-wrap155 e1085 w1087 s1088 mod1089))) tmp1090))) (syntax-dispatch tmp1090 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp1090 (quote (any #(each (any any)) any . each-any))))) e1085)))) (global-extend124 (quote core) (quote letrec) (lambda (e1117 r1118 w1119 s1120 mod1121) ((lambda (tmp1122) ((lambda (tmp1123) (if tmp1123 (apply (lambda (_1124 id1125 val1126 e11127 e21128) (let ((ids1129 id1125)) (if (not (valid-bound-ids?151 ids1129)) (syntax-error e1117 "duplicate bound variable in") (let ((labels1131 (gen-labels132 ids1129)) (new-vars1132 (map gen-var174 ids1129))) (let ((w1133 (make-binding-wrap143 ids1129 labels1131 w1119)) (r1134 (extend-var-env121 labels1131 new-vars1132 r1118))) (build-letrec108 s1120 new-vars1132 (map (lambda (x1135) (chi162 x1135 r1134 w1133 mod1121)) val1126) (chi-body166 (cons e11127 e21128) (source-wrap155 e1117 w1133 s1120 mod1121) r1134 w1133 mod1121))))))) tmp1123) ((lambda (_1138) (syntax-error (source-wrap155 e1117 w1119 s1120 mod1121))) tmp1122))) (syntax-dispatch tmp1122 (quote (any #(each (any any)) any . each-any))))) e1117))) (global-extend124 (quote core) (quote set!) (lambda (e1139 r1140 w1141 s1142 mod1143) ((lambda (tmp1144) ((lambda (tmp1145) (if (if tmp1145 (apply (lambda (_1146 id1147 val1148) (id?126 id1147)) tmp1145) #f) (apply (lambda (_1149 id1150 val1151) (let ((val1152 (chi162 val1151 r1140 w1141 mod1143)) (n1153 (id-var-name148 id1150 w1141))) (let ((b1154 (lookup123 n1153 r1140 mod1143))) (let ((t1155 (binding-type118 b1154))) (if (memv t1155 (quote (lexical))) (build-annotated103 s1142 (list (quote set!) (binding-value119 b1154) val1152)) (if (memv t1155 (quote (global))) (build-annotated103 s1142 (list (quote set!) (if mod1143 (make-module-ref (cdr mod1143) n1153 (car mod1143)) (make-module-ref mod1143 n1153 (quote bare))) val1152)) (if (memv t1155 (quote (displaced-lexical))) (syntax-error (wrap154 id1150 w1141 mod1143) "identifier out of context") (syntax-error (source-wrap155 e1139 w1141 s1142 mod1143))))))))) tmp1145) ((lambda (tmp1156) (if tmp1156 (apply (lambda (_1157 head1158 tail1159 val1160) (call-with-values (lambda () (syntax-type160 head1158 r1140 (quote (())) #f #f mod1143)) (lambda (type1161 value1162 ee1163 ww1164 ss1165 modmod1166) (let ((t1167 type1161)) (if (memv t1167 (quote (module-ref))) (let ((val1168 (chi162 val1160 r1140 w1141 mod1143))) (call-with-values (lambda () (value1162 (cons head1158 tail1159))) (lambda (id1170 mod1171) (build-annotated103 s1142 (list (quote set!) (if mod1171 (make-module-ref (cdr mod1171) id1170 (car mod1171)) (make-module-ref mod1171 id1170 (quote bare))) val1168))))) (build-annotated103 s1142 (cons (chi162 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head1158) r1140 w1141 mod1143) (map (lambda (e1172) (chi162 e1172 r1140 w1141 mod1143)) (append tail1159 (list val1160)))))))))) tmp1156) ((lambda (_1174) (syntax-error (source-wrap155 e1139 w1141 s1142 mod1143))) tmp1144))) (syntax-dispatch tmp1144 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp1144 (quote (any any any))))) e1139))) (global-extend124 (quote module-ref) (quote @) (lambda (e1175) ((lambda (tmp1176) ((lambda (tmp1177) (if (if tmp1177 (apply (lambda (_1178 mod1179 id1180) (and (andmap id?126 mod1179) (id?126 id1180))) tmp1177) #f) (apply (lambda (_1182 mod1183 id1184) (values (syntax-object->datum id1184) (syntax-object->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod1183)))) tmp1177) (syntax-error tmp1176))) (syntax-dispatch tmp1176 (quote (any each-any any))))) e1175))) (global-extend124 (quote module-ref) (quote @@) (lambda (e1186) ((lambda (tmp1187) ((lambda (tmp1188) (if (if tmp1188 (apply (lambda (_1189 mod1190 id1191) (and (andmap id?126 mod1190) (id?126 id1191))) tmp1188) #f) (apply (lambda (_1193 mod1194 id1195) (values (syntax-object->datum id1195) (syntax-object->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod1194)))) tmp1188) (syntax-error tmp1187))) (syntax-dispatch tmp1187 (quote (any each-any any))))) e1186))) (global-extend124 (quote begin) (quote begin) (quote ())) (global-extend124 (quote define) (quote define) (quote ())) (global-extend124 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend124 (quote eval-when) (quote eval-when) (quote ())) (global-extend124 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1200 (lambda (x1201 keys1202 clauses1203 r1204 mod1205) (if (null? clauses1203) (build-annotated103 #f (list (build-annotated103 #f (quote syntax-error)) x1201)) ((lambda (tmp1206) ((lambda (tmp1207) (if tmp1207 (apply (lambda (pat1208 exp1209) (if (and (id?126 pat1208) (andmap (lambda (x1210) (not (free-id=?149 pat1208 x1210))) (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys1202))) (let ((labels1211 (list (gen-label131))) (var1212 (gen-var174 pat1208))) (build-annotated103 #f (list (build-annotated103 #f (list (quote lambda) (list var1212) (chi162 exp1209 (extend-env120 labels1211 (list (cons (quote syntax) (cons var1212 0))) r1204) (make-binding-wrap143 (list pat1208) labels1211 (quote (()))) mod1205))) x1201))) (gen-clause1199 x1201 keys1202 (cdr clauses1203) r1204 pat1208 #t exp1209 mod1205))) tmp1207) ((lambda (tmp1213) (if tmp1213 (apply (lambda (pat1214 fender1215 exp1216) (gen-clause1199 x1201 keys1202 (cdr clauses1203) r1204 pat1214 fender1215 exp1216 mod1205)) tmp1213) ((lambda (_1217) (syntax-error (car clauses1203) "invalid syntax-case clause")) tmp1206))) (syntax-dispatch tmp1206 (quote (any any any)))))) (syntax-dispatch tmp1206 (quote (any any))))) (car clauses1203))))) (gen-clause1199 (lambda (x1218 keys1219 clauses1220 r1221 pat1222 fender1223 exp1224 mod1225) (call-with-values (lambda () (convert-pattern1197 pat1222 keys1219)) (lambda (p1226 pvars1227) (cond ((not (distinct-bound-ids?152 (map car pvars1227))) (syntax-error pat1222 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x1228) (not (ellipsis?171 (car x1228)))) pvars1227)) (syntax-error pat1222 "misplaced ellipsis in syntax-case pattern")) (else (let ((y1229 (gen-var174 (quote tmp)))) (build-annotated103 #f (list (build-annotated103 #f (list (quote lambda) (list y1229) (let ((y1230 (build-annotated103 #f y1229))) (build-annotated103 #f (list (quote if) ((lambda (tmp1231) ((lambda (tmp1232) (if tmp1232 (apply (lambda () y1230) tmp1232) ((lambda (_1233) (build-annotated103 #f (list (quote if) y1230 (build-dispatch-call1198 pvars1227 fender1223 y1230 r1221 mod1225) (build-data104 #f #f)))) tmp1231))) (syntax-dispatch tmp1231 (quote #(atom #t))))) fender1223) (build-dispatch-call1198 pvars1227 exp1224 y1230 r1221 mod1225) (gen-syntax-case1200 x1218 keys1219 clauses1220 r1221 mod1225)))))) (if (eq? p1226 (quote any)) (build-annotated103 #f (list (build-annotated103 #f (quote list)) x1218)) (build-annotated103 #f (list (build-annotated103 #f (quote syntax-dispatch)) x1218 (build-data104 #f p1226))))))))))))) (build-dispatch-call1198 (lambda (pvars1234 exp1235 y1236 r1237 mod1238) (let ((ids1239 (map car pvars1234)) (levels1240 (map cdr pvars1234))) (let ((labels1241 (gen-labels132 ids1239)) (new-vars1242 (map gen-var174 ids1239))) (build-annotated103 #f (list (build-annotated103 #f (quote apply)) (build-annotated103 #f (list (quote lambda) new-vars1242 (chi162 exp1235 (extend-env120 labels1241 (map (lambda (var1243 level1244) (cons (quote syntax) (cons var1243 level1244))) new-vars1242 (map cdr pvars1234)) r1237) (make-binding-wrap143 ids1239 labels1241 (quote (()))) mod1238))) y1236)))))) (convert-pattern1197 (lambda (pattern1245 keys1246) (let cvt1247 ((p1248 pattern1245) (n1249 0) (ids1250 (quote ()))) (if (id?126 p1248) (if (bound-id-member?153 p1248 keys1246) (values (vector (quote free-id) p1248) ids1250) (values (quote any) (cons (cons p1248 n1249) ids1250))) ((lambda (tmp1251) ((lambda (tmp1252) (if (if tmp1252 (apply (lambda (x1253 dots1254) (ellipsis?171 dots1254)) tmp1252) #f) (apply (lambda (x1255 dots1256) (call-with-values (lambda () (cvt1247 x1255 (fx+93 n1249 1) ids1250)) (lambda (p1257 ids1258) (values (if (eq? p1257 (quote any)) (quote each-any) (vector (quote each) p1257)) ids1258)))) tmp1252) ((lambda (tmp1259) (if tmp1259 (apply (lambda (x1260 y1261) (call-with-values (lambda () (cvt1247 y1261 n1249 ids1250)) (lambda (y1262 ids1263) (call-with-values (lambda () (cvt1247 x1260 n1249 ids1263)) (lambda (x1264 ids1265) (values (cons x1264 y1262) ids1265)))))) tmp1259) ((lambda (tmp1266) (if tmp1266 (apply (lambda () (values (quote ()) ids1250)) tmp1266) ((lambda (tmp1267) (if tmp1267 (apply (lambda (x1268) (call-with-values (lambda () (cvt1247 x1268 n1249 ids1250)) (lambda (p1270 ids1271) (values (vector (quote vector) p1270) ids1271)))) tmp1267) ((lambda (x1272) (values (vector (quote atom) (strip173 p1248 (quote (())))) ids1250)) tmp1251))) (syntax-dispatch tmp1251 (quote #(vector each-any)))))) (syntax-dispatch tmp1251 (quote ()))))) (syntax-dispatch tmp1251 (quote (any . any)))))) (syntax-dispatch tmp1251 (quote (any any))))) p1248)))))) (lambda (e1273 r1274 w1275 s1276 mod1277) (let ((e1278 (source-wrap155 e1273 w1275 s1276 mod1277))) ((lambda (tmp1279) ((lambda (tmp1280) (if tmp1280 (apply (lambda (_1281 val1282 key1283 m1284) (if (andmap (lambda (x1285) (and (id?126 x1285) (not (ellipsis?171 x1285)))) key1283) (let ((x1287 (gen-var174 (quote tmp)))) (build-annotated103 s1276 (list (build-annotated103 #f (list (quote lambda) (list x1287) (gen-syntax-case1200 (build-annotated103 #f x1287) key1283 m1284 r1274 mod1277))) (chi162 val1282 r1274 (quote (())) mod1277)))) (syntax-error e1278 "invalid literals list in"))) tmp1280) (syntax-error tmp1279))) (syntax-dispatch tmp1279 (quote (any any each-any . each-any))))) e1278))))) (set! sc-expand (let ((m1290 (quote e)) (esew1291 (quote (eval)))) (lambda (x1292) (if (and (pair? x1292) (equal? (car x1292) noexpand92)) (cadr x1292) (chi-top161 x1292 (quote ()) (quote ((top))) m1290 esew1291 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m1293 (quote e)) (esew1294 (quote (eval)))) (lambda (x1296 . rest1295) (if (and (pair? x1296) (equal? (car x1296) noexpand92)) (cadr x1296) (chi-top161 x1296 (quote ()) (quote ((top))) (if (null? rest1295) m1293 (car rest1295)) (if (or (null? rest1295) (null? (cdr rest1295))) esew1294 (cadr rest1295)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x1297) (nonsymbol-id?125 x1297))) (set! datum->syntax-object (lambda (id1298 datum1299) (make-syntax-object109 datum1299 (syntax-object-wrap112 id1298) #f))) (set! syntax-object->datum (lambda (x1300) (strip173 x1300 (quote (()))))) (set! generate-temporaries (lambda (ls1301) (begin (let ((x1302 ls1301)) (if (not (list? x1302)) (error-hook99 (quote generate-temporaries) "invalid argument" x1302))) (map (lambda (x1303) (wrap154 (gensym) (quote ((top))) #f)) ls1301)))) (set! free-identifier=? (lambda (x1304 y1305) (begin (let ((x1306 x1304)) (if (not (nonsymbol-id?125 x1306)) (error-hook99 (quote free-identifier=?) "invalid argument" x1306))) (let ((x1307 y1305)) (if (not (nonsymbol-id?125 x1307)) (error-hook99 (quote free-identifier=?) "invalid argument" x1307))) (free-id=?149 x1304 y1305)))) (set! bound-identifier=? (lambda (x1308 y1309) (begin (let ((x1310 x1308)) (if (not (nonsymbol-id?125 x1310)) (error-hook99 (quote bound-identifier=?) "invalid argument" x1310))) (let ((x1311 y1309)) (if (not (nonsymbol-id?125 x1311)) (error-hook99 (quote bound-identifier=?) "invalid argument" x1311))) (bound-id=?150 x1308 y1309)))) (set! syntax-error (lambda (object1313 . messages1312) (begin (for-each (lambda (x1314) (let ((x1315 x1314)) (if (not (string? x1315)) (error-hook99 (quote syntax-error) "invalid argument" x1315)))) messages1312) (let ((message1316 (if (null? messages1312) "invalid syntax" (apply string-append messages1312)))) (error-hook99 #f message1316 (strip173 object1313 (quote (())))))))) (set! install-global-transformer (lambda (sym1317 v1318) (begin (let ((x1319 sym1317)) (if (not (symbol? x1319)) (error-hook99 (quote define-syntax) "invalid argument" x1319))) (let ((x1320 v1318)) (if (not (procedure? x1320)) (error-hook99 (quote define-syntax) "invalid argument" x1320))) (global-extend124 (quote macro) sym1317 v1318)))) (letrec ((match1325 (lambda (e1326 p1327 w1328 r1329 mod1330) (cond ((not r1329) #f) ((eq? p1327 (quote any)) (cons (wrap154 e1326 w1328 mod1330) r1329)) ((syntax-object?110 e1326) (match*1324 (let ((e1331 (syntax-object-expression111 e1326))) (if (annotation? e1331) (annotation-expression e1331) e1331)) p1327 (join-wraps145 w1328 (syntax-object-wrap112 e1326)) r1329 (syntax-object-module113 e1326))) (else (match*1324 (let ((e1332 e1326)) (if (annotation? e1332) (annotation-expression e1332) e1332)) p1327 w1328 r1329 mod1330))))) (match*1324 (lambda (e1333 p1334 w1335 r1336 mod1337) (cond ((null? p1334) (and (null? e1333) r1336)) ((pair? p1334) (and (pair? e1333) (match1325 (car e1333) (car p1334) w1335 (match1325 (cdr e1333) (cdr p1334) w1335 r1336 mod1337) mod1337))) ((eq? p1334 (quote each-any)) (let ((l1338 (match-each-any1322 e1333 w1335 mod1337))) (and l1338 (cons l1338 r1336)))) (else (let ((t1339 (vector-ref p1334 0))) (if (memv t1339 (quote (each))) (if (null? e1333) (match-empty1323 (vector-ref p1334 1) r1336) (let ((l1340 (match-each1321 e1333 (vector-ref p1334 1) w1335 mod1337))) (and l1340 (let collect1341 ((l1342 l1340)) (if (null? (car l1342)) r1336 (cons (map car l1342) (collect1341 (map cdr l1342)))))))) (if (memv t1339 (quote (free-id))) (and (id?126 e1333) (free-id=?149 (wrap154 e1333 w1335 mod1337) (vector-ref p1334 1)) r1336) (if (memv t1339 (quote (atom))) (and (equal? (vector-ref p1334 1) (strip173 e1333 w1335)) r1336) (if (memv t1339 (quote (vector))) (and (vector? e1333) (match1325 (vector->list e1333) (vector-ref p1334 1) w1335 r1336 mod1337))))))))))) (match-empty1323 (lambda (p1343 r1344) (cond ((null? p1343) r1344) ((eq? p1343 (quote any)) (cons (quote ()) r1344)) ((pair? p1343) (match-empty1323 (car p1343) (match-empty1323 (cdr p1343) r1344))) ((eq? p1343 (quote each-any)) (cons (quote ()) r1344)) (else (let ((t1345 (vector-ref p1343 0))) (if (memv t1345 (quote (each))) (match-empty1323 (vector-ref p1343 1) r1344) (if (memv t1345 (quote (free-id atom))) r1344 (if (memv t1345 (quote (vector))) (match-empty1323 (vector-ref p1343 1) r1344))))))))) (match-each-any1322 (lambda (e1346 w1347 mod1348) (cond ((annotation? e1346) (match-each-any1322 (annotation-expression e1346) w1347 mod1348)) ((pair? e1346) (let ((l1349 (match-each-any1322 (cdr e1346) w1347 mod1348))) (and l1349 (cons (wrap154 (car e1346) w1347 mod1348) l1349)))) ((null? e1346) (quote ())) ((syntax-object?110 e1346) (match-each-any1322 (syntax-object-expression111 e1346) (join-wraps145 w1347 (syntax-object-wrap112 e1346)) mod1348)) (else #f)))) (match-each1321 (lambda (e1350 p1351 w1352 mod1353) (cond ((annotation? e1350) (match-each1321 (annotation-expression e1350) p1351 w1352 mod1353)) ((pair? e1350) (let ((first1354 (match1325 (car e1350) p1351 w1352 (quote ()) mod1353))) (and first1354 (let ((rest1355 (match-each1321 (cdr e1350) p1351 w1352 mod1353))) (and rest1355 (cons first1354 rest1355)))))) ((null? e1350) (quote ())) ((syntax-object?110 e1350) (match-each1321 (syntax-object-expression111 e1350) p1351 (join-wraps145 w1352 (syntax-object-wrap112 e1350)) (syntax-object-module113 e1350))) (else #f))))) (begin (set! syntax-dispatch (lambda (e1356 p1357) (cond ((eq? p1357 (quote any)) (list e1356)) ((syntax-object?110 e1356) (match*1324 (let ((e1358 (syntax-object-expression111 e1356))) (if (annotation? e1358) (annotation-expression e1358) e1358)) p1357 (syntax-object-wrap112 e1356) (quote ()) (syntax-object-module113 e1356))) (else (match*1324 (let ((e1359 e1356)) (if (annotation? e1359) (annotation-expression e1359) e1359)) p1357 (quote (())) (quote ()) #f))))) (set! sc-chi chi162)))))
-(install-global-transformer (quote with-syntax) (lambda (x1360) ((lambda (tmp1361) ((lambda (tmp1362) (if tmp1362 (apply (lambda (_1363 e11364 e21365) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11364 e21365))) tmp1362) ((lambda (tmp1367) (if tmp1367 (apply (lambda (_1368 out1369 in1370 e11371 e21372) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1370 (quote ()) (list out1369 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11371 e21372))))) tmp1367) ((lambda (tmp1374) (if tmp1374 (apply (lambda (_1375 out1376 in1377 e11378 e21379) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1377) (quote ()) (list out1376 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11378 e21379))))) tmp1374) (syntax-error tmp1361))) (syntax-dispatch tmp1361 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp1361 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp1361 (quote (any () any . each-any))))) x1360)))
-(install-global-transformer (quote syntax-rules) (lambda (x1383) ((lambda (tmp1384) ((lambda (tmp1385) (if tmp1385 (apply (lambda (_1386 k1387 keyword1388 pattern1389 template1390) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k1387 (map (lambda (tmp1393 tmp1392) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1392) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1393))) template1390 pattern1389)))))) tmp1385) (syntax-error tmp1384))) (syntax-dispatch tmp1384 (quote (any each-any . #(each ((any . any) any))))))) x1383)))
-(install-global-transformer (quote let*) (lambda (x1394) ((lambda (tmp1395) ((lambda (tmp1396) (if (if tmp1396 (apply (lambda (let*1397 x1398 v1399 e11400 e21401) (andmap identifier? x1398)) tmp1396) #f) (apply (lambda (let*1403 x1404 v1405 e11406 e21407) (let f1408 ((bindings1409 (map list x1404 v1405))) (if (null? bindings1409) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11406 e21407))) ((lambda (tmp1413) ((lambda (tmp1414) (if tmp1414 (apply (lambda (body1415 binding1416) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding1416) body1415)) tmp1414) (syntax-error tmp1413))) (syntax-dispatch tmp1413 (quote (any any))))) (list (f1408 (cdr bindings1409)) (car bindings1409)))))) tmp1396) (syntax-error tmp1395))) (syntax-dispatch tmp1395 (quote (any #(each (any any)) any . each-any))))) x1394)))
-(install-global-transformer (quote do) (lambda (orig-x1417) ((lambda (tmp1418) ((lambda (tmp1419) (if tmp1419 (apply (lambda (_1420 var1421 init1422 step1423 e01424 e11425 c1426) ((lambda (tmp1427) ((lambda (tmp1428) (if tmp1428 (apply (lambda (step1429) ((lambda (tmp1430) ((lambda (tmp1431) (if tmp1431 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1421 init1422) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01424) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1426 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1429))))))) tmp1431) ((lambda (tmp1436) (if tmp1436 (apply (lambda (e11437 e21438) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1421 init1422) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01424 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e11437 e21438)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1426 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1429))))))) tmp1436) (syntax-error tmp1430))) (syntax-dispatch tmp1430 (quote (any . each-any)))))) (syntax-dispatch tmp1430 (quote ())))) e11425)) tmp1428) (syntax-error tmp1427))) (syntax-dispatch tmp1427 (quote each-any)))) (map (lambda (v1445 s1446) ((lambda (tmp1447) ((lambda (tmp1448) (if tmp1448 (apply (lambda () v1445) tmp1448) ((lambda (tmp1449) (if tmp1449 (apply (lambda (e1450) e1450) tmp1449) ((lambda (_1451) (syntax-error orig-x1417)) tmp1447))) (syntax-dispatch tmp1447 (quote (any)))))) (syntax-dispatch tmp1447 (quote ())))) s1446)) var1421 step1423))) tmp1419) (syntax-error tmp1418))) (syntax-dispatch tmp1418 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1417)))
-(install-global-transformer (quote quasiquote) (letrec ((quasicons1454 (lambda (x1458 y1459) ((lambda (tmp1460) ((lambda (tmp1461) (if tmp1461 (apply (lambda (x1462 y1463) ((lambda (tmp1464) ((lambda (tmp1465) (if tmp1465 (apply (lambda (dy1466) ((lambda (tmp1467) ((lambda (tmp1468) (if tmp1468 (apply (lambda (dx1469) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx1469 dy1466))) tmp1468) ((lambda (_1470) (if (null? dy1466) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1462) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1462 y1463))) tmp1467))) (syntax-dispatch tmp1467 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x1462)) tmp1465) ((lambda (tmp1471) (if tmp1471 (apply (lambda (stuff1472) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1462 stuff1472))) tmp1471) ((lambda (else1473) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1462 y1463)) tmp1464))) (syntax-dispatch tmp1464 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) (syntax-dispatch tmp1464 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y1463)) tmp1461) (syntax-error tmp1460))) (syntax-dispatch tmp1460 (quote (any any))))) (list x1458 y1459)))) (quasiappend1455 (lambda (x1474 y1475) ((lambda (tmp1476) ((lambda (tmp1477) (if tmp1477 (apply (lambda (x1478 y1479) ((lambda (tmp1480) ((lambda (tmp1481) (if tmp1481 (apply (lambda () x1478) tmp1481) ((lambda (_1482) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1478 y1479)) tmp1480))) (syntax-dispatch tmp1480 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1479)) tmp1477) (syntax-error tmp1476))) (syntax-dispatch tmp1476 (quote (any any))))) (list x1474 y1475)))) (quasivector1456 (lambda (x1483) ((lambda (tmp1484) ((lambda (x1485) ((lambda (tmp1486) ((lambda (tmp1487) (if tmp1487 (apply (lambda (x1488) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x1488))) tmp1487) ((lambda (tmp1490) (if tmp1490 (apply (lambda (x1491) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1491)) tmp1490) ((lambda (_1493) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1485)) tmp1486))) (syntax-dispatch tmp1486 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) (syntax-dispatch tmp1486 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x1485)) tmp1484)) x1483))) (quasi1457 (lambda (p1494 lev1495) ((lambda (tmp1496) ((lambda (tmp1497) (if tmp1497 (apply (lambda (p1498) (if (= lev1495 0) p1498 (quasicons1454 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1457 (list p1498) (- lev1495 1))))) tmp1497) ((lambda (tmp1499) (if tmp1499 (apply (lambda (p1500 q1501) (if (= lev1495 0) (quasiappend1455 p1500 (quasi1457 q1501 lev1495)) (quasicons1454 (quasicons1454 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1457 (list p1500) (- lev1495 1))) (quasi1457 q1501 lev1495)))) tmp1499) ((lambda (tmp1502) (if tmp1502 (apply (lambda (p1503) (quasicons1454 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1457 (list p1503) (+ lev1495 1)))) tmp1502) ((lambda (tmp1504) (if tmp1504 (apply (lambda (p1505 q1506) (quasicons1454 (quasi1457 p1505 lev1495) (quasi1457 q1506 lev1495))) tmp1504) ((lambda (tmp1507) (if tmp1507 (apply (lambda (x1508) (quasivector1456 (quasi1457 x1508 lev1495))) tmp1507) ((lambda (p1510) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p1510)) tmp1496))) (syntax-dispatch tmp1496 (quote #(vector each-any)))))) (syntax-dispatch tmp1496 (quote (any . any)))))) (syntax-dispatch tmp1496 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) (syntax-dispatch tmp1496 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) (syntax-dispatch tmp1496 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p1494)))) (lambda (x1511) ((lambda (tmp1512) ((lambda (tmp1513) (if tmp1513 (apply (lambda (_1514 e1515) (quasi1457 e1515 0)) tmp1513) (syntax-error tmp1512))) (syntax-dispatch tmp1512 (quote (any any))))) x1511))))
-(install-global-transformer (quote include) (lambda (x1516) (letrec ((read-file1517 (lambda (fn1518 k1519) (let ((p1520 (open-input-file fn1518))) (let f1521 ((x1522 (read p1520))) (if (eof-object? x1522) (begin (close-input-port p1520) (quote ())) (cons (datum->syntax-object k1519 x1522) (f1521 (read p1520))))))))) ((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (k1525 filename1526) (let ((fn1527 (syntax-object->datum filename1526))) ((lambda (tmp1528) ((lambda (tmp1529) (if tmp1529 (apply (lambda (exp1530) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp1530)) tmp1529) (syntax-error tmp1528))) (syntax-dispatch tmp1528 (quote each-any)))) (read-file1517 fn1527 k1525)))) tmp1524) (syntax-error tmp1523))) (syntax-dispatch tmp1523 (quote (any any))))) x1516))))
-(install-global-transformer (quote unquote) (lambda (x1532) ((lambda (tmp1533) ((lambda (tmp1534) (if tmp1534 (apply (lambda (_1535 e1536) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e1536))) tmp1534) (syntax-error tmp1533))) (syntax-dispatch tmp1533 (quote (any any))))) x1532)))
-(install-global-transformer (quote unquote-splicing) (lambda (x1537) ((lambda (tmp1538) ((lambda (tmp1539) (if tmp1539 (apply (lambda (_1540 e1541) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e1541))) tmp1539) (syntax-error tmp1538))) (syntax-dispatch tmp1538 (quote (any any))))) x1537)))
-(install-global-transformer (quote case) (lambda (x1542) ((lambda (tmp1543) ((lambda (tmp1544) (if tmp1544 (apply (lambda (_1545 e1546 m11547 m21548) ((lambda (tmp1549) ((lambda (body1550) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1546)) body1550)) tmp1549)) (let f1551 ((clause1552 m11547) (clauses1553 m21548)) (if (null? clauses1553) ((lambda (tmp1555) ((lambda (tmp1556) (if tmp1556 (apply (lambda (e11557 e21558) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11557 e21558))) tmp1556) ((lambda (tmp1560) (if tmp1560 (apply (lambda (k1561 e11562 e21563) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1561)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11562 e21563)))) tmp1560) ((lambda (_1566) (syntax-error x1542)) tmp1555))) (syntax-dispatch tmp1555 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1555 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause1552) ((lambda (tmp1567) ((lambda (rest1568) ((lambda (tmp1569) ((lambda (tmp1570) (if tmp1570 (apply (lambda (k1571 e11572 e21573) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1571)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11572 e21573)) rest1568)) tmp1570) ((lambda (_1576) (syntax-error x1542)) tmp1569))) (syntax-dispatch tmp1569 (quote (each-any any . each-any))))) clause1552)) tmp1567)) (f1551 (car clauses1553) (cdr clauses1553))))))) tmp1544) (syntax-error tmp1543))) (syntax-dispatch tmp1543 (quote (any any any . each-any))))) x1542)))
-(install-global-transformer (quote identifier-syntax) (lambda (x1577) ((lambda (tmp1578) ((lambda (tmp1579) (if tmp1579 (apply (lambda (_1580 e1581) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1581)) (list (cons _1580 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e1581 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp1579) (syntax-error tmp1578))) (syntax-dispatch tmp1578 (quote (any any))))) x1577)))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(void)
+(letrec ((lambda-var-list1165 (lambda (vars1370) (let lvl1371 ((vars1372 vars1370) (ls1373 (quote ())) (w1374 (quote (())))) (cond ((pair? vars1372) (lvl1371 (cdr vars1372) (cons (wrap1144 (car vars1372) w1374 #f) ls1373) w1374)) ((id?1116 vars1372) (cons (wrap1144 vars1372 w1374 #f) ls1373)) ((null? vars1372) ls1373) ((syntax-object?1100 vars1372) (lvl1371 (syntax-object-expression1101 vars1372) ls1373 (join-wraps1135 w1374 (syntax-object-wrap1102 vars1372)))) ((annotation? vars1372) (lvl1371 (annotation-expression vars1372) ls1373 w1374)) (else (cons vars1372 ls1373)))))) (gen-var1164 (lambda (id1375) (let ((id1376 (if (syntax-object?1100 id1375) (syntax-object-expression1101 id1375) id1375))) (if (annotation? id1376) (build-annotated1093 (annotation-source id1376) (gensym (symbol->string (annotation-expression id1376)))) (build-annotated1093 #f (gensym (symbol->string id1376))))))) (strip1163 (lambda (x1377 w1378) (if (memq (quote top) (wrap-marks1119 w1378)) (if (or (annotation? x1377) (and (pair? x1377) (annotation? (car x1377)))) (strip-annotation1162 x1377 #f) x1377) (let f1379 ((x1380 x1377)) (cond ((syntax-object?1100 x1380) (strip1163 (syntax-object-expression1101 x1380) (syntax-object-wrap1102 x1380))) ((pair? x1380) (let ((a1381 (f1379 (car x1380))) (d1382 (f1379 (cdr x1380)))) (if (and (eq? a1381 (car x1380)) (eq? d1382 (cdr x1380))) x1380 (cons a1381 d1382)))) ((vector? x1380) (let ((old1383 (vector->list x1380))) (let ((new1384 (map f1379 old1383))) (if (andmap eq? old1383 new1384) x1380 (list->vector new1384))))) (else x1380)))))) (strip-annotation1162 (lambda (x1385 parent1386) (cond ((pair? x1385) (let ((new1387 (cons #f #f))) (begin (if parent1386 (set-annotation-stripped! parent1386 new1387)) (set-car! new1387 (strip-annotation1162 (car x1385) #f)) (set-cdr! new1387 (strip-annotation1162 (cdr x1385) #f)) new1387))) ((annotation? x1385) (or (annotation-stripped x1385) (strip-annotation1162 (annotation-expression x1385) x1385))) ((vector? x1385) (let ((new1388 (make-vector (vector-length x1385)))) (begin (if parent1386 (set-annotation-stripped! parent1386 new1388)) (let loop1389 ((i1390 (- (vector-length x1385) 1))) (unless (fx<1086 i1390 0) (vector-set! new1388 i1390 (strip-annotation1162 (vector-ref x1385 i1390) #f)) (loop1389 (fx-1084 i1390 1)))) new1388))) (else x1385)))) (ellipsis?1161 (lambda (x1391) (and (nonsymbol-id?1115 x1391) (free-id=?1139 x1391 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1160 (lambda () (build-annotated1093 #f (list (build-annotated1093 #f (quote void)))))) (eval-local-transformer1159 (lambda (expanded1392 mod1393) (let ((p1394 (local-eval-hook1088 expanded1392 mod1393))) (if (procedure? p1394) p1394 (syntax-error p1394 "nonprocedure transformer"))))) (chi-local-syntax1158 (lambda (rec?1395 e1396 r1397 w1398 s1399 mod1400 k1401) ((lambda (tmp1402) ((lambda (tmp1403) (if tmp1403 (apply (lambda (_1404 id1405 val1406 e11407 e21408) (let ((ids1409 id1405)) (if (not (valid-bound-ids?1141 ids1409)) (syntax-error e1396 "duplicate bound keyword in") (let ((labels1411 (gen-labels1122 ids1409))) (let ((new-w1412 (make-binding-wrap1133 ids1409 labels1411 w1398))) (k1401 (cons e11407 e21408) (extend-env1110 labels1411 (let ((w1414 (if rec?1395 new-w1412 w1398)) (trans-r1415 (macros-only-env1112 r1397))) (map (lambda (x1416) (cons (quote macro) (eval-local-transformer1159 (chi1152 x1416 trans-r1415 w1414 mod1400) mod1400))) val1406)) r1397) new-w1412 s1399 mod1400)))))) tmp1403) ((lambda (_1418) (syntax-error (source-wrap1145 e1396 w1398 s1399 mod1400))) tmp1402))) (syntax-dispatch tmp1402 (quote (any #(each (any any)) any . each-any))))) e1396))) (chi-lambda-clause1157 (lambda (e1419 docstring1420 c1421 r1422 w1423 mod1424 k1425) ((lambda (tmp1426) ((lambda (tmp1427) (if (if tmp1427 (apply (lambda (args1428 doc1429 e11430 e21431) (and (string? (syntax-object->datum doc1429)) (not docstring1420))) tmp1427) #f) (apply (lambda (args1432 doc1433 e11434 e21435) (chi-lambda-clause1157 e1419 doc1433 (cons args1432 (cons e11434 e21435)) r1422 w1423 mod1424 k1425)) tmp1427) ((lambda (tmp1437) (if tmp1437 (apply (lambda (id1438 e11439 e21440) (let ((ids1441 id1438)) (if (not (valid-bound-ids?1141 ids1441)) (syntax-error e1419 "invalid parameter list in") (let ((labels1443 (gen-labels1122 ids1441)) (new-vars1444 (map gen-var1164 ids1441))) (k1425 new-vars1444 docstring1420 (chi-body1156 (cons e11439 e21440) e1419 (extend-var-env1111 labels1443 new-vars1444 r1422) (make-binding-wrap1133 ids1441 labels1443 w1423) mod1424)))))) tmp1437) ((lambda (tmp1446) (if tmp1446 (apply (lambda (ids1447 e11448 e21449) (let ((old-ids1450 (lambda-var-list1165 ids1447))) (if (not (valid-bound-ids?1141 old-ids1450)) (syntax-error e1419 "invalid parameter list in") (let ((labels1451 (gen-labels1122 old-ids1450)) (new-vars1452 (map gen-var1164 old-ids1450))) (k1425 (let f1453 ((ls11454 (cdr new-vars1452)) (ls21455 (car new-vars1452))) (if (null? ls11454) ls21455 (f1453 (cdr ls11454) (cons (car ls11454) ls21455)))) docstring1420 (chi-body1156 (cons e11448 e21449) e1419 (extend-var-env1111 labels1451 new-vars1452 r1422) (make-binding-wrap1133 old-ids1450 labels1451 w1423) mod1424)))))) tmp1446) ((lambda (_1457) (syntax-error e1419)) tmp1426))) (syntax-dispatch tmp1426 (quote (any any . each-any)))))) (syntax-dispatch tmp1426 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1426 (quote (any any any . each-any))))) c1421))) (chi-body1156 (lambda (body1458 outer-form1459 r1460 w1461 mod1462) (let ((r1463 (cons (quote ("placeholder" placeholder)) r1460))) (let ((ribcage1464 (make-ribcage1123 (quote ()) (quote ()) (quote ())))) (let ((w1465 (make-wrap1118 (wrap-marks1119 w1461) (cons ribcage1464 (wrap-subst1120 w1461))))) (let parse1466 ((body1467 (map (lambda (x1473) (cons r1463 (wrap1144 x1473 w1465 mod1462))) body1458)) (ids1468 (quote ())) (labels1469 (quote ())) (vars1470 (quote ())) (vals1471 (quote ())) (bindings1472 (quote ()))) (if (null? body1467) (syntax-error outer-form1459 "no expressions in body") (let ((e1474 (cdar body1467)) (er1475 (caar body1467))) (call-with-values (lambda () (syntax-type1150 e1474 er1475 (quote (())) #f ribcage1464 mod1462)) (lambda (type1476 value1477 e1478 w1479 s1480 mod1481) (let ((t1482 type1476)) (if (memv t1482 (quote (define-form))) (let ((id1483 (wrap1144 value1477 w1479 mod1481)) (label1484 (gen-label1121))) (let ((var1485 (gen-var1164 id1483))) (begin (extend-ribcage!1132 ribcage1464 id1483 label1484) (parse1466 (cdr body1467) (cons id1483 ids1468) (cons label1484 labels1469) (cons var1485 vars1470) (cons (cons er1475 (wrap1144 e1478 w1479 mod1481)) vals1471) (cons (cons (quote lexical) var1485) bindings1472))))) (if (memv t1482 (quote (define-syntax-form))) (let ((id1486 (wrap1144 value1477 w1479 mod1481)) (label1487 (gen-label1121))) (begin (extend-ribcage!1132 ribcage1464 id1486 label1487) (parse1466 (cdr body1467) (cons id1486 ids1468) (cons label1487 labels1469) vars1470 vals1471 (cons (cons (quote macro) (cons er1475 (wrap1144 e1478 w1479 mod1481))) bindings1472)))) (if (memv t1482 (quote (begin-form))) ((lambda (tmp1488) ((lambda (tmp1489) (if tmp1489 (apply (lambda (_1490 e11491) (parse1466 (let f1492 ((forms1493 e11491)) (if (null? forms1493) (cdr body1467) (cons (cons er1475 (wrap1144 (car forms1493) w1479 mod1481)) (f1492 (cdr forms1493))))) ids1468 labels1469 vars1470 vals1471 bindings1472)) tmp1489) (syntax-error tmp1488))) (syntax-dispatch tmp1488 (quote (any . each-any))))) e1478) (if (memv t1482 (quote (local-syntax-form))) (chi-local-syntax1158 value1477 e1478 er1475 w1479 s1480 mod1481 (lambda (forms1495 er1496 w1497 s1498 mod1499) (parse1466 (let f1500 ((forms1501 forms1495)) (if (null? forms1501) (cdr body1467) (cons (cons er1496 (wrap1144 (car forms1501) w1497 mod1499)) (f1500 (cdr forms1501))))) ids1468 labels1469 vars1470 vals1471 bindings1472))) (if (null? ids1468) (build-sequence1095 #f (map (lambda (x1502) (chi1152 (cdr x1502) (car x1502) (quote (())) mod1481)) (cons (cons er1475 (source-wrap1145 e1478 w1479 s1480 mod1481)) (cdr body1467)))) (begin (if (not (valid-bound-ids?1141 ids1468)) (syntax-error outer-form1459 "invalid or duplicate identifier in definition")) (let loop1503 ((bs1504 bindings1472) (er-cache1505 #f) (r-cache1506 #f)) (if (not (null? bs1504)) (let ((b1507 (car bs1504))) (if (eq? (car b1507) (quote macro)) (let ((er1508 (cadr b1507))) (let ((r-cache1509 (if (eq? er1508 er-cache1505) r-cache1506 (macros-only-env1112 er1508)))) (begin (set-cdr! b1507 (eval-local-transformer1159 (chi1152 (cddr b1507) r-cache1509 (quote (())) mod1481) mod1481)) (loop1503 (cdr bs1504) er1508 r-cache1509)))) (loop1503 (cdr bs1504) er-cache1505 r-cache1506))))) (set-cdr! r1463 (extend-env1110 labels1469 bindings1472 (cdr r1463))) (build-letrec1098 #f vars1470 (map (lambda (x1510) (chi1152 (cdr x1510) (car x1510) (quote (())) mod1481)) vals1471) (build-sequence1095 #f (map (lambda (x1511) (chi1152 (cdr x1511) (car x1511) (quote (())) mod1481)) (cons (cons er1475 (source-wrap1145 e1478 w1479 s1480 mod1481)) (cdr body1467)))))))))))))))))))))) (chi-macro1155 (lambda (p1512 e1513 r1514 w1515 rib1516 mod1517) (letrec ((rebuild-macro-output1518 (lambda (x1519 m1520) (cond ((pair? x1519) (cons (rebuild-macro-output1518 (car x1519) m1520) (rebuild-macro-output1518 (cdr x1519) m1520))) ((syntax-object?1100 x1519) (let ((w1521 (syntax-object-wrap1102 x1519))) (let ((ms1522 (wrap-marks1119 w1521)) (s1523 (wrap-subst1120 w1521))) (if (and (pair? ms1522) (eq? (car ms1522) #f)) (make-syntax-object1099 (syntax-object-expression1101 x1519) (make-wrap1118 (cdr ms1522) (if rib1516 (cons rib1516 (cdr s1523)) (cdr s1523))) (syntax-object-module1103 x1519)) (make-syntax-object1099 (syntax-object-expression1101 x1519) (make-wrap1118 (cons m1520 ms1522) (if rib1516 (cons rib1516 (cons (quote shift) s1523)) (cons (quote shift) s1523))) (let ((pmod1524 (procedure-module p1512))) (if pmod1524 (cons (quote hygiene) (module-name pmod1524)) (quote (hygiene guile))))))))) ((vector? x1519) (let ((n1525 (vector-length x1519))) (let ((v1526 (make-vector n1525))) (let doloop1527 ((i1528 0)) (if (fx=1085 i1528 n1525) v1526 (begin (vector-set! v1526 i1528 (rebuild-macro-output1518 (vector-ref x1519 i1528) m1520)) (doloop1527 (fx+1083 i1528 1)))))))) ((symbol? x1519) (syntax-error x1519 "encountered raw symbol in macro output")) (else x1519))))) (rebuild-macro-output1518 (p1512 (wrap1144 e1513 (anti-mark1131 w1515) mod1517)) (string #\m))))) (chi-application1154 (lambda (x1529 e1530 r1531 w1532 s1533 mod1534) ((lambda (tmp1535) ((lambda (tmp1536) (if tmp1536 (apply (lambda (e01537 e11538) (build-annotated1093 s1533 (cons x1529 (map (lambda (e1539) (chi1152 e1539 r1531 w1532 mod1534)) e11538)))) tmp1536) (syntax-error tmp1535))) (syntax-dispatch tmp1535 (quote (any . each-any))))) e1530))) (chi-expr1153 (lambda (type1541 value1542 e1543 r1544 w1545 s1546 mod1547) (let ((t1548 type1541)) (if (memv t1548 (quote (lexical))) (build-annotated1093 s1546 value1542) (if (memv t1548 (quote (core external-macro))) (value1542 e1543 r1544 w1545 s1546 mod1547) (if (memv t1548 (quote (module-ref))) (call-with-values (lambda () (value1542 e1543)) (lambda (id1549 mod1550) (build-annotated1093 s1546 (if mod1550 (make-module-ref (cdr mod1550) id1549 (car mod1550)) (make-module-ref mod1550 id1549 (quote bare)))))) (if (memv t1548 (quote (lexical-call))) (chi-application1154 (build-annotated1093 (source-annotation1107 (car e1543)) value1542) e1543 r1544 w1545 s1546 mod1547) (if (memv t1548 (quote (global-call))) (chi-application1154 (build-annotated1093 (source-annotation1107 (car e1543)) (if (if (syntax-object?1100 (car e1543)) (syntax-object-module1103 (car e1543)) mod1547) (make-module-ref (cdr (if (syntax-object?1100 (car e1543)) (syntax-object-module1103 (car e1543)) mod1547)) value1542 (car (if (syntax-object?1100 (car e1543)) (syntax-object-module1103 (car e1543)) mod1547))) (make-module-ref (if (syntax-object?1100 (car e1543)) (syntax-object-module1103 (car e1543)) mod1547) value1542 (quote bare)))) e1543 r1544 w1545 s1546 mod1547) (if (memv t1548 (quote (constant))) (build-data1094 s1546 (strip1163 (source-wrap1145 e1543 w1545 s1546 mod1547) (quote (())))) (if (memv t1548 (quote (global))) (build-annotated1093 s1546 (if mod1547 (make-module-ref (cdr mod1547) value1542 (car mod1547)) (make-module-ref mod1547 value1542 (quote bare)))) (if (memv t1548 (quote (call))) (chi-application1154 (chi1152 (car e1543) r1544 w1545 mod1547) e1543 r1544 w1545 s1546 mod1547) (if (memv t1548 (quote (begin-form))) ((lambda (tmp1551) ((lambda (tmp1552) (if tmp1552 (apply (lambda (_1553 e11554 e21555) (chi-sequence1146 (cons e11554 e21555) r1544 w1545 s1546 mod1547)) tmp1552) (syntax-error tmp1551))) (syntax-dispatch tmp1551 (quote (any any . each-any))))) e1543) (if (memv t1548 (quote (local-syntax-form))) (chi-local-syntax1158 value1542 e1543 r1544 w1545 s1546 mod1547 chi-sequence1146) (if (memv t1548 (quote (eval-when-form))) ((lambda (tmp1557) ((lambda (tmp1558) (if tmp1558 (apply (lambda (_1559 x1560 e11561 e21562) (let ((when-list1563 (chi-when-list1149 e1543 x1560 w1545))) (if (memq (quote eval) when-list1563) (chi-sequence1146 (cons e11561 e21562) r1544 w1545 s1546 mod1547) (chi-void1160)))) tmp1558) (syntax-error tmp1557))) (syntax-dispatch tmp1557 (quote (any each-any any . each-any))))) e1543) (if (memv t1548 (quote (define-form define-syntax-form))) (syntax-error (wrap1144 value1542 w1545 mod1547) "invalid context for definition of") (if (memv t1548 (quote (syntax))) (syntax-error (source-wrap1145 e1543 w1545 s1546 mod1547) "reference to pattern variable outside syntax form") (if (memv t1548 (quote (displaced-lexical))) (syntax-error (source-wrap1145 e1543 w1545 s1546 mod1547) "reference to identifier outside its scope") (syntax-error (source-wrap1145 e1543 w1545 s1546 mod1547))))))))))))))))))) (chi1152 (lambda (e1566 r1567 w1568 mod1569) (call-with-values (lambda () (syntax-type1150 e1566 r1567 w1568 #f #f mod1569)) (lambda (type1570 value1571 e1572 w1573 s1574 mod1575) (chi-expr1153 type1570 value1571 e1572 r1567 w1573 s1574 mod1575))))) (chi-top1151 (lambda (e1576 r1577 w1578 m1579 esew1580 mod1581) (call-with-values (lambda () (syntax-type1150 e1576 r1577 w1578 #f #f mod1581)) (lambda (type1589 value1590 e1591 w1592 s1593 mod1594) (let ((t1595 type1589)) (if (memv t1595 (quote (begin-form))) ((lambda (tmp1596) ((lambda (tmp1597) (if tmp1597 (apply (lambda (_1598) (chi-void1160)) tmp1597) ((lambda (tmp1599) (if tmp1599 (apply (lambda (_1600 e11601 e21602) (chi-top-sequence1147 (cons e11601 e21602) r1577 w1592 s1593 m1579 esew1580 mod1594)) tmp1599) (syntax-error tmp1596))) (syntax-dispatch tmp1596 (quote (any any . each-any)))))) (syntax-dispatch tmp1596 (quote (any))))) e1591) (if (memv t1595 (quote (local-syntax-form))) (chi-local-syntax1158 value1590 e1591 r1577 w1592 s1593 mod1594 (lambda (body1604 r1605 w1606 s1607 mod1608) (chi-top-sequence1147 body1604 r1605 w1606 s1607 m1579 esew1580 mod1608))) (if (memv t1595 (quote (eval-when-form))) ((lambda (tmp1609) ((lambda (tmp1610) (if tmp1610 (apply (lambda (_1611 x1612 e11613 e21614) (let ((when-list1615 (chi-when-list1149 e1591 x1612 w1592)) (body1616 (cons e11613 e21614))) (cond ((eq? m1579 (quote e)) (if (memq (quote eval) when-list1615) (chi-top-sequence1147 body1616 r1577 w1592 s1593 (quote e) (quote (eval)) mod1594) (chi-void1160))) ((memq (quote load) when-list1615) (if (or (memq (quote compile) when-list1615) (and (eq? m1579 (quote c&e)) (memq (quote eval) when-list1615))) (chi-top-sequence1147 body1616 r1577 w1592 s1593 (quote c&e) (quote (compile load)) mod1594) (if (memq m1579 (quote (c c&e))) (chi-top-sequence1147 body1616 r1577 w1592 s1593 (quote c) (quote (load)) mod1594) (chi-void1160)))) ((or (memq (quote compile) when-list1615) (and (eq? m1579 (quote c&e)) (memq (quote eval) when-list1615))) (top-level-eval-hook1087 (chi-top-sequence1147 body1616 r1577 w1592 s1593 (quote e) (quote (eval)) mod1594) mod1594) (chi-void1160)) (else (chi-void1160))))) tmp1610) (syntax-error tmp1609))) (syntax-dispatch tmp1609 (quote (any each-any any . each-any))))) e1591) (if (memv t1595 (quote (define-syntax-form))) (let ((n1619 (id-var-name1138 value1590 w1592)) (r1620 (macros-only-env1112 r1577))) (let ((t1621 m1579)) (if (memv t1621 (quote (c))) (if (memq (quote compile) esew1580) (let ((e1622 (chi-install-global1148 n1619 (chi1152 e1591 r1620 w1592 mod1594)))) (begin (top-level-eval-hook1087 e1622 mod1594) (if (memq (quote load) esew1580) e1622 (chi-void1160)))) (if (memq (quote load) esew1580) (chi-install-global1148 n1619 (chi1152 e1591 r1620 w1592 mod1594)) (chi-void1160))) (if (memv t1621 (quote (c&e))) (let ((e1623 (chi-install-global1148 n1619 (chi1152 e1591 r1620 w1592 mod1594)))) (begin (top-level-eval-hook1087 e1623 mod1594) e1623)) (begin (if (memq (quote eval) esew1580) (top-level-eval-hook1087 (chi-install-global1148 n1619 (chi1152 e1591 r1620 w1592 mod1594)) mod1594)) (chi-void1160)))))) (if (memv t1595 (quote (define-form))) (let ((n1624 (id-var-name1138 value1590 w1592))) (let ((type1625 (binding-type1108 (lookup1113 n1624 r1577 mod1594)))) (let ((t1626 type1625)) (if (memv t1626 (quote (global))) (let ((x1627 (build-annotated1093 s1593 (list (quote define) n1624 (chi1152 e1591 r1577 w1592 mod1594))))) (begin (if (eq? m1579 (quote c&e)) (top-level-eval-hook1087 x1627 mod1594)) x1627)) (if (memv t1626 (quote (displaced-lexical))) (syntax-error (wrap1144 value1590 w1592 mod1594) "identifier out of context") (if (memv t1626 (quote (core macro module-ref))) (begin (remove-global-definition-hook1091 n1624) (let ((x1628 (build-annotated1093 s1593 (list (quote define) n1624 (chi1152 e1591 r1577 w1592 mod1594))))) (begin (if (eq? m1579 (quote c&e)) (top-level-eval-hook1087 x1628 mod1594)) x1628))) (syntax-error (wrap1144 value1590 w1592 mod1594) "cannot define keyword at top level"))))))) (let ((x1629 (chi-expr1153 type1589 value1590 e1591 r1577 w1592 s1593 mod1594))) (begin (if (eq? m1579 (quote c&e)) (top-level-eval-hook1087 x1629 mod1594)) x1629)))))))))))) (syntax-type1150 (lambda (e1630 r1631 w1632 s1633 rib1634 mod1635) (cond ((symbol? e1630) (let ((n1636 (id-var-name1138 e1630 w1632))) (let ((b1637 (lookup1113 n1636 r1631 mod1635))) (let ((type1638 (binding-type1108 b1637))) (let ((t1639 type1638)) (if (memv t1639 (quote (lexical))) (values type1638 (binding-value1109 b1637) e1630 w1632 s1633 mod1635) (if (memv t1639 (quote (global))) (values type1638 n1636 e1630 w1632 s1633 mod1635) (if (memv t1639 (quote (macro))) (syntax-type1150 (chi-macro1155 (binding-value1109 b1637) e1630 r1631 w1632 rib1634 mod1635) r1631 (quote (())) s1633 rib1634 mod1635) (values type1638 (binding-value1109 b1637) e1630 w1632 s1633 mod1635))))))))) ((pair? e1630) (let ((first1640 (car e1630))) (if (id?1116 first1640) (let ((n1641 (id-var-name1138 first1640 w1632))) (let ((b1642 (lookup1113 n1641 r1631 (or (and (syntax-object?1100 first1640) (syntax-object-module1103 first1640)) mod1635)))) (let ((type1643 (binding-type1108 b1642))) (let ((t1644 type1643)) (if (memv t1644 (quote (lexical))) (values (quote lexical-call) (binding-value1109 b1642) e1630 w1632 s1633 mod1635) (if (memv t1644 (quote (global))) (values (quote global-call) n1641 e1630 w1632 s1633 mod1635) (if (memv t1644 (quote (macro))) (syntax-type1150 (chi-macro1155 (binding-value1109 b1642) e1630 r1631 w1632 rib1634 mod1635) r1631 (quote (())) s1633 rib1634 mod1635) (if (memv t1644 (quote (core external-macro module-ref))) (values type1643 (binding-value1109 b1642) e1630 w1632 s1633 mod1635) (if (memv t1644 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1109 b1642) e1630 w1632 s1633 mod1635) (if (memv t1644 (quote (begin))) (values (quote begin-form) #f e1630 w1632 s1633 mod1635) (if (memv t1644 (quote (eval-when))) (values (quote eval-when-form) #f e1630 w1632 s1633 mod1635) (if (memv t1644 (quote (define))) ((lambda (tmp1645) ((lambda (tmp1646) (if (if tmp1646 (apply (lambda (_1647 name1648 val1649) (id?1116 name1648)) tmp1646) #f) (apply (lambda (_1650 name1651 val1652) (values (quote define-form) name1651 val1652 w1632 s1633 mod1635)) tmp1646) ((lambda (tmp1653) (if (if tmp1653 (apply (lambda (_1654 name1655 args1656 e11657 e21658) (and (id?1116 name1655) (valid-bound-ids?1141 (lambda-var-list1165 args1656)))) tmp1653) #f) (apply (lambda (_1659 name1660 args1661 e11662 e21663) (values (quote define-form) (wrap1144 name1660 w1632 mod1635) (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1144 (cons args1661 (cons e11662 e21663)) w1632 mod1635)) (quote (())) s1633 mod1635)) tmp1653) ((lambda (tmp1665) (if (if tmp1665 (apply (lambda (_1666 name1667) (id?1116 name1667)) tmp1665) #f) (apply (lambda (_1668 name1669) (values (quote define-form) (wrap1144 name1669 w1632 mod1635) (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1633 mod1635)) tmp1665) (syntax-error tmp1645))) (syntax-dispatch tmp1645 (quote (any any)))))) (syntax-dispatch tmp1645 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1645 (quote (any any any))))) e1630) (if (memv t1644 (quote (define-syntax))) ((lambda (tmp1670) ((lambda (tmp1671) (if (if tmp1671 (apply (lambda (_1672 name1673 val1674) (id?1116 name1673)) tmp1671) #f) (apply (lambda (_1675 name1676 val1677) (values (quote define-syntax-form) name1676 val1677 w1632 s1633 mod1635)) tmp1671) (syntax-error tmp1670))) (syntax-dispatch tmp1670 (quote (any any any))))) e1630) (values (quote call) #f e1630 w1632 s1633 mod1635)))))))))))))) (values (quote call) #f e1630 w1632 s1633 mod1635)))) ((syntax-object?1100 e1630) (syntax-type1150 (syntax-object-expression1101 e1630) r1631 (join-wraps1135 w1632 (syntax-object-wrap1102 e1630)) #f rib1634 (or (syntax-object-module1103 e1630) mod1635))) ((annotation? e1630) (syntax-type1150 (annotation-expression e1630) r1631 w1632 (annotation-source e1630) rib1634 mod1635)) ((self-evaluating? e1630) (values (quote constant) #f e1630 w1632 s1633 mod1635)) (else (values (quote other) #f e1630 w1632 s1633 mod1635))))) (chi-when-list1149 (lambda (e1678 when-list1679 w1680) (let f1681 ((when-list1682 when-list1679) (situations1683 (quote ()))) (if (null? when-list1682) situations1683 (f1681 (cdr when-list1682) (cons (let ((x1684 (car when-list1682))) (cond ((free-id=?1139 x1684 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1139 x1684 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1139 x1684 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-error (wrap1144 x1684 w1680 #f) "invalid eval-when situation")))) situations1683)))))) (chi-install-global1148 (lambda (name1685 e1686) (build-annotated1093 #f (list (build-annotated1093 #f (quote install-global-transformer)) (build-data1094 #f name1685) e1686)))) (chi-top-sequence1147 (lambda (body1687 r1688 w1689 s1690 m1691 esew1692 mod1693) (build-sequence1095 s1690 (let dobody1694 ((body1695 body1687) (r1696 r1688) (w1697 w1689) (m1698 m1691) (esew1699 esew1692) (mod1700 mod1693)) (if (null? body1695) (quote ()) (let ((first1701 (chi-top1151 (car body1695) r1696 w1697 m1698 esew1699 mod1700))) (cons first1701 (dobody1694 (cdr body1695) r1696 w1697 m1698 esew1699 mod1700)))))))) (chi-sequence1146 (lambda (body1702 r1703 w1704 s1705 mod1706) (build-sequence1095 s1705 (let dobody1707 ((body1708 body1702) (r1709 r1703) (w1710 w1704) (mod1711 mod1706)) (if (null? body1708) (quote ()) (let ((first1712 (chi1152 (car body1708) r1709 w1710 mod1711))) (cons first1712 (dobody1707 (cdr body1708) r1709 w1710 mod1711)))))))) (source-wrap1145 (lambda (x1713 w1714 s1715 defmod1716) (wrap1144 (if s1715 (make-annotation x1713 s1715 #f) x1713) w1714 defmod1716))) (wrap1144 (lambda (x1717 w1718 defmod1719) (cond ((and (null? (wrap-marks1119 w1718)) (null? (wrap-subst1120 w1718))) x1717) ((syntax-object?1100 x1717) (make-syntax-object1099 (syntax-object-expression1101 x1717) (join-wraps1135 w1718 (syntax-object-wrap1102 x1717)) (syntax-object-module1103 x1717))) ((null? x1717) x1717) (else (make-syntax-object1099 x1717 w1718 defmod1719))))) (bound-id-member?1143 (lambda (x1720 list1721) (and (not (null? list1721)) (or (bound-id=?1140 x1720 (car list1721)) (bound-id-member?1143 x1720 (cdr list1721)))))) (distinct-bound-ids?1142 (lambda (ids1722) (let distinct?1723 ((ids1724 ids1722)) (or (null? ids1724) (and (not (bound-id-member?1143 (car ids1724) (cdr ids1724))) (distinct?1723 (cdr ids1724))))))) (valid-bound-ids?1141 (lambda (ids1725) (and (let all-ids?1726 ((ids1727 ids1725)) (or (null? ids1727) (and (id?1116 (car ids1727)) (all-ids?1726 (cdr ids1727))))) (distinct-bound-ids?1142 ids1725)))) (bound-id=?1140 (lambda (i1728 j1729) (if (and (syntax-object?1100 i1728) (syntax-object?1100 j1729)) (and (eq? (let ((e1730 (syntax-object-expression1101 i1728))) (if (annotation? e1730) (annotation-expression e1730) e1730)) (let ((e1731 (syntax-object-expression1101 j1729))) (if (annotation? e1731) (annotation-expression e1731) e1731))) (same-marks?1137 (wrap-marks1119 (syntax-object-wrap1102 i1728)) (wrap-marks1119 (syntax-object-wrap1102 j1729)))) (eq? (let ((e1732 i1728)) (if (annotation? e1732) (annotation-expression e1732) e1732)) (let ((e1733 j1729)) (if (annotation? e1733) (annotation-expression e1733) e1733)))))) (free-id=?1139 (lambda (i1734 j1735) (and (eq? (let ((x1736 i1734)) (let ((e1737 (if (syntax-object?1100 x1736) (syntax-object-expression1101 x1736) x1736))) (if (annotation? e1737) (annotation-expression e1737) e1737))) (let ((x1738 j1735)) (let ((e1739 (if (syntax-object?1100 x1738) (syntax-object-expression1101 x1738) x1738))) (if (annotation? e1739) (annotation-expression e1739) e1739)))) (eq? (id-var-name1138 i1734 (quote (()))) (id-var-name1138 j1735 (quote (()))))))) (id-var-name1138 (lambda (id1740 w1741) (letrec ((search-vector-rib1744 (lambda (sym1750 subst1751 marks1752 symnames1753 ribcage1754) (let ((n1755 (vector-length symnames1753))) (let f1756 ((i1757 0)) (cond ((fx=1085 i1757 n1755) (search1742 sym1750 (cdr subst1751) marks1752)) ((and (eq? (vector-ref symnames1753 i1757) sym1750) (same-marks?1137 marks1752 (vector-ref (ribcage-marks1126 ribcage1754) i1757))) (values (vector-ref (ribcage-labels1127 ribcage1754) i1757) marks1752)) (else (f1756 (fx+1083 i1757 1)))))))) (search-list-rib1743 (lambda (sym1758 subst1759 marks1760 symnames1761 ribcage1762) (let f1763 ((symnames1764 symnames1761) (i1765 0)) (cond ((null? symnames1764) (search1742 sym1758 (cdr subst1759) marks1760)) ((and (eq? (car symnames1764) sym1758) (same-marks?1137 marks1760 (list-ref (ribcage-marks1126 ribcage1762) i1765))) (values (list-ref (ribcage-labels1127 ribcage1762) i1765) marks1760)) (else (f1763 (cdr symnames1764) (fx+1083 i1765 1))))))) (search1742 (lambda (sym1766 subst1767 marks1768) (if (null? subst1767) (values #f marks1768) (let ((fst1769 (car subst1767))) (if (eq? fst1769 (quote shift)) (search1742 sym1766 (cdr subst1767) (cdr marks1768)) (let ((symnames1770 (ribcage-symnames1125 fst1769))) (if (vector? symnames1770) (search-vector-rib1744 sym1766 subst1767 marks1768 symnames1770 fst1769) (search-list-rib1743 sym1766 subst1767 marks1768 symnames1770 fst1769))))))))) (cond ((symbol? id1740) (or (call-with-values (lambda () (search1742 id1740 (wrap-subst1120 w1741) (wrap-marks1119 w1741))) (lambda (x1772 . ignore1771) x1772)) id1740)) ((syntax-object?1100 id1740) (let ((id1773 (let ((e1775 (syntax-object-expression1101 id1740))) (if (annotation? e1775) (annotation-expression e1775) e1775))) (w11774 (syntax-object-wrap1102 id1740))) (let ((marks1776 (join-marks1136 (wrap-marks1119 w1741) (wrap-marks1119 w11774)))) (call-with-values (lambda () (search1742 id1773 (wrap-subst1120 w1741) marks1776)) (lambda (new-id1777 marks1778) (or new-id1777 (call-with-values (lambda () (search1742 id1773 (wrap-subst1120 w11774) marks1778)) (lambda (x1780 . ignore1779) x1780)) id1773)))))) ((annotation? id1740) (let ((id1781 (let ((e1782 id1740)) (if (annotation? e1782) (annotation-expression e1782) e1782)))) (or (call-with-values (lambda () (search1742 id1781 (wrap-subst1120 w1741) (wrap-marks1119 w1741))) (lambda (x1784 . ignore1783) x1784)) id1781))) (else (error-hook1089 (quote id-var-name) "invalid id" id1740)))))) (same-marks?1137 (lambda (x1785 y1786) (or (eq? x1785 y1786) (and (not (null? x1785)) (not (null? y1786)) (eq? (car x1785) (car y1786)) (same-marks?1137 (cdr x1785) (cdr y1786)))))) (join-marks1136 (lambda (m11787 m21788) (smart-append1134 m11787 m21788))) (join-wraps1135 (lambda (w11789 w21790) (let ((m11791 (wrap-marks1119 w11789)) (s11792 (wrap-subst1120 w11789))) (if (null? m11791) (if (null? s11792) w21790 (make-wrap1118 (wrap-marks1119 w21790) (smart-append1134 s11792 (wrap-subst1120 w21790)))) (make-wrap1118 (smart-append1134 m11791 (wrap-marks1119 w21790)) (smart-append1134 s11792 (wrap-subst1120 w21790))))))) (smart-append1134 (lambda (m11793 m21794) (if (null? m21794) m11793 (append m11793 m21794)))) (make-binding-wrap1133 (lambda (ids1795 labels1796 w1797) (if (null? ids1795) w1797 (make-wrap1118 (wrap-marks1119 w1797) (cons (let ((labelvec1798 (list->vector labels1796))) (let ((n1799 (vector-length labelvec1798))) (let ((symnamevec1800 (make-vector n1799)) (marksvec1801 (make-vector n1799))) (begin (let f1802 ((ids1803 ids1795) (i1804 0)) (if (not (null? ids1803)) (call-with-values (lambda () (id-sym-name&marks1117 (car ids1803) w1797)) (lambda (symname1805 marks1806) (begin (vector-set! symnamevec1800 i1804 symname1805) (vector-set! marksvec1801 i1804 marks1806) (f1802 (cdr ids1803) (fx+1083 i1804 1))))))) (make-ribcage1123 symnamevec1800 marksvec1801 labelvec1798))))) (wrap-subst1120 w1797)))))) (extend-ribcage!1132 (lambda (ribcage1807 id1808 label1809) (begin (set-ribcage-symnames!1128 ribcage1807 (cons (let ((e1810 (syntax-object-expression1101 id1808))) (if (annotation? e1810) (annotation-expression e1810) e1810)) (ribcage-symnames1125 ribcage1807))) (set-ribcage-marks!1129 ribcage1807 (cons (wrap-marks1119 (syntax-object-wrap1102 id1808)) (ribcage-marks1126 ribcage1807))) (set-ribcage-labels!1130 ribcage1807 (cons label1809 (ribcage-labels1127 ribcage1807)))))) (anti-mark1131 (lambda (w1811) (make-wrap1118 (cons #f (wrap-marks1119 w1811)) (cons (quote shift) (wrap-subst1120 w1811))))) (set-ribcage-labels!1130 (lambda (x1812 update1813) (vector-set! x1812 3 update1813))) (set-ribcage-marks!1129 (lambda (x1814 update1815) (vector-set! x1814 2 update1815))) (set-ribcage-symnames!1128 (lambda (x1816 update1817) (vector-set! x1816 1 update1817))) (ribcage-labels1127 (lambda (x1818) (vector-ref x1818 3))) (ribcage-marks1126 (lambda (x1819) (vector-ref x1819 2))) (ribcage-symnames1125 (lambda (x1820) (vector-ref x1820 1))) (ribcage?1124 (lambda (x1821) (and (vector? x1821) (= (vector-length x1821) 4) (eq? (vector-ref x1821 0) (quote ribcage))))) (make-ribcage1123 (lambda (symnames1822 marks1823 labels1824) (vector (quote ribcage) symnames1822 marks1823 labels1824))) (gen-labels1122 (lambda (ls1825) (if (null? ls1825) (quote ()) (cons (gen-label1121) (gen-labels1122 (cdr ls1825)))))) (gen-label1121 (lambda () (string #\i))) (wrap-subst1120 cdr) (wrap-marks1119 car) (make-wrap1118 cons) (id-sym-name&marks1117 (lambda (x1826 w1827) (if (syntax-object?1100 x1826) (values (let ((e1828 (syntax-object-expression1101 x1826))) (if (annotation? e1828) (annotation-expression e1828) e1828)) (join-marks1136 (wrap-marks1119 w1827) (wrap-marks1119 (syntax-object-wrap1102 x1826)))) (values (let ((e1829 x1826)) (if (annotation? e1829) (annotation-expression e1829) e1829)) (wrap-marks1119 w1827))))) (id?1116 (lambda (x1830) (cond ((symbol? x1830) #t) ((syntax-object?1100 x1830) (symbol? (let ((e1831 (syntax-object-expression1101 x1830))) (if (annotation? e1831) (annotation-expression e1831) e1831)))) ((annotation? x1830) (symbol? (annotation-expression x1830))) (else #f)))) (nonsymbol-id?1115 (lambda (x1832) (and (syntax-object?1100 x1832) (symbol? (let ((e1833 (syntax-object-expression1101 x1832))) (if (annotation? e1833) (annotation-expression e1833) e1833)))))) (global-extend1114 (lambda (type1834 sym1835 val1836) (put-global-definition-hook1090 sym1835 type1834 val1836))) (lookup1113 (lambda (x1837 r1838 mod1839) (cond ((assq x1837 r1838) => cdr) ((symbol? x1837) (or (get-global-definition-hook1092 x1837 mod1839) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1112 (lambda (r1840) (if (null? r1840) (quote ()) (let ((a1841 (car r1840))) (if (eq? (cadr a1841) (quote macro)) (cons a1841 (macros-only-env1112 (cdr r1840))) (macros-only-env1112 (cdr r1840))))))) (extend-var-env1111 (lambda (labels1842 vars1843 r1844) (if (null? labels1842) r1844 (extend-var-env1111 (cdr labels1842) (cdr vars1843) (cons (cons (car labels1842) (cons (quote lexical) (car vars1843))) r1844))))) (extend-env1110 (lambda (labels1845 bindings1846 r1847) (if (null? labels1845) r1847 (extend-env1110 (cdr labels1845) (cdr bindings1846) (cons (cons (car labels1845) (car bindings1846)) r1847))))) (binding-value1109 cdr) (binding-type1108 car) (source-annotation1107 (lambda (x1848) (cond ((annotation? x1848) (annotation-source x1848)) ((syntax-object?1100 x1848) (source-annotation1107 (syntax-object-expression1101 x1848))) (else #f)))) (set-syntax-object-module!1106 (lambda (x1849 update1850) (vector-set! x1849 3 update1850))) (set-syntax-object-wrap!1105 (lambda (x1851 update1852) (vector-set! x1851 2 update1852))) (set-syntax-object-expression!1104 (lambda (x1853 update1854) (vector-set! x1853 1 update1854))) (syntax-object-module1103 (lambda (x1855) (vector-ref x1855 3))) (syntax-object-wrap1102 (lambda (x1856) (vector-ref x1856 2))) (syntax-object-expression1101 (lambda (x1857) (vector-ref x1857 1))) (syntax-object?1100 (lambda (x1858) (and (vector? x1858) (= (vector-length x1858) 4) (eq? (vector-ref x1858 0) (quote syntax-object))))) (make-syntax-object1099 (lambda (expression1859 wrap1860 module1861) (vector (quote syntax-object) expression1859 wrap1860 module1861))) (build-letrec1098 (lambda (src1862 vars1863 val-exps1864 body-exp1865) (if (null? vars1863) (build-annotated1093 src1862 body-exp1865) (build-annotated1093 src1862 (list (quote letrec) (map list vars1863 val-exps1864) body-exp1865))))) (build-named-let1097 (lambda (src1866 vars1867 val-exps1868 body-exp1869) (if (null? vars1867) (build-annotated1093 src1866 body-exp1869) (build-annotated1093 src1866 (list (quote let) (car vars1867) (map list (cdr vars1867) val-exps1868) body-exp1869))))) (build-let1096 (lambda (src1870 vars1871 val-exps1872 body-exp1873) (if (null? vars1871) (build-annotated1093 src1870 body-exp1873) (build-annotated1093 src1870 (list (quote let) (map list vars1871 val-exps1872) body-exp1873))))) (build-sequence1095 (lambda (src1874 exps1875) (if (null? (cdr exps1875)) (build-annotated1093 src1874 (car exps1875)) (build-annotated1093 src1874 (cons (quote begin) exps1875))))) (build-data1094 (lambda (src1876 exp1877) (if (and (self-evaluating? exp1877) (not (vector? exp1877))) (build-annotated1093 src1876 exp1877) (build-annotated1093 src1876 (list (quote quote) exp1877))))) (build-annotated1093 (lambda (src1878 exp1879) (if (and src1878 (not (annotation? exp1879))) (make-annotation exp1879 src1878 #t) exp1879))) (get-global-definition-hook1092 (lambda (symbol1880 module1881) (let ((module1882 (if module1881 (resolve-module (cdr module1881)) (let ((mod1883 (current-module))) (begin (if mod1883 (warn "wha" symbol1880)) mod1883))))) (let ((v1884 (module-variable module1882 symbol1880))) (and v1884 (object-property v1884 (quote *sc-expander*))))))) (remove-global-definition-hook1091 (lambda (symbol1885) (let ((module1886 (current-module))) (let ((v1887 (module-local-variable module1886 symbol1885))) (if v1887 (let ((p1888 (assq (quote *sc-expander*) (object-properties v1887)))) (set-object-properties! v1887 (delq p1888 (object-properties v1887))))))))) (put-global-definition-hook1090 (lambda (symbol1889 type1890 val1891) (let ((module1892 (current-module))) (let ((v1893 (or (module-variable module1892 symbol1889) (let ((v1894 (make-variable val1891))) (begin (module-add! module1892 symbol1889 v1894) v1894))))) (begin (if (not (variable-bound? v1893)) (variable-set! v1893 val1891)) (set-object-property! v1893 (quote *sc-expander*) (cons type1890 val1891))))))) (error-hook1089 (lambda (who1895 why1896 what1897) (error who1895 "~a ~s" why1896 what1897))) (local-eval-hook1088 (lambda (x1898 mod1899) (primitive-eval (list noexpand1082 x1898)))) (top-level-eval-hook1087 (lambda (x1900 mod1901) (primitive-eval (list noexpand1082 x1900)))) (fx<1086 <) (fx=1085 =) (fx-1084 -) (fx+1083 +) (noexpand1082 "noexpand")) (begin (global-extend1114 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1114 (quote local-syntax) (quote let-syntax) #f) (global-extend1114 (quote core) (quote fluid-let-syntax) (lambda (e1902 r1903 w1904 s1905 mod1906) ((lambda (tmp1907) ((lambda (tmp1908) (if (if tmp1908 (apply (lambda (_1909 var1910 val1911 e11912 e21913) (valid-bound-ids?1141 var1910)) tmp1908) #f) (apply (lambda (_1915 var1916 val1917 e11918 e21919) (let ((names1920 (map (lambda (x1921) (id-var-name1138 x1921 w1904)) var1916))) (begin (for-each (lambda (id1923 n1924) (let ((t1925 (binding-type1108 (lookup1113 n1924 r1903 mod1906)))) (if (memv t1925 (quote (displaced-lexical))) (syntax-error (source-wrap1145 id1923 w1904 s1905 mod1906) "identifier out of context")))) var1916 names1920) (chi-body1156 (cons e11918 e21919) (source-wrap1145 e1902 w1904 s1905 mod1906) (extend-env1110 names1920 (let ((trans-r1928 (macros-only-env1112 r1903))) (map (lambda (x1929) (cons (quote macro) (eval-local-transformer1159 (chi1152 x1929 trans-r1928 w1904 mod1906) mod1906))) val1917)) r1903) w1904 mod1906)))) tmp1908) ((lambda (_1931) (syntax-error (source-wrap1145 e1902 w1904 s1905 mod1906))) tmp1907))) (syntax-dispatch tmp1907 (quote (any #(each (any any)) any . each-any))))) e1902))) (global-extend1114 (quote core) (quote quote) (lambda (e1932 r1933 w1934 s1935 mod1936) ((lambda (tmp1937) ((lambda (tmp1938) (if tmp1938 (apply (lambda (_1939 e1940) (build-data1094 s1935 (strip1163 e1940 w1934))) tmp1938) ((lambda (_1941) (syntax-error (source-wrap1145 e1932 w1934 s1935 mod1936))) tmp1937))) (syntax-dispatch tmp1937 (quote (any any))))) e1932))) (global-extend1114 (quote core) (quote syntax) (letrec ((regen1949 (lambda (x1950) (let ((t1951 (car x1950))) (if (memv t1951 (quote (ref))) (build-annotated1093 #f (cadr x1950)) (if (memv t1951 (quote (primitive))) (build-annotated1093 #f (cadr x1950)) (if (memv t1951 (quote (quote))) (build-data1094 #f (cadr x1950)) (if (memv t1951 (quote (lambda))) (build-annotated1093 #f (list (quote lambda) (cadr x1950) (regen1949 (caddr x1950)))) (if (memv t1951 (quote (map))) (let ((ls1952 (map regen1949 (cdr x1950)))) (build-annotated1093 #f (cons (if (fx=1085 (length ls1952) 2) (build-annotated1093 #f (quote map)) (build-annotated1093 #f (quote map))) ls1952))) (build-annotated1093 #f (cons (build-annotated1093 #f (car x1950)) (map regen1949 (cdr x1950)))))))))))) (gen-vector1948 (lambda (x1953) (cond ((eq? (car x1953) (quote list)) (cons (quote vector) (cdr x1953))) ((eq? (car x1953) (quote quote)) (list (quote quote) (list->vector (cadr x1953)))) (else (list (quote list->vector) x1953))))) (gen-append1947 (lambda (x1954 y1955) (if (equal? y1955 (quote (quote ()))) x1954 (list (quote append) x1954 y1955)))) (gen-cons1946 (lambda (x1956 y1957) (let ((t1958 (car y1957))) (if (memv t1958 (quote (quote))) (if (eq? (car x1956) (quote quote)) (list (quote quote) (cons (cadr x1956) (cadr y1957))) (if (eq? (cadr y1957) (quote ())) (list (quote list) x1956) (list (quote cons) x1956 y1957))) (if (memv t1958 (quote (list))) (cons (quote list) (cons x1956 (cdr y1957))) (list (quote cons) x1956 y1957)))))) (gen-map1945 (lambda (e1959 map-env1960) (let ((formals1961 (map cdr map-env1960)) (actuals1962 (map (lambda (x1963) (list (quote ref) (car x1963))) map-env1960))) (cond ((eq? (car e1959) (quote ref)) (car actuals1962)) ((andmap (lambda (x1964) (and (eq? (car x1964) (quote ref)) (memq (cadr x1964) formals1961))) (cdr e1959)) (cons (quote map) (cons (list (quote primitive) (car e1959)) (map (let ((r1965 (map cons formals1961 actuals1962))) (lambda (x1966) (cdr (assq (cadr x1966) r1965)))) (cdr e1959))))) (else (cons (quote map) (cons (list (quote lambda) formals1961 e1959) actuals1962))))))) (gen-mappend1944 (lambda (e1967 map-env1968) (list (quote apply) (quote (primitive append)) (gen-map1945 e1967 map-env1968)))) (gen-ref1943 (lambda (src1969 var1970 level1971 maps1972) (if (fx=1085 level1971 0) (values var1970 maps1972) (if (null? maps1972) (syntax-error src1969 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1943 src1969 var1970 (fx-1084 level1971 1) (cdr maps1972))) (lambda (outer-var1973 outer-maps1974) (let ((b1975 (assq outer-var1973 (car maps1972)))) (if b1975 (values (cdr b1975) maps1972) (let ((inner-var1976 (gen-var1164 (quote tmp)))) (values inner-var1976 (cons (cons (cons outer-var1973 inner-var1976) (car maps1972)) outer-maps1974))))))))))) (gen-syntax1942 (lambda (src1977 e1978 r1979 maps1980 ellipsis?1981 mod1982) (if (id?1116 e1978) (let ((label1983 (id-var-name1138 e1978 (quote (()))))) (let ((b1984 (lookup1113 label1983 r1979 mod1982))) (if (eq? (binding-type1108 b1984) (quote syntax)) (call-with-values (lambda () (let ((var.lev1985 (binding-value1109 b1984))) (gen-ref1943 src1977 (car var.lev1985) (cdr var.lev1985) maps1980))) (lambda (var1986 maps1987) (values (list (quote ref) var1986) maps1987))) (if (ellipsis?1981 e1978) (syntax-error src1977 "misplaced ellipsis in syntax form") (values (list (quote quote) e1978) maps1980))))) ((lambda (tmp1988) ((lambda (tmp1989) (if (if tmp1989 (apply (lambda (dots1990 e1991) (ellipsis?1981 dots1990)) tmp1989) #f) (apply (lambda (dots1992 e1993) (gen-syntax1942 src1977 e1993 r1979 maps1980 (lambda (x1994) #f) mod1982)) tmp1989) ((lambda (tmp1995) (if (if tmp1995 (apply (lambda (x1996 dots1997 y1998) (ellipsis?1981 dots1997)) tmp1995) #f) (apply (lambda (x1999 dots2000 y2001) (let f2002 ((y2003 y2001) (k2004 (lambda (maps2005) (call-with-values (lambda () (gen-syntax1942 src1977 x1999 r1979 (cons (quote ()) maps2005) ellipsis?1981 mod1982)) (lambda (x2006 maps2007) (if (null? (car maps2007)) (syntax-error src1977 "extra ellipsis in syntax form") (values (gen-map1945 x2006 (car maps2007)) (cdr maps2007)))))))) ((lambda (tmp2008) ((lambda (tmp2009) (if (if tmp2009 (apply (lambda (dots2010 y2011) (ellipsis?1981 dots2010)) tmp2009) #f) (apply (lambda (dots2012 y2013) (f2002 y2013 (lambda (maps2014) (call-with-values (lambda () (k2004 (cons (quote ()) maps2014))) (lambda (x2015 maps2016) (if (null? (car maps2016)) (syntax-error src1977 "extra ellipsis in syntax form") (values (gen-mappend1944 x2015 (car maps2016)) (cdr maps2016)))))))) tmp2009) ((lambda (_2017) (call-with-values (lambda () (gen-syntax1942 src1977 y2003 r1979 maps1980 ellipsis?1981 mod1982)) (lambda (y2018 maps2019) (call-with-values (lambda () (k2004 maps2019)) (lambda (x2020 maps2021) (values (gen-append1947 x2020 y2018) maps2021)))))) tmp2008))) (syntax-dispatch tmp2008 (quote (any . any))))) y2003))) tmp1995) ((lambda (tmp2022) (if tmp2022 (apply (lambda (x2023 y2024) (call-with-values (lambda () (gen-syntax1942 src1977 x2023 r1979 maps1980 ellipsis?1981 mod1982)) (lambda (x2025 maps2026) (call-with-values (lambda () (gen-syntax1942 src1977 y2024 r1979 maps2026 ellipsis?1981 mod1982)) (lambda (y2027 maps2028) (values (gen-cons1946 x2025 y2027) maps2028)))))) tmp2022) ((lambda (tmp2029) (if tmp2029 (apply (lambda (e12030 e22031) (call-with-values (lambda () (gen-syntax1942 src1977 (cons e12030 e22031) r1979 maps1980 ellipsis?1981 mod1982)) (lambda (e2033 maps2034) (values (gen-vector1948 e2033) maps2034)))) tmp2029) ((lambda (_2035) (values (list (quote quote) e1978) maps1980)) tmp1988))) (syntax-dispatch tmp1988 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1988 (quote (any . any)))))) (syntax-dispatch tmp1988 (quote (any any . any)))))) (syntax-dispatch tmp1988 (quote (any any))))) e1978))))) (lambda (e2036 r2037 w2038 s2039 mod2040) (let ((e2041 (source-wrap1145 e2036 w2038 s2039 mod2040))) ((lambda (tmp2042) ((lambda (tmp2043) (if tmp2043 (apply (lambda (_2044 x2045) (call-with-values (lambda () (gen-syntax1942 e2041 x2045 r2037 (quote ()) ellipsis?1161 mod2040)) (lambda (e2046 maps2047) (regen1949 e2046)))) tmp2043) ((lambda (_2048) (syntax-error e2041)) tmp2042))) (syntax-dispatch tmp2042 (quote (any any))))) e2041))))) (global-extend1114 (quote core) (quote lambda) (lambda (e2049 r2050 w2051 s2052 mod2053) ((lambda (tmp2054) ((lambda (tmp2055) (if tmp2055 (apply (lambda (_2056 c2057) (chi-lambda-clause1157 (source-wrap1145 e2049 w2051 s2052 mod2053) #f c2057 r2050 w2051 mod2053 (lambda (vars2058 docstring2059 body2060) (build-annotated1093 s2052 (cons (quote lambda) (cons vars2058 (append (if docstring2059 (list docstring2059) (quote ())) (list body2060)))))))) tmp2055) (syntax-error tmp2054))) (syntax-dispatch tmp2054 (quote (any . any))))) e2049))) (global-extend1114 (quote core) (quote let) (letrec ((chi-let2061 (lambda (e2062 r2063 w2064 s2065 mod2066 constructor2067 ids2068 vals2069 exps2070) (if (not (valid-bound-ids?1141 ids2068)) (syntax-error e2062 "duplicate bound variable in") (let ((labels2071 (gen-labels1122 ids2068)) (new-vars2072 (map gen-var1164 ids2068))) (let ((nw2073 (make-binding-wrap1133 ids2068 labels2071 w2064)) (nr2074 (extend-var-env1111 labels2071 new-vars2072 r2063))) (constructor2067 s2065 new-vars2072 (map (lambda (x2075) (chi1152 x2075 r2063 w2064 mod2066)) vals2069) (chi-body1156 exps2070 (source-wrap1145 e2062 nw2073 s2065 mod2066) nr2074 nw2073 mod2066)))))))) (lambda (e2076 r2077 w2078 s2079 mod2080) ((lambda (tmp2081) ((lambda (tmp2082) (if tmp2082 (apply (lambda (_2083 id2084 val2085 e12086 e22087) (chi-let2061 e2076 r2077 w2078 s2079 mod2080 build-let1096 id2084 val2085 (cons e12086 e22087))) tmp2082) ((lambda (tmp2091) (if (if tmp2091 (apply (lambda (_2092 f2093 id2094 val2095 e12096 e22097) (id?1116 f2093)) tmp2091) #f) (apply (lambda (_2098 f2099 id2100 val2101 e12102 e22103) (chi-let2061 e2076 r2077 w2078 s2079 mod2080 build-named-let1097 (cons f2099 id2100) val2101 (cons e12102 e22103))) tmp2091) ((lambda (_2107) (syntax-error (source-wrap1145 e2076 w2078 s2079 mod2080))) tmp2081))) (syntax-dispatch tmp2081 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2081 (quote (any #(each (any any)) any . each-any))))) e2076)))) (global-extend1114 (quote core) (quote letrec) (lambda (e2108 r2109 w2110 s2111 mod2112) ((lambda (tmp2113) ((lambda (tmp2114) (if tmp2114 (apply (lambda (_2115 id2116 val2117 e12118 e22119) (let ((ids2120 id2116)) (if (not (valid-bound-ids?1141 ids2120)) (syntax-error e2108 "duplicate bound variable in") (let ((labels2122 (gen-labels1122 ids2120)) (new-vars2123 (map gen-var1164 ids2120))) (let ((w2124 (make-binding-wrap1133 ids2120 labels2122 w2110)) (r2125 (extend-var-env1111 labels2122 new-vars2123 r2109))) (build-letrec1098 s2111 new-vars2123 (map (lambda (x2126) (chi1152 x2126 r2125 w2124 mod2112)) val2117) (chi-body1156 (cons e12118 e22119) (source-wrap1145 e2108 w2124 s2111 mod2112) r2125 w2124 mod2112))))))) tmp2114) ((lambda (_2129) (syntax-error (source-wrap1145 e2108 w2110 s2111 mod2112))) tmp2113))) (syntax-dispatch tmp2113 (quote (any #(each (any any)) any . each-any))))) e2108))) (global-extend1114 (quote core) (quote set!) (lambda (e2130 r2131 w2132 s2133 mod2134) ((lambda (tmp2135) ((lambda (tmp2136) (if (if tmp2136 (apply (lambda (_2137 id2138 val2139) (id?1116 id2138)) tmp2136) #f) (apply (lambda (_2140 id2141 val2142) (let ((val2143 (chi1152 val2142 r2131 w2132 mod2134)) (n2144 (id-var-name1138 id2141 w2132))) (let ((b2145 (lookup1113 n2144 r2131 mod2134))) (let ((t2146 (binding-type1108 b2145))) (if (memv t2146 (quote (lexical))) (build-annotated1093 s2133 (list (quote set!) (binding-value1109 b2145) val2143)) (if (memv t2146 (quote (global))) (build-annotated1093 s2133 (list (quote set!) (if mod2134 (make-module-ref (cdr mod2134) n2144 (car mod2134)) (make-module-ref mod2134 n2144 (quote bare))) val2143)) (if (memv t2146 (quote (displaced-lexical))) (syntax-error (wrap1144 id2141 w2132 mod2134) "identifier out of context") (syntax-error (source-wrap1145 e2130 w2132 s2133 mod2134))))))))) tmp2136) ((lambda (tmp2147) (if tmp2147 (apply (lambda (_2148 head2149 tail2150 val2151) (call-with-values (lambda () (syntax-type1150 head2149 r2131 (quote (())) #f #f mod2134)) (lambda (type2152 value2153 ee2154 ww2155 ss2156 modmod2157) (let ((t2158 type2152)) (if (memv t2158 (quote (module-ref))) (let ((val2159 (chi1152 val2151 r2131 w2132 mod2134))) (call-with-values (lambda () (value2153 (cons head2149 tail2150))) (lambda (id2161 mod2162) (build-annotated1093 s2133 (list (quote set!) (if mod2162 (make-module-ref (cdr mod2162) id2161 (car mod2162)) (make-module-ref mod2162 id2161 (quote bare))) val2159))))) (build-annotated1093 s2133 (cons (chi1152 (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2149) r2131 w2132 mod2134) (map (lambda (e2163) (chi1152 e2163 r2131 w2132 mod2134)) (append tail2150 (list val2151)))))))))) tmp2147) ((lambda (_2165) (syntax-error (source-wrap1145 e2130 w2132 s2133 mod2134))) tmp2135))) (syntax-dispatch tmp2135 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2135 (quote (any any any))))) e2130))) (global-extend1114 (quote module-ref) (quote @) (lambda (e2166) ((lambda (tmp2167) ((lambda (tmp2168) (if (if tmp2168 (apply (lambda (_2169 mod2170 id2171) (and (andmap id?1116 mod2170) (id?1116 id2171))) tmp2168) #f) (apply (lambda (_2173 mod2174 id2175) (values (syntax-object->datum id2175) (syntax-object->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2174)))) tmp2168) (syntax-error tmp2167))) (syntax-dispatch tmp2167 (quote (any each-any any))))) e2166))) (global-extend1114 (quote module-ref) (quote @@) (lambda (e2177) ((lambda (tmp2178) ((lambda (tmp2179) (if (if tmp2179 (apply (lambda (_2180 mod2181 id2182) (and (andmap id?1116 mod2181) (id?1116 id2182))) tmp2179) #f) (apply (lambda (_2184 mod2185 id2186) (values (syntax-object->datum id2186) (syntax-object->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2185)))) tmp2179) (syntax-error tmp2178))) (syntax-dispatch tmp2178 (quote (any each-any any))))) e2177))) (global-extend1114 (quote begin) (quote begin) (quote ())) (global-extend1114 (quote define) (quote define) (quote ())) (global-extend1114 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1114 (quote eval-when) (quote eval-when) (quote ())) (global-extend1114 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2191 (lambda (x2192 keys2193 clauses2194 r2195 mod2196) (if (null? clauses2194) (build-annotated1093 #f (list (build-annotated1093 #f (quote syntax-error)) x2192)) ((lambda (tmp2197) ((lambda (tmp2198) (if tmp2198 (apply (lambda (pat2199 exp2200) (if (and (id?1116 pat2199) (andmap (lambda (x2201) (not (free-id=?1139 pat2199 x2201))) (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 remove-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) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2193))) (let ((labels2202 (list (gen-label1121))) (var2203 (gen-var1164 pat2199))) (build-annotated1093 #f (list (build-annotated1093 #f (list (quote lambda) (list var2203) (chi1152 exp2200 (extend-env1110 labels2202 (list (cons (quote syntax) (cons var2203 0))) r2195) (make-binding-wrap1133 (list pat2199) labels2202 (quote (()))) mod2196))) x2192))) (gen-clause2190 x2192 keys2193 (cdr clauses2194) r2195 pat2199 #t exp2200 mod2196))) tmp2198) ((lambda (tmp2204) (if tmp2204 (apply (lambda (pat2205 fender2206 exp2207) (gen-clause2190 x2192 keys2193 (cdr clauses2194) r2195 pat2205 fender2206 exp2207 mod2196)) tmp2204) ((lambda (_2208) (syntax-error (car clauses2194) "invalid syntax-case clause")) tmp2197))) (syntax-dispatch tmp2197 (quote (any any any)))))) (syntax-dispatch tmp2197 (quote (any any))))) (car clauses2194))))) (gen-clause2190 (lambda (x2209 keys2210 clauses2211 r2212 pat2213 fender2214 exp2215 mod2216) (call-with-values (lambda () (convert-pattern2188 pat2213 keys2210)) (lambda (p2217 pvars2218) (cond ((not (distinct-bound-ids?1142 (map car pvars2218))) (syntax-error pat2213 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2219) (not (ellipsis?1161 (car x2219)))) pvars2218)) (syntax-error pat2213 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2220 (gen-var1164 (quote tmp)))) (build-annotated1093 #f (list (build-annotated1093 #f (list (quote lambda) (list y2220) (let ((y2221 (build-annotated1093 #f y2220))) (build-annotated1093 #f (list (quote if) ((lambda (tmp2222) ((lambda (tmp2223) (if tmp2223 (apply (lambda () y2221) tmp2223) ((lambda (_2224) (build-annotated1093 #f (list (quote if) y2221 (build-dispatch-call2189 pvars2218 fender2214 y2221 r2212 mod2216) (build-data1094 #f #f)))) tmp2222))) (syntax-dispatch tmp2222 (quote #(atom #t))))) fender2214) (build-dispatch-call2189 pvars2218 exp2215 y2221 r2212 mod2216) (gen-syntax-case2191 x2209 keys2210 clauses2211 r2212 mod2216)))))) (if (eq? p2217 (quote any)) (build-annotated1093 #f (list (build-annotated1093 #f (quote list)) x2209)) (build-annotated1093 #f (list (build-annotated1093 #f (quote syntax-dispatch)) x2209 (build-data1094 #f p2217))))))))))))) (build-dispatch-call2189 (lambda (pvars2225 exp2226 y2227 r2228 mod2229) (let ((ids2230 (map car pvars2225)) (levels2231 (map cdr pvars2225))) (let ((labels2232 (gen-labels1122 ids2230)) (new-vars2233 (map gen-var1164 ids2230))) (build-annotated1093 #f (list (build-annotated1093 #f (quote apply)) (build-annotated1093 #f (list (quote lambda) new-vars2233 (chi1152 exp2226 (extend-env1110 labels2232 (map (lambda (var2234 level2235) (cons (quote syntax) (cons var2234 level2235))) new-vars2233 (map cdr pvars2225)) r2228) (make-binding-wrap1133 ids2230 labels2232 (quote (()))) mod2229))) y2227)))))) (convert-pattern2188 (lambda (pattern2236 keys2237) (let cvt2238 ((p2239 pattern2236) (n2240 0) (ids2241 (quote ()))) (if (id?1116 p2239) (if (bound-id-member?1143 p2239 keys2237) (values (vector (quote free-id) p2239) ids2241) (values (quote any) (cons (cons p2239 n2240) ids2241))) ((lambda (tmp2242) ((lambda (tmp2243) (if (if tmp2243 (apply (lambda (x2244 dots2245) (ellipsis?1161 dots2245)) tmp2243) #f) (apply (lambda (x2246 dots2247) (call-with-values (lambda () (cvt2238 x2246 (fx+1083 n2240 1) ids2241)) (lambda (p2248 ids2249) (values (if (eq? p2248 (quote any)) (quote each-any) (vector (quote each) p2248)) ids2249)))) tmp2243) ((lambda (tmp2250) (if tmp2250 (apply (lambda (x2251 y2252) (call-with-values (lambda () (cvt2238 y2252 n2240 ids2241)) (lambda (y2253 ids2254) (call-with-values (lambda () (cvt2238 x2251 n2240 ids2254)) (lambda (x2255 ids2256) (values (cons x2255 y2253) ids2256)))))) tmp2250) ((lambda (tmp2257) (if tmp2257 (apply (lambda () (values (quote ()) ids2241)) tmp2257) ((lambda (tmp2258) (if tmp2258 (apply (lambda (x2259) (call-with-values (lambda () (cvt2238 x2259 n2240 ids2241)) (lambda (p2261 ids2262) (values (vector (quote vector) p2261) ids2262)))) tmp2258) ((lambda (x2263) (values (vector (quote atom) (strip1163 p2239 (quote (())))) ids2241)) tmp2242))) (syntax-dispatch tmp2242 (quote #(vector each-any)))))) (syntax-dispatch tmp2242 (quote ()))))) (syntax-dispatch tmp2242 (quote (any . any)))))) (syntax-dispatch tmp2242 (quote (any any))))) p2239)))))) (lambda (e2264 r2265 w2266 s2267 mod2268) (let ((e2269 (source-wrap1145 e2264 w2266 s2267 mod2268))) ((lambda (tmp2270) ((lambda (tmp2271) (if tmp2271 (apply (lambda (_2272 val2273 key2274 m2275) (if (andmap (lambda (x2276) (and (id?1116 x2276) (not (ellipsis?1161 x2276)))) key2274) (let ((x2278 (gen-var1164 (quote tmp)))) (build-annotated1093 s2267 (list (build-annotated1093 #f (list (quote lambda) (list x2278) (gen-syntax-case2191 (build-annotated1093 #f x2278) key2274 m2275 r2265 mod2268))) (chi1152 val2273 r2265 (quote (())) mod2268)))) (syntax-error e2269 "invalid literals list in"))) tmp2271) (syntax-error tmp2270))) (syntax-dispatch tmp2270 (quote (any any each-any . each-any))))) e2269))))) (set! sc-expand (let ((m2281 (quote e)) (esew2282 (quote (eval)))) (lambda (x2283) (if (and (pair? x2283) (equal? (car x2283) noexpand1082)) (cadr x2283) (chi-top1151 x2283 (quote ()) (quote ((top))) m2281 esew2282 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2284 (quote e)) (esew2285 (quote (eval)))) (lambda (x2287 . rest2286) (if (and (pair? x2287) (equal? (car x2287) noexpand1082)) (cadr x2287) (chi-top1151 x2287 (quote ()) (quote ((top))) (if (null? rest2286) m2284 (car rest2286)) (if (or (null? rest2286) (null? (cdr rest2286))) esew2285 (cadr rest2286)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2288) (nonsymbol-id?1115 x2288))) (set! datum->syntax-object (lambda (id2289 datum2290) (make-syntax-object1099 datum2290 (syntax-object-wrap1102 id2289) #f))) (set! syntax-object->datum (lambda (x2291) (strip1163 x2291 (quote (()))))) (set! generate-temporaries (lambda (ls2292) (begin (let ((x2293 ls2292)) (if (not (list? x2293)) (error-hook1089 (quote generate-temporaries) "invalid argument" x2293))) (map (lambda (x2294) (wrap1144 (gensym) (quote ((top))) #f)) ls2292)))) (set! free-identifier=? (lambda (x2295 y2296) (begin (let ((x2297 x2295)) (if (not (nonsymbol-id?1115 x2297)) (error-hook1089 (quote free-identifier=?) "invalid argument" x2297))) (let ((x2298 y2296)) (if (not (nonsymbol-id?1115 x2298)) (error-hook1089 (quote free-identifier=?) "invalid argument" x2298))) (free-id=?1139 x2295 y2296)))) (set! bound-identifier=? (lambda (x2299 y2300) (begin (let ((x2301 x2299)) (if (not (nonsymbol-id?1115 x2301)) (error-hook1089 (quote bound-identifier=?) "invalid argument" x2301))) (let ((x2302 y2300)) (if (not (nonsymbol-id?1115 x2302)) (error-hook1089 (quote bound-identifier=?) "invalid argument" x2302))) (bound-id=?1140 x2299 y2300)))) (set! syntax-error (lambda (object2304 . messages2303) (begin (for-each (lambda (x2305) (let ((x2306 x2305)) (if (not (string? x2306)) (error-hook1089 (quote syntax-error) "invalid argument" x2306)))) messages2303) (let ((message2307 (if (null? messages2303) "invalid syntax" (apply string-append messages2303)))) (error-hook1089 #f message2307 (strip1163 object2304 (quote (())))))))) (set! install-global-transformer (lambda (sym2308 v2309) (begin (let ((x2310 sym2308)) (if (not (symbol? x2310)) (error-hook1089 (quote define-syntax) "invalid argument" x2310))) (let ((x2311 v2309)) (if (not (procedure? x2311)) (error-hook1089 (quote define-syntax) "invalid argument" x2311))) (global-extend1114 (quote macro) sym2308 v2309)))) (letrec ((match2316 (lambda (e2317 p2318 w2319 r2320 mod2321) (cond ((not r2320) #f) ((eq? p2318 (quote any)) (cons (wrap1144 e2317 w2319 mod2321) r2320)) ((syntax-object?1100 e2317) (match*2315 (let ((e2322 (syntax-object-expression1101 e2317))) (if (annotation? e2322) (annotation-expression e2322) e2322)) p2318 (join-wraps1135 w2319 (syntax-object-wrap1102 e2317)) r2320 (syntax-object-module1103 e2317))) (else (match*2315 (let ((e2323 e2317)) (if (annotation? e2323) (annotation-expression e2323) e2323)) p2318 w2319 r2320 mod2321))))) (match*2315 (lambda (e2324 p2325 w2326 r2327 mod2328) (cond ((null? p2325) (and (null? e2324) r2327)) ((pair? p2325) (and (pair? e2324) (match2316 (car e2324) (car p2325) w2326 (match2316 (cdr e2324) (cdr p2325) w2326 r2327 mod2328) mod2328))) ((eq? p2325 (quote each-any)) (let ((l2329 (match-each-any2313 e2324 w2326 mod2328))) (and l2329 (cons l2329 r2327)))) (else (let ((t2330 (vector-ref p2325 0))) (if (memv t2330 (quote (each))) (if (null? e2324) (match-empty2314 (vector-ref p2325 1) r2327) (let ((l2331 (match-each2312 e2324 (vector-ref p2325 1) w2326 mod2328))) (and l2331 (let collect2332 ((l2333 l2331)) (if (null? (car l2333)) r2327 (cons (map car l2333) (collect2332 (map cdr l2333)))))))) (if (memv t2330 (quote (free-id))) (and (id?1116 e2324) (free-id=?1139 (wrap1144 e2324 w2326 mod2328) (vector-ref p2325 1)) r2327) (if (memv t2330 (quote (atom))) (and (equal? (vector-ref p2325 1) (strip1163 e2324 w2326)) r2327) (if (memv t2330 (quote (vector))) (and (vector? e2324) (match2316 (vector->list e2324) (vector-ref p2325 1) w2326 r2327 mod2328))))))))))) (match-empty2314 (lambda (p2334 r2335) (cond ((null? p2334) r2335) ((eq? p2334 (quote any)) (cons (quote ()) r2335)) ((pair? p2334) (match-empty2314 (car p2334) (match-empty2314 (cdr p2334) r2335))) ((eq? p2334 (quote each-any)) (cons (quote ()) r2335)) (else (let ((t2336 (vector-ref p2334 0))) (if (memv t2336 (quote (each))) (match-empty2314 (vector-ref p2334 1) r2335) (if (memv t2336 (quote (free-id atom))) r2335 (if (memv t2336 (quote (vector))) (match-empty2314 (vector-ref p2334 1) r2335))))))))) (match-each-any2313 (lambda (e2337 w2338 mod2339) (cond ((annotation? e2337) (match-each-any2313 (annotation-expression e2337) w2338 mod2339)) ((pair? e2337) (let ((l2340 (match-each-any2313 (cdr e2337) w2338 mod2339))) (and l2340 (cons (wrap1144 (car e2337) w2338 mod2339) l2340)))) ((null? e2337) (quote ())) ((syntax-object?1100 e2337) (match-each-any2313 (syntax-object-expression1101 e2337) (join-wraps1135 w2338 (syntax-object-wrap1102 e2337)) mod2339)) (else #f)))) (match-each2312 (lambda (e2341 p2342 w2343 mod2344) (cond ((annotation? e2341) (match-each2312 (annotation-expression e2341) p2342 w2343 mod2344)) ((pair? e2341) (let ((first2345 (match2316 (car e2341) p2342 w2343 (quote ()) mod2344))) (and first2345 (let ((rest2346 (match-each2312 (cdr e2341) p2342 w2343 mod2344))) (and rest2346 (cons first2345 rest2346)))))) ((null? e2341) (quote ())) ((syntax-object?1100 e2341) (match-each2312 (syntax-object-expression1101 e2341) p2342 (join-wraps1135 w2343 (syntax-object-wrap1102 e2341)) (syntax-object-module1103 e2341))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2347 p2348) (cond ((eq? p2348 (quote any)) (list e2347)) ((syntax-object?1100 e2347) (match*2315 (let ((e2349 (syntax-object-expression1101 e2347))) (if (annotation? e2349) (annotation-expression e2349) e2349)) p2348 (syntax-object-wrap1102 e2347) (quote ()) (syntax-object-module1103 e2347))) (else (match*2315 (let ((e2350 e2347)) (if (annotation? e2350) (annotation-expression e2350) e2350)) p2348 (quote (())) (quote ()) #f))))) (set! sc-chi chi1152)))))
+(install-global-transformer (quote with-syntax) (lambda (x2351) ((lambda (tmp2352) ((lambda (tmp2353) (if tmp2353 (apply (lambda (_2354 e12355 e22356) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12355 e22356))) tmp2353) ((lambda (tmp2358) (if tmp2358 (apply (lambda (_2359 out2360 in2361 e12362 e22363) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2361 (quote ()) (list out2360 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12362 e22363))))) tmp2358) ((lambda (tmp2365) (if tmp2365 (apply (lambda (_2366 out2367 in2368 e12369 e22370) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2368) (quote ()) (list out2367 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12369 e22370))))) tmp2365) (syntax-error tmp2352))) (syntax-dispatch tmp2352 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2352 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2352 (quote (any () any . each-any))))) x2351)))
+(install-global-transformer (quote syntax-rules) (lambda (x2374) ((lambda (tmp2375) ((lambda (tmp2376) (if tmp2376 (apply (lambda (_2377 k2378 keyword2379 pattern2380 template2381) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k2378 (map (lambda (tmp2384 tmp2383) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2383) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2384))) template2381 pattern2380)))))) tmp2376) (syntax-error tmp2375))) (syntax-dispatch tmp2375 (quote (any each-any . #(each ((any . any) any))))))) x2374)))
+(install-global-transformer (quote let*) (lambda (x2385) ((lambda (tmp2386) ((lambda (tmp2387) (if (if tmp2387 (apply (lambda (let*2388 x2389 v2390 e12391 e22392) (andmap identifier? x2389)) tmp2387) #f) (apply (lambda (let*2394 x2395 v2396 e12397 e22398) (let f2399 ((bindings2400 (map list x2395 v2396))) (if (null? bindings2400) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e12397 e22398))) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda (body2406 binding2407) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding2407) body2406)) tmp2405) (syntax-error tmp2404))) (syntax-dispatch tmp2404 (quote (any any))))) (list (f2399 (cdr bindings2400)) (car bindings2400)))))) tmp2387) (syntax-error tmp2386))) (syntax-dispatch tmp2386 (quote (any #(each (any any)) any . each-any))))) x2385)))
+(install-global-transformer (quote do) (lambda (orig-x2408) ((lambda (tmp2409) ((lambda (tmp2410) (if tmp2410 (apply (lambda (_2411 var2412 init2413 step2414 e02415 e12416 c2417) ((lambda (tmp2418) ((lambda (tmp2419) (if tmp2419 (apply (lambda (step2420) ((lambda (tmp2421) ((lambda (tmp2422) (if tmp2422 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2412 init2413) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02415) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2417 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2420))))))) tmp2422) ((lambda (tmp2427) (if tmp2427 (apply (lambda (e12428 e22429) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2412 init2413) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02415 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e12428 e22429)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2417 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2420))))))) tmp2427) (syntax-error tmp2421))) (syntax-dispatch tmp2421 (quote (any . each-any)))))) (syntax-dispatch tmp2421 (quote ())))) e12416)) tmp2419) (syntax-error tmp2418))) (syntax-dispatch tmp2418 (quote each-any)))) (map (lambda (v2436 s2437) ((lambda (tmp2438) ((lambda (tmp2439) (if tmp2439 (apply (lambda () v2436) tmp2439) ((lambda (tmp2440) (if tmp2440 (apply (lambda (e2441) e2441) tmp2440) ((lambda (_2442) (syntax-error orig-x2408)) tmp2438))) (syntax-dispatch tmp2438 (quote (any)))))) (syntax-dispatch tmp2438 (quote ())))) s2437)) var2412 step2414))) tmp2410) (syntax-error tmp2409))) (syntax-dispatch tmp2409 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2408)))
+(install-global-transformer (quote quasiquote) (letrec ((quasicons2445 (lambda (x2449 y2450) ((lambda (tmp2451) ((lambda (tmp2452) (if tmp2452 (apply (lambda (x2453 y2454) ((lambda (tmp2455) ((lambda (tmp2456) (if tmp2456 (apply (lambda (dy2457) ((lambda (tmp2458) ((lambda (tmp2459) (if tmp2459 (apply (lambda (dx2460) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx2460 dy2457))) tmp2459) ((lambda (_2461) (if (null? dy2457) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2453) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2453 y2454))) tmp2458))) (syntax-dispatch tmp2458 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x2453)) tmp2456) ((lambda (tmp2462) (if tmp2462 (apply (lambda (stuff2463) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x2453 stuff2463))) tmp2462) ((lambda (else2464) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2453 y2454)) tmp2455))) (syntax-dispatch tmp2455 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) (syntax-dispatch tmp2455 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y2454)) tmp2452) (syntax-error tmp2451))) (syntax-dispatch tmp2451 (quote (any any))))) (list x2449 y2450)))) (quasiappend2446 (lambda (x2465 y2466) ((lambda (tmp2467) ((lambda (tmp2468) (if tmp2468 (apply (lambda (x2469 y2470) ((lambda (tmp2471) ((lambda (tmp2472) (if tmp2472 (apply (lambda () x2469) tmp2472) ((lambda (_2473) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2469 y2470)) tmp2471))) (syntax-dispatch tmp2471 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y2470)) tmp2468) (syntax-error tmp2467))) (syntax-dispatch tmp2467 (quote (any any))))) (list x2465 y2466)))) (quasivector2447 (lambda (x2474) ((lambda (tmp2475) ((lambda (x2476) ((lambda (tmp2477) ((lambda (tmp2478) (if tmp2478 (apply (lambda (x2479) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x2479))) tmp2478) ((lambda (tmp2481) (if tmp2481 (apply (lambda (x2482) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2482)) tmp2481) ((lambda (_2484) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2476)) tmp2477))) (syntax-dispatch tmp2477 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) (syntax-dispatch tmp2477 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x2476)) tmp2475)) x2474))) (quasi2448 (lambda (p2485 lev2486) ((lambda (tmp2487) ((lambda (tmp2488) (if tmp2488 (apply (lambda (p2489) (if (= lev2486 0) p2489 (quasicons2445 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2448 (list p2489) (- lev2486 1))))) tmp2488) ((lambda (tmp2490) (if tmp2490 (apply (lambda (p2491 q2492) (if (= lev2486 0) (quasiappend2446 p2491 (quasi2448 q2492 lev2486)) (quasicons2445 (quasicons2445 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2448 (list p2491) (- lev2486 1))) (quasi2448 q2492 lev2486)))) tmp2490) ((lambda (tmp2493) (if tmp2493 (apply (lambda (p2494) (quasicons2445 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2448 (list p2494) (+ lev2486 1)))) tmp2493) ((lambda (tmp2495) (if tmp2495 (apply (lambda (p2496 q2497) (quasicons2445 (quasi2448 p2496 lev2486) (quasi2448 q2497 lev2486))) tmp2495) ((lambda (tmp2498) (if tmp2498 (apply (lambda (x2499) (quasivector2447 (quasi2448 x2499 lev2486))) tmp2498) ((lambda (p2501) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p2501)) tmp2487))) (syntax-dispatch tmp2487 (quote #(vector each-any)))))) (syntax-dispatch tmp2487 (quote (any . any)))))) (syntax-dispatch tmp2487 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) (syntax-dispatch tmp2487 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) (syntax-dispatch tmp2487 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p2485)))) (lambda (x2502) ((lambda (tmp2503) ((lambda (tmp2504) (if tmp2504 (apply (lambda (_2505 e2506) (quasi2448 e2506 0)) tmp2504) (syntax-error tmp2503))) (syntax-dispatch tmp2503 (quote (any any))))) x2502))))
+(install-global-transformer (quote include) (lambda (x2507) (letrec ((read-file2508 (lambda (fn2509 k2510) (let ((p2511 (open-input-file fn2509))) (let f2512 ((x2513 (read p2511))) (if (eof-object? x2513) (begin (close-input-port p2511) (quote ())) (cons (datum->syntax-object k2510 x2513) (f2512 (read p2511))))))))) ((lambda (tmp2514) ((lambda (tmp2515) (if tmp2515 (apply (lambda (k2516 filename2517) (let ((fn2518 (syntax-object->datum filename2517))) ((lambda (tmp2519) ((lambda (tmp2520) (if tmp2520 (apply (lambda (exp2521) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp2521)) tmp2520) (syntax-error tmp2519))) (syntax-dispatch tmp2519 (quote each-any)))) (read-file2508 fn2518 k2516)))) tmp2515) (syntax-error tmp2514))) (syntax-dispatch tmp2514 (quote (any any))))) x2507))))
+(install-global-transformer (quote unquote) (lambda (x2523) ((lambda (tmp2524) ((lambda (tmp2525) (if tmp2525 (apply (lambda (_2526 e2527) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2527))) tmp2525) (syntax-error tmp2524))) (syntax-dispatch tmp2524 (quote (any any))))) x2523)))
+(install-global-transformer (quote unquote-splicing) (lambda (x2528) ((lambda (tmp2529) ((lambda (tmp2530) (if tmp2530 (apply (lambda (_2531 e2532) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2532))) tmp2530) (syntax-error tmp2529))) (syntax-dispatch tmp2529 (quote (any any))))) x2528)))
+(install-global-transformer (quote case) (lambda (x2533) ((lambda (tmp2534) ((lambda (tmp2535) (if tmp2535 (apply (lambda (_2536 e2537 m12538 m22539) ((lambda (tmp2540) ((lambda (body2541) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2537)) body2541)) tmp2540)) (let f2542 ((clause2543 m12538) (clauses2544 m22539)) (if (null? clauses2544) ((lambda (tmp2546) ((lambda (tmp2547) (if tmp2547 (apply (lambda (e12548 e22549) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12548 e22549))) tmp2547) ((lambda (tmp2551) (if tmp2551 (apply (lambda (k2552 e12553 e22554) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2552)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12553 e22554)))) tmp2551) ((lambda (_2557) (syntax-error x2533)) tmp2546))) (syntax-dispatch tmp2546 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2546 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause2543) ((lambda (tmp2558) ((lambda (rest2559) ((lambda (tmp2560) ((lambda (tmp2561) (if tmp2561 (apply (lambda (k2562 e12563 e22564) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2562)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12563 e22564)) rest2559)) tmp2561) ((lambda (_2567) (syntax-error x2533)) tmp2560))) (syntax-dispatch tmp2560 (quote (each-any any . each-any))))) clause2543)) tmp2558)) (f2542 (car clauses2544) (cdr clauses2544))))))) tmp2535) (syntax-error tmp2534))) (syntax-dispatch tmp2534 (quote (any any any . each-any))))) x2533)))
+(install-global-transformer (quote identifier-syntax) (lambda (x2568) ((lambda (tmp2569) ((lambda (tmp2570) (if tmp2570 (apply (lambda (_2571 e2572) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2572)) (list (cons _2571 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e2572 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp2570) (syntax-error tmp2569))) (syntax-dispatch tmp2569 (quote (any any))))) x2568)))
((_) (gensym))))
(define put-global-definition-hook
- (lambda (symbol binding)
+ (lambda (symbol type val)
(let* ((module (current-module))
(v (or (module-variable module symbol)
- (let ((v (make-variable (gensym))))
+ (let ((v (make-variable val)))
(module-add! module symbol v)
v))))
(if (not (variable-bound? v))
- (variable-set! v (gensym)))
+ (variable-set! v val))
;; Properties are tied to variable objects
- (set-object-property! v '*sc-expander* binding))))
+ (set-object-property! v '*sc-expander*
+ (make-binding type val)))))
(define remove-global-definition-hook
(lambda (symbol)
(define global-extend
(lambda (type sym val)
- (put-global-definition-hook sym (make-binding type val))))
+ (put-global-definition-hook sym type val)))
;;; Conceptually, identifiers are always syntax objects. Internally,
HCoop / bpt / guile.git / commitdiff