diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index f33f49286..0043cbbd3 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,13 +1,13 @@
 (eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
 (if #f #f)
-(letrec ((and-map*151 (lambda (f191 first190 . rest189) (let ((t192 (null? first190))) (if t192 t192 (if (null? rest189) (letrec ((andmap193 (lambda (first194) (let ((x195 (car first194)) (first196 (cdr first194))) (if (null? first196) (f191 x195) (if (f191 x195) (andmap193 first196) #f)))))) (andmap193 first190)) (letrec ((andmap197 (lambda (first198 rest199) (let ((x200 (car first198)) (xr201 (map car rest199)) (first202 (cdr first198)) (rest203 (map cdr rest199))) (if (null? first202) (apply f191 (cons x200 xr201)) (if (apply f191 (cons x200 xr201)) (andmap197 first202 rest203) #f)))))) (andmap197 first190 rest189)))))))) (letrec ((lambda-var-list296 (lambda (vars420) (letrec ((lvl421 (lambda (vars422 ls423 w424) (if (pair? vars422) (lvl421 (cdr vars422) (cons (wrap276 (car vars422) w424 #f) ls423) w424) (if (id?248 vars422) (cons (wrap276 vars422 w424 #f) ls423) (if (null? vars422) ls423 (if (syntax-object?232 vars422) (lvl421 (syntax-object-expression233 vars422) ls423 (join-wraps267 w424 (syntax-object-wrap234 vars422))) (cons vars422 ls423)))))))) (lvl421 vars420 (quote ()) (quote (())))))) (gen-var295 (lambda (id425) (let ((id426 (if (syntax-object?232 id425) (syntax-object-expression233 id425) id425))) (gensym (symbol->string id426))))) (strip294 (lambda (x427 w428) (if (memq (quote top) (wrap-marks251 w428)) x427 (letrec ((f429 (lambda (x430) (if (syntax-object?232 x430) (strip294 (syntax-object-expression233 x430) (syntax-object-wrap234 x430)) (if (pair? x430) (let ((a431 (f429 (car x430))) (d432 (f429 (cdr x430)))) (if (if (eq? a431 (car x430)) (eq? d432 (cdr x430)) #f) x430 (cons a431 d432))) (if (vector? x430) (let ((old433 (vector->list x430))) (let ((new434 (map f429 old433))) (if (and-map*151 eq? old433 new434) x430 (list->vector new434)))) x430)))))) (f429 x427))))) (ellipsis?293 (lambda (x435) (if (nonsymbol-id?247 x435) (free-id=?271 x435 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void292 (lambda () (build-void214 #f))) (eval-local-transformer291 (lambda (expanded436 mod437) (let ((p438 (local-eval-hook211 expanded436 mod437))) (if (procedure? p438) p438 (syntax-violation #f "nonprocedure transformer" p438))))) (chi-local-syntax290 (lambda (rec?439 e440 r441 w442 s443 mod444 k445) ((lambda (tmp446) ((lambda (tmp447) (if tmp447 (apply (lambda (_448 id449 val450 e1451 e2452) (let ((ids453 id449)) (if (not (valid-bound-ids?273 ids453)) (syntax-violation #f "duplicate bound keyword" e440) (let ((labels455 (gen-labels254 ids453))) (let ((new-w456 (make-binding-wrap265 ids453 labels455 w442))) (k445 (cons e1451 e2452) (extend-env242 labels455 (let ((w458 (if rec?439 new-w456 w442)) (trans-r459 (macros-only-env244 r441))) (map (lambda (x460) (cons (quote macro) (eval-local-transformer291 (chi284 x460 trans-r459 w458 mod444) mod444))) val450)) r441) new-w456 s443 mod444)))))) tmp447) ((lambda (_462) (syntax-violation #f "bad local syntax definition" (source-wrap277 e440 w442 s443 mod444))) tmp446))) ($sc-dispatch tmp446 (quote (any #(each (any any)) any . each-any))))) e440))) (chi-lambda-clause289 (lambda (e463 docstring464 c465 r466 w467 mod468 k469) ((lambda (tmp470) ((lambda (tmp471) (if (if tmp471 (apply (lambda (args472 doc473 e1474 e2475) (if (string? (syntax->datum doc473)) (not docstring464) #f)) tmp471) #f) (apply (lambda (args476 doc477 e1478 e2479) (chi-lambda-clause289 e463 doc477 (cons args476 (cons e1478 e2479)) r466 w467 mod468 k469)) tmp471) ((lambda (tmp481) (if tmp481 (apply (lambda (id482 e1483 e2484) (let ((ids485 id482)) (if (not (valid-bound-ids?273 ids485)) (syntax-violation (quote lambda) "invalid parameter list" e463) (let ((labels487 (gen-labels254 ids485)) (new-vars488 (map gen-var295 ids485))) (k469 (map syntax->datum ids485) new-vars488 (if docstring464 (syntax->datum docstring464) #f) (chi-body288 (cons e1483 e2484) e463 (extend-var-env243 labels487 new-vars488 r466) (make-binding-wrap265 ids485 labels487 w467) mod468)))))) tmp481) ((lambda (tmp490) (if tmp490 (apply (lambda (ids491 e1492 e2493) (let ((old-ids494 (lambda-var-list296 ids491))) (if (not (valid-bound-ids?273 old-ids494)) (syntax-violation (quote lambda) "invalid parameter list" e463) (let ((labels495 (gen-labels254 old-ids494)) (new-vars496 (map gen-var295 old-ids494))) (k469 (letrec ((f497 (lambda (ls1498 ls2499) (if (null? ls1498) (syntax->datum ls2499) (f497 (cdr ls1498) (cons (syntax->datum (car ls1498)) ls2499)))))) (f497 (cdr old-ids494) (car old-ids494))) (letrec ((f500 (lambda (ls1501 ls2502) (if (null? ls1501) ls2502 (f500 (cdr ls1501) (cons (car ls1501) ls2502)))))) (f500 (cdr new-vars496) (car new-vars496))) (if docstring464 (syntax->datum docstring464) #f) (chi-body288 (cons e1492 e2493) e463 (extend-var-env243 labels495 new-vars496 r466) (make-binding-wrap265 old-ids494 labels495 w467) mod468)))))) tmp490) ((lambda (_504) (syntax-violation (quote lambda) "bad lambda" e463)) tmp470))) ($sc-dispatch tmp470 (quote (any any . each-any)))))) ($sc-dispatch tmp470 (quote (each-any any . each-any)))))) ($sc-dispatch tmp470 (quote (any any any . each-any))))) c465))) (chi-body288 (lambda (body505 outer-form506 r507 w508 mod509) (let ((r510 (cons (quote ("placeholder" placeholder)) r507))) (let ((ribcage511 (make-ribcage255 (quote ()) (quote ()) (quote ())))) (let ((w512 (make-wrap250 (wrap-marks251 w508) (cons ribcage511 (wrap-subst252 w508))))) (letrec ((parse513 (lambda (body514 ids515 labels516 var-ids517 vars518 vals519 bindings520) (if (null? body514) (syntax-violation #f "no expressions in body" outer-form506) (let ((e522 (cdar body514)) (er523 (caar body514))) (call-with-values (lambda () (syntax-type282 e522 er523 (quote (())) (source-annotation239 er523) ribcage511 mod509)) (lambda (type524 value525 e526 w527 s528 mod529) (if (memv type524 (quote (define-form))) (let ((id530 (wrap276 value525 w527 mod529)) (label531 (gen-label253))) (let ((var532 (gen-var295 id530))) (begin (extend-ribcage!264 ribcage511 id530 label531) (parse513 (cdr body514) (cons id530 ids515) (cons label531 labels516) (cons id530 var-ids517) (cons var532 vars518) (cons (cons er523 (wrap276 e526 w527 mod529)) vals519) (cons (cons (quote lexical) var532) bindings520))))) (if (memv type524 (quote (define-syntax-form))) (let ((id533 (wrap276 value525 w527 mod529)) (label534 (gen-label253))) (begin (extend-ribcage!264 ribcage511 id533 label534) (parse513 (cdr body514) (cons id533 ids515) (cons label534 labels516) var-ids517 vars518 vals519 (cons (cons (quote macro) (cons er523 (wrap276 e526 w527 mod529))) bindings520)))) (if (memv type524 (quote (begin-form))) ((lambda (tmp535) ((lambda (tmp536) (if tmp536 (apply (lambda (_537 e1538) (parse513 (letrec ((f539 (lambda (forms540) (if (null? forms540) (cdr body514) (cons (cons er523 (wrap276 (car forms540) w527 mod529)) (f539 (cdr forms540))))))) (f539 e1538)) ids515 labels516 var-ids517 vars518 vals519 bindings520)) tmp536) (syntax-violation #f "source expression failed to match any pattern" tmp535))) ($sc-dispatch tmp535 (quote (any . each-any))))) e526) (if (memv type524 (quote (local-syntax-form))) (chi-local-syntax290 value525 e526 er523 w527 s528 mod529 (lambda (forms542 er543 w544 s545 mod546) (parse513 (letrec ((f547 (lambda (forms548) (if (null? forms548) (cdr body514) (cons (cons er543 (wrap276 (car forms548) w544 mod546)) (f547 (cdr forms548))))))) (f547 forms542)) ids515 labels516 var-ids517 vars518 vals519 bindings520))) (if (null? ids515) (build-sequence227 #f (map (lambda (x549) (chi284 (cdr x549) (car x549) (quote (())) mod529)) (cons (cons er523 (source-wrap277 e526 w527 s528 mod529)) (cdr body514)))) (begin (if (not (valid-bound-ids?273 ids515)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form506)) (letrec ((loop550 (lambda (bs551 er-cache552 r-cache553) (if (not (null? bs551)) (let ((b554 (car bs551))) (if (eq? (car b554) (quote macro)) (let ((er555 (cadr b554))) (let ((r-cache556 (if (eq? er555 er-cache552) r-cache553 (macros-only-env244 er555)))) (begin (set-cdr! b554 (eval-local-transformer291 (chi284 (cddr b554) r-cache556 (quote (())) mod529) mod529)) (loop550 (cdr bs551) er555 r-cache556)))) (loop550 (cdr bs551) er-cache552 r-cache553))))))) (loop550 bindings520 #f #f)) (set-cdr! r510 (extend-env242 labels516 bindings520 (cdr r510))) (build-letrec230 #f (map syntax->datum var-ids517) vars518 (map (lambda (x557) (chi284 (cdr x557) (car x557) (quote (())) mod529)) vals519) (build-sequence227 #f (map (lambda (x558) (chi284 (cdr x558) (car x558) (quote (())) mod529)) (cons (cons er523 (source-wrap277 e526 w527 s528 mod529)) (cdr body514)))))))))))))))))) (parse513 (map (lambda (x521) (cons r510 (wrap276 x521 w512 mod509))) body505) (quote ()) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro287 (lambda (p559 e560 r561 w562 rib563 mod564) (letrec ((rebuild-macro-output565 (lambda (x566 m567) (if (pair? x566) (cons (rebuild-macro-output565 (car x566) m567) (rebuild-macro-output565 (cdr x566) m567)) (if (syntax-object?232 x566) (let ((w568 (syntax-object-wrap234 x566))) (let ((ms569 (wrap-marks251 w568)) (s570 (wrap-subst252 w568))) (if (if (pair? ms569) (eq? (car ms569) #f) #f) (make-syntax-object231 (syntax-object-expression233 x566) (make-wrap250 (cdr ms569) (if rib563 (cons rib563 (cdr s570)) (cdr s570))) (syntax-object-module235 x566)) (make-syntax-object231 (syntax-object-expression233 x566) (make-wrap250 (cons m567 ms569) (if rib563 (cons rib563 (cons (quote shift) s570)) (cons (quote shift) s570))) (let ((pmod571 (procedure-module p559))) (if pmod571 (cons (quote hygiene) (module-name pmod571)) (quote (hygiene guile)))))))) (if (vector? x566) (let ((n572 (vector-length x566))) (let ((v573 (make-vector n572))) (letrec ((loop574 (lambda (i575) (if (fx=208 i575 n572) (begin (if #f #f) v573) (begin (vector-set! v573 i575 (rebuild-macro-output565 (vector-ref x566 i575) m567)) (loop574 (fx+206 i575 1))))))) (loop574 0)))) (if (symbol? x566) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap277 e560 w562 s mod564) x566) x566))))))) (rebuild-macro-output565 (p559 (wrap276 e560 (anti-mark263 w562) mod564)) (string #\m))))) (chi-application286 (lambda (x576 e577 r578 w579 s580 mod581) ((lambda (tmp582) ((lambda (tmp583) (if tmp583 (apply (lambda (e0584 e1585) (build-application215 s580 x576 (map (lambda (e586) (chi284 e586 r578 w579 mod581)) e1585))) tmp583) (syntax-violation #f "source expression failed to match any pattern" tmp582))) ($sc-dispatch tmp582 (quote (any . each-any))))) e577))) (chi-expr285 (lambda (type588 value589 e590 r591 w592 s593 mod594) (if (memv type588 (quote (lexical))) (build-lexical-reference217 (quote value) s593 e590 value589) (if (memv type588 (quote (core external-macro))) (value589 e590 r591 w592 s593 mod594) (if (memv type588 (quote (module-ref))) (call-with-values (lambda () (value589 e590)) (lambda (id595 mod596) (build-global-reference220 s593 id595 mod596))) (if (memv type588 (quote (lexical-call))) (chi-application286 (build-lexical-reference217 (quote fun) (source-annotation239 (car e590)) (car e590) value589) e590 r591 w592 s593 mod594) (if (memv type588 (quote (global-call))) (chi-application286 (build-global-reference220 (source-annotation239 (car e590)) value589 (if (syntax-object?232 (car e590)) (syntax-object-module235 (car e590)) mod594)) e590 r591 w592 s593 mod594) (if (memv type588 (quote (constant))) (build-data226 s593 (strip294 (source-wrap277 e590 w592 s593 mod594) (quote (())))) (if (memv type588 (quote (global))) (build-global-reference220 s593 value589 mod594) (if (memv type588 (quote (call))) (chi-application286 (chi284 (car e590) r591 w592 mod594) e590 r591 w592 s593 mod594) (if (memv type588 (quote (begin-form))) ((lambda (tmp597) ((lambda (tmp598) (if tmp598 (apply (lambda (_599 e1600 e2601) (chi-sequence278 (cons e1600 e2601) r591 w592 s593 mod594)) tmp598) (syntax-violation #f "source expression failed to match any pattern" tmp597))) ($sc-dispatch tmp597 (quote (any any . each-any))))) e590) (if (memv type588 (quote (local-syntax-form))) (chi-local-syntax290 value589 e590 r591 w592 s593 mod594 chi-sequence278) (if (memv type588 (quote (eval-when-form))) ((lambda (tmp603) ((lambda (tmp604) (if tmp604 (apply (lambda (_605 x606 e1607 e2608) (let ((when-list609 (chi-when-list281 e590 x606 w592))) (if (memq (quote eval) when-list609) (chi-sequence278 (cons e1607 e2608) r591 w592 s593 mod594) (chi-void292)))) tmp604) (syntax-violation #f "source expression failed to match any pattern" tmp603))) ($sc-dispatch tmp603 (quote (any each-any any . each-any))))) e590) (if (memv type588 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e590 (wrap276 value589 w592 mod594)) (if (memv type588 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap277 e590 w592 s593 mod594)) (if (memv type588 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap277 e590 w592 s593 mod594)) (syntax-violation #f "unexpected syntax" (source-wrap277 e590 w592 s593 mod594)))))))))))))))))) (chi284 (lambda (e612 r613 w614 mod615) (call-with-values (lambda () (syntax-type282 e612 r613 w614 (source-annotation239 e612) #f mod615)) (lambda (type616 value617 e618 w619 s620 mod621) (chi-expr285 type616 value617 e618 r613 w619 s620 mod621))))) (chi-top283 (lambda (e622 r623 w624 m625 esew626 mod627) (call-with-values (lambda () (syntax-type282 e622 r623 w624 (source-annotation239 e622) #f mod627)) (lambda (type635 value636 e637 w638 s639 mod640) (if (memv type635 (quote (begin-form))) ((lambda (tmp641) ((lambda (tmp642) (if tmp642 (apply (lambda (_643) (chi-void292)) tmp642) ((lambda (tmp644) (if tmp644 (apply (lambda (_645 e1646 e2647) (chi-top-sequence279 (cons e1646 e2647) r623 w638 s639 m625 esew626 mod640)) tmp644) (syntax-violation #f "source expression failed to match any pattern" tmp641))) ($sc-dispatch tmp641 (quote (any any . each-any)))))) ($sc-dispatch tmp641 (quote (any))))) e637) (if (memv type635 (quote (local-syntax-form))) (chi-local-syntax290 value636 e637 r623 w638 s639 mod640 (lambda (body649 r650 w651 s652 mod653) (chi-top-sequence279 body649 r650 w651 s652 m625 esew626 mod653))) (if (memv type635 (quote (eval-when-form))) ((lambda (tmp654) ((lambda (tmp655) (if tmp655 (apply (lambda (_656 x657 e1658 e2659) (let ((when-list660 (chi-when-list281 e637 x657 w638)) (body661 (cons e1658 e2659))) (if (eq? m625 (quote e)) (if (memq (quote eval) when-list660) (chi-top-sequence279 body661 r623 w638 s639 (quote e) (quote (eval)) mod640) (chi-void292)) (if (memq (quote load) when-list660) (if (let ((t664 (memq (quote compile) when-list660))) (if t664 t664 (if (eq? m625 (quote c&e)) (memq (quote eval) when-list660) #f))) (chi-top-sequence279 body661 r623 w638 s639 (quote c&e) (quote (compile load)) mod640) (if (memq m625 (quote (c c&e))) (chi-top-sequence279 body661 r623 w638 s639 (quote c) (quote (load)) mod640) (chi-void292))) (if (let ((t665 (memq (quote compile) when-list660))) (if t665 t665 (if (eq? m625 (quote c&e)) (memq (quote eval) when-list660) #f))) (begin (top-level-eval-hook210 (chi-top-sequence279 body661 r623 w638 s639 (quote e) (quote (eval)) mod640) mod640) (chi-void292)) (chi-void292)))))) tmp655) (syntax-violation #f "source expression failed to match any pattern" tmp654))) ($sc-dispatch tmp654 (quote (any each-any any . each-any))))) e637) (if (memv type635 (quote (define-syntax-form))) (let ((n666 (id-var-name270 value636 w638)) (r667 (macros-only-env244 r623))) (if (memv m625 (quote (c))) (if (memq (quote compile) esew626) (let ((e668 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)))) (begin (top-level-eval-hook210 e668 mod640) (if (memq (quote load) esew626) e668 (chi-void292)))) (if (memq (quote load) esew626) (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)) (chi-void292))) (if (memv m625 (quote (c&e))) (let ((e669 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)))) (begin (top-level-eval-hook210 e669 mod640) e669)) (begin (if (memq (quote eval) esew626) (top-level-eval-hook210 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)) mod640)) (chi-void292))))) (if (memv type635 (quote (define-form))) (let ((n670 (id-var-name270 value636 w638))) (let ((type671 (binding-type240 (lookup245 n670 r623 mod640)))) (if (memv type671 (quote (global core macro module-ref))) (let ((x672 (build-global-definition223 s639 n670 (chi284 e637 r623 w638 mod640)))) (begin (if (eq? m625 (quote c&e)) (top-level-eval-hook210 x672 mod640)) x672)) (if (memv type671 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e637 (wrap276 value636 w638 mod640)) (syntax-violation #f "cannot define keyword at top level" e637 (wrap276 value636 w638 mod640)))))) (let ((x673 (chi-expr285 type635 value636 e637 r623 w638 s639 mod640))) (begin (if (eq? m625 (quote c&e)) (top-level-eval-hook210 x673 mod640)) x673))))))))))) (syntax-type282 (lambda (e674 r675 w676 s677 rib678 mod679) (if (symbol? e674) (let ((n680 (id-var-name270 e674 w676))) (let ((b681 (lookup245 n680 r675 mod679))) (let ((type682 (binding-type240 b681))) (if (memv type682 (quote (lexical))) (values type682 (binding-value241 b681) e674 w676 s677 mod679) (if (memv type682 (quote (global))) (values type682 n680 e674 w676 s677 mod679) (if (memv type682 (quote (macro))) (syntax-type282 (chi-macro287 (binding-value241 b681) e674 r675 w676 rib678 mod679) r675 (quote (())) s677 rib678 mod679) (values type682 (binding-value241 b681) e674 w676 s677 mod679))))))) (if (pair? e674) (let ((first683 (car e674))) (if (id?248 first683) (let ((n684 (id-var-name270 first683 w676))) (let ((b685 (lookup245 n684 r675 (let ((t686 (if (syntax-object?232 first683) (syntax-object-module235 first683) #f))) (if t686 t686 mod679))))) (let ((type687 (binding-type240 b685))) (if (memv type687 (quote (lexical))) (values (quote lexical-call) (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (global))) (values (quote global-call) n684 e674 w676 s677 mod679) (if (memv type687 (quote (macro))) (syntax-type282 (chi-macro287 (binding-value241 b685) e674 r675 w676 rib678 mod679) r675 (quote (())) s677 rib678 mod679) (if (memv type687 (quote (core external-macro module-ref))) (values type687 (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (begin))) (values (quote begin-form) #f e674 w676 s677 mod679) (if (memv type687 (quote (eval-when))) (values (quote eval-when-form) #f e674 w676 s677 mod679) (if (memv type687 (quote (define))) ((lambda (tmp688) ((lambda (tmp689) (if (if tmp689 (apply (lambda (_690 name691 val692) (id?248 name691)) tmp689) #f) (apply (lambda (_693 name694 val695) (values (quote define-form) name694 val695 w676 s677 mod679)) tmp689) ((lambda (tmp696) (if (if tmp696 (apply (lambda (_697 name698 args699 e1700 e2701) (if (id?248 name698) (valid-bound-ids?273 (lambda-var-list296 args699)) #f)) tmp696) #f) (apply (lambda (_702 name703 args704 e1705 e2706) (values (quote define-form) (wrap276 name703 w676 mod679) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(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 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap276 (cons args704 (cons e1705 e2706)) w676 mod679)) (quote (())) s677 mod679)) tmp696) ((lambda (tmp708) (if (if tmp708 (apply (lambda (_709 name710) (id?248 name710)) tmp708) #f) (apply (lambda (_711 name712) (values (quote define-form) (wrap276 name712 w676 mod679) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(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 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(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 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(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 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s677 mod679)) tmp708) (syntax-violation #f "source expression failed to match any pattern" tmp688))) ($sc-dispatch tmp688 (quote (any any)))))) ($sc-dispatch tmp688 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp688 (quote (any any any))))) e674) (if (memv type687 (quote (define-syntax))) ((lambda (tmp713) ((lambda (tmp714) (if (if tmp714 (apply (lambda (_715 name716 val717) (id?248 name716)) tmp714) #f) (apply (lambda (_718 name719 val720) (values (quote define-syntax-form) name719 val720 w676 s677 mod679)) tmp714) (syntax-violation #f "source expression failed to match any pattern" tmp713))) ($sc-dispatch tmp713 (quote (any any any))))) e674) (values (quote call) #f e674 w676 s677 mod679))))))))))))) (values (quote call) #f e674 w676 s677 mod679))) (if (syntax-object?232 e674) (syntax-type282 (syntax-object-expression233 e674) r675 (join-wraps267 w676 (syntax-object-wrap234 e674)) s677 rib678 (let ((t721 (syntax-object-module235 e674))) (if t721 t721 mod679))) (if (self-evaluating? e674) (values (quote constant) #f e674 w676 s677 mod679) (values (quote other) #f e674 w676 s677 mod679))))))) (chi-when-list281 (lambda (e722 when-list723 w724) (letrec ((f725 (lambda (when-list726 situations727) (if (null? when-list726) situations727 (f725 (cdr when-list726) (cons (let ((x728 (car when-list726))) (if (free-id=?271 x728 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?271 x728 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?271 x728 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e722 (wrap276 x728 w724 #f)))))) situations727)))))) (f725 when-list723 (quote ()))))) (chi-install-global280 (lambda (name729 e730) (build-global-definition223 #f name729 (if (let ((v731 (module-variable (current-module) name729))) (if v731 (if (variable-bound? v731) (if (macro? (variable-ref v731)) (not (eq? (macro-type (variable-ref v731)) (quote syncase-macro))) #f) #f) #f)) (build-application215 #f (build-primref225 #f (quote make-extended-syncase-macro)) (list (build-application215 #f (build-primref225 #f (quote module-ref)) (list (build-application215 #f (build-primref225 #f (quote current-module)) (quote ())) (build-data226 #f name729))) (build-data226 #f (quote macro)) e730)) (build-application215 #f (build-primref225 #f (quote make-syncase-macro)) (list (build-data226 #f (quote macro)) e730)))))) (chi-top-sequence279 (lambda (body732 r733 w734 s735 m736 esew737 mod738) (build-sequence227 s735 (letrec ((dobody739 (lambda (body740 r741 w742 m743 esew744 mod745) (if (null? body740) (quote ()) (let ((first746 (chi-top283 (car body740) r741 w742 m743 esew744 mod745))) (cons first746 (dobody739 (cdr body740) r741 w742 m743 esew744 mod745))))))) (dobody739 body732 r733 w734 m736 esew737 mod738))))) (chi-sequence278 (lambda (body747 r748 w749 s750 mod751) (build-sequence227 s750 (letrec ((dobody752 (lambda (body753 r754 w755 mod756) (if (null? body753) (quote ()) (let ((first757 (chi284 (car body753) r754 w755 mod756))) (cons first757 (dobody752 (cdr body753) r754 w755 mod756))))))) (dobody752 body747 r748 w749 mod751))))) (source-wrap277 (lambda (x758 w759 s760 defmod761) (begin (if (if s760 (pair? x758) #f) (set-source-properties! x758 s760)) (wrap276 x758 w759 defmod761)))) (wrap276 (lambda (x762 w763 defmod764) (if (if (null? (wrap-marks251 w763)) (null? (wrap-subst252 w763)) #f) x762 (if (syntax-object?232 x762) (make-syntax-object231 (syntax-object-expression233 x762) (join-wraps267 w763 (syntax-object-wrap234 x762)) (syntax-object-module235 x762)) (if (null? x762) x762 (make-syntax-object231 x762 w763 defmod764)))))) (bound-id-member?275 (lambda (x765 list766) (if (not (null? list766)) (let ((t767 (bound-id=?272 x765 (car list766)))) (if t767 t767 (bound-id-member?275 x765 (cdr list766)))) #f))) (distinct-bound-ids?274 (lambda (ids768) (letrec ((distinct?769 (lambda (ids770) (let ((t771 (null? ids770))) (if t771 t771 (if (not (bound-id-member?275 (car ids770) (cdr ids770))) (distinct?769 (cdr ids770)) #f)))))) (distinct?769 ids768)))) (valid-bound-ids?273 (lambda (ids772) (if (letrec ((all-ids?773 (lambda (ids774) (let ((t775 (null? ids774))) (if t775 t775 (if (id?248 (car ids774)) (all-ids?773 (cdr ids774)) #f)))))) (all-ids?773 ids772)) (distinct-bound-ids?274 ids772) #f))) (bound-id=?272 (lambda (i776 j777) (if (if (syntax-object?232 i776) (syntax-object?232 j777) #f) (if (eq? (syntax-object-expression233 i776) (syntax-object-expression233 j777)) (same-marks?269 (wrap-marks251 (syntax-object-wrap234 i776)) (wrap-marks251 (syntax-object-wrap234 j777))) #f) (eq? i776 j777)))) (free-id=?271 (lambda (i778 j779) (if (eq? (let ((x780 i778)) (if (syntax-object?232 x780) (syntax-object-expression233 x780) x780)) (let ((x781 j779)) (if (syntax-object?232 x781) (syntax-object-expression233 x781) x781))) (eq? (id-var-name270 i778 (quote (()))) (id-var-name270 j779 (quote (())))) #f))) (id-var-name270 (lambda (id782 w783) (letrec ((search-vector-rib786 (lambda (sym792 subst793 marks794 symnames795 ribcage796) (let ((n797 (vector-length symnames795))) (letrec ((f798 (lambda (i799) (if (fx=208 i799 n797) (search784 sym792 (cdr subst793) marks794) (if (if (eq? (vector-ref symnames795 i799) sym792) (same-marks?269 marks794 (vector-ref (ribcage-marks258 ribcage796) i799)) #f) (values (vector-ref (ribcage-labels259 ribcage796) i799) marks794) (f798 (fx+206 i799 1))))))) (f798 0))))) (search-list-rib785 (lambda (sym800 subst801 marks802 symnames803 ribcage804) (letrec ((f805 (lambda (symnames806 i807) (if (null? symnames806) (search784 sym800 (cdr subst801) marks802) (if (if (eq? (car symnames806) sym800) (same-marks?269 marks802 (list-ref (ribcage-marks258 ribcage804) i807)) #f) (values (list-ref (ribcage-labels259 ribcage804) i807) marks802) (f805 (cdr symnames806) (fx+206 i807 1))))))) (f805 symnames803 0)))) (search784 (lambda (sym808 subst809 marks810) (if (null? subst809) (values #f marks810) (let ((fst811 (car subst809))) (if (eq? fst811 (quote shift)) (search784 sym808 (cdr subst809) (cdr marks810)) (let ((symnames812 (ribcage-symnames257 fst811))) (if (vector? symnames812) (search-vector-rib786 sym808 subst809 marks810 symnames812 fst811) (search-list-rib785 sym808 subst809 marks810 symnames812 fst811))))))))) (if (symbol? id782) (let ((t813 (call-with-values (lambda () (search784 id782 (wrap-subst252 w783) (wrap-marks251 w783))) (lambda (x815 . ignore814) x815)))) (if t813 t813 id782)) (if (syntax-object?232 id782) (let ((id816 (syntax-object-expression233 id782)) (w1817 (syntax-object-wrap234 id782))) (let ((marks818 (join-marks268 (wrap-marks251 w783) (wrap-marks251 w1817)))) (call-with-values (lambda () (search784 id816 (wrap-subst252 w783) marks818)) (lambda (new-id819 marks820) (let ((t821 new-id819)) (if t821 t821 (let ((t822 (call-with-values (lambda () (search784 id816 (wrap-subst252 w1817) marks820)) (lambda (x824 . ignore823) x824)))) (if t822 t822 id816)))))))) (syntax-violation (quote id-var-name) "invalid id" id782)))))) (same-marks?269 (lambda (x825 y826) (let ((t827 (eq? x825 y826))) (if t827 t827 (if (not (null? x825)) (if (not (null? y826)) (if (eq? (car x825) (car y826)) (same-marks?269 (cdr x825) (cdr y826)) #f) #f) #f))))) (join-marks268 (lambda (m1828 m2829) (smart-append266 m1828 m2829))) (join-wraps267 (lambda (w1830 w2831) (let ((m1832 (wrap-marks251 w1830)) (s1833 (wrap-subst252 w1830))) (if (null? m1832) (if (null? s1833) w2831 (make-wrap250 (wrap-marks251 w2831) (smart-append266 s1833 (wrap-subst252 w2831)))) (make-wrap250 (smart-append266 m1832 (wrap-marks251 w2831)) (smart-append266 s1833 (wrap-subst252 w2831))))))) (smart-append266 (lambda (m1834 m2835) (if (null? m2835) m1834 (append m1834 m2835)))) (make-binding-wrap265 (lambda (ids836 labels837 w838) (if (null? ids836) w838 (make-wrap250 (wrap-marks251 w838) (cons (let ((labelvec839 (list->vector labels837))) (let ((n840 (vector-length labelvec839))) (let ((symnamevec841 (make-vector n840)) (marksvec842 (make-vector n840))) (begin (letrec ((f843 (lambda (ids844 i845) (if (not (null? ids844)) (call-with-values (lambda () (id-sym-name&marks249 (car ids844) w838)) (lambda (symname846 marks847) (begin (vector-set! symnamevec841 i845 symname846) (vector-set! marksvec842 i845 marks847) (f843 (cdr ids844) (fx+206 i845 1))))))))) (f843 ids836 0)) (make-ribcage255 symnamevec841 marksvec842 labelvec839))))) (wrap-subst252 w838)))))) (extend-ribcage!264 (lambda (ribcage848 id849 label850) (begin (set-ribcage-symnames!260 ribcage848 (cons (syntax-object-expression233 id849) (ribcage-symnames257 ribcage848))) (set-ribcage-marks!261 ribcage848 (cons (wrap-marks251 (syntax-object-wrap234 id849)) (ribcage-marks258 ribcage848))) (set-ribcage-labels!262 ribcage848 (cons label850 (ribcage-labels259 ribcage848)))))) (anti-mark263 (lambda (w851) (make-wrap250 (cons #f (wrap-marks251 w851)) (cons (quote shift) (wrap-subst252 w851))))) (set-ribcage-labels!262 (lambda (x852 update853) (vector-set! x852 3 update853))) (set-ribcage-marks!261 (lambda (x854 update855) (vector-set! x854 2 update855))) (set-ribcage-symnames!260 (lambda (x856 update857) (vector-set! x856 1 update857))) (ribcage-labels259 (lambda (x858) (vector-ref x858 3))) (ribcage-marks258 (lambda (x859) (vector-ref x859 2))) (ribcage-symnames257 (lambda (x860) (vector-ref x860 1))) (ribcage?256 (lambda (x861) (if (vector? x861) (if (= (vector-length x861) 4) (eq? (vector-ref x861 0) (quote ribcage)) #f) #f))) (make-ribcage255 (lambda (symnames862 marks863 labels864) (vector (quote ribcage) symnames862 marks863 labels864))) (gen-labels254 (lambda (ls865) (if (null? ls865) (quote ()) (cons (gen-label253) (gen-labels254 (cdr ls865)))))) (gen-label253 (lambda () (string #\i))) (wrap-subst252 cdr) (wrap-marks251 car) (make-wrap250 cons) (id-sym-name&marks249 (lambda (x866 w867) (if (syntax-object?232 x866) (values (syntax-object-expression233 x866) (join-marks268 (wrap-marks251 w867) (wrap-marks251 (syntax-object-wrap234 x866)))) (values x866 (wrap-marks251 w867))))) (id?248 (lambda (x868) (if (symbol? x868) #t (if (syntax-object?232 x868) (symbol? (syntax-object-expression233 x868)) #f)))) (nonsymbol-id?247 (lambda (x869) (if (syntax-object?232 x869) (symbol? (syntax-object-expression233 x869)) #f))) (global-extend246 (lambda (type870 sym871 val872) (put-global-definition-hook212 sym871 type870 val872))) (lookup245 (lambda (x873 r874 mod875) (let ((t876 (assq x873 r874))) (if t876 (cdr t876) (if (symbol? x873) (let ((t877 (get-global-definition-hook213 x873 mod875))) (if t877 t877 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env244 (lambda (r878) (if (null? r878) (quote ()) (let ((a879 (car r878))) (if (eq? (cadr a879) (quote macro)) (cons a879 (macros-only-env244 (cdr r878))) (macros-only-env244 (cdr r878))))))) (extend-var-env243 (lambda (labels880 vars881 r882) (if (null? labels880) r882 (extend-var-env243 (cdr labels880) (cdr vars881) (cons (cons (car labels880) (cons (quote lexical) (car vars881))) r882))))) (extend-env242 (lambda (labels883 bindings884 r885) (if (null? labels883) r885 (extend-env242 (cdr labels883) (cdr bindings884) (cons (cons (car labels883) (car bindings884)) r885))))) (binding-value241 cdr) (binding-type240 car) (source-annotation239 (lambda (x886) (if (syntax-object?232 x886) (source-annotation239 (syntax-object-expression233 x886)) (if (pair? x886) (let ((props887 (source-properties x886))) (if (pair? props887) props887 #f)) #f)))) (set-syntax-object-module!238 (lambda (x888 update889) (vector-set! x888 3 update889))) (set-syntax-object-wrap!237 (lambda (x890 update891) (vector-set! x890 2 update891))) (set-syntax-object-expression!236 (lambda (x892 update893) (vector-set! x892 1 update893))) (syntax-object-module235 (lambda (x894) (vector-ref x894 3))) (syntax-object-wrap234 (lambda (x895) (vector-ref x895 2))) (syntax-object-expression233 (lambda (x896) (vector-ref x896 1))) (syntax-object?232 (lambda (x897) (if (vector? x897) (if (= (vector-length x897) 4) (eq? (vector-ref x897 0) (quote syntax-object)) #f) #f))) (make-syntax-object231 (lambda (expression898 wrap899 module900) (vector (quote syntax-object) expression898 wrap899 module900))) (build-letrec230 (lambda (src901 ids902 vars903 val-exps904 body-exp905) (if (null? vars903) body-exp905 (let ((atom-key906 (fluid-ref *mode*205))) (if (memv atom-key906 (quote (c))) (begin (for-each maybe-name-value!222 ids902 val-exps904) ((@ (language tree-il) make-letrec) src901 ids902 vars903 val-exps904 body-exp905)) (list (quote letrec) (map list vars903 val-exps904) body-exp905)))))) (build-named-let229 (lambda (src907 ids908 vars909 val-exps910 body-exp911) (let ((f912 (car vars909)) (f-name913 (car ids908)) (vars914 (cdr vars909)) (ids915 (cdr ids908))) (let ((atom-key916 (fluid-ref *mode*205))) (if (memv atom-key916 (quote (c))) (let ((proc917 (build-lambda224 src907 ids915 vars914 #f body-exp911))) (begin (maybe-name-value!222 f-name913 proc917) (for-each maybe-name-value!222 ids915 val-exps910) ((@ (language tree-il) make-letrec) src907 (list f-name913) (list f912) (list proc917) (build-application215 src907 (build-lexical-reference217 (quote fun) src907 f-name913 f912) val-exps910)))) (list (quote let) f912 (map list vars914 val-exps910) body-exp911)))))) (build-let228 (lambda (src918 ids919 vars920 val-exps921 body-exp922) (if (null? vars920) body-exp922 (let ((atom-key923 (fluid-ref *mode*205))) (if (memv atom-key923 (quote (c))) (begin (for-each maybe-name-value!222 ids919 val-exps921) ((@ (language tree-il) make-let) src918 ids919 vars920 val-exps921 body-exp922)) (list (quote let) (map list vars920 val-exps921) body-exp922)))))) (build-sequence227 (lambda (src924 exps925) (if (null? (cdr exps925)) (car exps925) (let ((atom-key926 (fluid-ref *mode*205))) (if (memv atom-key926 (quote (c))) ((@ (language tree-il) make-sequence) src924 exps925) (cons (quote begin) exps925)))))) (build-data226 (lambda (src927 exp928) (let ((atom-key929 (fluid-ref *mode*205))) (if (memv atom-key929 (quote (c))) ((@ (language tree-il) make-const) src927 exp928) (if (if (self-evaluating? exp928) (not (vector? exp928)) #f) exp928 (list (quote quote) exp928)))))) (build-primref225 (lambda (src930 name931) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key932 (fluid-ref *mode*205))) (if (memv atom-key932 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src930 name931) name931)) (let ((atom-key933 (fluid-ref *mode*205))) (if (memv atom-key933 (quote (c))) ((@ (language tree-il) make-module-ref) src930 (quote (guile)) name931 #f) (list (quote @@) (quote (guile)) name931)))))) (build-lambda224 (lambda (src934 ids935 vars936 docstring937 exp938) (let ((atom-key939 (fluid-ref *mode*205))) (if (memv atom-key939 (quote (c))) ((@ (language tree-il) make-lambda) src934 ids935 vars936 (if docstring937 (list (cons (quote documentation) docstring937)) (quote ())) exp938) (cons (quote lambda) (cons vars936 (append (if docstring937 (list docstring937) (quote ())) (list exp938)))))))) (build-global-definition223 (lambda (source940 var941 exp942) (let ((atom-key943 (fluid-ref *mode*205))) (if (memv atom-key943 (quote (c))) (begin (maybe-name-value!222 var941 exp942) ((@ (language tree-il) make-toplevel-define) source940 var941 exp942)) (list (quote define) var941 exp942))))) (maybe-name-value!222 (lambda (name944 val945) (if ((@ (language tree-il) lambda?) val945) (let ((meta946 ((@ (language tree-il) lambda-meta) val945))) (if (not (assq (quote name) meta946)) ((setter (@ (language tree-il) lambda-meta)) val945 (acons (quote name) name944 meta946))))))) (build-global-assignment221 (lambda (source947 var948 exp949 mod950) (analyze-variable219 mod950 var948 (lambda (mod951 var952 public?953) (let ((atom-key954 (fluid-ref *mode*205))) (if (memv atom-key954 (quote (c))) ((@ (language tree-il) make-module-set) source947 mod951 var952 public?953 exp949) (list (quote set!) (list (if public?953 (quote @) (quote @@)) mod951 var952) exp949)))) (lambda (var955) (let ((atom-key956 (fluid-ref *mode*205))) (if (memv atom-key956 (quote (c))) ((@ (language tree-il) make-toplevel-set) source947 var955 exp949) (list (quote set!) var955 exp949))))))) (build-global-reference220 (lambda (source957 var958 mod959) (analyze-variable219 mod959 var958 (lambda (mod960 var961 public?962) (let ((atom-key963 (fluid-ref *mode*205))) (if (memv atom-key963 (quote (c))) ((@ (language tree-il) make-module-ref) source957 mod960 var961 public?962) (list (if public?962 (quote @) (quote @@)) mod960 var961)))) (lambda (var964) (let ((atom-key965 (fluid-ref *mode*205))) (if (memv atom-key965 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source957 var964) var964)))))) (analyze-variable219 (lambda (mod966 var967 modref-cont968 bare-cont969) (if (not mod966) (bare-cont969 var967) (let ((kind970 (car mod966)) (mod971 (cdr mod966))) (if (memv kind970 (quote (public))) (modref-cont968 mod971 var967 #t) (if (memv kind970 (quote (private))) (if (not (equal? mod971 (module-name (current-module)))) (modref-cont968 mod971 var967 #f) (bare-cont969 var967)) (if (memv kind970 (quote (bare))) (bare-cont969 var967) (if (memv kind970 (quote (hygiene))) (if (if (not (equal? mod971 (module-name (current-module)))) (module-variable (resolve-module mod971) var967) #f) (modref-cont968 mod971 var967 #f) (bare-cont969 var967)) (syntax-violation #f "bad module kind" var967 mod971))))))))) (build-lexical-assignment218 (lambda (source972 name973 var974 exp975) (let ((atom-key976 (fluid-ref *mode*205))) (if (memv atom-key976 (quote (c))) ((@ (language tree-il) make-lexical-set) source972 name973 var974 exp975) (list (quote set!) var974 exp975))))) (build-lexical-reference217 (lambda (type977 source978 name979 var980) (let ((atom-key981 (fluid-ref *mode*205))) (if (memv atom-key981 (quote (c))) ((@ (language tree-il) make-lexical-ref) source978 name979 var980) var980)))) (build-conditional216 (lambda (source982 test-exp983 then-exp984 else-exp985) (let ((atom-key986 (fluid-ref *mode*205))) (if (memv atom-key986 (quote (c))) ((@ (language tree-il) make-conditional) source982 test-exp983 then-exp984 else-exp985) (if (equal? else-exp985 (quote (if #f #f))) (list (quote if) test-exp983 then-exp984) (list (quote if) test-exp983 then-exp984 else-exp985)))))) (build-application215 (lambda (source987 fun-exp988 arg-exps989) (let ((atom-key990 (fluid-ref *mode*205))) (if (memv atom-key990 (quote (c))) ((@ (language tree-il) make-application) source987 fun-exp988 arg-exps989) (cons fun-exp988 arg-exps989))))) (build-void214 (lambda (source991) (let ((atom-key992 (fluid-ref *mode*205))) (if (memv atom-key992 (quote (c))) ((@ (language tree-il) make-void) source991) (quote (if #f #f)))))) (get-global-definition-hook213 (lambda (symbol993 module994) (begin (if (if (not module994) (current-module) #f) (warn "module system is booted, we should have a module" symbol993)) (let ((v995 (module-variable (if module994 (resolve-module (cdr module994)) (current-module)) symbol993))) (if v995 (if (variable-bound? v995) (let ((val996 (variable-ref v995))) (if (macro? val996) (if (syncase-macro-type val996) (cons (syncase-macro-type val996) (syncase-macro-binding val996)) #f) #f)) #f) #f))))) (put-global-definition-hook212 (lambda (symbol997 type998 val999) (let ((existing1000 (let ((v1001 (module-variable (current-module) symbol997))) (if v1001 (if (variable-bound? v1001) (let ((val1002 (variable-ref v1001))) (if (macro? val1002) (if (not (syncase-macro-type val1002)) val1002 #f) #f)) #f) #f)))) (module-define! (current-module) symbol997 (if existing1000 (make-extended-syncase-macro existing1000 type998 val999) (make-syncase-macro type998 val999)))))) (local-eval-hook211 (lambda (x1003 mod1004) (primitive-eval (list noexpand204 (let ((atom-key1005 (fluid-ref *mode*205))) (if (memv atom-key1005 (quote (c))) ((@ (language tree-il) tree-il->scheme) x1003) x1003)))))) (top-level-eval-hook210 (lambda (x1006 mod1007) (primitive-eval (list noexpand204 (let ((atom-key1008 (fluid-ref *mode*205))) (if (memv atom-key1008 (quote (c))) ((@ (language tree-il) tree-il->scheme) x1006) x1006)))))) (fx<209 <) (fx=208 =) (fx-207 -) (fx+206 +) (*mode*205 (make-fluid)) (noexpand204 "noexpand")) (begin (global-extend246 (quote local-syntax) (quote letrec-syntax) #t) (global-extend246 (quote local-syntax) (quote let-syntax) #f) (global-extend246 (quote core) (quote fluid-let-syntax) (lambda (e1009 r1010 w1011 s1012 mod1013) ((lambda (tmp1014) ((lambda (tmp1015) (if (if tmp1015 (apply (lambda (_1016 var1017 val1018 e11019 e21020) (valid-bound-ids?273 var1017)) tmp1015) #f) (apply (lambda (_1022 var1023 val1024 e11025 e21026) (let ((names1027 (map (lambda (x1028) (id-var-name270 x1028 w1011)) var1023))) (begin (for-each (lambda (id1030 n1031) (let ((atom-key1032 (binding-type240 (lookup245 n1031 r1010 mod1013)))) (if (memv atom-key1032 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1009 (source-wrap277 id1030 w1011 s1012 mod1013))))) var1023 names1027) (chi-body288 (cons e11025 e21026) (source-wrap277 e1009 w1011 s1012 mod1013) (extend-env242 names1027 (let ((trans-r1035 (macros-only-env244 r1010))) (map (lambda (x1036) (cons (quote macro) (eval-local-transformer291 (chi284 x1036 trans-r1035 w1011 mod1013) mod1013))) val1024)) r1010) w1011 mod1013)))) tmp1015) ((lambda (_1038) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap277 e1009 w1011 s1012 mod1013))) tmp1014))) ($sc-dispatch tmp1014 (quote (any #(each (any any)) any . each-any))))) e1009))) (global-extend246 (quote core) (quote quote) (lambda (e1039 r1040 w1041 s1042 mod1043) ((lambda (tmp1044) ((lambda (tmp1045) (if tmp1045 (apply (lambda (_1046 e1047) (build-data226 s1042 (strip294 e1047 w1041))) tmp1045) ((lambda (_1048) (syntax-violation (quote quote) "bad syntax" (source-wrap277 e1039 w1041 s1042 mod1043))) tmp1044))) ($sc-dispatch tmp1044 (quote (any any))))) e1039))) (global-extend246 (quote core) (quote syntax) (letrec ((regen1056 (lambda (x1057) (let ((atom-key1058 (car x1057))) (if (memv atom-key1058 (quote (ref))) (build-lexical-reference217 (quote value) #f (cadr x1057) (cadr x1057)) (if (memv atom-key1058 (quote (primitive))) (build-primref225 #f (cadr x1057)) (if (memv atom-key1058 (quote (quote))) (build-data226 #f (cadr x1057)) (if (memv atom-key1058 (quote (lambda))) (build-lambda224 #f (cadr x1057) (cadr x1057) #f (regen1056 (caddr x1057))) (build-application215 #f (build-primref225 #f (car x1057)) (map regen1056 (cdr x1057)))))))))) (gen-vector1055 (lambda (x1059) (if (eq? (car x1059) (quote list)) (cons (quote vector) (cdr x1059)) (if (eq? (car x1059) (quote quote)) (list (quote quote) (list->vector (cadr x1059))) (list (quote list->vector) x1059))))) (gen-append1054 (lambda (x1060 y1061) (if (equal? y1061 (quote (quote ()))) x1060 (list (quote append) x1060 y1061)))) (gen-cons1053 (lambda (x1062 y1063) (let ((atom-key1064 (car y1063))) (if (memv atom-key1064 (quote (quote))) (if (eq? (car x1062) (quote quote)) (list (quote quote) (cons (cadr x1062) (cadr y1063))) (if (eq? (cadr y1063) (quote ())) (list (quote list) x1062) (list (quote cons) x1062 y1063))) (if (memv atom-key1064 (quote (list))) (cons (quote list) (cons x1062 (cdr y1063))) (list (quote cons) x1062 y1063)))))) (gen-map1052 (lambda (e1065 map-env1066) (let ((formals1067 (map cdr map-env1066)) (actuals1068 (map (lambda (x1069) (list (quote ref) (car x1069))) map-env1066))) (if (eq? (car e1065) (quote ref)) (car actuals1068) (if (and-map (lambda (x1070) (if (eq? (car x1070) (quote ref)) (memq (cadr x1070) formals1067) #f)) (cdr e1065)) (cons (quote map) (cons (list (quote primitive) (car e1065)) (map (let ((r1071 (map cons formals1067 actuals1068))) (lambda (x1072) (cdr (assq (cadr x1072) r1071)))) (cdr e1065)))) (cons (quote map) (cons (list (quote lambda) formals1067 e1065) actuals1068))))))) (gen-mappend1051 (lambda (e1073 map-env1074) (list (quote apply) (quote (primitive append)) (gen-map1052 e1073 map-env1074)))) (gen-ref1050 (lambda (src1075 var1076 level1077 maps1078) (if (fx=208 level1077 0) (values var1076 maps1078) (if (null? maps1078) (syntax-violation (quote syntax) "missing ellipsis" src1075) (call-with-values (lambda () (gen-ref1050 src1075 var1076 (fx-207 level1077 1) (cdr maps1078))) (lambda (outer-var1079 outer-maps1080) (let ((b1081 (assq outer-var1079 (car maps1078)))) (if b1081 (values (cdr b1081) maps1078) (let ((inner-var1082 (gen-var295 (quote tmp)))) (values inner-var1082 (cons (cons (cons outer-var1079 inner-var1082) (car maps1078)) outer-maps1080))))))))))) (gen-syntax1049 (lambda (src1083 e1084 r1085 maps1086 ellipsis?1087 mod1088) (if (id?248 e1084) (let ((label1089 (id-var-name270 e1084 (quote (()))))) (let ((b1090 (lookup245 label1089 r1085 mod1088))) (if (eq? (binding-type240 b1090) (quote syntax)) (call-with-values (lambda () (let ((var.lev1091 (binding-value241 b1090))) (gen-ref1050 src1083 (car var.lev1091) (cdr var.lev1091) maps1086))) (lambda (var1092 maps1093) (values (list (quote ref) var1092) maps1093))) (if (ellipsis?1087 e1084) (syntax-violation (quote syntax) "misplaced ellipsis" src1083) (values (list (quote quote) e1084) maps1086))))) ((lambda (tmp1094) ((lambda (tmp1095) (if (if tmp1095 (apply (lambda (dots1096 e1097) (ellipsis?1087 dots1096)) tmp1095) #f) (apply (lambda (dots1098 e1099) (gen-syntax1049 src1083 e1099 r1085 maps1086 (lambda (x1100) #f) mod1088)) tmp1095) ((lambda (tmp1101) (if (if tmp1101 (apply (lambda (x1102 dots1103 y1104) (ellipsis?1087 dots1103)) tmp1101) #f) (apply (lambda (x1105 dots1106 y1107) (letrec ((f1108 (lambda (y1109 k1110) ((lambda (tmp1114) ((lambda (tmp1115) (if (if tmp1115 (apply (lambda (dots1116 y1117) (ellipsis?1087 dots1116)) tmp1115) #f) (apply (lambda (dots1118 y1119) (f1108 y1119 (lambda (maps1120) (call-with-values (lambda () (k1110 (cons (quote ()) maps1120))) (lambda (x1121 maps1122) (if (null? (car maps1122)) (syntax-violation (quote syntax) "extra ellipsis" src1083) (values (gen-mappend1051 x1121 (car maps1122)) (cdr maps1122)))))))) tmp1115) ((lambda (_1123) (call-with-values (lambda () (gen-syntax1049 src1083 y1109 r1085 maps1086 ellipsis?1087 mod1088)) (lambda (y1124 maps1125) (call-with-values (lambda () (k1110 maps1125)) (lambda (x1126 maps1127) (values (gen-append1054 x1126 y1124) maps1127)))))) tmp1114))) ($sc-dispatch tmp1114 (quote (any . any))))) y1109)))) (f1108 y1107 (lambda (maps1111) (call-with-values (lambda () (gen-syntax1049 src1083 x1105 r1085 (cons (quote ()) maps1111) ellipsis?1087 mod1088)) (lambda (x1112 maps1113) (if (null? (car maps1113)) (syntax-violation (quote syntax) "extra ellipsis" src1083) (values (gen-map1052 x1112 (car maps1113)) (cdr maps1113))))))))) tmp1101) ((lambda (tmp1128) (if tmp1128 (apply (lambda (x1129 y1130) (call-with-values (lambda () (gen-syntax1049 src1083 x1129 r1085 maps1086 ellipsis?1087 mod1088)) (lambda (x1131 maps1132) (call-with-values (lambda () (gen-syntax1049 src1083 y1130 r1085 maps1132 ellipsis?1087 mod1088)) (lambda (y1133 maps1134) (values (gen-cons1053 x1131 y1133) maps1134)))))) tmp1128) ((lambda (tmp1135) (if tmp1135 (apply (lambda (e11136 e21137) (call-with-values (lambda () (gen-syntax1049 src1083 (cons e11136 e21137) r1085 maps1086 ellipsis?1087 mod1088)) (lambda (e1139 maps1140) (values (gen-vector1055 e1139) maps1140)))) tmp1135) ((lambda (_1141) (values (list (quote quote) e1084) maps1086)) tmp1094))) ($sc-dispatch tmp1094 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1094 (quote (any . any)))))) ($sc-dispatch tmp1094 (quote (any any . any)))))) ($sc-dispatch tmp1094 (quote (any any))))) e1084))))) (lambda (e1142 r1143 w1144 s1145 mod1146) (let ((e1147 (source-wrap277 e1142 w1144 s1145 mod1146))) ((lambda (tmp1148) ((lambda (tmp1149) (if tmp1149 (apply (lambda (_1150 x1151) (call-with-values (lambda () (gen-syntax1049 e1147 x1151 r1143 (quote ()) ellipsis?293 mod1146)) (lambda (e1152 maps1153) (regen1056 e1152)))) tmp1149) ((lambda (_1154) (syntax-violation (quote syntax) "bad `syntax' form" e1147)) tmp1148))) ($sc-dispatch tmp1148 (quote (any any))))) e1147))))) (global-extend246 (quote core) (quote lambda) (lambda (e1155 r1156 w1157 s1158 mod1159) ((lambda (tmp1160) ((lambda (tmp1161) (if tmp1161 (apply (lambda (_1162 c1163) (chi-lambda-clause289 (source-wrap277 e1155 w1157 s1158 mod1159) #f c1163 r1156 w1157 mod1159 (lambda (names1164 vars1165 docstring1166 body1167) (build-lambda224 s1158 names1164 vars1165 docstring1166 body1167)))) tmp1161) (syntax-violation #f "source expression failed to match any pattern" tmp1160))) ($sc-dispatch tmp1160 (quote (any . any))))) e1155))) (global-extend246 (quote core) (quote let) (letrec ((chi-let1168 (lambda (e1169 r1170 w1171 s1172 mod1173 constructor1174 ids1175 vals1176 exps1177) (if (not (valid-bound-ids?273 ids1175)) (syntax-violation (quote let) "duplicate bound variable" e1169) (let ((labels1178 (gen-labels254 ids1175)) (new-vars1179 (map gen-var295 ids1175))) (let ((nw1180 (make-binding-wrap265 ids1175 labels1178 w1171)) (nr1181 (extend-var-env243 labels1178 new-vars1179 r1170))) (constructor1174 s1172 (map syntax->datum ids1175) new-vars1179 (map (lambda (x1182) (chi284 x1182 r1170 w1171 mod1173)) vals1176) (chi-body288 exps1177 (source-wrap277 e1169 nw1180 s1172 mod1173) nr1181 nw1180 mod1173)))))))) (lambda (e1183 r1184 w1185 s1186 mod1187) ((lambda (tmp1188) ((lambda (tmp1189) (if (if tmp1189 (apply (lambda (_1190 id1191 val1192 e11193 e21194) (and-map id?248 id1191)) tmp1189) #f) (apply (lambda (_1196 id1197 val1198 e11199 e21200) (chi-let1168 e1183 r1184 w1185 s1186 mod1187 build-let228 id1197 val1198 (cons e11199 e21200))) tmp1189) ((lambda (tmp1204) (if (if tmp1204 (apply (lambda (_1205 f1206 id1207 val1208 e11209 e21210) (if (id?248 f1206) (and-map id?248 id1207) #f)) tmp1204) #f) (apply (lambda (_1212 f1213 id1214 val1215 e11216 e21217) (chi-let1168 e1183 r1184 w1185 s1186 mod1187 build-named-let229 (cons f1213 id1214) val1215 (cons e11216 e21217))) tmp1204) ((lambda (_1221) (syntax-violation (quote let) "bad let" (source-wrap277 e1183 w1185 s1186 mod1187))) tmp1188))) ($sc-dispatch tmp1188 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1188 (quote (any #(each (any any)) any . each-any))))) e1183)))) (global-extend246 (quote core) (quote letrec) (lambda (e1222 r1223 w1224 s1225 mod1226) ((lambda (tmp1227) ((lambda (tmp1228) (if (if tmp1228 (apply (lambda (_1229 id1230 val1231 e11232 e21233) (and-map id?248 id1230)) tmp1228) #f) (apply (lambda (_1235 id1236 val1237 e11238 e21239) (let ((ids1240 id1236)) (if (not (valid-bound-ids?273 ids1240)) (syntax-violation (quote letrec) "duplicate bound variable" e1222) (let ((labels1242 (gen-labels254 ids1240)) (new-vars1243 (map gen-var295 ids1240))) (let ((w1244 (make-binding-wrap265 ids1240 labels1242 w1224)) (r1245 (extend-var-env243 labels1242 new-vars1243 r1223))) (build-letrec230 s1225 (map syntax->datum ids1240) new-vars1243 (map (lambda (x1246) (chi284 x1246 r1245 w1244 mod1226)) val1237) (chi-body288 (cons e11238 e21239) (source-wrap277 e1222 w1244 s1225 mod1226) r1245 w1244 mod1226))))))) tmp1228) ((lambda (_1249) (syntax-violation (quote letrec) "bad letrec" (source-wrap277 e1222 w1224 s1225 mod1226))) tmp1227))) ($sc-dispatch tmp1227 (quote (any #(each (any any)) any . each-any))))) e1222))) (global-extend246 (quote core) (quote set!) (lambda (e1250 r1251 w1252 s1253 mod1254) ((lambda (tmp1255) ((lambda (tmp1256) (if (if tmp1256 (apply (lambda (_1257 id1258 val1259) (id?248 id1258)) tmp1256) #f) (apply (lambda (_1260 id1261 val1262) (let ((val1263 (chi284 val1262 r1251 w1252 mod1254)) (n1264 (id-var-name270 id1261 w1252))) (let ((b1265 (lookup245 n1264 r1251 mod1254))) (let ((atom-key1266 (binding-type240 b1265))) (if (memv atom-key1266 (quote (lexical))) (build-lexical-assignment218 s1253 (syntax->datum id1261) (binding-value241 b1265) val1263) (if (memv atom-key1266 (quote (global))) (build-global-assignment221 s1253 n1264 val1263 mod1254) (if (memv atom-key1266 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap276 id1261 w1252 mod1254)) (syntax-violation (quote set!) "bad set!" (source-wrap277 e1250 w1252 s1253 mod1254))))))))) tmp1256) ((lambda (tmp1267) (if tmp1267 (apply (lambda (_1268 head1269 tail1270 val1271) (call-with-values (lambda () (syntax-type282 head1269 r1251 (quote (())) #f #f mod1254)) (lambda (type1272 value1273 ee1274 ww1275 ss1276 modmod1277) (if (memv type1272 (quote (module-ref))) (let ((val1278 (chi284 val1271 r1251 w1252 mod1254))) (call-with-values (lambda () (value1273 (cons head1269 tail1270))) (lambda (id1280 mod1281) (build-global-assignment221 s1253 id1280 val1278 mod1281)))) (build-application215 s1253 (chi284 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1269) r1251 w1252 mod1254) (map (lambda (e1282) (chi284 e1282 r1251 w1252 mod1254)) (append tail1270 (list val1271)))))))) tmp1267) ((lambda (_1284) (syntax-violation (quote set!) "bad set!" (source-wrap277 e1250 w1252 s1253 mod1254))) tmp1255))) ($sc-dispatch tmp1255 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1255 (quote (any any any))))) e1250))) (global-extend246 (quote module-ref) (quote @) (lambda (e1285) ((lambda (tmp1286) ((lambda (tmp1287) (if (if tmp1287 (apply (lambda (_1288 mod1289 id1290) (if (and-map id?248 mod1289) (id?248 id1290) #f)) tmp1287) #f) (apply (lambda (_1292 mod1293 id1294) (values (syntax->datum id1294) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1293)))) tmp1287) (syntax-violation #f "source expression failed to match any pattern" tmp1286))) ($sc-dispatch tmp1286 (quote (any each-any any))))) e1285))) (global-extend246 (quote module-ref) (quote @@) (lambda (e1296) ((lambda (tmp1297) ((lambda (tmp1298) (if (if tmp1298 (apply (lambda (_1299 mod1300 id1301) (if (and-map id?248 mod1300) (id?248 id1301) #f)) tmp1298) #f) (apply (lambda (_1303 mod1304 id1305) (values (syntax->datum id1305) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1304)))) tmp1298) (syntax-violation #f "source expression failed to match any pattern" tmp1297))) ($sc-dispatch tmp1297 (quote (any each-any any))))) e1296))) (global-extend246 (quote core) (quote if) (lambda (e1307 r1308 w1309 s1310 mod1311) ((lambda (tmp1312) ((lambda (tmp1313) (if tmp1313 (apply (lambda (_1314 test1315 then1316) (build-conditional216 s1310 (chi284 test1315 r1308 w1309 mod1311) (chi284 then1316 r1308 w1309 mod1311) (build-void214 #f))) tmp1313) ((lambda (tmp1317) (if tmp1317 (apply (lambda (_1318 test1319 then1320 else1321) (build-conditional216 s1310 (chi284 test1319 r1308 w1309 mod1311) (chi284 then1320 r1308 w1309 mod1311) (chi284 else1321 r1308 w1309 mod1311))) tmp1317) (syntax-violation #f "source expression failed to match any pattern" tmp1312))) ($sc-dispatch tmp1312 (quote (any any any any)))))) ($sc-dispatch tmp1312 (quote (any any any))))) e1307))) (global-extend246 (quote begin) (quote begin) (quote ())) (global-extend246 (quote define) (quote define) (quote ())) (global-extend246 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend246 (quote eval-when) (quote eval-when) (quote ())) (global-extend246 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1325 (lambda (x1326 keys1327 clauses1328 r1329 mod1330) (if (null? clauses1328) (build-application215 #f (build-primref225 #f (quote syntax-violation)) (list (build-data226 #f #f) (build-data226 #f "source expression failed to match any pattern") x1326)) ((lambda (tmp1331) ((lambda (tmp1332) (if tmp1332 (apply (lambda (pat1333 exp1334) (if (if (id?248 pat1333) (and-map (lambda (x1335) (not (free-id=?271 pat1333 x1335))) (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 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1327)) #f) (let ((labels1336 (list (gen-label253))) (var1337 (gen-var295 pat1333))) (build-application215 #f (build-lambda224 #f (list (syntax->datum pat1333)) (list var1337) #f (chi284 exp1334 (extend-env242 labels1336 (list (cons (quote syntax) (cons var1337 0))) r1329) (make-binding-wrap265 (list pat1333) labels1336 (quote (()))) mod1330)) (list x1326))) (gen-clause1324 x1326 keys1327 (cdr clauses1328) r1329 pat1333 #t exp1334 mod1330))) tmp1332) ((lambda (tmp1338) (if tmp1338 (apply (lambda (pat1339 fender1340 exp1341) (gen-clause1324 x1326 keys1327 (cdr clauses1328) r1329 pat1339 fender1340 exp1341 mod1330)) tmp1338) ((lambda (_1342) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1328))) tmp1331))) ($sc-dispatch tmp1331 (quote (any any any)))))) ($sc-dispatch tmp1331 (quote (any any))))) (car clauses1328))))) (gen-clause1324 (lambda (x1343 keys1344 clauses1345 r1346 pat1347 fender1348 exp1349 mod1350) (call-with-values (lambda () (convert-pattern1322 pat1347 keys1344)) (lambda (p1351 pvars1352) (if (not (distinct-bound-ids?274 (map car pvars1352))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1347) (if (not (and-map (lambda (x1353) (not (ellipsis?293 (car x1353)))) pvars1352)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1347) (let ((y1354 (gen-var295 (quote tmp)))) (build-application215 #f (build-lambda224 #f (list (quote tmp)) (list y1354) #f (let ((y1355 (build-lexical-reference217 (quote value) #f (quote tmp) y1354))) (build-conditional216 #f ((lambda (tmp1356) ((lambda (tmp1357) (if tmp1357 (apply (lambda () y1355) tmp1357) ((lambda (_1358) (build-conditional216 #f y1355 (build-dispatch-call1323 pvars1352 fender1348 y1355 r1346 mod1350) (build-data226 #f #f))) tmp1356))) ($sc-dispatch tmp1356 (quote #(atom #t))))) fender1348) (build-dispatch-call1323 pvars1352 exp1349 y1355 r1346 mod1350) (gen-syntax-case1325 x1343 keys1344 clauses1345 r1346 mod1350)))) (list (if (eq? p1351 (quote any)) (build-application215 #f (build-primref225 #f (quote list)) (list x1343)) (build-application215 #f (build-primref225 #f (quote $sc-dispatch)) (list x1343 (build-data226 #f p1351))))))))))))) (build-dispatch-call1323 (lambda (pvars1359 exp1360 y1361 r1362 mod1363) (let ((ids1364 (map car pvars1359)) (levels1365 (map cdr pvars1359))) (let ((labels1366 (gen-labels254 ids1364)) (new-vars1367 (map gen-var295 ids1364))) (build-application215 #f (build-primref225 #f (quote apply)) (list (build-lambda224 #f (map syntax->datum ids1364) new-vars1367 #f (chi284 exp1360 (extend-env242 labels1366 (map (lambda (var1368 level1369) (cons (quote syntax) (cons var1368 level1369))) new-vars1367 (map cdr pvars1359)) r1362) (make-binding-wrap265 ids1364 labels1366 (quote (()))) mod1363)) y1361)))))) (convert-pattern1322 (lambda (pattern1370 keys1371) (letrec ((cvt1372 (lambda (p1373 n1374 ids1375) (if (id?248 p1373) (if (bound-id-member?275 p1373 keys1371) (values (vector (quote free-id) p1373) ids1375) (values (quote any) (cons (cons p1373 n1374) ids1375))) ((lambda (tmp1376) ((lambda (tmp1377) (if (if tmp1377 (apply (lambda (x1378 dots1379) (ellipsis?293 dots1379)) tmp1377) #f) (apply (lambda (x1380 dots1381) (call-with-values (lambda () (cvt1372 x1380 (fx+206 n1374 1) ids1375)) (lambda (p1382 ids1383) (values (if (eq? p1382 (quote any)) (quote each-any) (vector (quote each) p1382)) ids1383)))) tmp1377) ((lambda (tmp1384) (if tmp1384 (apply (lambda (x1385 y1386) (call-with-values (lambda () (cvt1372 y1386 n1374 ids1375)) (lambda (y1387 ids1388) (call-with-values (lambda () (cvt1372 x1385 n1374 ids1388)) (lambda (x1389 ids1390) (values (cons x1389 y1387) ids1390)))))) tmp1384) ((lambda (tmp1391) (if tmp1391 (apply (lambda () (values (quote ()) ids1375)) tmp1391) ((lambda (tmp1392) (if tmp1392 (apply (lambda (x1393) (call-with-values (lambda () (cvt1372 x1393 n1374 ids1375)) (lambda (p1395 ids1396) (values (vector (quote vector) p1395) ids1396)))) tmp1392) ((lambda (x1397) (values (vector (quote atom) (strip294 p1373 (quote (())))) ids1375)) tmp1376))) ($sc-dispatch tmp1376 (quote #(vector each-any)))))) ($sc-dispatch tmp1376 (quote ()))))) ($sc-dispatch tmp1376 (quote (any . any)))))) ($sc-dispatch tmp1376 (quote (any any))))) p1373))))) (cvt1372 pattern1370 0 (quote ())))))) (lambda (e1398 r1399 w1400 s1401 mod1402) (let ((e1403 (source-wrap277 e1398 w1400 s1401 mod1402))) ((lambda (tmp1404) ((lambda (tmp1405) (if tmp1405 (apply (lambda (_1406 val1407 key1408 m1409) (if (and-map (lambda (x1410) (if (id?248 x1410) (not (ellipsis?293 x1410)) #f)) key1408) (let ((x1412 (gen-var295 (quote tmp)))) (build-application215 s1401 (build-lambda224 #f (list (quote tmp)) (list x1412) #f (gen-syntax-case1325 (build-lexical-reference217 (quote value) #f (quote tmp) x1412) key1408 m1409 r1399 mod1402)) (list (chi284 val1407 r1399 (quote (())) mod1402)))) (syntax-violation (quote syntax-case) "invalid literals list" e1403))) tmp1405) (syntax-violation #f "source expression failed to match any pattern" tmp1404))) ($sc-dispatch tmp1404 (quote (any any each-any . each-any))))) e1403))))) (set! sc-expand (lambda (x1416 . rest1415) (if (if (pair? x1416) (equal? (car x1416) noexpand204) #f) (cadr x1416) (let ((m1417 (if (null? rest1415) (quote e) (car rest1415))) (esew1418 (if (let ((t1419 (null? rest1415))) (if t1419 t1419 (null? (cdr rest1415)))) (quote (eval)) (cadr rest1415)))) (with-fluid* *mode*205 m1417 (lambda () (chi-top283 x1416 (quote ()) (quote ((top))) m1417 esew1418 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1420) (nonsymbol-id?247 x1420))) (set! datum->syntax (lambda (id1421 datum1422) (make-syntax-object231 datum1422 (syntax-object-wrap234 id1421) #f))) (set! syntax->datum (lambda (x1423) (strip294 x1423 (quote (()))))) (set! generate-temporaries (lambda (ls1424) (begin (let ((x1425 ls1424)) (if (not (list? x1425)) (syntax-violation (quote generate-temporaries) "invalid argument" x1425))) (map (lambda (x1426) (wrap276 (gensym) (quote ((top))) #f)) ls1424)))) (set! free-identifier=? (lambda (x1427 y1428) (begin (let ((x1429 x1427)) (if (not (nonsymbol-id?247 x1429)) (syntax-violation (quote free-identifier=?) "invalid argument" x1429))) (let ((x1430 y1428)) (if (not (nonsymbol-id?247 x1430)) (syntax-violation (quote free-identifier=?) "invalid argument" x1430))) (free-id=?271 x1427 y1428)))) (set! bound-identifier=? (lambda (x1431 y1432) (begin (let ((x1433 x1431)) (if (not (nonsymbol-id?247 x1433)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1433))) (let ((x1434 y1432)) (if (not (nonsymbol-id?247 x1434)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1434))) (bound-id=?272 x1431 y1432)))) (set! syntax-violation (lambda (who1438 message1437 form1436 . subform1435) (begin (let ((x1439 who1438)) (if (not ((lambda (x1440) (let ((t1441 (not x1440))) (if t1441 t1441 (let ((t1442 (string? x1440))) (if t1442 t1442 (symbol? x1440)))))) x1439)) (syntax-violation (quote syntax-violation) "invalid argument" x1439))) (let ((x1443 message1437)) (if (not (string? x1443)) (syntax-violation (quote syntax-violation) "invalid argument" x1443))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1438 "~a: " "") "~a " (if (null? subform1435) "in ~a" "in subform `~s' of `~s'")) (let ((tail1444 (cons message1437 (map (lambda (x1445) (strip294 x1445 (quote (())))) (append subform1435 (list form1436)))))) (if who1438 (cons who1438 tail1444) tail1444)) #f)))) (letrec ((match1450 (lambda (e1451 p1452 w1453 r1454 mod1455) (if (not r1454) #f (if (eq? p1452 (quote any)) (cons (wrap276 e1451 w1453 mod1455) r1454) (if (syntax-object?232 e1451) (match*1449 (syntax-object-expression233 e1451) p1452 (join-wraps267 w1453 (syntax-object-wrap234 e1451)) r1454 (syntax-object-module235 e1451)) (match*1449 e1451 p1452 w1453 r1454 mod1455)))))) (match*1449 (lambda (e1456 p1457 w1458 r1459 mod1460) (if (null? p1457) (if (null? e1456) r1459 #f) (if (pair? p1457) (if (pair? e1456) (match1450 (car e1456) (car p1457) w1458 (match1450 (cdr e1456) (cdr p1457) w1458 r1459 mod1460) mod1460) #f) (if (eq? p1457 (quote each-any)) (let ((l1461 (match-each-any1447 e1456 w1458 mod1460))) (if l1461 (cons l1461 r1459) #f)) (let ((atom-key1462 (vector-ref p1457 0))) (if (memv atom-key1462 (quote (each))) (if (null? e1456) (match-empty1448 (vector-ref p1457 1) r1459) (let ((l1463 (match-each1446 e1456 (vector-ref p1457 1) w1458 mod1460))) (if l1463 (letrec ((collect1464 (lambda (l1465) (if (null? (car l1465)) r1459 (cons (map car l1465) (collect1464 (map cdr l1465))))))) (collect1464 l1463)) #f))) (if (memv atom-key1462 (quote (free-id))) (if (id?248 e1456) (if (free-id=?271 (wrap276 e1456 w1458 mod1460) (vector-ref p1457 1)) r1459 #f) #f) (if (memv atom-key1462 (quote (atom))) (if (equal? (vector-ref p1457 1) (strip294 e1456 w1458)) r1459 #f) (if (memv atom-key1462 (quote (vector))) (if (vector? e1456) (match1450 (vector->list e1456) (vector-ref p1457 1) w1458 r1459 mod1460) #f))))))))))) (match-empty1448 (lambda (p1466 r1467) (if (null? p1466) r1467 (if (eq? p1466 (quote any)) (cons (quote ()) r1467) (if (pair? p1466) (match-empty1448 (car p1466) (match-empty1448 (cdr p1466) r1467)) (if (eq? p1466 (quote each-any)) (cons (quote ()) r1467) (let ((atom-key1468 (vector-ref p1466 0))) (if (memv atom-key1468 (quote (each))) (match-empty1448 (vector-ref p1466 1) r1467) (if (memv atom-key1468 (quote (free-id atom))) r1467 (if (memv atom-key1468 (quote (vector))) (match-empty1448 (vector-ref p1466 1) r1467))))))))))) (match-each-any1447 (lambda (e1469 w1470 mod1471) (if (pair? e1469) (let ((l1472 (match-each-any1447 (cdr e1469) w1470 mod1471))) (if l1472 (cons (wrap276 (car e1469) w1470 mod1471) l1472) #f)) (if (null? e1469) (quote ()) (if (syntax-object?232 e1469) (match-each-any1447 (syntax-object-expression233 e1469) (join-wraps267 w1470 (syntax-object-wrap234 e1469)) mod1471) #f))))) (match-each1446 (lambda (e1473 p1474 w1475 mod1476) (if (pair? e1473) (let ((first1477 (match1450 (car e1473) p1474 w1475 (quote ()) mod1476))) (if first1477 (let ((rest1478 (match-each1446 (cdr e1473) p1474 w1475 mod1476))) (if rest1478 (cons first1477 rest1478) #f)) #f)) (if (null? e1473) (quote ()) (if (syntax-object?232 e1473) (match-each1446 (syntax-object-expression233 e1473) p1474 (join-wraps267 w1475 (syntax-object-wrap234 e1473)) (syntax-object-module235 e1473)) #f)))))) (set! $sc-dispatch (lambda (e1479 p1480) (if (eq? p1480 (quote any)) (list e1479) (if (syntax-object?232 e1479) (match*1449 (syntax-object-expression233 e1479) p1480 (syntax-object-wrap234 e1479) (quote ()) (syntax-object-module235 e1479)) (match*1449 e1479 p1480 (quote (())) (quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x1481) ((lambda (tmp1482) ((lambda (tmp1483) (if tmp1483 (apply (lambda (_1484 e11485 e21486) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11485 e21486))) tmp1483) ((lambda (tmp1488) (if tmp1488 (apply (lambda (_1489 out1490 in1491 e11492 e21493) (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))) in1491 (quote ()) (list out1490 (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 e11492 e21493))))) tmp1488) ((lambda (tmp1495) (if tmp1495 (apply (lambda (_1496 out1497 in1498 e11499 e21500) (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))) in1498) (quote ()) (list out1497 (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 e11499 e21500))))) tmp1495) (syntax-violation #f "source expression failed to match any pattern" tmp1482))) ($sc-dispatch tmp1482 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1482 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1482 (quote (any () any . each-any))))) x1481))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1504) ((lambda (tmp1505) ((lambda (tmp1506) (if tmp1506 (apply (lambda (_1507 k1508 keyword1509 pattern1510 template1511) (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 k1508 (map (lambda (tmp1514 tmp1513) (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))) tmp1513) (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))) tmp1514))) template1511 pattern1510)))))) tmp1506) (syntax-violation #f "source expression failed to match any pattern" tmp1505))) ($sc-dispatch tmp1505 (quote (any each-any . #(each ((any . any) any))))))) x1504))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1515) ((lambda (tmp1516) ((lambda (tmp1517) (if (if tmp1517 (apply (lambda (let*1518 x1519 v1520 e11521 e21522) (and-map identifier? x1519)) tmp1517) #f) (apply (lambda (let*1524 x1525 v1526 e11527 e21528) (letrec ((f1529 (lambda (bindings1530) (if (null? bindings1530) (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 e11527 e21528))) ((lambda (tmp1534) ((lambda (tmp1535) (if tmp1535 (apply (lambda (body1536 binding1537) (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 binding1537) body1536)) tmp1535) (syntax-violation #f "source expression failed to match any pattern" tmp1534))) ($sc-dispatch tmp1534 (quote (any any))))) (list (f1529 (cdr bindings1530)) (car bindings1530))))))) (f1529 (map list x1525 v1526)))) tmp1517) (syntax-violation #f "source expression failed to match any pattern" tmp1516))) ($sc-dispatch tmp1516 (quote (any #(each (any any)) any . each-any))))) x1515))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1538) ((lambda (tmp1539) ((lambda (tmp1540) (if tmp1540 (apply (lambda (_1541 var1542 init1543 step1544 e01545 e11546 c1547) ((lambda (tmp1548) ((lambda (tmp1549) (if tmp1549 (apply (lambda (step1550) ((lambda (tmp1551) ((lambda (tmp1552) (if tmp1552 (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 var1542 init1543) (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))) e01545) (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 c1547 (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))) step1550))))))) tmp1552) ((lambda (tmp1557) (if tmp1557 (apply (lambda (e11558 e21559) (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 var1542 init1543) (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))) e01545 (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 e11558 e21559)) (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 c1547 (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))) step1550))))))) tmp1557) (syntax-violation #f "source expression failed to match any pattern" tmp1551))) ($sc-dispatch tmp1551 (quote (any . each-any)))))) ($sc-dispatch tmp1551 (quote ())))) e11546)) tmp1549) (syntax-violation #f "source expression failed to match any pattern" tmp1548))) ($sc-dispatch tmp1548 (quote each-any)))) (map (lambda (v1566 s1567) ((lambda (tmp1568) ((lambda (tmp1569) (if tmp1569 (apply (lambda () v1566) tmp1569) ((lambda (tmp1570) (if tmp1570 (apply (lambda (e1571) e1571) tmp1570) ((lambda (_1572) (syntax-violation (quote do) "bad step expression" orig-x1538 s1567)) tmp1568))) ($sc-dispatch tmp1568 (quote (any)))))) ($sc-dispatch tmp1568 (quote ())))) s1567)) var1542 step1544))) tmp1540) (syntax-violation #f "source expression failed to match any pattern" tmp1539))) ($sc-dispatch tmp1539 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1538))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1575 (lambda (x1579 y1580) ((lambda (tmp1581) ((lambda (tmp1582) (if tmp1582 (apply (lambda (x1583 y1584) ((lambda (tmp1585) ((lambda (tmp1586) (if tmp1586 (apply (lambda (dy1587) ((lambda (tmp1588) ((lambda (tmp1589) (if tmp1589 (apply (lambda (dx1590) (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 dx1590 dy1587))) tmp1589) ((lambda (_1591) (if (null? dy1587) (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))) x1583) (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))) x1583 y1584))) tmp1588))) ($sc-dispatch tmp1588 (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))))) x1583)) tmp1586) ((lambda (tmp1592) (if tmp1592 (apply (lambda (stuff1593) (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 x1583 stuff1593))) tmp1592) ((lambda (else1594) (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))) x1583 y1584)) tmp1585))) ($sc-dispatch tmp1585 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1585 (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))))) y1584)) tmp1582) (syntax-violation #f "source expression failed to match any pattern" tmp1581))) ($sc-dispatch tmp1581 (quote (any any))))) (list x1579 y1580)))) (quasiappend1576 (lambda (x1595 y1596) ((lambda (tmp1597) ((lambda (tmp1598) (if tmp1598 (apply (lambda (x1599 y1600) ((lambda (tmp1601) ((lambda (tmp1602) (if tmp1602 (apply (lambda () x1599) tmp1602) ((lambda (_1603) (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))) x1599 y1600)) tmp1601))) ($sc-dispatch tmp1601 (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))) ()))))) y1600)) tmp1598) (syntax-violation #f "source expression failed to match any pattern" tmp1597))) ($sc-dispatch tmp1597 (quote (any any))))) (list x1595 y1596)))) (quasivector1577 (lambda (x1604) ((lambda (tmp1605) ((lambda (x1606) ((lambda (tmp1607) ((lambda (tmp1608) (if tmp1608 (apply (lambda (x1609) (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 x1609))) tmp1608) ((lambda (tmp1611) (if tmp1611 (apply (lambda (x1612) (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))) x1612)) tmp1611) ((lambda (_1614) (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))) x1606)) tmp1607))) ($sc-dispatch tmp1607 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp1607 (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))))) x1606)) tmp1605)) x1604))) (quasi1578 (lambda (p1615 lev1616) ((lambda (tmp1617) ((lambda (tmp1618) (if tmp1618 (apply (lambda (p1619) (if (= lev1616 0) p1619 (quasicons1575 (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)))) (quasi1578 (list p1619) (- lev1616 1))))) tmp1618) ((lambda (tmp1620) (if (if tmp1620 (apply (lambda (args1621) (= lev1616 0)) tmp1620) #f) (apply (lambda (args1622) (syntax-violation (quote unquote) "unquote takes exactly one argument" p1615 (cons (quote #(syntax-object unquote ((top) #(ribcage #(args) #((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))) args1622))) tmp1620) ((lambda (tmp1623) (if tmp1623 (apply (lambda (p1624 q1625) (if (= lev1616 0) (quasiappend1576 p1624 (quasi1578 q1625 lev1616)) (quasicons1575 (quasicons1575 (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)))) (quasi1578 (list p1624) (- lev1616 1))) (quasi1578 q1625 lev1616)))) tmp1623) ((lambda (tmp1626) (if (if tmp1626 (apply (lambda (args1627 q1628) (= lev1616 0)) tmp1626) #f) (apply (lambda (args1629 q1630) (syntax-violation (quote unquote-splicing) "unquote-splicing takes exactly one argument" p1615 (cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args 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))) args1629))) tmp1626) ((lambda (tmp1631) (if tmp1631 (apply (lambda (p1632) (quasicons1575 (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)))) (quasi1578 (list p1632) (+ lev1616 1)))) tmp1631) ((lambda (tmp1633) (if tmp1633 (apply (lambda (p1634 q1635) (quasicons1575 (quasi1578 p1634 lev1616) (quasi1578 q1635 lev1616))) tmp1633) ((lambda (tmp1636) (if tmp1636 (apply (lambda (x1637) (quasivector1577 (quasi1578 x1637 lev1616))) tmp1636) ((lambda (p1639) (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))) p1639)) tmp1617))) ($sc-dispatch tmp1617 (quote #(vector each-any)))))) ($sc-dispatch tmp1617 (quote (any . any)))))) ($sc-dispatch tmp1617 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp1617 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any) . any)))))) ($sc-dispatch tmp1617 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1617 (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)))))) ($sc-dispatch tmp1617 (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))))) p1615)))) (lambda (x1640) ((lambda (tmp1641) ((lambda (tmp1642) (if tmp1642 (apply (lambda (_1643 e1644) (quasi1578 e1644 0)) tmp1642) (syntax-violation #f "source expression failed to match any pattern" tmp1641))) ($sc-dispatch tmp1641 (quote (any any))))) x1640)))))
-(define include (make-syncase-macro (quote macro) (lambda (x1645) (letrec ((read-file1646 (lambda (fn1647 k1648) (let ((p1649 (open-input-file fn1647))) (letrec ((f1650 (lambda (x1651) (if (eof-object? x1651) (begin (close-input-port p1649) (quote ())) (cons (datum->syntax k1648 x1651) (f1650 (read p1649))))))) (f1650 (read p1649))))))) ((lambda (tmp1652) ((lambda (tmp1653) (if tmp1653 (apply (lambda (k1654 filename1655) (let ((fn1656 (syntax->datum filename1655))) ((lambda (tmp1657) ((lambda (tmp1658) (if tmp1658 (apply (lambda (exp1659) (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))) exp1659)) tmp1658) (syntax-violation #f "source expression failed to match any pattern" tmp1657))) ($sc-dispatch tmp1657 (quote each-any)))) (read-file1646 fn1656 k1654)))) tmp1653) (syntax-violation #f "source expression failed to match any pattern" tmp1652))) ($sc-dispatch tmp1652 (quote (any any))))) x1645)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x1661) ((lambda (tmp1662) ((lambda (tmp1663) (if tmp1663 (apply (lambda (_1664 e1665) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1661)) tmp1663) (syntax-violation #f "source expression failed to match any pattern" tmp1662))) ($sc-dispatch tmp1662 (quote (any any))))) x1661))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1666) ((lambda (tmp1667) ((lambda (tmp1668) (if tmp1668 (apply (lambda (_1669 e1670) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1666)) tmp1668) (syntax-violation #f "source expression failed to match any pattern" tmp1667))) ($sc-dispatch tmp1667 (quote (any any))))) x1666))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1671) ((lambda (tmp1672) ((lambda (tmp1673) (if tmp1673 (apply (lambda (_1674 e1675 m11676 m21677) ((lambda (tmp1678) ((lambda (body1679) (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))) e1675)) body1679)) tmp1678)) (letrec ((f1680 (lambda (clause1681 clauses1682) (if (null? clauses1682) ((lambda (tmp1684) ((lambda (tmp1685) (if tmp1685 (apply (lambda (e11686 e21687) (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 e11686 e21687))) tmp1685) ((lambda (tmp1689) (if tmp1689 (apply (lambda (k1690 e11691 e21692) (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))) k1690)) (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 e11691 e21692)))) tmp1689) ((lambda (_1695) (syntax-violation (quote case) "bad clause" x1671 clause1681)) tmp1684))) ($sc-dispatch tmp1684 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1684 (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))))) clause1681) ((lambda (tmp1696) ((lambda (rest1697) ((lambda (tmp1698) ((lambda (tmp1699) (if tmp1699 (apply (lambda (k1700 e11701 e21702) (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))) k1700)) (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 e11701 e21702)) rest1697)) tmp1699) ((lambda (_1705) (syntax-violation (quote case) "bad clause" x1671 clause1681)) tmp1698))) ($sc-dispatch tmp1698 (quote (each-any any . each-any))))) clause1681)) tmp1696)) (f1680 (car clauses1682) (cdr clauses1682))))))) (f1680 m11676 m21677)))) tmp1673) (syntax-violation #f "source expression failed to match any pattern" tmp1672))) ($sc-dispatch tmp1672 (quote (any any any . each-any))))) x1671))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1706) ((lambda (tmp1707) ((lambda (tmp1708) (if tmp1708 (apply (lambda (_1709 e1710) (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))) e1710)) (list (cons _1709 (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 e1710 (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)))))))))) tmp1708) (syntax-violation #f "source expression failed to match any pattern" tmp1707))) ($sc-dispatch tmp1707 (quote (any any))))) x1706))))
+(letrec ((and-map*17 (lambda (f57 first56 . rest55) (let ((t58 (null? first56))) (if t58 t58 (if (null? rest55) (letrec ((andmap59 (lambda (first60) (let ((x61 (car first60)) (first62 (cdr first60))) (if (null? first62) (f57 x61) (if (f57 x61) (andmap59 first62) #f)))))) (andmap59 first56)) (letrec ((andmap63 (lambda (first64 rest65) (let ((x66 (car first64)) (xr67 (map car rest65)) (first68 (cdr first64)) (rest69 (map cdr rest65))) (if (null? first68) (apply f57 (cons x66 xr67)) (if (apply f57 (cons x66 xr67)) (andmap63 first68 rest69) #f)))))) (andmap63 first56 rest55)))))))) (letrec ((lambda-var-list162 (lambda (vars286) (letrec ((lvl287 (lambda (vars288 ls289 w290) (if (pair? vars288) (lvl287 (cdr vars288) (cons (wrap142 (car vars288) w290 #f) ls289) w290) (if (id?114 vars288) (cons (wrap142 vars288 w290 #f) ls289) (if (null? vars288) ls289 (if (syntax-object?98 vars288) (lvl287 (syntax-object-expression99 vars288) ls289 (join-wraps133 w290 (syntax-object-wrap100 vars288))) (cons vars288 ls289)))))))) (lvl287 vars286 (quote ()) (quote (())))))) (gen-var161 (lambda (id291) (let ((id292 (if (syntax-object?98 id291) (syntax-object-expression99 id291) id291))) (gensym (symbol->string id292))))) (strip160 (lambda (x293 w294) (if (memq (quote top) (wrap-marks117 w294)) x293 (letrec ((f295 (lambda (x296) (if (syntax-object?98 x296) (strip160 (syntax-object-expression99 x296) (syntax-object-wrap100 x296)) (if (pair? x296) (let ((a297 (f295 (car x296))) (d298 (f295 (cdr x296)))) (if (if (eq? a297 (car x296)) (eq? d298 (cdr x296)) #f) x296 (cons a297 d298))) (if (vector? x296) (let ((old299 (vector->list x296))) (let ((new300 (map f295 old299))) (if (and-map*17 eq? old299 new300) x296 (list->vector new300)))) x296)))))) (f295 x293))))) (ellipsis?159 (lambda (x301) (if (nonsymbol-id?113 x301) (free-id=?137 x301 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void158 (lambda () (build-void80 #f))) (eval-local-transformer157 (lambda (expanded302 mod303) (let ((p304 (local-eval-hook77 expanded302 mod303))) (if (procedure? p304) p304 (syntax-violation #f "nonprocedure transformer" p304))))) (chi-local-syntax156 (lambda (rec?305 e306 r307 w308 s309 mod310 k311) ((lambda (tmp312) ((lambda (tmp313) (if tmp313 (apply (lambda (_314 id315 val316 e1317 e2318) (let ((ids319 id315)) (if (not (valid-bound-ids?139 ids319)) (syntax-violation #f "duplicate bound keyword" e306) (let ((labels321 (gen-labels120 ids319))) (let ((new-w322 (make-binding-wrap131 ids319 labels321 w308))) (k311 (cons e1317 e2318) (extend-env108 labels321 (let ((w324 (if rec?305 new-w322 w308)) (trans-r325 (macros-only-env110 r307))) (map (lambda (x326) (cons (quote macro) (eval-local-transformer157 (chi150 x326 trans-r325 w324 mod310) mod310))) val316)) r307) new-w322 s309 mod310)))))) tmp313) ((lambda (_328) (syntax-violation #f "bad local syntax definition" (source-wrap143 e306 w308 s309 mod310))) tmp312))) ($sc-dispatch tmp312 (quote (any #(each (any any)) any . each-any))))) e306))) (chi-lambda-clause155 (lambda (e329 docstring330 c331 r332 w333 mod334 k335) ((lambda (tmp336) ((lambda (tmp337) (if (if tmp337 (apply (lambda (args338 doc339 e1340 e2341) (if (string? (syntax->datum doc339)) (not docstring330) #f)) tmp337) #f) (apply (lambda (args342 doc343 e1344 e2345) (chi-lambda-clause155 e329 doc343 (cons args342 (cons e1344 e2345)) r332 w333 mod334 k335)) tmp337) ((lambda (tmp347) (if tmp347 (apply (lambda (id348 e1349 e2350) (let ((ids351 id348)) (if (not (valid-bound-ids?139 ids351)) (syntax-violation (quote lambda) "invalid parameter list" e329) (let ((labels353 (gen-labels120 ids351)) (new-vars354 (map gen-var161 ids351))) (k335 (map syntax->datum ids351) new-vars354 (if docstring330 (syntax->datum docstring330) #f) (chi-body154 (cons e1349 e2350) e329 (extend-var-env109 labels353 new-vars354 r332) (make-binding-wrap131 ids351 labels353 w333) mod334)))))) tmp347) ((lambda (tmp356) (if tmp356 (apply (lambda (ids357 e1358 e2359) (let ((old-ids360 (lambda-var-list162 ids357))) (if (not (valid-bound-ids?139 old-ids360)) (syntax-violation (quote lambda) "invalid parameter list" e329) (let ((labels361 (gen-labels120 old-ids360)) (new-vars362 (map gen-var161 old-ids360))) (k335 (letrec ((f363 (lambda (ls1364 ls2365) (if (null? ls1364) (syntax->datum ls2365) (f363 (cdr ls1364) (cons (syntax->datum (car ls1364)) ls2365)))))) (f363 (cdr old-ids360) (car old-ids360))) (letrec ((f366 (lambda (ls1367 ls2368) (if (null? ls1367) ls2368 (f366 (cdr ls1367) (cons (car ls1367) ls2368)))))) (f366 (cdr new-vars362) (car new-vars362))) (if docstring330 (syntax->datum docstring330) #f) (chi-body154 (cons e1358 e2359) e329 (extend-var-env109 labels361 new-vars362 r332) (make-binding-wrap131 old-ids360 labels361 w333) mod334)))))) tmp356) ((lambda (_370) (syntax-violation (quote lambda) "bad lambda" e329)) tmp336))) ($sc-dispatch tmp336 (quote (any any . each-any)))))) ($sc-dispatch tmp336 (quote (each-any any . each-any)))))) ($sc-dispatch tmp336 (quote (any any any . each-any))))) c331))) (chi-body154 (lambda (body371 outer-form372 r373 w374 mod375) (let ((r376 (cons (quote ("placeholder" placeholder)) r373))) (let ((ribcage377 (make-ribcage121 (quote ()) (quote ()) (quote ())))) (let ((w378 (make-wrap116 (wrap-marks117 w374) (cons ribcage377 (wrap-subst118 w374))))) (letrec ((parse379 (lambda (body380 ids381 labels382 var-ids383 vars384 vals385 bindings386) (if (null? body380) (syntax-violation #f "no expressions in body" outer-form372) (let ((e388 (cdar body380)) (er389 (caar body380))) (call-with-values (lambda () (syntax-type148 e388 er389 (quote (())) (source-annotation105 er389) ribcage377 mod375 #f)) (lambda (type390 value391 e392 w393 s394 mod395) (if (memv type390 (quote (define-form))) (let ((id396 (wrap142 value391 w393 mod395)) (label397 (gen-label119))) (let ((var398 (gen-var161 id396))) (begin (extend-ribcage!130 ribcage377 id396 label397) (parse379 (cdr body380) (cons id396 ids381) (cons label397 labels382) (cons id396 var-ids383) (cons var398 vars384) (cons (cons er389 (wrap142 e392 w393 mod395)) vals385) (cons (cons (quote lexical) var398) bindings386))))) (if (memv type390 (quote (define-syntax-form))) (let ((id399 (wrap142 value391 w393 mod395)) (label400 (gen-label119))) (begin (extend-ribcage!130 ribcage377 id399 label400) (parse379 (cdr body380) (cons id399 ids381) (cons label400 labels382) var-ids383 vars384 vals385 (cons (cons (quote macro) (cons er389 (wrap142 e392 w393 mod395))) bindings386)))) (if (memv type390 (quote (begin-form))) ((lambda (tmp401) ((lambda (tmp402) (if tmp402 (apply (lambda (_403 e1404) (parse379 (letrec ((f405 (lambda (forms406) (if (null? forms406) (cdr body380) (cons (cons er389 (wrap142 (car forms406) w393 mod395)) (f405 (cdr forms406))))))) (f405 e1404)) ids381 labels382 var-ids383 vars384 vals385 bindings386)) tmp402) (syntax-violation #f "source expression failed to match any pattern" tmp401))) ($sc-dispatch tmp401 (quote (any . each-any))))) e392) (if (memv type390 (quote (local-syntax-form))) (chi-local-syntax156 value391 e392 er389 w393 s394 mod395 (lambda (forms408 er409 w410 s411 mod412) (parse379 (letrec ((f413 (lambda (forms414) (if (null? forms414) (cdr body380) (cons (cons er409 (wrap142 (car forms414) w410 mod412)) (f413 (cdr forms414))))))) (f413 forms408)) ids381 labels382 var-ids383 vars384 vals385 bindings386))) (if (null? ids381) (build-sequence93 #f (map (lambda (x415) (chi150 (cdr x415) (car x415) (quote (())) mod395)) (cons (cons er389 (source-wrap143 e392 w393 s394 mod395)) (cdr body380)))) (begin (if (not (valid-bound-ids?139 ids381)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form372)) (letrec ((loop416 (lambda (bs417 er-cache418 r-cache419) (if (not (null? bs417)) (let ((b420 (car bs417))) (if (eq? (car b420) (quote macro)) (let ((er421 (cadr b420))) (let ((r-cache422 (if (eq? er421 er-cache418) r-cache419 (macros-only-env110 er421)))) (begin (set-cdr! b420 (eval-local-transformer157 (chi150 (cddr b420) r-cache422 (quote (())) mod395) mod395)) (loop416 (cdr bs417) er421 r-cache422)))) (loop416 (cdr bs417) er-cache418 r-cache419))))))) (loop416 bindings386 #f #f)) (set-cdr! r376 (extend-env108 labels382 bindings386 (cdr r376))) (build-letrec96 #f (map syntax->datum var-ids383) vars384 (map (lambda (x423) (chi150 (cdr x423) (car x423) (quote (())) mod395)) vals385) (build-sequence93 #f (map (lambda (x424) (chi150 (cdr x424) (car x424) (quote (())) mod395)) (cons (cons er389 (source-wrap143 e392 w393 s394 mod395)) (cdr body380)))))))))))))))))) (parse379 (map (lambda (x387) (cons r376 (wrap142 x387 w378 mod375))) body371) (quote ()) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro153 (lambda (p425 e426 r427 w428 rib429 mod430) (letrec ((rebuild-macro-output431 (lambda (x432 m433) (if (pair? x432) (cons (rebuild-macro-output431 (car x432) m433) (rebuild-macro-output431 (cdr x432) m433)) (if (syntax-object?98 x432) (let ((w434 (syntax-object-wrap100 x432))) (let ((ms435 (wrap-marks117 w434)) (s436 (wrap-subst118 w434))) (if (if (pair? ms435) (eq? (car ms435) #f) #f) (make-syntax-object97 (syntax-object-expression99 x432) (make-wrap116 (cdr ms435) (if rib429 (cons rib429 (cdr s436)) (cdr s436))) (syntax-object-module101 x432)) (make-syntax-object97 (syntax-object-expression99 x432) (make-wrap116 (cons m433 ms435) (if rib429 (cons rib429 (cons (quote shift) s436)) (cons (quote shift) s436))) (let ((pmod437 (procedure-module p425))) (if pmod437 (cons (quote hygiene) (module-name pmod437)) (quote (hygiene guile)))))))) (if (vector? x432) (let ((n438 (vector-length x432))) (let ((v439 (make-vector n438))) (letrec ((loop440 (lambda (i441) (if (fx=74 i441 n438) (begin (if #f #f) v439) (begin (vector-set! v439 i441 (rebuild-macro-output431 (vector-ref x432 i441) m433)) (loop440 (fx+72 i441 1))))))) (loop440 0)))) (if (symbol? x432) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap143 e426 w428 s mod430) x432) x432))))))) (rebuild-macro-output431 (p425 (wrap142 e426 (anti-mark129 w428) mod430)) (string #\m))))) (chi-application152 (lambda (x442 e443 r444 w445 s446 mod447) ((lambda (tmp448) ((lambda (tmp449) (if tmp449 (apply (lambda (e0450 e1451) (build-application81 s446 x442 (map (lambda (e452) (chi150 e452 r444 w445 mod447)) e1451))) tmp449) (syntax-violation #f "source expression failed to match any pattern" tmp448))) ($sc-dispatch tmp448 (quote (any . each-any))))) e443))) (chi-expr151 (lambda (type454 value455 e456 r457 w458 s459 mod460) (if (memv type454 (quote (lexical))) (build-lexical-reference83 (quote value) s459 e456 value455) (if (memv type454 (quote (core core-form))) (value455 e456 r457 w458 s459 mod460) (if (memv type454 (quote (module-ref))) (call-with-values (lambda () (value455 e456)) (lambda (id461 mod462) (build-global-reference86 s459 id461 mod462))) (if (memv type454 (quote (lexical-call))) (chi-application152 (build-lexical-reference83 (quote fun) (source-annotation105 (car e456)) (car e456) value455) e456 r457 w458 s459 mod460) (if (memv type454 (quote (global-call))) (chi-application152 (build-global-reference86 (source-annotation105 (car e456)) (if (syntax-object?98 value455) (syntax-object-expression99 value455) value455) (if (syntax-object?98 value455) (syntax-object-module101 value455) mod460)) e456 r457 w458 s459 mod460) (if (memv type454 (quote (constant))) (build-data92 s459 (strip160 (source-wrap143 e456 w458 s459 mod460) (quote (())))) (if (memv type454 (quote (global))) (build-global-reference86 s459 value455 mod460) (if (memv type454 (quote (call))) (chi-application152 (chi150 (car e456) r457 w458 mod460) e456 r457 w458 s459 mod460) (if (memv type454 (quote (begin-form))) ((lambda (tmp463) ((lambda (tmp464) (if tmp464 (apply (lambda (_465 e1466 e2467) (chi-sequence144 (cons e1466 e2467) r457 w458 s459 mod460)) tmp464) (syntax-violation #f "source expression failed to match any pattern" tmp463))) ($sc-dispatch tmp463 (quote (any any . each-any))))) e456) (if (memv type454 (quote (local-syntax-form))) (chi-local-syntax156 value455 e456 r457 w458 s459 mod460 chi-sequence144) (if (memv type454 (quote (eval-when-form))) ((lambda (tmp469) ((lambda (tmp470) (if tmp470 (apply (lambda (_471 x472 e1473 e2474) (let ((when-list475 (chi-when-list147 e456 x472 w458))) (if (memq (quote eval) when-list475) (chi-sequence144 (cons e1473 e2474) r457 w458 s459 mod460) (chi-void158)))) tmp470) (syntax-violation #f "source expression failed to match any pattern" tmp469))) ($sc-dispatch tmp469 (quote (any each-any any . each-any))))) e456) (if (memv type454 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e456 (wrap142 value455 w458 mod460)) (if (memv type454 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap143 e456 w458 s459 mod460)) (if (memv type454 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap143 e456 w458 s459 mod460)) (syntax-violation #f "unexpected syntax" (source-wrap143 e456 w458 s459 mod460)))))))))))))))))) (chi150 (lambda (e478 r479 w480 mod481) (call-with-values (lambda () (syntax-type148 e478 r479 w480 (source-annotation105 e478) #f mod481 #f)) (lambda (type482 value483 e484 w485 s486 mod487) (chi-expr151 type482 value483 e484 r479 w485 s486 mod487))))) (chi-top149 (lambda (e488 r489 w490 m491 esew492 mod493) (call-with-values (lambda () (syntax-type148 e488 r489 w490 (source-annotation105 e488) #f mod493 #f)) (lambda (type501 value502 e503 w504 s505 mod506) (if (memv type501 (quote (begin-form))) ((lambda (tmp507) ((lambda (tmp508) (if tmp508 (apply (lambda (_509) (chi-void158)) tmp508) ((lambda (tmp510) (if tmp510 (apply (lambda (_511 e1512 e2513) (chi-top-sequence145 (cons e1512 e2513) r489 w504 s505 m491 esew492 mod506)) tmp510) (syntax-violation #f "source expression failed to match any pattern" tmp507))) ($sc-dispatch tmp507 (quote (any any . each-any)))))) ($sc-dispatch tmp507 (quote (any))))) e503) (if (memv type501 (quote (local-syntax-form))) (chi-local-syntax156 value502 e503 r489 w504 s505 mod506 (lambda (body515 r516 w517 s518 mod519) (chi-top-sequence145 body515 r516 w517 s518 m491 esew492 mod519))) (if (memv type501 (quote (eval-when-form))) ((lambda (tmp520) ((lambda (tmp521) (if tmp521 (apply (lambda (_522 x523 e1524 e2525) (let ((when-list526 (chi-when-list147 e503 x523 w504)) (body527 (cons e1524 e2525))) (if (eq? m491 (quote e)) (if (memq (quote eval) when-list526) (chi-top-sequence145 body527 r489 w504 s505 (quote e) (quote (eval)) mod506) (chi-void158)) (if (memq (quote load) when-list526) (if (let ((t530 (memq (quote compile) when-list526))) (if t530 t530 (if (eq? m491 (quote c&e)) (memq (quote eval) when-list526) #f))) (chi-top-sequence145 body527 r489 w504 s505 (quote c&e) (quote (compile load)) mod506) (if (memq m491 (quote (c c&e))) (chi-top-sequence145 body527 r489 w504 s505 (quote c) (quote (load)) mod506) (chi-void158))) (if (let ((t531 (memq (quote compile) when-list526))) (if t531 t531 (if (eq? m491 (quote c&e)) (memq (quote eval) when-list526) #f))) (begin (top-level-eval-hook76 (chi-top-sequence145 body527 r489 w504 s505 (quote e) (quote (eval)) mod506) mod506) (chi-void158)) (chi-void158)))))) tmp521) (syntax-violation #f "source expression failed to match any pattern" tmp520))) ($sc-dispatch tmp520 (quote (any each-any any . each-any))))) e503) (if (memv type501 (quote (define-syntax-form))) (let ((n532 (id-var-name136 value502 w504)) (r533 (macros-only-env110 r489))) (if (memv m491 (quote (c))) (if (memq (quote compile) esew492) (let ((e534 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)))) (begin (top-level-eval-hook76 e534 mod506) (if (memq (quote load) esew492) e534 (chi-void158)))) (if (memq (quote load) esew492) (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)) (chi-void158))) (if (memv m491 (quote (c&e))) (let ((e535 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)))) (begin (top-level-eval-hook76 e535 mod506) e535)) (begin (if (memq (quote eval) esew492) (top-level-eval-hook76 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)) mod506)) (chi-void158))))) (if (memv type501 (quote (define-form))) (let ((n536 (id-var-name136 value502 w504))) (let ((type537 (binding-type106 (lookup111 n536 r489 mod506)))) (if (memv type537 (quote (global core macro module-ref))) (let ((x538 (build-global-definition89 s505 n536 (chi150 e503 r489 w504 mod506)))) (begin (if (eq? m491 (quote c&e)) (top-level-eval-hook76 x538 mod506)) x538)) (if (memv type537 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e503 (wrap142 value502 w504 mod506)) (syntax-violation #f "cannot define keyword at top level" e503 (wrap142 value502 w504 mod506)))))) (let ((x539 (chi-expr151 type501 value502 e503 r489 w504 s505 mod506))) (begin (if (eq? m491 (quote c&e)) (top-level-eval-hook76 x539 mod506)) x539))))))))))) (syntax-type148 (lambda (e540 r541 w542 s543 rib544 mod545 for-car?546) (if (symbol? e540) (let ((n547 (id-var-name136 e540 w542))) (let ((b548 (lookup111 n547 r541 mod545))) (let ((type549 (binding-type106 b548))) (if (memv type549 (quote (lexical))) (values type549 (binding-value107 b548) e540 w542 s543 mod545) (if (memv type549 (quote (global))) (values type549 n547 e540 w542 s543 mod545) (if (memv type549 (quote (macro))) (if for-car?546 (values type549 (binding-value107 b548) e540 w542 s543 mod545) (syntax-type148 (chi-macro153 (binding-value107 b548) e540 r541 w542 rib544 mod545) r541 (quote (())) s543 rib544 mod545 #f)) (values type549 (binding-value107 b548) e540 w542 s543 mod545))))))) (if (pair? e540) (let ((first550 (car e540))) (call-with-values (lambda () (syntax-type148 first550 r541 w542 s543 rib544 mod545 #t)) (lambda (ftype551 fval552 fe553 fw554 fs555 fmod556) (if (memv ftype551 (quote (lexical))) (values (quote lexical-call) fval552 e540 w542 s543 mod545) (if (memv ftype551 (quote (global))) (values (quote global-call) (make-syntax-object97 fval552 w542 fmod556) e540 w542 s543 mod545) (if (memv ftype551 (quote (macro))) (syntax-type148 (chi-macro153 fval552 e540 r541 w542 rib544 mod545) r541 (quote (())) s543 rib544 mod545 for-car?546) (if (memv ftype551 (quote (module-ref))) (call-with-values (lambda () (fval552 e540)) (lambda (sym557 mod558) (syntax-type148 sym557 r541 w542 s543 rib544 mod558 for-car?546))) (if (memv ftype551 (quote (core))) (values (quote core-form) fval552 e540 w542 s543 mod545) (if (memv ftype551 (quote (local-syntax))) (values (quote local-syntax-form) fval552 e540 w542 s543 mod545) (if (memv ftype551 (quote (begin))) (values (quote begin-form) #f e540 w542 s543 mod545) (if (memv ftype551 (quote (eval-when))) (values (quote eval-when-form) #f e540 w542 s543 mod545) (if (memv ftype551 (quote (define))) ((lambda (tmp559) ((lambda (tmp560) (if (if tmp560 (apply (lambda (_561 name562 val563) (id?114 name562)) tmp560) #f) (apply (lambda (_564 name565 val566) (values (quote define-form) name565 val566 w542 s543 mod545)) tmp560) ((lambda (tmp567) (if (if tmp567 (apply (lambda (_568 name569 args570 e1571 e2572) (if (id?114 name569) (valid-bound-ids?139 (lambda-var-list162 args570)) #f)) tmp567) #f) (apply (lambda (_573 name574 args575 e1576 e2577) (values (quote define-form) (wrap142 name574 w542 mod545) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap142 (cons args575 (cons e1576 e2577)) w542 mod545)) (quote (())) s543 mod545)) tmp567) ((lambda (tmp579) (if (if tmp579 (apply (lambda (_580 name581) (id?114 name581)) tmp579) #f) (apply (lambda (_582 name583) (values (quote define-form) (wrap142 name583 w542 mod545) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s543 mod545)) tmp579) (syntax-violation #f "source expression failed to match any pattern" tmp559))) ($sc-dispatch tmp559 (quote (any any)))))) ($sc-dispatch tmp559 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp559 (quote (any any any))))) e540) (if (memv ftype551 (quote (define-syntax))) ((lambda (tmp584) ((lambda (tmp585) (if (if tmp585 (apply (lambda (_586 name587 val588) (id?114 name587)) tmp585) #f) (apply (lambda (_589 name590 val591) (values (quote define-syntax-form) name590 val591 w542 s543 mod545)) tmp585) (syntax-violation #f "source expression failed to match any pattern" tmp584))) ($sc-dispatch tmp584 (quote (any any any))))) e540) (values (quote call) #f e540 w542 s543 mod545)))))))))))))) (if (syntax-object?98 e540) (syntax-type148 (syntax-object-expression99 e540) r541 (join-wraps133 w542 (syntax-object-wrap100 e540)) s543 rib544 (let ((t592 (syntax-object-module101 e540))) (if t592 t592 mod545)) for-car?546) (if (self-evaluating? e540) (values (quote constant) #f e540 w542 s543 mod545) (values (quote other) #f e540 w542 s543 mod545))))))) (chi-when-list147 (lambda (e593 when-list594 w595) (letrec ((f596 (lambda (when-list597 situations598) (if (null? when-list597) situations598 (f596 (cdr when-list597) (cons (let ((x599 (car when-list597))) (if (free-id=?137 x599 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?137 x599 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?137 x599 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e593 (wrap142 x599 w595 #f)))))) situations598)))))) (f596 when-list594 (quote ()))))) (chi-install-global146 (lambda (name600 e601) (build-global-definition89 #f name600 (if (let ((v602 (module-variable (current-module) name600))) (if v602 (if (variable-bound? v602) (if (macro? (variable-ref v602)) (not (eq? (macro-type (variable-ref v602)) (quote syncase-macro))) #f) #f) #f)) (build-application81 #f (build-primref91 #f (quote make-extended-syncase-macro)) (list (build-application81 #f (build-primref91 #f (quote module-ref)) (list (build-application81 #f (build-primref91 #f (quote current-module)) (quote ())) (build-data92 #f name600))) (build-data92 #f (quote macro)) e601)) (build-application81 #f (build-primref91 #f (quote make-syncase-macro)) (list (build-data92 #f (quote macro)) e601)))))) (chi-top-sequence145 (lambda (body603 r604 w605 s606 m607 esew608 mod609) (build-sequence93 s606 (letrec ((dobody610 (lambda (body611 r612 w613 m614 esew615 mod616) (if (null? body611) (quote ()) (let ((first617 (chi-top149 (car body611) r612 w613 m614 esew615 mod616))) (cons first617 (dobody610 (cdr body611) r612 w613 m614 esew615 mod616))))))) (dobody610 body603 r604 w605 m607 esew608 mod609))))) (chi-sequence144 (lambda (body618 r619 w620 s621 mod622) (build-sequence93 s621 (letrec ((dobody623 (lambda (body624 r625 w626 mod627) (if (null? body624) (quote ()) (let ((first628 (chi150 (car body624) r625 w626 mod627))) (cons first628 (dobody623 (cdr body624) r625 w626 mod627))))))) (dobody623 body618 r619 w620 mod622))))) (source-wrap143 (lambda (x629 w630 s631 defmod632) (begin (if (if s631 (pair? x629) #f) (set-source-properties! x629 s631)) (wrap142 x629 w630 defmod632)))) (wrap142 (lambda (x633 w634 defmod635) (if (if (null? (wrap-marks117 w634)) (null? (wrap-subst118 w634)) #f) x633 (if (syntax-object?98 x633) (make-syntax-object97 (syntax-object-expression99 x633) (join-wraps133 w634 (syntax-object-wrap100 x633)) (syntax-object-module101 x633)) (if (null? x633) x633 (make-syntax-object97 x633 w634 defmod635)))))) (bound-id-member?141 (lambda (x636 list637) (if (not (null? list637)) (let ((t638 (bound-id=?138 x636 (car list637)))) (if t638 t638 (bound-id-member?141 x636 (cdr list637)))) #f))) (distinct-bound-ids?140 (lambda (ids639) (letrec ((distinct?640 (lambda (ids641) (let ((t642 (null? ids641))) (if t642 t642 (if (not (bound-id-member?141 (car ids641) (cdr ids641))) (distinct?640 (cdr ids641)) #f)))))) (distinct?640 ids639)))) (valid-bound-ids?139 (lambda (ids643) (if (letrec ((all-ids?644 (lambda (ids645) (let ((t646 (null? ids645))) (if t646 t646 (if (id?114 (car ids645)) (all-ids?644 (cdr ids645)) #f)))))) (all-ids?644 ids643)) (distinct-bound-ids?140 ids643) #f))) (bound-id=?138 (lambda (i647 j648) (if (if (syntax-object?98 i647) (syntax-object?98 j648) #f) (if (eq? (syntax-object-expression99 i647) (syntax-object-expression99 j648)) (same-marks?135 (wrap-marks117 (syntax-object-wrap100 i647)) (wrap-marks117 (syntax-object-wrap100 j648))) #f) (eq? i647 j648)))) (free-id=?137 (lambda (i649 j650) (if (eq? (let ((x651 i649)) (if (syntax-object?98 x651) (syntax-object-expression99 x651) x651)) (let ((x652 j650)) (if (syntax-object?98 x652) (syntax-object-expression99 x652) x652))) (eq? (id-var-name136 i649 (quote (()))) (id-var-name136 j650 (quote (())))) #f))) (id-var-name136 (lambda (id653 w654) (letrec ((search-vector-rib657 (lambda (sym663 subst664 marks665 symnames666 ribcage667) (let ((n668 (vector-length symnames666))) (letrec ((f669 (lambda (i670) (if (fx=74 i670 n668) (search655 sym663 (cdr subst664) marks665) (if (if (eq? (vector-ref symnames666 i670) sym663) (same-marks?135 marks665 (vector-ref (ribcage-marks124 ribcage667) i670)) #f) (values (vector-ref (ribcage-labels125 ribcage667) i670) marks665) (f669 (fx+72 i670 1))))))) (f669 0))))) (search-list-rib656 (lambda (sym671 subst672 marks673 symnames674 ribcage675) (letrec ((f676 (lambda (symnames677 i678) (if (null? symnames677) (search655 sym671 (cdr subst672) marks673) (if (if (eq? (car symnames677) sym671) (same-marks?135 marks673 (list-ref (ribcage-marks124 ribcage675) i678)) #f) (values (list-ref (ribcage-labels125 ribcage675) i678) marks673) (f676 (cdr symnames677) (fx+72 i678 1))))))) (f676 symnames674 0)))) (search655 (lambda (sym679 subst680 marks681) (if (null? subst680) (values #f marks681) (let ((fst682 (car subst680))) (if (eq? fst682 (quote shift)) (search655 sym679 (cdr subst680) (cdr marks681)) (let ((symnames683 (ribcage-symnames123 fst682))) (if (vector? symnames683) (search-vector-rib657 sym679 subst680 marks681 symnames683 fst682) (search-list-rib656 sym679 subst680 marks681 symnames683 fst682))))))))) (if (symbol? id653) (let ((t684 (call-with-values (lambda () (search655 id653 (wrap-subst118 w654) (wrap-marks117 w654))) (lambda (x686 . ignore685) x686)))) (if t684 t684 id653)) (if (syntax-object?98 id653) (let ((id687 (syntax-object-expression99 id653)) (w1688 (syntax-object-wrap100 id653))) (let ((marks689 (join-marks134 (wrap-marks117 w654) (wrap-marks117 w1688)))) (call-with-values (lambda () (search655 id687 (wrap-subst118 w654) marks689)) (lambda (new-id690 marks691) (let ((t692 new-id690)) (if t692 t692 (let ((t693 (call-with-values (lambda () (search655 id687 (wrap-subst118 w1688) marks691)) (lambda (x695 . ignore694) x695)))) (if t693 t693 id687)))))))) (syntax-violation (quote id-var-name) "invalid id" id653)))))) (same-marks?135 (lambda (x696 y697) (let ((t698 (eq? x696 y697))) (if t698 t698 (if (not (null? x696)) (if (not (null? y697)) (if (eq? (car x696) (car y697)) (same-marks?135 (cdr x696) (cdr y697)) #f) #f) #f))))) (join-marks134 (lambda (m1699 m2700) (smart-append132 m1699 m2700))) (join-wraps133 (lambda (w1701 w2702) (let ((m1703 (wrap-marks117 w1701)) (s1704 (wrap-subst118 w1701))) (if (null? m1703) (if (null? s1704) w2702 (make-wrap116 (wrap-marks117 w2702) (smart-append132 s1704 (wrap-subst118 w2702)))) (make-wrap116 (smart-append132 m1703 (wrap-marks117 w2702)) (smart-append132 s1704 (wrap-subst118 w2702))))))) (smart-append132 (lambda (m1705 m2706) (if (null? m2706) m1705 (append m1705 m2706)))) (make-binding-wrap131 (lambda (ids707 labels708 w709) (if (null? ids707) w709 (make-wrap116 (wrap-marks117 w709) (cons (let ((labelvec710 (list->vector labels708))) (let ((n711 (vector-length labelvec710))) (let ((symnamevec712 (make-vector n711)) (marksvec713 (make-vector n711))) (begin (letrec ((f714 (lambda (ids715 i716) (if (not (null? ids715)) (call-with-values (lambda () (id-sym-name&marks115 (car ids715) w709)) (lambda (symname717 marks718) (begin (vector-set! symnamevec712 i716 symname717) (vector-set! marksvec713 i716 marks718) (f714 (cdr ids715) (fx+72 i716 1))))))))) (f714 ids707 0)) (make-ribcage121 symnamevec712 marksvec713 labelvec710))))) (wrap-subst118 w709)))))) (extend-ribcage!130 (lambda (ribcage719 id720 label721) (begin (set-ribcage-symnames!126 ribcage719 (cons (syntax-object-expression99 id720) (ribcage-symnames123 ribcage719))) (set-ribcage-marks!127 ribcage719 (cons (wrap-marks117 (syntax-object-wrap100 id720)) (ribcage-marks124 ribcage719))) (set-ribcage-labels!128 ribcage719 (cons label721 (ribcage-labels125 ribcage719)))))) (anti-mark129 (lambda (w722) (make-wrap116 (cons #f (wrap-marks117 w722)) (cons (quote shift) (wrap-subst118 w722))))) (set-ribcage-labels!128 (lambda (x723 update724) (vector-set! x723 3 update724))) (set-ribcage-marks!127 (lambda (x725 update726) (vector-set! x725 2 update726))) (set-ribcage-symnames!126 (lambda (x727 update728) (vector-set! x727 1 update728))) (ribcage-labels125 (lambda (x729) (vector-ref x729 3))) (ribcage-marks124 (lambda (x730) (vector-ref x730 2))) (ribcage-symnames123 (lambda (x731) (vector-ref x731 1))) (ribcage?122 (lambda (x732) (if (vector? x732) (if (= (vector-length x732) 4) (eq? (vector-ref x732 0) (quote ribcage)) #f) #f))) (make-ribcage121 (lambda (symnames733 marks734 labels735) (vector (quote ribcage) symnames733 marks734 labels735))) (gen-labels120 (lambda (ls736) (if (null? ls736) (quote ()) (cons (gen-label119) (gen-labels120 (cdr ls736)))))) (gen-label119 (lambda () (string #\i))) (wrap-subst118 cdr) (wrap-marks117 car) (make-wrap116 cons) (id-sym-name&marks115 (lambda (x737 w738) (if (syntax-object?98 x737) (values (syntax-object-expression99 x737) (join-marks134 (wrap-marks117 w738) (wrap-marks117 (syntax-object-wrap100 x737)))) (values x737 (wrap-marks117 w738))))) (id?114 (lambda (x739) (if (symbol? x739) #t (if (syntax-object?98 x739) (symbol? (syntax-object-expression99 x739)) #f)))) (nonsymbol-id?113 (lambda (x740) (if (syntax-object?98 x740) (symbol? (syntax-object-expression99 x740)) #f))) (global-extend112 (lambda (type741 sym742 val743) (put-global-definition-hook78 sym742 type741 val743))) (lookup111 (lambda (x744 r745 mod746) (let ((t747 (assq x744 r745))) (if t747 (cdr t747) (if (symbol? x744) (let ((t748 (get-global-definition-hook79 x744 mod746))) (if t748 t748 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env110 (lambda (r749) (if (null? r749) (quote ()) (let ((a750 (car r749))) (if (eq? (cadr a750) (quote macro)) (cons a750 (macros-only-env110 (cdr r749))) (macros-only-env110 (cdr r749))))))) (extend-var-env109 (lambda (labels751 vars752 r753) (if (null? labels751) r753 (extend-var-env109 (cdr labels751) (cdr vars752) (cons (cons (car labels751) (cons (quote lexical) (car vars752))) r753))))) (extend-env108 (lambda (labels754 bindings755 r756) (if (null? labels754) r756 (extend-env108 (cdr labels754) (cdr bindings755) (cons (cons (car labels754) (car bindings755)) r756))))) (binding-value107 cdr) (binding-type106 car) (source-annotation105 (lambda (x757) (if (syntax-object?98 x757) (source-annotation105 (syntax-object-expression99 x757)) (if (pair? x757) (let ((props758 (source-properties x757))) (if (pair? props758) props758 #f)) #f)))) (set-syntax-object-module!104 (lambda (x759 update760) (vector-set! x759 3 update760))) (set-syntax-object-wrap!103 (lambda (x761 update762) (vector-set! x761 2 update762))) (set-syntax-object-expression!102 (lambda (x763 update764) (vector-set! x763 1 update764))) (syntax-object-module101 (lambda (x765) (vector-ref x765 3))) (syntax-object-wrap100 (lambda (x766) (vector-ref x766 2))) (syntax-object-expression99 (lambda (x767) (vector-ref x767 1))) (syntax-object?98 (lambda (x768) (if (vector? x768) (if (= (vector-length x768) 4) (eq? (vector-ref x768 0) (quote syntax-object)) #f) #f))) (make-syntax-object97 (lambda (expression769 wrap770 module771) (vector (quote syntax-object) expression769 wrap770 module771))) (build-letrec96 (lambda (src772 ids773 vars774 val-exps775 body-exp776) (if (null? vars774) body-exp776 (let ((atom-key777 (fluid-ref *mode*71))) (if (memv atom-key777 (quote (c))) (begin (for-each maybe-name-value!88 ids773 val-exps775) ((@ (language tree-il) make-letrec) src772 ids773 vars774 val-exps775 body-exp776)) (list (quote letrec) (map list vars774 val-exps775) body-exp776)))))) (build-named-let95 (lambda (src778 ids779 vars780 val-exps781 body-exp782) (let ((f783 (car vars780)) (f-name784 (car ids779)) (vars785 (cdr vars780)) (ids786 (cdr ids779))) (let ((atom-key787 (fluid-ref *mode*71))) (if (memv atom-key787 (quote (c))) (let ((proc788 (build-lambda90 src778 ids786 vars785 #f body-exp782))) (begin (maybe-name-value!88 f-name784 proc788) (for-each maybe-name-value!88 ids786 val-exps781) ((@ (language tree-il) make-letrec) src778 (list f-name784) (list f783) (list proc788) (build-application81 src778 (build-lexical-reference83 (quote fun) src778 f-name784 f783) val-exps781)))) (list (quote let) f783 (map list vars785 val-exps781) body-exp782)))))) (build-let94 (lambda (src789 ids790 vars791 val-exps792 body-exp793) (if (null? vars791) body-exp793 (let ((atom-key794 (fluid-ref *mode*71))) (if (memv atom-key794 (quote (c))) (begin (for-each maybe-name-value!88 ids790 val-exps792) ((@ (language tree-il) make-let) src789 ids790 vars791 val-exps792 body-exp793)) (list (quote let) (map list vars791 val-exps792) body-exp793)))))) (build-sequence93 (lambda (src795 exps796) (if (null? (cdr exps796)) (car exps796) (let ((atom-key797 (fluid-ref *mode*71))) (if (memv atom-key797 (quote (c))) ((@ (language tree-il) make-sequence) src795 exps796) (cons (quote begin) exps796)))))) (build-data92 (lambda (src798 exp799) (let ((atom-key800 (fluid-ref *mode*71))) (if (memv atom-key800 (quote (c))) ((@ (language tree-il) make-const) src798 exp799) (if (if (self-evaluating? exp799) (not (vector? exp799)) #f) exp799 (list (quote quote) exp799)))))) (build-primref91 (lambda (src801 name802) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key803 (fluid-ref *mode*71))) (if (memv atom-key803 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src801 name802) name802)) (let ((atom-key804 (fluid-ref *mode*71))) (if (memv atom-key804 (quote (c))) ((@ (language tree-il) make-module-ref) src801 (quote (guile)) name802 #f) (list (quote @@) (quote (guile)) name802)))))) (build-lambda90 (lambda (src805 ids806 vars807 docstring808 exp809) (let ((atom-key810 (fluid-ref *mode*71))) (if (memv atom-key810 (quote (c))) ((@ (language tree-il) make-lambda) src805 ids806 vars807 (if docstring808 (list (cons (quote documentation) docstring808)) (quote ())) exp809) (cons (quote lambda) (cons vars807 (append (if docstring808 (list docstring808) (quote ())) (list exp809)))))))) (build-global-definition89 (lambda (source811 var812 exp813) (let ((atom-key814 (fluid-ref *mode*71))) (if (memv atom-key814 (quote (c))) (begin (maybe-name-value!88 var812 exp813) ((@ (language tree-il) make-toplevel-define) source811 var812 exp813)) (list (quote define) var812 exp813))))) (maybe-name-value!88 (lambda (name815 val816) (if ((@ (language tree-il) lambda?) val816) (let ((meta817 ((@ (language tree-il) lambda-meta) val816))) (if (not (assq (quote name) meta817)) ((setter (@ (language tree-il) lambda-meta)) val816 (acons (quote name) name815 meta817))))))) (build-global-assignment87 (lambda (source818 var819 exp820 mod821) (analyze-variable85 mod821 var819 (lambda (mod822 var823 public?824) (let ((atom-key825 (fluid-ref *mode*71))) (if (memv atom-key825 (quote (c))) ((@ (language tree-il) make-module-set) source818 mod822 var823 public?824 exp820) (list (quote set!) (list (if public?824 (quote @) (quote @@)) mod822 var823) exp820)))) (lambda (var826) (let ((atom-key827 (fluid-ref *mode*71))) (if (memv atom-key827 (quote (c))) ((@ (language tree-il) make-toplevel-set) source818 var826 exp820) (list (quote set!) var826 exp820))))))) (build-global-reference86 (lambda (source828 var829 mod830) (analyze-variable85 mod830 var829 (lambda (mod831 var832 public?833) (let ((atom-key834 (fluid-ref *mode*71))) (if (memv atom-key834 (quote (c))) ((@ (language tree-il) make-module-ref) source828 mod831 var832 public?833) (list (if public?833 (quote @) (quote @@)) mod831 var832)))) (lambda (var835) (let ((atom-key836 (fluid-ref *mode*71))) (if (memv atom-key836 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source828 var835) var835)))))) (analyze-variable85 (lambda (mod837 var838 modref-cont839 bare-cont840) (if (not mod837) (bare-cont840 var838) (let ((kind841 (car mod837)) (mod842 (cdr mod837))) (if (memv kind841 (quote (public))) (modref-cont839 mod842 var838 #t) (if (memv kind841 (quote (private))) (if (not (equal? mod842 (module-name (current-module)))) (modref-cont839 mod842 var838 #f) (bare-cont840 var838)) (if (memv kind841 (quote (bare))) (bare-cont840 var838) (if (memv kind841 (quote (hygiene))) (if (if (not (equal? mod842 (module-name (current-module)))) (module-variable (resolve-module mod842) var838) #f) (modref-cont839 mod842 var838 #f) (bare-cont840 var838)) (syntax-violation #f "bad module kind" var838 mod842))))))))) (build-lexical-assignment84 (lambda (source843 name844 var845 exp846) (let ((atom-key847 (fluid-ref *mode*71))) (if (memv atom-key847 (quote (c))) ((@ (language tree-il) make-lexical-set) source843 name844 var845 exp846) (list (quote set!) var845 exp846))))) (build-lexical-reference83 (lambda (type848 source849 name850 var851) (let ((atom-key852 (fluid-ref *mode*71))) (if (memv atom-key852 (quote (c))) ((@ (language tree-il) make-lexical-ref) source849 name850 var851) var851)))) (build-conditional82 (lambda (source853 test-exp854 then-exp855 else-exp856) (let ((atom-key857 (fluid-ref *mode*71))) (if (memv atom-key857 (quote (c))) ((@ (language tree-il) make-conditional) source853 test-exp854 then-exp855 else-exp856) (if (equal? else-exp856 (quote (if #f #f))) (list (quote if) test-exp854 then-exp855) (list (quote if) test-exp854 then-exp855 else-exp856)))))) (build-application81 (lambda (source858 fun-exp859 arg-exps860) (let ((atom-key861 (fluid-ref *mode*71))) (if (memv atom-key861 (quote (c))) ((@ (language tree-il) make-application) source858 fun-exp859 arg-exps860) (cons fun-exp859 arg-exps860))))) (build-void80 (lambda (source862) (let ((atom-key863 (fluid-ref *mode*71))) (if (memv atom-key863 (quote (c))) ((@ (language tree-il) make-void) source862) (quote (if #f #f)))))) (get-global-definition-hook79 (lambda (symbol864 module865) (begin (if (if (not module865) (current-module) #f) (warn "module system is booted, we should have a module" symbol864)) (let ((v866 (module-variable (if module865 (resolve-module (cdr module865)) (current-module)) symbol864))) (if v866 (if (variable-bound? v866) (let ((val867 (variable-ref v866))) (if (macro? val867) (if (syncase-macro-type val867) (cons (syncase-macro-type val867) (syncase-macro-binding val867)) #f) #f)) #f) #f))))) (put-global-definition-hook78 (lambda (symbol868 type869 val870) (let ((existing871 (let ((v872 (module-variable (current-module) symbol868))) (if v872 (if (variable-bound? v872) (let ((val873 (variable-ref v872))) (if (macro? val873) (if (not (syncase-macro-type val873)) val873 #f) #f)) #f) #f)))) (module-define! (current-module) symbol868 (if existing871 (make-extended-syncase-macro existing871 type869 val870) (make-syncase-macro type869 val870)))))) (local-eval-hook77 (lambda (x874 mod875) (primitive-eval (list noexpand70 (let ((atom-key876 (fluid-ref *mode*71))) (if (memv atom-key876 (quote (c))) ((@ (language tree-il) tree-il->scheme) x874) x874)))))) (top-level-eval-hook76 (lambda (x877 mod878) (primitive-eval (list noexpand70 (let ((atom-key879 (fluid-ref *mode*71))) (if (memv atom-key879 (quote (c))) ((@ (language tree-il) tree-il->scheme) x877) x877)))))) (fx<75 <) (fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand")) (begin (global-extend112 (quote local-syntax) (quote letrec-syntax) #t) (global-extend112 (quote local-syntax) (quote let-syntax) #f) (global-extend112 (quote core) (quote fluid-let-syntax) (lambda (e880 r881 w882 s883 mod884) ((lambda (tmp885) ((lambda (tmp886) (if (if tmp886 (apply (lambda (_887 var888 val889 e1890 e2891) (valid-bound-ids?139 var888)) tmp886) #f) (apply (lambda (_893 var894 val895 e1896 e2897) (let ((names898 (map (lambda (x899) (id-var-name136 x899 w882)) var894))) (begin (for-each (lambda (id901 n902) (let ((atom-key903 (binding-type106 (lookup111 n902 r881 mod884)))) (if (memv atom-key903 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e880 (source-wrap143 id901 w882 s883 mod884))))) var894 names898) (chi-body154 (cons e1896 e2897) (source-wrap143 e880 w882 s883 mod884) (extend-env108 names898 (let ((trans-r906 (macros-only-env110 r881))) (map (lambda (x907) (cons (quote macro) (eval-local-transformer157 (chi150 x907 trans-r906 w882 mod884) mod884))) val895)) r881) w882 mod884)))) tmp886) ((lambda (_909) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap143 e880 w882 s883 mod884))) tmp885))) ($sc-dispatch tmp885 (quote (any #(each (any any)) any . each-any))))) e880))) (global-extend112 (quote core) (quote quote) (lambda (e910 r911 w912 s913 mod914) ((lambda (tmp915) ((lambda (tmp916) (if tmp916 (apply (lambda (_917 e918) (build-data92 s913 (strip160 e918 w912))) tmp916) ((lambda (_919) (syntax-violation (quote quote) "bad syntax" (source-wrap143 e910 w912 s913 mod914))) tmp915))) ($sc-dispatch tmp915 (quote (any any))))) e910))) (global-extend112 (quote core) (quote syntax) (letrec ((regen927 (lambda (x928) (let ((atom-key929 (car x928))) (if (memv atom-key929 (quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x928) (cadr x928)) (if (memv atom-key929 (quote (primitive))) (build-primref91 #f (cadr x928)) (if (memv atom-key929 (quote (quote))) (build-data92 #f (cadr x928)) (if (memv atom-key929 (quote (lambda))) (build-lambda90 #f (cadr x928) (cadr x928) #f (regen927 (caddr x928))) (build-application81 #f (build-primref91 #f (car x928)) (map regen927 (cdr x928)))))))))) (gen-vector926 (lambda (x930) (if (eq? (car x930) (quote list)) (cons (quote vector) (cdr x930)) (if (eq? (car x930) (quote quote)) (list (quote quote) (list->vector (cadr x930))) (list (quote list->vector) x930))))) (gen-append925 (lambda (x931 y932) (if (equal? y932 (quote (quote ()))) x931 (list (quote append) x931 y932)))) (gen-cons924 (lambda (x933 y934) (let ((atom-key935 (car y934))) (if (memv atom-key935 (quote (quote))) (if (eq? (car x933) (quote quote)) (list (quote quote) (cons (cadr x933) (cadr y934))) (if (eq? (cadr y934) (quote ())) (list (quote list) x933) (list (quote cons) x933 y934))) (if (memv atom-key935 (quote (list))) (cons (quote list) (cons x933 (cdr y934))) (list (quote cons) x933 y934)))))) (gen-map923 (lambda (e936 map-env937) (let ((formals938 (map cdr map-env937)) (actuals939 (map (lambda (x940) (list (quote ref) (car x940))) map-env937))) (if (eq? (car e936) (quote ref)) (car actuals939) (if (and-map (lambda (x941) (if (eq? (car x941) (quote ref)) (memq (cadr x941) formals938) #f)) (cdr e936)) (cons (quote map) (cons (list (quote primitive) (car e936)) (map (let ((r942 (map cons formals938 actuals939))) (lambda (x943) (cdr (assq (cadr x943) r942)))) (cdr e936)))) (cons (quote map) (cons (list (quote lambda) formals938 e936) actuals939))))))) (gen-mappend922 (lambda (e944 map-env945) (list (quote apply) (quote (primitive append)) (gen-map923 e944 map-env945)))) (gen-ref921 (lambda (src946 var947 level948 maps949) (if (fx=74 level948 0) (values var947 maps949) (if (null? maps949) (syntax-violation (quote syntax) "missing ellipsis" src946) (call-with-values (lambda () (gen-ref921 src946 var947 (fx-73 level948 1) (cdr maps949))) (lambda (outer-var950 outer-maps951) (let ((b952 (assq outer-var950 (car maps949)))) (if b952 (values (cdr b952) maps949) (let ((inner-var953 (gen-var161 (quote tmp)))) (values inner-var953 (cons (cons (cons outer-var950 inner-var953) (car maps949)) outer-maps951))))))))))) (gen-syntax920 (lambda (src954 e955 r956 maps957 ellipsis?958 mod959) (if (id?114 e955) (let ((label960 (id-var-name136 e955 (quote (()))))) (let ((b961 (lookup111 label960 r956 mod959))) (if (eq? (binding-type106 b961) (quote syntax)) (call-with-values (lambda () (let ((var.lev962 (binding-value107 b961))) (gen-ref921 src954 (car var.lev962) (cdr var.lev962) maps957))) (lambda (var963 maps964) (values (list (quote ref) var963) maps964))) (if (ellipsis?958 e955) (syntax-violation (quote syntax) "misplaced ellipsis" src954) (values (list (quote quote) e955) maps957))))) ((lambda (tmp965) ((lambda (tmp966) (if (if tmp966 (apply (lambda (dots967 e968) (ellipsis?958 dots967)) tmp966) #f) (apply (lambda (dots969 e970) (gen-syntax920 src954 e970 r956 maps957 (lambda (x971) #f) mod959)) tmp966) ((lambda (tmp972) (if (if tmp972 (apply (lambda (x973 dots974 y975) (ellipsis?958 dots974)) tmp972) #f) (apply (lambda (x976 dots977 y978) (letrec ((f979 (lambda (y980 k981) ((lambda (tmp985) ((lambda (tmp986) (if (if tmp986 (apply (lambda (dots987 y988) (ellipsis?958 dots987)) tmp986) #f) (apply (lambda (dots989 y990) (f979 y990 (lambda (maps991) (call-with-values (lambda () (k981 (cons (quote ()) maps991))) (lambda (x992 maps993) (if (null? (car maps993)) (syntax-violation (quote syntax) "extra ellipsis" src954) (values (gen-mappend922 x992 (car maps993)) (cdr maps993)))))))) tmp986) ((lambda (_994) (call-with-values (lambda () (gen-syntax920 src954 y980 r956 maps957 ellipsis?958 mod959)) (lambda (y995 maps996) (call-with-values (lambda () (k981 maps996)) (lambda (x997 maps998) (values (gen-append925 x997 y995) maps998)))))) tmp985))) ($sc-dispatch tmp985 (quote (any . any))))) y980)))) (f979 y978 (lambda (maps982) (call-with-values (lambda () (gen-syntax920 src954 x976 r956 (cons (quote ()) maps982) ellipsis?958 mod959)) (lambda (x983 maps984) (if (null? (car maps984)) (syntax-violation (quote syntax) "extra ellipsis" src954) (values (gen-map923 x983 (car maps984)) (cdr maps984))))))))) tmp972) ((lambda (tmp999) (if tmp999 (apply (lambda (x1000 y1001) (call-with-values (lambda () (gen-syntax920 src954 x1000 r956 maps957 ellipsis?958 mod959)) (lambda (x1002 maps1003) (call-with-values (lambda () (gen-syntax920 src954 y1001 r956 maps1003 ellipsis?958 mod959)) (lambda (y1004 maps1005) (values (gen-cons924 x1002 y1004) maps1005)))))) tmp999) ((lambda (tmp1006) (if tmp1006 (apply (lambda (e11007 e21008) (call-with-values (lambda () (gen-syntax920 src954 (cons e11007 e21008) r956 maps957 ellipsis?958 mod959)) (lambda (e1010 maps1011) (values (gen-vector926 e1010) maps1011)))) tmp1006) ((lambda (_1012) (values (list (quote quote) e955) maps957)) tmp965))) ($sc-dispatch tmp965 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp965 (quote (any . any)))))) ($sc-dispatch tmp965 (quote (any any . any)))))) ($sc-dispatch tmp965 (quote (any any))))) e955))))) (lambda (e1013 r1014 w1015 s1016 mod1017) (let ((e1018 (source-wrap143 e1013 w1015 s1016 mod1017))) ((lambda (tmp1019) ((lambda (tmp1020) (if tmp1020 (apply (lambda (_1021 x1022) (call-with-values (lambda () (gen-syntax920 e1018 x1022 r1014 (quote ()) ellipsis?159 mod1017)) (lambda (e1023 maps1024) (regen927 e1023)))) tmp1020) ((lambda (_1025) (syntax-violation (quote syntax) "bad `syntax' form" e1018)) tmp1019))) ($sc-dispatch tmp1019 (quote (any any))))) e1018))))) (global-extend112 (quote core) (quote lambda) (lambda (e1026 r1027 w1028 s1029 mod1030) ((lambda (tmp1031) ((lambda (tmp1032) (if tmp1032 (apply (lambda (_1033 c1034) (chi-lambda-clause155 (source-wrap143 e1026 w1028 s1029 mod1030) #f c1034 r1027 w1028 mod1030 (lambda (names1035 vars1036 docstring1037 body1038) (build-lambda90 s1029 names1035 vars1036 docstring1037 body1038)))) tmp1032) (syntax-violation #f "source expression failed to match any pattern" tmp1031))) ($sc-dispatch tmp1031 (quote (any . any))))) e1026))) (global-extend112 (quote core) (quote let) (letrec ((chi-let1039 (lambda (e1040 r1041 w1042 s1043 mod1044 constructor1045 ids1046 vals1047 exps1048) (if (not (valid-bound-ids?139 ids1046)) (syntax-violation (quote let) "duplicate bound variable" e1040) (let ((labels1049 (gen-labels120 ids1046)) (new-vars1050 (map gen-var161 ids1046))) (let ((nw1051 (make-binding-wrap131 ids1046 labels1049 w1042)) (nr1052 (extend-var-env109 labels1049 new-vars1050 r1041))) (constructor1045 s1043 (map syntax->datum ids1046) new-vars1050 (map (lambda (x1053) (chi150 x1053 r1041 w1042 mod1044)) vals1047) (chi-body154 exps1048 (source-wrap143 e1040 nw1051 s1043 mod1044) nr1052 nw1051 mod1044)))))))) (lambda (e1054 r1055 w1056 s1057 mod1058) ((lambda (tmp1059) ((lambda (tmp1060) (if (if tmp1060 (apply (lambda (_1061 id1062 val1063 e11064 e21065) (and-map id?114 id1062)) tmp1060) #f) (apply (lambda (_1067 id1068 val1069 e11070 e21071) (chi-let1039 e1054 r1055 w1056 s1057 mod1058 build-let94 id1068 val1069 (cons e11070 e21071))) tmp1060) ((lambda (tmp1075) (if (if tmp1075 (apply (lambda (_1076 f1077 id1078 val1079 e11080 e21081) (if (id?114 f1077) (and-map id?114 id1078) #f)) tmp1075) #f) (apply (lambda (_1083 f1084 id1085 val1086 e11087 e21088) (chi-let1039 e1054 r1055 w1056 s1057 mod1058 build-named-let95 (cons f1084 id1085) val1086 (cons e11087 e21088))) tmp1075) ((lambda (_1092) (syntax-violation (quote let) "bad let" (source-wrap143 e1054 w1056 s1057 mod1058))) tmp1059))) ($sc-dispatch tmp1059 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1059 (quote (any #(each (any any)) any . each-any))))) e1054)))) (global-extend112 (quote core) (quote letrec) (lambda (e1093 r1094 w1095 s1096 mod1097) ((lambda (tmp1098) ((lambda (tmp1099) (if (if tmp1099 (apply (lambda (_1100 id1101 val1102 e11103 e21104) (and-map id?114 id1101)) tmp1099) #f) (apply (lambda (_1106 id1107 val1108 e11109 e21110) (let ((ids1111 id1107)) (if (not (valid-bound-ids?139 ids1111)) (syntax-violation (quote letrec) "duplicate bound variable" e1093) (let ((labels1113 (gen-labels120 ids1111)) (new-vars1114 (map gen-var161 ids1111))) (let ((w1115 (make-binding-wrap131 ids1111 labels1113 w1095)) (r1116 (extend-var-env109 labels1113 new-vars1114 r1094))) (build-letrec96 s1096 (map syntax->datum ids1111) new-vars1114 (map (lambda (x1117) (chi150 x1117 r1116 w1115 mod1097)) val1108) (chi-body154 (cons e11109 e21110) (source-wrap143 e1093 w1115 s1096 mod1097) r1116 w1115 mod1097))))))) tmp1099) ((lambda (_1120) (syntax-violation (quote letrec) "bad letrec" (source-wrap143 e1093 w1095 s1096 mod1097))) tmp1098))) ($sc-dispatch tmp1098 (quote (any #(each (any any)) any . each-any))))) e1093))) (global-extend112 (quote core) (quote set!) (lambda (e1121 r1122 w1123 s1124 mod1125) ((lambda (tmp1126) ((lambda (tmp1127) (if (if tmp1127 (apply (lambda (_1128 id1129 val1130) (id?114 id1129)) tmp1127) #f) (apply (lambda (_1131 id1132 val1133) (let ((val1134 (chi150 val1133 r1122 w1123 mod1125)) (n1135 (id-var-name136 id1132 w1123))) (let ((b1136 (lookup111 n1135 r1122 mod1125))) (let ((atom-key1137 (binding-type106 b1136))) (if (memv atom-key1137 (quote (lexical))) (build-lexical-assignment84 s1124 (syntax->datum id1132) (binding-value107 b1136) val1134) (if (memv atom-key1137 (quote (global))) (build-global-assignment87 s1124 n1135 val1134 mod1125) (if (memv atom-key1137 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap142 id1132 w1123 mod1125)) (syntax-violation (quote set!) "bad set!" (source-wrap143 e1121 w1123 s1124 mod1125))))))))) tmp1127) ((lambda (tmp1138) (if tmp1138 (apply (lambda (_1139 head1140 tail1141 val1142) (call-with-values (lambda () (syntax-type148 head1140 r1122 (quote (())) #f #f mod1125 #t)) (lambda (type1143 value1144 ee1145 ww1146 ss1147 modmod1148) (if (memv type1143 (quote (module-ref))) (let ((val1149 (chi150 val1142 r1122 w1123 mod1125))) (call-with-values (lambda () (value1144 (cons head1140 tail1141))) (lambda (id1151 mod1152) (build-global-assignment87 s1124 id1151 val1149 mod1152)))) (build-application81 s1124 (chi150 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1140) r1122 w1123 mod1125) (map (lambda (e1153) (chi150 e1153 r1122 w1123 mod1125)) (append tail1141 (list val1142)))))))) tmp1138) ((lambda (_1155) (syntax-violation (quote set!) "bad set!" (source-wrap143 e1121 w1123 s1124 mod1125))) tmp1126))) ($sc-dispatch tmp1126 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1126 (quote (any any any))))) e1121))) (global-extend112 (quote module-ref) (quote @) (lambda (e1156) ((lambda (tmp1157) ((lambda (tmp1158) (if (if tmp1158 (apply (lambda (_1159 mod1160 id1161) (if (and-map id?114 mod1160) (id?114 id1161) #f)) tmp1158) #f) (apply (lambda (_1163 mod1164 id1165) (values (syntax->datum id1165) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1164)))) tmp1158) (syntax-violation #f "source expression failed to match any pattern" tmp1157))) ($sc-dispatch tmp1157 (quote (any each-any any))))) e1156))) (global-extend112 (quote module-ref) (quote @@) (lambda (e1167) ((lambda (tmp1168) ((lambda (tmp1169) (if (if tmp1169 (apply (lambda (_1170 mod1171 id1172) (if (and-map id?114 mod1171) (id?114 id1172) #f)) tmp1169) #f) (apply (lambda (_1174 mod1175 id1176) (values (syntax->datum id1176) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1175)))) tmp1169) (syntax-violation #f "source expression failed to match any pattern" tmp1168))) ($sc-dispatch tmp1168 (quote (any each-any any))))) e1167))) (global-extend112 (quote core) (quote if) (lambda (e1178 r1179 w1180 s1181 mod1182) ((lambda (tmp1183) ((lambda (tmp1184) (if tmp1184 (apply (lambda (_1185 test1186 then1187) (build-conditional82 s1181 (chi150 test1186 r1179 w1180 mod1182) (chi150 then1187 r1179 w1180 mod1182) (build-void80 #f))) tmp1184) ((lambda (tmp1188) (if tmp1188 (apply (lambda (_1189 test1190 then1191 else1192) (build-conditional82 s1181 (chi150 test1190 r1179 w1180 mod1182) (chi150 then1191 r1179 w1180 mod1182) (chi150 else1192 r1179 w1180 mod1182))) tmp1188) (syntax-violation #f "source expression failed to match any pattern" tmp1183))) ($sc-dispatch tmp1183 (quote (any any any any)))))) ($sc-dispatch tmp1183 (quote (any any any))))) e1178))) (global-extend112 (quote begin) (quote begin) (quote ())) (global-extend112 (quote define) (quote define) (quote ())) (global-extend112 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend112 (quote eval-when) (quote eval-when) (quote ())) (global-extend112 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1196 (lambda (x1197 keys1198 clauses1199 r1200 mod1201) (if (null? clauses1199) (build-application81 #f (build-primref91 #f (quote syntax-violation)) (list (build-data92 #f #f) (build-data92 #f "source expression failed to match any pattern") x1197)) ((lambda (tmp1202) ((lambda (tmp1203) (if tmp1203 (apply (lambda (pat1204 exp1205) (if (if (id?114 pat1204) (and-map (lambda (x1206) (not (free-id=?137 pat1204 x1206))) (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 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 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1198)) #f) (let ((labels1207 (list (gen-label119))) (var1208 (gen-var161 pat1204))) (build-application81 #f (build-lambda90 #f (list (syntax->datum pat1204)) (list var1208) #f (chi150 exp1205 (extend-env108 labels1207 (list (cons (quote syntax) (cons var1208 0))) r1200) (make-binding-wrap131 (list pat1204) labels1207 (quote (()))) mod1201)) (list x1197))) (gen-clause1195 x1197 keys1198 (cdr clauses1199) r1200 pat1204 #t exp1205 mod1201))) tmp1203) ((lambda (tmp1209) (if tmp1209 (apply (lambda (pat1210 fender1211 exp1212) (gen-clause1195 x1197 keys1198 (cdr clauses1199) r1200 pat1210 fender1211 exp1212 mod1201)) tmp1209) ((lambda (_1213) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1199))) tmp1202))) ($sc-dispatch tmp1202 (quote (any any any)))))) ($sc-dispatch tmp1202 (quote (any any))))) (car clauses1199))))) (gen-clause1195 (lambda (x1214 keys1215 clauses1216 r1217 pat1218 fender1219 exp1220 mod1221) (call-with-values (lambda () (convert-pattern1193 pat1218 keys1215)) (lambda (p1222 pvars1223) (if (not (distinct-bound-ids?140 (map car pvars1223))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1218) (if (not (and-map (lambda (x1224) (not (ellipsis?159 (car x1224)))) pvars1223)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1218) (let ((y1225 (gen-var161 (quote tmp)))) (build-application81 #f (build-lambda90 #f (list (quote tmp)) (list y1225) #f (let ((y1226 (build-lexical-reference83 (quote value) #f (quote tmp) y1225))) (build-conditional82 #f ((lambda (tmp1227) ((lambda (tmp1228) (if tmp1228 (apply (lambda () y1226) tmp1228) ((lambda (_1229) (build-conditional82 #f y1226 (build-dispatch-call1194 pvars1223 fender1219 y1226 r1217 mod1221) (build-data92 #f #f))) tmp1227))) ($sc-dispatch tmp1227 (quote #(atom #t))))) fender1219) (build-dispatch-call1194 pvars1223 exp1220 y1226 r1217 mod1221) (gen-syntax-case1196 x1214 keys1215 clauses1216 r1217 mod1221)))) (list (if (eq? p1222 (quote any)) (build-application81 #f (build-primref91 #f (quote list)) (list x1214)) (build-application81 #f (build-primref91 #f (quote $sc-dispatch)) (list x1214 (build-data92 #f p1222))))))))))))) (build-dispatch-call1194 (lambda (pvars1230 exp1231 y1232 r1233 mod1234) (let ((ids1235 (map car pvars1230)) (levels1236 (map cdr pvars1230))) (let ((labels1237 (gen-labels120 ids1235)) (new-vars1238 (map gen-var161 ids1235))) (build-application81 #f (build-primref91 #f (quote apply)) (list (build-lambda90 #f (map syntax->datum ids1235) new-vars1238 #f (chi150 exp1231 (extend-env108 labels1237 (map (lambda (var1239 level1240) (cons (quote syntax) (cons var1239 level1240))) new-vars1238 (map cdr pvars1230)) r1233) (make-binding-wrap131 ids1235 labels1237 (quote (()))) mod1234)) y1232)))))) (convert-pattern1193 (lambda (pattern1241 keys1242) (letrec ((cvt1243 (lambda (p1244 n1245 ids1246) (if (id?114 p1244) (if (bound-id-member?141 p1244 keys1242) (values (vector (quote free-id) p1244) ids1246) (values (quote any) (cons (cons p1244 n1245) ids1246))) ((lambda (tmp1247) ((lambda (tmp1248) (if (if tmp1248 (apply (lambda (x1249 dots1250) (ellipsis?159 dots1250)) tmp1248) #f) (apply (lambda (x1251 dots1252) (call-with-values (lambda () (cvt1243 x1251 (fx+72 n1245 1) ids1246)) (lambda (p1253 ids1254) (values (if (eq? p1253 (quote any)) (quote each-any) (vector (quote each) p1253)) ids1254)))) tmp1248) ((lambda (tmp1255) (if tmp1255 (apply (lambda (x1256 y1257) (call-with-values (lambda () (cvt1243 y1257 n1245 ids1246)) (lambda (y1258 ids1259) (call-with-values (lambda () (cvt1243 x1256 n1245 ids1259)) (lambda (x1260 ids1261) (values (cons x1260 y1258) ids1261)))))) tmp1255) ((lambda (tmp1262) (if tmp1262 (apply (lambda () (values (quote ()) ids1246)) tmp1262) ((lambda (tmp1263) (if tmp1263 (apply (lambda (x1264) (call-with-values (lambda () (cvt1243 x1264 n1245 ids1246)) (lambda (p1266 ids1267) (values (vector (quote vector) p1266) ids1267)))) tmp1263) ((lambda (x1268) (values (vector (quote atom) (strip160 p1244 (quote (())))) ids1246)) tmp1247))) ($sc-dispatch tmp1247 (quote #(vector each-any)))))) ($sc-dispatch tmp1247 (quote ()))))) ($sc-dispatch tmp1247 (quote (any . any)))))) ($sc-dispatch tmp1247 (quote (any any))))) p1244))))) (cvt1243 pattern1241 0 (quote ())))))) (lambda (e1269 r1270 w1271 s1272 mod1273) (let ((e1274 (source-wrap143 e1269 w1271 s1272 mod1273))) ((lambda (tmp1275) ((lambda (tmp1276) (if tmp1276 (apply (lambda (_1277 val1278 key1279 m1280) (if (and-map (lambda (x1281) (if (id?114 x1281) (not (ellipsis?159 x1281)) #f)) key1279) (let ((x1283 (gen-var161 (quote tmp)))) (build-application81 s1272 (build-lambda90 #f (list (quote tmp)) (list x1283) #f (gen-syntax-case1196 (build-lexical-reference83 (quote value) #f (quote tmp) x1283) key1279 m1280 r1270 mod1273)) (list (chi150 val1278 r1270 (quote (())) mod1273)))) (syntax-violation (quote syntax-case) "invalid literals list" e1274))) tmp1276) (syntax-violation #f "source expression failed to match any pattern" tmp1275))) ($sc-dispatch tmp1275 (quote (any any each-any . each-any))))) e1274))))) (set! sc-expand (lambda (x1287 . rest1286) (if (if (pair? x1287) (equal? (car x1287) noexpand70) #f) (cadr x1287) (let ((m1288 (if (null? rest1286) (quote e) (car rest1286))) (esew1289 (if (let ((t1290 (null? rest1286))) (if t1290 t1290 (null? (cdr rest1286)))) (quote (eval)) (cadr rest1286)))) (with-fluid* *mode*71 m1288 (lambda () (chi-top149 x1287 (quote ()) (quote ((top))) m1288 esew1289 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1291) (nonsymbol-id?113 x1291))) (set! datum->syntax (lambda (id1292 datum1293) (make-syntax-object97 datum1293 (syntax-object-wrap100 id1292) #f))) (set! syntax->datum (lambda (x1294) (strip160 x1294 (quote (()))))) (set! generate-temporaries (lambda (ls1295) (begin (let ((x1296 ls1295)) (if (not (list? x1296)) (syntax-violation (quote generate-temporaries) "invalid argument" x1296))) (map (lambda (x1297) (wrap142 (gensym) (quote ((top))) #f)) ls1295)))) (set! free-identifier=? (lambda (x1298 y1299) (begin (let ((x1300 x1298)) (if (not (nonsymbol-id?113 x1300)) (syntax-violation (quote free-identifier=?) "invalid argument" x1300))) (let ((x1301 y1299)) (if (not (nonsymbol-id?113 x1301)) (syntax-violation (quote free-identifier=?) "invalid argument" x1301))) (free-id=?137 x1298 y1299)))) (set! bound-identifier=? (lambda (x1302 y1303) (begin (let ((x1304 x1302)) (if (not (nonsymbol-id?113 x1304)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1304))) (let ((x1305 y1303)) (if (not (nonsymbol-id?113 x1305)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1305))) (bound-id=?138 x1302 y1303)))) (set! syntax-violation (lambda (who1309 message1308 form1307 . subform1306) (begin (let ((x1310 who1309)) (if (not ((lambda (x1311) (let ((t1312 (not x1311))) (if t1312 t1312 (let ((t1313 (string? x1311))) (if t1313 t1313 (symbol? x1311)))))) x1310)) (syntax-violation (quote syntax-violation) "invalid argument" x1310))) (let ((x1314 message1308)) (if (not (string? x1314)) (syntax-violation (quote syntax-violation) "invalid argument" x1314))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1309 "~a: " "") "~a " (if (null? subform1306) "in ~a" "in subform `~s' of `~s'")) (let ((tail1315 (cons message1308 (map (lambda (x1316) (strip160 x1316 (quote (())))) (append subform1306 (list form1307)))))) (if who1309 (cons who1309 tail1315) tail1315)) #f)))) (letrec ((match1321 (lambda (e1322 p1323 w1324 r1325 mod1326) (if (not r1325) #f (if (eq? p1323 (quote any)) (cons (wrap142 e1322 w1324 mod1326) r1325) (if (syntax-object?98 e1322) (match*1320 (syntax-object-expression99 e1322) p1323 (join-wraps133 w1324 (syntax-object-wrap100 e1322)) r1325 (syntax-object-module101 e1322)) (match*1320 e1322 p1323 w1324 r1325 mod1326)))))) (match*1320 (lambda (e1327 p1328 w1329 r1330 mod1331) (if (null? p1328) (if (null? e1327) r1330 #f) (if (pair? p1328) (if (pair? e1327) (match1321 (car e1327) (car p1328) w1329 (match1321 (cdr e1327) (cdr p1328) w1329 r1330 mod1331) mod1331) #f) (if (eq? p1328 (quote each-any)) (let ((l1332 (match-each-any1318 e1327 w1329 mod1331))) (if l1332 (cons l1332 r1330) #f)) (let ((atom-key1333 (vector-ref p1328 0))) (if (memv atom-key1333 (quote (each))) (if (null? e1327) (match-empty1319 (vector-ref p1328 1) r1330) (let ((l1334 (match-each1317 e1327 (vector-ref p1328 1) w1329 mod1331))) (if l1334 (letrec ((collect1335 (lambda (l1336) (if (null? (car l1336)) r1330 (cons (map car l1336) (collect1335 (map cdr l1336))))))) (collect1335 l1334)) #f))) (if (memv atom-key1333 (quote (free-id))) (if (id?114 e1327) (if (free-id=?137 (wrap142 e1327 w1329 mod1331) (vector-ref p1328 1)) r1330 #f) #f) (if (memv atom-key1333 (quote (atom))) (if (equal? (vector-ref p1328 1) (strip160 e1327 w1329)) r1330 #f) (if (memv atom-key1333 (quote (vector))) (if (vector? e1327) (match1321 (vector->list e1327) (vector-ref p1328 1) w1329 r1330 mod1331) #f))))))))))) (match-empty1319 (lambda (p1337 r1338) (if (null? p1337) r1338 (if (eq? p1337 (quote any)) (cons (quote ()) r1338) (if (pair? p1337) (match-empty1319 (car p1337) (match-empty1319 (cdr p1337) r1338)) (if (eq? p1337 (quote each-any)) (cons (quote ()) r1338) (let ((atom-key1339 (vector-ref p1337 0))) (if (memv atom-key1339 (quote (each))) (match-empty1319 (vector-ref p1337 1) r1338) (if (memv atom-key1339 (quote (free-id atom))) r1338 (if (memv atom-key1339 (quote (vector))) (match-empty1319 (vector-ref p1337 1) r1338))))))))))) (match-each-any1318 (lambda (e1340 w1341 mod1342) (if (pair? e1340) (let ((l1343 (match-each-any1318 (cdr e1340) w1341 mod1342))) (if l1343 (cons (wrap142 (car e1340) w1341 mod1342) l1343) #f)) (if (null? e1340) (quote ()) (if (syntax-object?98 e1340) (match-each-any1318 (syntax-object-expression99 e1340) (join-wraps133 w1341 (syntax-object-wrap100 e1340)) mod1342) #f))))) (match-each1317 (lambda (e1344 p1345 w1346 mod1347) (if (pair? e1344) (let ((first1348 (match1321 (car e1344) p1345 w1346 (quote ()) mod1347))) (if first1348 (let ((rest1349 (match-each1317 (cdr e1344) p1345 w1346 mod1347))) (if rest1349 (cons first1348 rest1349) #f)) #f)) (if (null? e1344) (quote ()) (if (syntax-object?98 e1344) (match-each1317 (syntax-object-expression99 e1344) p1345 (join-wraps133 w1346 (syntax-object-wrap100 e1344)) (syntax-object-module101 e1344)) #f)))))) (set! $sc-dispatch (lambda (e1350 p1351) (if (eq? p1351 (quote any)) (list e1350) (if (syntax-object?98 e1350) (match*1320 (syntax-object-expression99 e1350) p1351 (syntax-object-wrap100 e1350) (quote ()) (syntax-object-module101 e1350)) (match*1320 e1350 p1351 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x1352) ((lambda (tmp1353) ((lambda (tmp1354) (if tmp1354 (apply (lambda (_1355 e11356 e21357) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11356 e21357))) tmp1354) ((lambda (tmp1359) (if tmp1359 (apply (lambda (_1360 out1361 in1362 e11363 e21364) (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))) in1362 (quote ()) (list out1361 (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 e11363 e21364))))) tmp1359) ((lambda (tmp1366) (if tmp1366 (apply (lambda (_1367 out1368 in1369 e11370 e21371) (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))) in1369) (quote ()) (list out1368 (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 e11370 e21371))))) tmp1366) (syntax-violation #f "source expression failed to match any pattern" tmp1353))) ($sc-dispatch tmp1353 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1353 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1353 (quote (any () any . each-any))))) x1352))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1375) ((lambda (tmp1376) ((lambda (tmp1377) (if tmp1377 (apply (lambda (_1378 k1379 keyword1380 pattern1381 template1382) (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 k1379 (map (lambda (tmp1385 tmp1384) (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))) tmp1384) (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))) tmp1385))) template1382 pattern1381)))))) tmp1377) (syntax-violation #f "source expression failed to match any pattern" tmp1376))) ($sc-dispatch tmp1376 (quote (any each-any . #(each ((any . any) any))))))) x1375))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1386) ((lambda (tmp1387) ((lambda (tmp1388) (if (if tmp1388 (apply (lambda (let*1389 x1390 v1391 e11392 e21393) (and-map identifier? x1390)) tmp1388) #f) (apply (lambda (let*1395 x1396 v1397 e11398 e21399) (letrec ((f1400 (lambda (bindings1401) (if (null? bindings1401) (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 e11398 e21399))) ((lambda (tmp1405) ((lambda (tmp1406) (if tmp1406 (apply (lambda (body1407 binding1408) (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 binding1408) body1407)) tmp1406) (syntax-violation #f "source expression failed to match any pattern" tmp1405))) ($sc-dispatch tmp1405 (quote (any any))))) (list (f1400 (cdr bindings1401)) (car bindings1401))))))) (f1400 (map list x1396 v1397)))) tmp1388) (syntax-violation #f "source expression failed to match any pattern" tmp1387))) ($sc-dispatch tmp1387 (quote (any #(each (any any)) any . each-any))))) x1386))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1409) ((lambda (tmp1410) ((lambda (tmp1411) (if tmp1411 (apply (lambda (_1412 var1413 init1414 step1415 e01416 e11417 c1418) ((lambda (tmp1419) ((lambda (tmp1420) (if tmp1420 (apply (lambda (step1421) ((lambda (tmp1422) ((lambda (tmp1423) (if tmp1423 (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 var1413 init1414) (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))) e01416) (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 c1418 (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))) step1421))))))) tmp1423) ((lambda (tmp1428) (if tmp1428 (apply (lambda (e11429 e21430) (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 var1413 init1414) (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))) e01416 (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 e11429 e21430)) (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 c1418 (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))) step1421))))))) tmp1428) (syntax-violation #f "source expression failed to match any pattern" tmp1422))) ($sc-dispatch tmp1422 (quote (any . each-any)))))) ($sc-dispatch tmp1422 (quote ())))) e11417)) tmp1420) (syntax-violation #f "source expression failed to match any pattern" tmp1419))) ($sc-dispatch tmp1419 (quote each-any)))) (map (lambda (v1437 s1438) ((lambda (tmp1439) ((lambda (tmp1440) (if tmp1440 (apply (lambda () v1437) tmp1440) ((lambda (tmp1441) (if tmp1441 (apply (lambda (e1442) e1442) tmp1441) ((lambda (_1443) (syntax-violation (quote do) "bad step expression" orig-x1409 s1438)) tmp1439))) ($sc-dispatch tmp1439 (quote (any)))))) ($sc-dispatch tmp1439 (quote ())))) s1438)) var1413 step1415))) tmp1411) (syntax-violation #f "source expression failed to match any pattern" tmp1410))) ($sc-dispatch tmp1410 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1409))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1446 (lambda (x1450 y1451) ((lambda (tmp1452) ((lambda (tmp1453) (if tmp1453 (apply (lambda (x1454 y1455) ((lambda (tmp1456) ((lambda (tmp1457) (if tmp1457 (apply (lambda (dy1458) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (dx1461) (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 dx1461 dy1458))) tmp1460) ((lambda (_1462) (if (null? dy1458) (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))) x1454) (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))) x1454 y1455))) tmp1459))) ($sc-dispatch tmp1459 (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))))) x1454)) tmp1457) ((lambda (tmp1463) (if tmp1463 (apply (lambda (stuff1464) (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 x1454 stuff1464))) tmp1463) ((lambda (else1465) (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))) x1454 y1455)) tmp1456))) ($sc-dispatch tmp1456 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1456 (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))))) y1455)) tmp1453) (syntax-violation #f "source expression failed to match any pattern" tmp1452))) ($sc-dispatch tmp1452 (quote (any any))))) (list x1450 y1451)))) (quasiappend1447 (lambda (x1466 y1467) ((lambda (tmp1468) ((lambda (tmp1469) (if tmp1469 (apply (lambda (x1470 y1471) ((lambda (tmp1472) ((lambda (tmp1473) (if tmp1473 (apply (lambda () x1470) tmp1473) ((lambda (_1474) (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))) x1470 y1471)) tmp1472))) ($sc-dispatch tmp1472 (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))) ()))))) y1471)) tmp1469) (syntax-violation #f "source expression failed to match any pattern" tmp1468))) ($sc-dispatch tmp1468 (quote (any any))))) (list x1466 y1467)))) (quasivector1448 (lambda (x1475) ((lambda (tmp1476) ((lambda (x1477) ((lambda (tmp1478) ((lambda (tmp1479) (if tmp1479 (apply (lambda (x1480) (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 x1480))) tmp1479) ((lambda (tmp1482) (if tmp1482 (apply (lambda (x1483) (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))) x1483)) tmp1482) ((lambda (_1485) (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))) x1477)) tmp1478))) ($sc-dispatch tmp1478 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp1478 (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))))) x1477)) tmp1476)) x1475))) (quasi1449 (lambda (p1486 lev1487) ((lambda (tmp1488) ((lambda (tmp1489) (if tmp1489 (apply (lambda (p1490) (if (= lev1487 0) p1490 (quasicons1446 (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)))) (quasi1449 (list p1490) (- lev1487 1))))) tmp1489) ((lambda (tmp1491) (if (if tmp1491 (apply (lambda (args1492) (= lev1487 0)) tmp1491) #f) (apply (lambda (args1493) (syntax-violation (quote unquote) "unquote takes exactly one argument" p1486 (cons (quote #(syntax-object unquote ((top) #(ribcage #(args) #((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))) args1493))) tmp1491) ((lambda (tmp1494) (if tmp1494 (apply (lambda (p1495 q1496) (if (= lev1487 0) (quasiappend1447 p1495 (quasi1449 q1496 lev1487)) (quasicons1446 (quasicons1446 (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)))) (quasi1449 (list p1495) (- lev1487 1))) (quasi1449 q1496 lev1487)))) tmp1494) ((lambda (tmp1497) (if (if tmp1497 (apply (lambda (args1498 q1499) (= lev1487 0)) tmp1497) #f) (apply (lambda (args1500 q1501) (syntax-violation (quote unquote-splicing) "unquote-splicing takes exactly one argument" p1486 (cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args 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))) args1500))) tmp1497) ((lambda (tmp1502) (if tmp1502 (apply (lambda (p1503) (quasicons1446 (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)))) (quasi1449 (list p1503) (+ lev1487 1)))) tmp1502) ((lambda (tmp1504) (if tmp1504 (apply (lambda (p1505 q1506) (quasicons1446 (quasi1449 p1505 lev1487) (quasi1449 q1506 lev1487))) tmp1504) ((lambda (tmp1507) (if tmp1507 (apply (lambda (x1508) (quasivector1448 (quasi1449 x1508 lev1487))) 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)) tmp1488))) ($sc-dispatch tmp1488 (quote #(vector each-any)))))) ($sc-dispatch tmp1488 (quote (any . any)))))) ($sc-dispatch tmp1488 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp1488 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any) . any)))))) ($sc-dispatch tmp1488 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1488 (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)))))) ($sc-dispatch tmp1488 (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))))) p1486)))) (lambda (x1511) ((lambda (tmp1512) ((lambda (tmp1513) (if tmp1513 (apply (lambda (_1514 e1515) (quasi1449 e1515 0)) tmp1513) (syntax-violation #f "source expression failed to match any pattern" tmp1512))) ($sc-dispatch tmp1512 (quote (any any))))) x1511)))))
+(define include (make-syncase-macro (quote macro) (lambda (x1516) (letrec ((read-file1517 (lambda (fn1518 k1519) (let ((p1520 (open-input-file fn1518))) (letrec ((f1521 (lambda (x1522) (if (eof-object? x1522) (begin (close-input-port p1520) (quote ())) (cons (datum->syntax k1519 x1522) (f1521 (read p1520))))))) (f1521 (read p1520))))))) ((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (k1525 filename1526) (let ((fn1527 (syntax->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-violation #f "source expression failed to match any pattern" tmp1528))) ($sc-dispatch tmp1528 (quote each-any)))) (read-file1517 fn1527 k1525)))) tmp1524) (syntax-violation #f "source expression failed to match any pattern" tmp1523))) ($sc-dispatch tmp1523 (quote (any any))))) x1516)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x1532) ((lambda (tmp1533) ((lambda (tmp1534) (if tmp1534 (apply (lambda (_1535 e1536) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1532)) tmp1534) (syntax-violation #f "source expression failed to match any pattern" tmp1533))) ($sc-dispatch tmp1533 (quote (any any))))) x1532))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1537) ((lambda (tmp1538) ((lambda (tmp1539) (if tmp1539 (apply (lambda (_1540 e1541) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1537)) tmp1539) (syntax-violation #f "source expression failed to match any pattern" tmp1538))) ($sc-dispatch tmp1538 (quote (any any))))) x1537))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (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)) (letrec ((f1551 (lambda (clause1552 clauses1553) (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-violation (quote case) "bad clause" x1542 clause1552)) tmp1555))) ($sc-dispatch tmp1555 (quote (each-any any . each-any)))))) ($sc-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-violation (quote case) "bad clause" x1542 clause1552)) tmp1569))) ($sc-dispatch tmp1569 (quote (each-any any . each-any))))) clause1552)) tmp1567)) (f1551 (car clauses1553) (cdr clauses1553))))))) (f1551 m11547 m21548)))) tmp1544) (syntax-violation #f "source expression failed to match any pattern" tmp1543))) ($sc-dispatch tmp1543 (quote (any any any . each-any))))) x1542))))
+(define identifier-syntax (make-syncase-macro (quote macro) (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-violation #f "source expression failed to match any pattern" tmp1578))) ($sc-dispatch tmp1578 (quote (any any))))) x1577))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index c2668c0c4..f18b626e3 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -560,7 +560,6 @@
 
 ;;; <binding> ::= (macro . <procedure>)           macros
 ;;;               (core . <procedure>)            core forms
-;;;               (external-macro . <procedure>)  external-macro
 ;;;               (module-ref . <procedure>)      @ or @@
 ;;;               (begin)                         begin
 ;;;               (define)                        define
@@ -999,9 +998,9 @@
 ;;;
 ;;;    type                   value         explanation
 ;;;    -------------------------------------------------------------------
-;;;    core                   procedure     core form (including singleton)
-;;;    external-macro         procedure     external macro
-;;;    module-ref             procedure     @ or @@ form
+;;;    core                   procedure     core singleton
+;;;    core-form              procedure     core form
+;;;    module-ref             procedure     @ or @@ singleton
 ;;;    lexical                name          lexical variable reference
 ;;;    global                 name          global variable reference
 ;;;    begin                  none          begin keyword
@@ -1031,7 +1030,7 @@
 ;;; forms, although perhaps this should be done by the consumer.
 
 (define syntax-type
-  (lambda (e r w s rib mod)
+  (lambda (e r w s rib mod for-car?)
     (cond
       ((symbol? e)
        (let* ((n (id-var-name e w))
@@ -1041,64 +1040,70 @@
            ((lexical) (values type (binding-value b) e w s mod))
            ((global) (values type n e w s mod))
            ((macro)
-            (syntax-type (chi-macro (binding-value b) e r w rib mod)
-                         r empty-wrap s rib mod))
+            (if for-car?
+                (values type (binding-value b) e w s mod)
+                (syntax-type (chi-macro (binding-value b) e r w rib mod)
+                             r empty-wrap s rib mod #f)))
            (else (values type (binding-value b) e w s mod)))))
       ((pair? e)
        (let ((first (car e)))
-         (if (id? first)
-             (let* ((n (id-var-name first w))
-                    (b (lookup n r (or (and (syntax-object? first)
-                                            (syntax-object-module first))
-                                       mod)))
-                    (type (binding-type b)))
-               (case type
-                 ((lexical)
-                  (values 'lexical-call (binding-value b) e w s mod))
-                 ((global)
-                  (values 'global-call n e w s mod))
-                 ((macro)
-                  (syntax-type (chi-macro (binding-value b) e r w rib mod)
-                    r empty-wrap s rib mod))
-                 ((core external-macro module-ref)
-                  (values type (binding-value b) e w s mod))
-                 ((local-syntax)
-                  (values 'local-syntax-form (binding-value b) e w s mod))
-                 ((begin)
-                  (values 'begin-form #f e w s mod))
-                 ((eval-when)
-                  (values 'eval-when-form #f e w s mod))
-                 ((define)
-                  (syntax-case e ()
-                    ((_ name val)
-                     (id? (syntax name))
-                     (values 'define-form (syntax name) (syntax val) w s mod))
-                    ((_ (name . args) e1 e2 ...)
-                     (and (id? (syntax name))
-                          (valid-bound-ids? (lambda-var-list (syntax args))))
-                     ; need lambda here...
-                     (values 'define-form (wrap (syntax name) w mod)
-                       (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w mod))
-                       empty-wrap s mod))
-                    ((_ name)
-                     (id? (syntax name))
-                     (values 'define-form (wrap (syntax name) w mod)
-                       (syntax (if #f #f))
-                       empty-wrap s mod))))
-                 ((define-syntax)
-                  (syntax-case e ()
-                    ((_ name val)
-                     (id? (syntax name))
-                     (values 'define-syntax-form (syntax name)
-                       (syntax val) w s mod))))
-                 (else
-                  (values 'call #f e w s mod))))
-             (values 'call #f e w s mod))))
+         (call-with-values
+             (lambda () (syntax-type first r w s rib mod #t))
+           (lambda (ftype fval fe fw fs fmod)
+             (case ftype
+               ((lexical)
+                (values 'lexical-call fval e w s mod))
+               ((global)
+                ;; If we got here via an (@@ ...) expansion, we need to
+                ;; make sure the fmod information is propagated back
+                ;; correctly -- hence this consing.
+                (values 'global-call (make-syntax-object fval w fmod)
+                        e w s mod))
+               ((macro)
+                (syntax-type (chi-macro fval e r w rib mod)
+                             r empty-wrap s rib mod for-car?))
+               ((module-ref)
+                (call-with-values (lambda () (fval e))
+                  (lambda (sym mod)
+                    (syntax-type sym r w s rib mod for-car?))))
+               ((core)
+                (values 'core-form fval e w s mod))
+               ((local-syntax)
+                (values 'local-syntax-form fval e w s mod))
+               ((begin)
+                (values 'begin-form #f e w s mod))
+               ((eval-when)
+                (values 'eval-when-form #f e w s mod))
+               ((define)
+                (syntax-case e ()
+                  ((_ name val)
+                   (id? (syntax name))
+                   (values 'define-form (syntax name) (syntax val) w s mod))
+                  ((_ (name . args) e1 e2 ...)
+                   (and (id? (syntax name))
+                        (valid-bound-ids? (lambda-var-list (syntax args))))
+                                        ; need lambda here...
+                   (values 'define-form (wrap (syntax name) w mod)
+                           (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w mod))
+                           empty-wrap s mod))
+                  ((_ name)
+                   (id? (syntax name))
+                   (values 'define-form (wrap (syntax name) w mod)
+                           (syntax (if #f #f))
+                           empty-wrap s mod))))
+               ((define-syntax)
+                (syntax-case e ()
+                  ((_ name val)
+                   (id? (syntax name))
+                   (values 'define-syntax-form (syntax name)
+                           (syntax val) w s mod))))
+               (else
+                (values 'call #f e w s mod)))))))
       ((syntax-object? e)
        (syntax-type (syntax-object-expression e)
                     r
                     (join-wraps w (syntax-object-wrap e))
-                    s rib (or (syntax-object-module e) mod)))
+                    s rib (or (syntax-object-module e) mod) for-car?))
       ((self-evaluating? e) (values 'constant #f e w s mod))
       (else (values 'other #f e w s mod)))))
 
@@ -1111,7 +1116,7 @@
            (if (eq? m 'c&e) (top-level-eval-hook x mod))
            x))))
     (call-with-values
-      (lambda () (syntax-type e r w (source-annotation e) #f mod))
+      (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
       (lambda (type value e w s mod)
         (case type
           ((begin-form)
@@ -1187,7 +1192,7 @@
 (define chi
   (lambda (e r w mod)
     (call-with-values
-      (lambda () (syntax-type e r w (source-annotation e) #f mod))
+      (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
       (lambda (type value e w s mod)
         (chi-expr type value e r w s mod)))))
 
@@ -1196,7 +1201,7 @@
     (case type
       ((lexical)
        (build-lexical-reference 'value s e value))
-      ((core external-macro)
+      ((core core-form)
        ;; apply transformer
        (value e r w s mod))
       ((module-ref)
@@ -1210,9 +1215,12 @@
          e r w s mod))
       ((global-call)
        (chi-application
-         (build-global-reference (source-annotation (car e)) value
-                                 (if (syntax-object? (car e))
-                                     (syntax-object-module (car e))
+         (build-global-reference (source-annotation (car e))
+                                 (if (syntax-object? value)
+                                     (syntax-object-expression value)
+                                     value)
+                                 (if (syntax-object? value)
+                                     (syntax-object-module value)
                                      mod))
          e r w s mod))
       ((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap)))
@@ -1342,7 +1350,7 @@
             (syntax-violation #f "no expressions in body" outer-form)
             (let ((e (cdar body)) (er (caar body)))
               (call-with-values
-                (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod))
+                (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod #f))
                 (lambda (type value e w s mod)
                   (case type
                     ((define-form)
@@ -1843,7 +1851,7 @@
                                      (source-wrap e w s mod)))))))
       ((_ (head tail ...) val)
        (call-with-values
-           (lambda () (syntax-type (syntax head) r empty-wrap no-source #f mod))
+           (lambda () (syntax-type (syntax head) r empty-wrap no-source #f mod #t))
          (lambda (type value ee ww ss modmod)
            (case type
              ((module-ref)