some work on syntax.test

* module/language/tree-il.scm (tree-il->scheme):
* module/ice-9/psyntax.scm (build-conditional): Attempt to not generate
  (if #f #f) as the second arm of an if, but it doesn't seem to be
  successful.

* module/ice-9/psyntax-pp.scm (syntax-rules): Regenerate.

* test-suite/tests/syntax.test (exception:unexpected-syntax): Change
  capitalization.
  ("unquote-splicing"): Update test.
  ("begin"): Add in second arms on these ifs, to avoid the strange though
  harmless expansion of `if'.
  (matches?): New helper macro.
  ("lambda"): Match on lexically bound symbols, as they will be
  alpha-renamed.

4 files changed, 37 insertions, 19 deletions

diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 5b646d870..0fcd15cca 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,6 +1,6 @@
 (eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
 (if #f #f)
-(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 (vars291) (letrec ((lvl292 (lambda (vars293 ls294 w295) (if (pair? vars293) (lvl292 (cdr vars293) (cons (wrap141 (car vars293) w295 #f) ls294) w295) (if (id?113 vars293) (cons (wrap141 vars293 w295 #f) ls294) (if (null? vars293) ls294 (if (syntax-object?97 vars293) (lvl292 (syntax-object-expression98 vars293) ls294 (join-wraps132 w295 (syntax-object-wrap99 vars293))) (if (annotation? vars293) (lvl292 (annotation-expression vars293) ls294 w295) (cons vars293 ls294))))))))) (lvl292 vars291 (quote ()) (quote (())))))) (gen-var161 (lambda (id296) (let ((id297 (if (syntax-object?97 id296) (syntax-object-expression98 id296) id296))) (if (annotation? id297) (gensym (symbol->string (annotation-expression id297))) (gensym (symbol->string id297)))))) (strip160 (lambda (x298 w299) (if (memq (quote top) (wrap-marks116 w299)) (if (let ((t300 (annotation? x298))) (if t300 t300 (if (pair? x298) (annotation? (car x298)) #f))) (strip-annotation159 x298 #f) x298) (letrec ((f301 (lambda (x302) (if (syntax-object?97 x302) (strip160 (syntax-object-expression98 x302) (syntax-object-wrap99 x302)) (if (pair? x302) (let ((a303 (f301 (car x302))) (d304 (f301 (cdr x302)))) (if (if (eq? a303 (car x302)) (eq? d304 (cdr x302)) #f) x302 (cons a303 d304))) (if (vector? x302) (let ((old305 (vector->list x302))) (let ((new306 (map f301 old305))) (if (and-map*17 eq? old305 new306) x302 (list->vector new306)))) x302)))))) (f301 x298))))) (strip-annotation159 (lambda (x307 parent308) (if (pair? x307) (let ((new309 (cons #f #f))) (begin (if parent308 (set-annotation-stripped! parent308 new309) (if #f #f)) (set-car! new309 (strip-annotation159 (car x307) #f)) (set-cdr! new309 (strip-annotation159 (cdr x307) #f)) new309)) (if (annotation? x307) (let ((t310 (annotation-stripped x307))) (if t310 t310 (strip-annotation159 (annotation-expression x307) x307))) (if (vector? x307) (let ((new311 (make-vector (vector-length x307)))) (begin (if parent308 (set-annotation-stripped! parent308 new311) (if #f #f)) (letrec ((loop312 (lambda (i313) (unless (fx<75 i313 0) (vector-set! new311 i313 (strip-annotation159 (vector-ref x307 i313) #f)) (loop312 (fx-73 i313 1)))))) (loop312 (- (vector-length x307) 1))) new311)) x307))))) (ellipsis?158 (lambda (x314) (if (nonsymbol-id?112 x314) (free-id=?136 x314 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void157 (lambda () (build-void80 #f))) (eval-local-transformer156 (lambda (expanded315 mod316) (let ((p317 (local-eval-hook77 expanded315 mod316))) (if (procedure? p317) p317 (syntax-violation #f "nonprocedure transformer" p317))))) (chi-local-syntax155 (lambda (rec?318 e319 r320 w321 s322 mod323 k324) ((lambda (tmp325) ((lambda (tmp326) (if tmp326 (apply (lambda (_327 id328 val329 e1330 e2331) (let ((ids332 id328)) (if (not (valid-bound-ids?138 ids332)) (syntax-violation #f "duplicate bound keyword" e319) (let ((labels334 (gen-labels119 ids332))) (let ((new-w335 (make-binding-wrap130 ids332 labels334 w321))) (k324 (cons e1330 e2331) (extend-env107 labels334 (let ((w337 (if rec?318 new-w335 w321)) (trans-r338 (macros-only-env109 r320))) (map (lambda (x339) (cons (quote macro) (eval-local-transformer156 (chi149 x339 trans-r338 w337 mod323) mod323))) val329)) r320) new-w335 s322 mod323)))))) tmp326) ((lambda (_341) (syntax-violation #f "bad local syntax definition" (source-wrap142 e319 w321 s322 mod323))) tmp325))) ($sc-dispatch tmp325 (quote (any #(each (any any)) any . each-any))))) e319))) (chi-lambda-clause154 (lambda (e342 docstring343 c344 r345 w346 mod347 k348) ((lambda (tmp349) ((lambda (tmp350) (if (if tmp350 (apply (lambda (args351 doc352 e1353 e2354) (if (string? (syntax->datum doc352)) (not docstring343) #f)) tmp350) #f) (apply (lambda (args355 doc356 e1357 e2358) (chi-lambda-clause154 e342 doc356 (cons args355 (cons e1357 e2358)) r345 w346 mod347 k348)) tmp350) ((lambda (tmp360) (if tmp360 (apply (lambda (id361 e1362 e2363) (let ((ids364 id361)) (if (not (valid-bound-ids?138 ids364)) (syntax-violation (quote lambda) "invalid parameter list" e342) (let ((labels366 (gen-labels119 ids364)) (new-vars367 (map gen-var161 ids364))) (k348 (map syntax->datum ids364) new-vars367 (if docstring343 (syntax->datum docstring343) #f) (chi-body153 (cons e1362 e2363) e342 (extend-var-env108 labels366 new-vars367 r345) (make-binding-wrap130 ids364 labels366 w346) mod347)))))) tmp360) ((lambda (tmp369) (if tmp369 (apply (lambda (ids370 e1371 e2372) (let ((old-ids373 (lambda-var-list162 ids370))) (if (not (valid-bound-ids?138 old-ids373)) (syntax-violation (quote lambda) "invalid parameter list" e342) (let ((labels374 (gen-labels119 old-ids373)) (new-vars375 (map gen-var161 old-ids373))) (k348 (letrec ((f376 (lambda (ls1377 ls2378) (if (null? ls1377) (syntax->datum ls2378) (f376 (cdr ls1377) (cons (syntax->datum (car ls1377)) ls2378)))))) (f376 (cdr old-ids373) (car old-ids373))) (letrec ((f379 (lambda (ls1380 ls2381) (if (null? ls1380) ls2381 (f379 (cdr ls1380) (cons (car ls1380) ls2381)))))) (f379 (cdr new-vars375) (car new-vars375))) (if docstring343 (syntax->datum docstring343) #f) (chi-body153 (cons e1371 e2372) e342 (extend-var-env108 labels374 new-vars375 r345) (make-binding-wrap130 old-ids373 labels374 w346) mod347)))))) tmp369) ((lambda (_383) (syntax-violation (quote lambda) "bad lambda" e342)) tmp349))) ($sc-dispatch tmp349 (quote (any any . each-any)))))) ($sc-dispatch tmp349 (quote (each-any any . each-any)))))) ($sc-dispatch tmp349 (quote (any any any . each-any))))) c344))) (chi-body153 (lambda (body384 outer-form385 r386 w387 mod388) (let ((r389 (cons (quote ("placeholder" placeholder)) r386))) (let ((ribcage390 (make-ribcage120 (quote ()) (quote ()) (quote ())))) (let ((w391 (make-wrap115 (wrap-marks116 w387) (cons ribcage390 (wrap-subst117 w387))))) (letrec ((parse392 (lambda (body393 ids394 labels395 vars396 vals397 bindings398) (if (null? body393) (syntax-violation #f "no expressions in body" outer-form385) (let ((e400 (cdar body393)) (er401 (caar body393))) (call-with-values (lambda () (syntax-type147 e400 er401 (quote (())) #f ribcage390 mod388)) (lambda (type402 value403 e404 w405 s406 mod407) (if (memv type402 (quote (define-form))) (let ((id408 (wrap141 value403 w405 mod407)) (label409 (gen-label118))) (let ((var410 (gen-var161 id408))) (begin (extend-ribcage!129 ribcage390 id408 label409) (parse392 (cdr body393) (cons id408 ids394) (cons label409 labels395) (cons var410 vars396) (cons (cons er401 (wrap141 e404 w405 mod407)) vals397) (cons (cons (quote lexical) var410) bindings398))))) (if (memv type402 (quote (define-syntax-form))) (let ((id411 (wrap141 value403 w405 mod407)) (label412 (gen-label118))) (begin (extend-ribcage!129 ribcage390 id411 label412) (parse392 (cdr body393) (cons id411 ids394) (cons label412 labels395) vars396 vals397 (cons (cons (quote macro) (cons er401 (wrap141 e404 w405 mod407))) bindings398)))) (if (memv type402 (quote (begin-form))) ((lambda (tmp413) ((lambda (tmp414) (if tmp414 (apply (lambda (_415 e1416) (parse392 (letrec ((f417 (lambda (forms418) (if (null? forms418) (cdr body393) (cons (cons er401 (wrap141 (car forms418) w405 mod407)) (f417 (cdr forms418))))))) (f417 e1416)) ids394 labels395 vars396 vals397 bindings398)) tmp414) (syntax-violation #f "source expression failed to match any pattern" tmp413))) ($sc-dispatch tmp413 (quote (any . each-any))))) e404) (if (memv type402 (quote (local-syntax-form))) (chi-local-syntax155 value403 e404 er401 w405 s406 mod407 (lambda (forms420 er421 w422 s423 mod424) (parse392 (letrec ((f425 (lambda (forms426) (if (null? forms426) (cdr body393) (cons (cons er421 (wrap141 (car forms426) w422 mod424)) (f425 (cdr forms426))))))) (f425 forms420)) ids394 labels395 vars396 vals397 bindings398))) (if (null? ids394) (build-sequence92 #f (map (lambda (x427) (chi149 (cdr x427) (car x427) (quote (())) mod407)) (cons (cons er401 (source-wrap142 e404 w405 s406 mod407)) (cdr body393)))) (begin (if (not (valid-bound-ids?138 ids394)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form385) (if #f #f)) (letrec ((loop428 (lambda (bs429 er-cache430 r-cache431) (if (not (null? bs429)) (let ((b432 (car bs429))) (if (eq? (car b432) (quote macro)) (let ((er433 (cadr b432))) (let ((r-cache434 (if (eq? er433 er-cache430) r-cache431 (macros-only-env109 er433)))) (begin (set-cdr! b432 (eval-local-transformer156 (chi149 (cddr b432) r-cache434 (quote (())) mod407) mod407)) (loop428 (cdr bs429) er433 r-cache434)))) (loop428 (cdr bs429) er-cache430 r-cache431))) (if #f #f))))) (loop428 bindings398 #f #f)) (set-cdr! r389 (extend-env107 labels395 bindings398 (cdr r389))) (build-letrec95 #f (map syntax->datum ids394) vars396 (map (lambda (x435) (chi149 (cdr x435) (car x435) (quote (())) mod407)) vals397) (build-sequence92 #f (map (lambda (x436) (chi149 (cdr x436) (car x436) (quote (())) mod407)) (cons (cons er401 (source-wrap142 e404 w405 s406 mod407)) (cdr body393)))))))))))))))))) (parse392 (map (lambda (x399) (cons r389 (wrap141 x399 w391 mod388))) body384) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro152 (lambda (p437 e438 r439 w440 rib441 mod442) (letrec ((rebuild-macro-output443 (lambda (x444 m445) (if (pair? x444) (cons (rebuild-macro-output443 (car x444) m445) (rebuild-macro-output443 (cdr x444) m445)) (if (syntax-object?97 x444) (let ((w446 (syntax-object-wrap99 x444))) (let ((ms447 (wrap-marks116 w446)) (s448 (wrap-subst117 w446))) (if (if (pair? ms447) (eq? (car ms447) #f) #f) (make-syntax-object96 (syntax-object-expression98 x444) (make-wrap115 (cdr ms447) (if rib441 (cons rib441 (cdr s448)) (cdr s448))) (syntax-object-module100 x444)) (make-syntax-object96 (syntax-object-expression98 x444) (make-wrap115 (cons m445 ms447) (if rib441 (cons rib441 (cons (quote shift) s448)) (cons (quote shift) s448))) (let ((pmod449 (procedure-module p437))) (if pmod449 (cons (quote hygiene) (module-name pmod449)) (quote (hygiene guile)))))))) (if (vector? x444) (let ((n450 (vector-length x444))) (let ((v451 (make-vector n450))) (letrec ((loop452 (lambda (i453) (if (fx=74 i453 n450) (begin (if #f #f (if #f #f)) v451) (begin (vector-set! v451 i453 (rebuild-macro-output443 (vector-ref x444 i453) m445)) (loop452 (fx+72 i453 1))))))) (loop452 0)))) (if (symbol? x444) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap142 e438 w440 s mod442) x444) x444))))))) (rebuild-macro-output443 (p437 (wrap141 e438 (anti-mark128 w440) mod442)) (string #\m))))) (chi-application151 (lambda (x454 e455 r456 w457 s458 mod459) ((lambda (tmp460) ((lambda (tmp461) (if tmp461 (apply (lambda (e0462 e1463) (build-application81 s458 x454 (map (lambda (e464) (chi149 e464 r456 w457 mod459)) e1463))) tmp461) (syntax-violation #f "source expression failed to match any pattern" tmp460))) ($sc-dispatch tmp460 (quote (any . each-any))))) e455))) (chi-expr150 (lambda (type466 value467 e468 r469 w470 s471 mod472) (if (memv type466 (quote (lexical))) (build-lexical-reference83 (quote value) s471 e468 value467) (if (memv type466 (quote (core external-macro))) (value467 e468 r469 w470 s471 mod472) (if (memv type466 (quote (module-ref))) (call-with-values (lambda () (value467 e468)) (lambda (id473 mod474) (build-global-reference86 s471 id473 mod474))) (if (memv type466 (quote (lexical-call))) (chi-application151 (build-lexical-reference83 (quote fun) (source-annotation104 (car e468)) (car e468) value467) e468 r469 w470 s471 mod472) (if (memv type466 (quote (global-call))) (chi-application151 (build-global-reference86 (source-annotation104 (car e468)) value467 (if (syntax-object?97 (car e468)) (syntax-object-module100 (car e468)) mod472)) e468 r469 w470 s471 mod472) (if (memv type466 (quote (constant))) (build-data91 s471 (strip160 (source-wrap142 e468 w470 s471 mod472) (quote (())))) (if (memv type466 (quote (global))) (build-global-reference86 s471 value467 mod472) (if (memv type466 (quote (call))) (chi-application151 (chi149 (car e468) r469 w470 mod472) e468 r469 w470 s471 mod472) (if (memv type466 (quote (begin-form))) ((lambda (tmp475) ((lambda (tmp476) (if tmp476 (apply (lambda (_477 e1478 e2479) (chi-sequence143 (cons e1478 e2479) r469 w470 s471 mod472)) tmp476) (syntax-violation #f "source expression failed to match any pattern" tmp475))) ($sc-dispatch tmp475 (quote (any any . each-any))))) e468) (if (memv type466 (quote (local-syntax-form))) (chi-local-syntax155 value467 e468 r469 w470 s471 mod472 chi-sequence143) (if (memv type466 (quote (eval-when-form))) ((lambda (tmp481) ((lambda (tmp482) (if tmp482 (apply (lambda (_483 x484 e1485 e2486) (let ((when-list487 (chi-when-list146 e468 x484 w470))) (if (memq (quote eval) when-list487) (chi-sequence143 (cons e1485 e2486) r469 w470 s471 mod472) (chi-void157)))) tmp482) (syntax-violation #f "source expression failed to match any pattern" tmp481))) ($sc-dispatch tmp481 (quote (any each-any any . each-any))))) e468) (if (memv type466 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e468 (wrap141 value467 w470 mod472)) (if (memv type466 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap142 e468 w470 s471 mod472)) (if (memv type466 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap142 e468 w470 s471 mod472)) (syntax-violation #f "unexpected syntax" (source-wrap142 e468 w470 s471 mod472)))))))))))))))))) (chi149 (lambda (e490 r491 w492 mod493) (call-with-values (lambda () (syntax-type147 e490 r491 w492 #f #f mod493)) (lambda (type494 value495 e496 w497 s498 mod499) (chi-expr150 type494 value495 e496 r491 w497 s498 mod499))))) (chi-top148 (lambda (e500 r501 w502 m503 esew504 mod505) (call-with-values (lambda () (syntax-type147 e500 r501 w502 #f #f mod505)) (lambda (type513 value514 e515 w516 s517 mod518) (if (memv type513 (quote (begin-form))) ((lambda (tmp519) ((lambda (tmp520) (if tmp520 (apply (lambda (_521) (chi-void157)) tmp520) ((lambda (tmp522) (if tmp522 (apply (lambda (_523 e1524 e2525) (chi-top-sequence144 (cons e1524 e2525) r501 w516 s517 m503 esew504 mod518)) tmp522) (syntax-violation #f "source expression failed to match any pattern" tmp519))) ($sc-dispatch tmp519 (quote (any any . each-any)))))) ($sc-dispatch tmp519 (quote (any))))) e515) (if (memv type513 (quote (local-syntax-form))) (chi-local-syntax155 value514 e515 r501 w516 s517 mod518 (lambda (body527 r528 w529 s530 mod531) (chi-top-sequence144 body527 r528 w529 s530 m503 esew504 mod531))) (if (memv type513 (quote (eval-when-form))) ((lambda (tmp532) ((lambda (tmp533) (if tmp533 (apply (lambda (_534 x535 e1536 e2537) (let ((when-list538 (chi-when-list146 e515 x535 w516)) (body539 (cons e1536 e2537))) (if (eq? m503 (quote e)) (if (memq (quote eval) when-list538) (chi-top-sequence144 body539 r501 w516 s517 (quote e) (quote (eval)) mod518) (chi-void157)) (if (memq (quote load) when-list538) (if (let ((t542 (memq (quote compile) when-list538))) (if t542 t542 (if (eq? m503 (quote c&e)) (memq (quote eval) when-list538) #f))) (chi-top-sequence144 body539 r501 w516 s517 (quote c&e) (quote (compile load)) mod518) (if (memq m503 (quote (c c&e))) (chi-top-sequence144 body539 r501 w516 s517 (quote c) (quote (load)) mod518) (chi-void157))) (if (let ((t543 (memq (quote compile) when-list538))) (if t543 t543 (if (eq? m503 (quote c&e)) (memq (quote eval) when-list538) #f))) (begin (top-level-eval-hook76 (chi-top-sequence144 body539 r501 w516 s517 (quote e) (quote (eval)) mod518) mod518) (chi-void157)) (chi-void157)))))) tmp533) (syntax-violation #f "source expression failed to match any pattern" tmp532))) ($sc-dispatch tmp532 (quote (any each-any any . each-any))))) e515) (if (memv type513 (quote (define-syntax-form))) (let ((n544 (id-var-name135 value514 w516)) (r545 (macros-only-env109 r501))) (if (memv m503 (quote (c))) (if (memq (quote compile) esew504) (let ((e546 (chi-install-global145 n544 (chi149 e515 r545 w516 mod518)))) (begin (top-level-eval-hook76 e546 mod518) (if (memq (quote load) esew504) e546 (chi-void157)))) (if (memq (quote load) esew504) (chi-install-global145 n544 (chi149 e515 r545 w516 mod518)) (chi-void157))) (if (memv m503 (quote (c&e))) (let ((e547 (chi-install-global145 n544 (chi149 e515 r545 w516 mod518)))) (begin (top-level-eval-hook76 e547 mod518) e547)) (begin (if (memq (quote eval) esew504) (top-level-eval-hook76 (chi-install-global145 n544 (chi149 e515 r545 w516 mod518)) mod518) (if #f #f)) (chi-void157))))) (if (memv type513 (quote (define-form))) (let ((n548 (id-var-name135 value514 w516))) (let ((type549 (binding-type105 (lookup110 n548 r501 mod518)))) (if (memv type549 (quote (global core macro module-ref))) (let ((x550 (build-global-definition88 s517 n548 (chi149 e515 r501 w516 mod518)))) (begin (if (eq? m503 (quote c&e)) (top-level-eval-hook76 x550 mod518) (if #f #f)) x550)) (if (memv type549 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e515 (wrap141 value514 w516 mod518)) (syntax-violation #f "cannot define keyword at top level" e515 (wrap141 value514 w516 mod518)))))) (let ((x551 (chi-expr150 type513 value514 e515 r501 w516 s517 mod518))) (begin (if (eq? m503 (quote c&e)) (top-level-eval-hook76 x551 mod518) (if #f #f)) x551))))))))))) (syntax-type147 (lambda (e552 r553 w554 s555 rib556 mod557) (if (symbol? e552) (let ((n558 (id-var-name135 e552 w554))) (let ((b559 (lookup110 n558 r553 mod557))) (let ((type560 (binding-type105 b559))) (if (memv type560 (quote (lexical))) (values type560 (binding-value106 b559) e552 w554 s555 mod557) (if (memv type560 (quote (global))) (values type560 n558 e552 w554 s555 mod557) (if (memv type560 (quote (macro))) (syntax-type147 (chi-macro152 (binding-value106 b559) e552 r553 w554 rib556 mod557) r553 (quote (())) s555 rib556 mod557) (values type560 (binding-value106 b559) e552 w554 s555 mod557))))))) (if (pair? e552) (let ((first561 (car e552))) (if (id?113 first561) (let ((n562 (id-var-name135 first561 w554))) (let ((b563 (lookup110 n562 r553 (let ((t564 (if (syntax-object?97 first561) (syntax-object-module100 first561) #f))) (if t564 t564 mod557))))) (let ((type565 (binding-type105 b563))) (if (memv type565 (quote (lexical))) (values (quote lexical-call) (binding-value106 b563) e552 w554 s555 mod557) (if (memv type565 (quote (global))) (values (quote global-call) n562 e552 w554 s555 mod557) (if (memv type565 (quote (macro))) (syntax-type147 (chi-macro152 (binding-value106 b563) e552 r553 w554 rib556 mod557) r553 (quote (())) s555 rib556 mod557) (if (memv type565 (quote (core external-macro module-ref))) (values type565 (binding-value106 b563) e552 w554 s555 mod557) (if (memv type565 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value106 b563) e552 w554 s555 mod557) (if (memv type565 (quote (begin))) (values (quote begin-form) #f e552 w554 s555 mod557) (if (memv type565 (quote (eval-when))) (values (quote eval-when-form) #f e552 w554 s555 mod557) (if (memv type565 (quote (define))) ((lambda (tmp566) ((lambda (tmp567) (if (if tmp567 (apply (lambda (_568 name569 val570) (id?113 name569)) tmp567) #f) (apply (lambda (_571 name572 val573) (values (quote define-form) name572 val573 w554 s555 mod557)) tmp567) ((lambda (tmp574) (if (if tmp574 (apply (lambda (_575 name576 args577 e1578 e2579) (if (id?113 name576) (valid-bound-ids?138 (lambda-var-list162 args577)) #f)) tmp574) #f) (apply (lambda (_580 name581 args582 e1583 e2584) (values (quote define-form) (wrap141 name581 w554 mod557) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap141 (cons args582 (cons e1583 e2584)) w554 mod557)) (quote (())) s555 mod557)) tmp574) ((lambda (tmp586) (if (if tmp586 (apply (lambda (_587 name588) (id?113 name588)) tmp586) #f) (apply (lambda (_589 name590) (values (quote define-form) (wrap141 name590 w554 mod557) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s555 mod557)) tmp586) (syntax-violation #f "source expression failed to match any pattern" tmp566))) ($sc-dispatch tmp566 (quote (any any)))))) ($sc-dispatch tmp566 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp566 (quote (any any any))))) e552) (if (memv type565 (quote (define-syntax))) ((lambda (tmp591) ((lambda (tmp592) (if (if tmp592 (apply (lambda (_593 name594 val595) (id?113 name594)) tmp592) #f) (apply (lambda (_596 name597 val598) (values (quote define-syntax-form) name597 val598 w554 s555 mod557)) tmp592) (syntax-violation #f "source expression failed to match any pattern" tmp591))) ($sc-dispatch tmp591 (quote (any any any))))) e552) (values (quote call) #f e552 w554 s555 mod557))))))))))))) (values (quote call) #f e552 w554 s555 mod557))) (if (syntax-object?97 e552) (syntax-type147 (syntax-object-expression98 e552) r553 (join-wraps132 w554 (syntax-object-wrap99 e552)) #f rib556 (let ((t599 (syntax-object-module100 e552))) (if t599 t599 mod557))) (if (annotation? e552) (syntax-type147 (annotation-expression e552) r553 w554 (annotation-source e552) rib556 mod557) (if (self-evaluating? e552) (values (quote constant) #f e552 w554 s555 mod557) (values (quote other) #f e552 w554 s555 mod557)))))))) (chi-when-list146 (lambda (e600 when-list601 w602) (letrec ((f603 (lambda (when-list604 situations605) (if (null? when-list604) situations605 (f603 (cdr when-list604) (cons (let ((x606 (car when-list604))) (if (free-id=?136 x606 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?136 x606 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?136 x606 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e600 (wrap141 x606 w602 #f)))))) situations605)))))) (f603 when-list601 (quote ()))))) (chi-install-global145 (lambda (name607 e608) (build-global-definition88 #f name607 (if (let ((v609 (module-variable (current-module) name607))) (if v609 (if (variable-bound? v609) (if (macro? (variable-ref v609)) (not (eq? (macro-type (variable-ref v609)) (quote syncase-macro))) #f) #f) #f)) (build-application81 #f (build-primref90 #f (quote make-extended-syncase-macro)) (list (build-application81 #f (build-primref90 #f (quote module-ref)) (list (build-application81 #f (build-primref90 #f (quote current-module)) (quote ())) (build-data91 #f name607))) (build-data91 #f (quote macro)) e608)) (build-application81 #f (build-primref90 #f (quote make-syncase-macro)) (list (build-data91 #f (quote macro)) e608)))))) (chi-top-sequence144 (lambda (body610 r611 w612 s613 m614 esew615 mod616) (build-sequence92 s613 (letrec ((dobody617 (lambda (body618 r619 w620 m621 esew622 mod623) (if (null? body618) (quote ()) (let ((first624 (chi-top148 (car body618) r619 w620 m621 esew622 mod623))) (cons first624 (dobody617 (cdr body618) r619 w620 m621 esew622 mod623))))))) (dobody617 body610 r611 w612 m614 esew615 mod616))))) (chi-sequence143 (lambda (body625 r626 w627 s628 mod629) (build-sequence92 s628 (letrec ((dobody630 (lambda (body631 r632 w633 mod634) (if (null? body631) (quote ()) (let ((first635 (chi149 (car body631) r632 w633 mod634))) (cons first635 (dobody630 (cdr body631) r632 w633 mod634))))))) (dobody630 body625 r626 w627 mod629))))) (source-wrap142 (lambda (x636 w637 s638 defmod639) (wrap141 (if s638 (make-annotation x636 s638 #f) x636) w637 defmod639))) (wrap141 (lambda (x640 w641 defmod642) (if (if (null? (wrap-marks116 w641)) (null? (wrap-subst117 w641)) #f) x640 (if (syntax-object?97 x640) (make-syntax-object96 (syntax-object-expression98 x640) (join-wraps132 w641 (syntax-object-wrap99 x640)) (syntax-object-module100 x640)) (if (null? x640) x640 (make-syntax-object96 x640 w641 defmod642)))))) (bound-id-member?140 (lambda (x643 list644) (if (not (null? list644)) (let ((t645 (bound-id=?137 x643 (car list644)))) (if t645 t645 (bound-id-member?140 x643 (cdr list644)))) #f))) (distinct-bound-ids?139 (lambda (ids646) (letrec ((distinct?647 (lambda (ids648) (let ((t649 (null? ids648))) (if t649 t649 (if (not (bound-id-member?140 (car ids648) (cdr ids648))) (distinct?647 (cdr ids648)) #f)))))) (distinct?647 ids646)))) (valid-bound-ids?138 (lambda (ids650) (if (letrec ((all-ids?651 (lambda (ids652) (let ((t653 (null? ids652))) (if t653 t653 (if (id?113 (car ids652)) (all-ids?651 (cdr ids652)) #f)))))) (all-ids?651 ids650)) (distinct-bound-ids?139 ids650) #f))) (bound-id=?137 (lambda (i654 j655) (if (if (syntax-object?97 i654) (syntax-object?97 j655) #f) (if (eq? (let ((e656 (syntax-object-expression98 i654))) (if (annotation? e656) (annotation-expression e656) e656)) (let ((e657 (syntax-object-expression98 j655))) (if (annotation? e657) (annotation-expression e657) e657))) (same-marks?134 (wrap-marks116 (syntax-object-wrap99 i654)) (wrap-marks116 (syntax-object-wrap99 j655))) #f) (eq? (let ((e658 i654)) (if (annotation? e658) (annotation-expression e658) e658)) (let ((e659 j655)) (if (annotation? e659) (annotation-expression e659) e659)))))) (free-id=?136 (lambda (i660 j661) (if (eq? (let ((x662 i660)) (let ((e663 (if (syntax-object?97 x662) (syntax-object-expression98 x662) x662))) (if (annotation? e663) (annotation-expression e663) e663))) (let ((x664 j661)) (let ((e665 (if (syntax-object?97 x664) (syntax-object-expression98 x664) x664))) (if (annotation? e665) (annotation-expression e665) e665)))) (eq? (id-var-name135 i660 (quote (()))) (id-var-name135 j661 (quote (())))) #f))) (id-var-name135 (lambda (id666 w667) (letrec ((search-vector-rib670 (lambda (sym676 subst677 marks678 symnames679 ribcage680) (let ((n681 (vector-length symnames679))) (letrec ((f682 (lambda (i683) (if (fx=74 i683 n681) (search668 sym676 (cdr subst677) marks678) (if (if (eq? (vector-ref symnames679 i683) sym676) (same-marks?134 marks678 (vector-ref (ribcage-marks123 ribcage680) i683)) #f) (values (vector-ref (ribcage-labels124 ribcage680) i683) marks678) (f682 (fx+72 i683 1))))))) (f682 0))))) (search-list-rib669 (lambda (sym684 subst685 marks686 symnames687 ribcage688) (letrec ((f689 (lambda (symnames690 i691) (if (null? symnames690) (search668 sym684 (cdr subst685) marks686) (if (if (eq? (car symnames690) sym684) (same-marks?134 marks686 (list-ref (ribcage-marks123 ribcage688) i691)) #f) (values (list-ref (ribcage-labels124 ribcage688) i691) marks686) (f689 (cdr symnames690) (fx+72 i691 1))))))) (f689 symnames687 0)))) (search668 (lambda (sym692 subst693 marks694) (if (null? subst693) (values #f marks694) (let ((fst695 (car subst693))) (if (eq? fst695 (quote shift)) (search668 sym692 (cdr subst693) (cdr marks694)) (let ((symnames696 (ribcage-symnames122 fst695))) (if (vector? symnames696) (search-vector-rib670 sym692 subst693 marks694 symnames696 fst695) (search-list-rib669 sym692 subst693 marks694 symnames696 fst695))))))))) (if (symbol? id666) (let ((t697 (call-with-values (lambda () (search668 id666 (wrap-subst117 w667) (wrap-marks116 w667))) (lambda (x699 . ignore698) x699)))) (if t697 t697 id666)) (if (syntax-object?97 id666) (let ((id700 (let ((e702 (syntax-object-expression98 id666))) (if (annotation? e702) (annotation-expression e702) e702))) (w1701 (syntax-object-wrap99 id666))) (let ((marks703 (join-marks133 (wrap-marks116 w667) (wrap-marks116 w1701)))) (call-with-values (lambda () (search668 id700 (wrap-subst117 w667) marks703)) (lambda (new-id704 marks705) (let ((t706 new-id704)) (if t706 t706 (let ((t707 (call-with-values (lambda () (search668 id700 (wrap-subst117 w1701) marks705)) (lambda (x709 . ignore708) x709)))) (if t707 t707 id700)))))))) (if (annotation? id666) (let ((id710 (let ((e711 id666)) (if (annotation? e711) (annotation-expression e711) e711)))) (let ((t712 (call-with-values (lambda () (search668 id710 (wrap-subst117 w667) (wrap-marks116 w667))) (lambda (x714 . ignore713) x714)))) (if t712 t712 id710))) (syntax-violation (quote id-var-name) "invalid id" id666))))))) (same-marks?134 (lambda (x715 y716) (let ((t717 (eq? x715 y716))) (if t717 t717 (if (not (null? x715)) (if (not (null? y716)) (if (eq? (car x715) (car y716)) (same-marks?134 (cdr x715) (cdr y716)) #f) #f) #f))))) (join-marks133 (lambda (m1718 m2719) (smart-append131 m1718 m2719))) (join-wraps132 (lambda (w1720 w2721) (let ((m1722 (wrap-marks116 w1720)) (s1723 (wrap-subst117 w1720))) (if (null? m1722) (if (null? s1723) w2721 (make-wrap115 (wrap-marks116 w2721) (smart-append131 s1723 (wrap-subst117 w2721)))) (make-wrap115 (smart-append131 m1722 (wrap-marks116 w2721)) (smart-append131 s1723 (wrap-subst117 w2721))))))) (smart-append131 (lambda (m1724 m2725) (if (null? m2725) m1724 (append m1724 m2725)))) (make-binding-wrap130 (lambda (ids726 labels727 w728) (if (null? ids726) w728 (make-wrap115 (wrap-marks116 w728) (cons (let ((labelvec729 (list->vector labels727))) (let ((n730 (vector-length labelvec729))) (let ((symnamevec731 (make-vector n730)) (marksvec732 (make-vector n730))) (begin (letrec ((f733 (lambda (ids734 i735) (if (not (null? ids734)) (call-with-values (lambda () (id-sym-name&marks114 (car ids734) w728)) (lambda (symname736 marks737) (begin (vector-set! symnamevec731 i735 symname736) (vector-set! marksvec732 i735 marks737) (f733 (cdr ids734) (fx+72 i735 1))))) (if #f #f))))) (f733 ids726 0)) (make-ribcage120 symnamevec731 marksvec732 labelvec729))))) (wrap-subst117 w728)))))) (extend-ribcage!129 (lambda (ribcage738 id739 label740) (begin (set-ribcage-symnames!125 ribcage738 (cons (let ((e741 (syntax-object-expression98 id739))) (if (annotation? e741) (annotation-expression e741) e741)) (ribcage-symnames122 ribcage738))) (set-ribcage-marks!126 ribcage738 (cons (wrap-marks116 (syntax-object-wrap99 id739)) (ribcage-marks123 ribcage738))) (set-ribcage-labels!127 ribcage738 (cons label740 (ribcage-labels124 ribcage738)))))) (anti-mark128 (lambda (w742) (make-wrap115 (cons #f (wrap-marks116 w742)) (cons (quote shift) (wrap-subst117 w742))))) (set-ribcage-labels!127 (lambda (x743 update744) (vector-set! x743 3 update744))) (set-ribcage-marks!126 (lambda (x745 update746) (vector-set! x745 2 update746))) (set-ribcage-symnames!125 (lambda (x747 update748) (vector-set! x747 1 update748))) (ribcage-labels124 (lambda (x749) (vector-ref x749 3))) (ribcage-marks123 (lambda (x750) (vector-ref x750 2))) (ribcage-symnames122 (lambda (x751) (vector-ref x751 1))) (ribcage?121 (lambda (x752) (if (vector? x752) (if (= (vector-length x752) 4) (eq? (vector-ref x752 0) (quote ribcage)) #f) #f))) (make-ribcage120 (lambda (symnames753 marks754 labels755) (vector (quote ribcage) symnames753 marks754 labels755))) (gen-labels119 (lambda (ls756) (if (null? ls756) (quote ()) (cons (gen-label118) (gen-labels119 (cdr ls756)))))) (gen-label118 (lambda () (string #\i))) (wrap-subst117 cdr) (wrap-marks116 car) (make-wrap115 cons) (id-sym-name&marks114 (lambda (x757 w758) (if (syntax-object?97 x757) (values (let ((e759 (syntax-object-expression98 x757))) (if (annotation? e759) (annotation-expression e759) e759)) (join-marks133 (wrap-marks116 w758) (wrap-marks116 (syntax-object-wrap99 x757)))) (values (let ((e760 x757)) (if (annotation? e760) (annotation-expression e760) e760)) (wrap-marks116 w758))))) (id?113 (lambda (x761) (if (symbol? x761) #t (if (syntax-object?97 x761) (symbol? (let ((e762 (syntax-object-expression98 x761))) (if (annotation? e762) (annotation-expression e762) e762))) (if (annotation? x761) (symbol? (annotation-expression x761)) #f))))) (nonsymbol-id?112 (lambda (x763) (if (syntax-object?97 x763) (symbol? (let ((e764 (syntax-object-expression98 x763))) (if (annotation? e764) (annotation-expression e764) e764))) #f))) (global-extend111 (lambda (type765 sym766 val767) (put-global-definition-hook78 sym766 type765 val767))) (lookup110 (lambda (x768 r769 mod770) (let ((temp771 (assq x768 r769))) (if temp771 (cdr temp771) (if (symbol? x768) (let ((t772 (get-global-definition-hook79 x768 mod770))) (if t772 t772 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env109 (lambda (r773) (if (null? r773) (quote ()) (let ((a774 (car r773))) (if (eq? (cadr a774) (quote macro)) (cons a774 (macros-only-env109 (cdr r773))) (macros-only-env109 (cdr r773))))))) (extend-var-env108 (lambda (labels775 vars776 r777) (if (null? labels775) r777 (extend-var-env108 (cdr labels775) (cdr vars776) (cons (cons (car labels775) (cons (quote lexical) (car vars776))) r777))))) (extend-env107 (lambda (labels778 bindings779 r780) (if (null? labels778) r780 (extend-env107 (cdr labels778) (cdr bindings779) (cons (cons (car labels778) (car bindings779)) r780))))) (binding-value106 cdr) (binding-type105 car) (source-annotation104 (lambda (x781) (if (annotation? x781) (annotation-source x781) (if (syntax-object?97 x781) (source-annotation104 (syntax-object-expression98 x781)) #f)))) (set-syntax-object-module!103 (lambda (x782 update783) (vector-set! x782 3 update783))) (set-syntax-object-wrap!102 (lambda (x784 update785) (vector-set! x784 2 update785))) (set-syntax-object-expression!101 (lambda (x786 update787) (vector-set! x786 1 update787))) (syntax-object-module100 (lambda (x788) (vector-ref x788 3))) (syntax-object-wrap99 (lambda (x789) (vector-ref x789 2))) (syntax-object-expression98 (lambda (x790) (vector-ref x790 1))) (syntax-object?97 (lambda (x791) (if (vector? x791) (if (= (vector-length x791) 4) (eq? (vector-ref x791 0) (quote syntax-object)) #f) #f))) (make-syntax-object96 (lambda (expression792 wrap793 module794) (vector (quote syntax-object) expression792 wrap793 module794))) (build-letrec95 (lambda (src795 ids796 vars797 val-exps798 body-exp799) (if (null? vars797) body-exp799 (let ((atom-key800 (fluid-ref *mode*71))) (if (memv atom-key800 (quote (c))) ((@ (language tree-il) make-letrec) src795 ids796 vars797 val-exps798 body-exp799) (list (quote letrec) (map list vars797 val-exps798) body-exp799)))))) (build-named-let94 (lambda (src801 ids802 vars803 val-exps804 body-exp805) (let ((f806 (car vars803)) (f-name807 (car ids802)) (vars808 (cdr vars803)) (ids809 (cdr ids802))) (let ((atom-key810 (fluid-ref *mode*71))) (if (memv atom-key810 (quote (c))) ((@ (language tree-il) make-letrec) src801 (list f-name807) (list f806) (list (build-lambda89 src801 ids809 vars808 #f body-exp805)) (build-application81 src801 (build-lexical-reference83 (quote fun) src801 f-name807 f806) val-exps804)) (list (quote let) f806 (map list vars808 val-exps804) body-exp805)))))) (build-let93 (lambda (src811 ids812 vars813 val-exps814 body-exp815) (if (null? vars813) body-exp815 (let ((atom-key816 (fluid-ref *mode*71))) (if (memv atom-key816 (quote (c))) ((@ (language tree-il) make-let) src811 ids812 vars813 val-exps814 body-exp815) (list (quote let) (map list vars813 val-exps814) body-exp815)))))) (build-sequence92 (lambda (src817 exps818) (if (null? (cdr exps818)) (car exps818) (let ((atom-key819 (fluid-ref *mode*71))) (if (memv atom-key819 (quote (c))) ((@ (language tree-il) make-sequence) src817 exps818) (cons (quote begin) exps818)))))) (build-data91 (lambda (src820 exp821) (let ((atom-key822 (fluid-ref *mode*71))) (if (memv atom-key822 (quote (c))) ((@ (language tree-il) make-const) src820 exp821) (if (if (self-evaluating? exp821) (not (vector? exp821)) #f) exp821 (list (quote quote) exp821)))))) (build-primref90 (lambda (src823 name824) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key825 (fluid-ref *mode*71))) (if (memv atom-key825 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src823 name824) name824)) (let ((atom-key826 (fluid-ref *mode*71))) (if (memv atom-key826 (quote (c))) ((@ (language tree-il) make-module-ref) src823 (quote (guile)) name824 #f) (list (quote @@) (quote (guile)) name824)))))) (build-lambda89 (lambda (src827 ids828 vars829 docstring830 exp831) (let ((atom-key832 (fluid-ref *mode*71))) (if (memv atom-key832 (quote (c))) ((@ (language tree-il) make-lambda) src827 ids828 vars829 (if docstring830 (list (cons (quote documentation) docstring830)) (quote ())) exp831) (cons (quote lambda) (cons vars829 (append (if docstring830 (list docstring830) (quote ())) (list exp831)))))))) (build-global-definition88 (lambda (source833 var834 exp835) (let ((atom-key836 (fluid-ref *mode*71))) (if (memv atom-key836 (quote (c))) ((@ (language tree-il) make-toplevel-define) source833 var834 exp835) (list (quote define) var834 exp835))))) (build-global-assignment87 (lambda (source837 var838 exp839 mod840) (analyze-variable85 mod840 var838 (lambda (mod841 var842 public?843) (let ((atom-key844 (fluid-ref *mode*71))) (if (memv atom-key844 (quote (c))) ((@ (language tree-il) make-module-set) source837 mod841 var842 public?843 exp839) (list (quote set!) (list (if public?843 (quote @) (quote @@)) mod841 var842) exp839)))) (lambda (var845) (let ((atom-key846 (fluid-ref *mode*71))) (if (memv atom-key846 (quote (c))) ((@ (language tree-il) make-toplevel-set) source837 var845 exp839) (list (quote set!) var845 exp839))))))) (build-global-reference86 (lambda (source847 var848 mod849) (analyze-variable85 mod849 var848 (lambda (mod850 var851 public?852) (let ((atom-key853 (fluid-ref *mode*71))) (if (memv atom-key853 (quote (c))) ((@ (language tree-il) make-module-ref) source847 mod850 var851 public?852) (list (if public?852 (quote @) (quote @@)) mod850 var851)))) (lambda (var854) (let ((atom-key855 (fluid-ref *mode*71))) (if (memv atom-key855 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source847 var854) var854)))))) (analyze-variable85 (lambda (mod856 var857 modref-cont858 bare-cont859) (if (not mod856) (bare-cont859 var857) (let ((kind860 (car mod856)) (mod861 (cdr mod856))) (if (memv kind860 (quote (public))) (modref-cont858 mod861 var857 #t) (if (memv kind860 (quote (private))) (if (not (equal? mod861 (module-name (current-module)))) (modref-cont858 mod861 var857 #f) (bare-cont859 var857)) (if (memv kind860 (quote (bare))) (bare-cont859 var857) (if (memv kind860 (quote (hygiene))) (if (if (not (equal? mod861 (module-name (current-module)))) (module-variable (resolve-module mod861) var857) #f) (modref-cont858 mod861 var857 #f) (bare-cont859 var857)) (syntax-violation #f "bad module kind" var857 mod861))))))))) (build-lexical-assignment84 (lambda (source862 name863 var864 exp865) (let ((atom-key866 (fluid-ref *mode*71))) (if (memv atom-key866 (quote (c))) ((@ (language tree-il) make-lexical-set) source862 name863 var864 exp865) (list (quote set!) var864 exp865))))) (build-lexical-reference83 (lambda (type867 source868 name869 var870) (let ((atom-key871 (fluid-ref *mode*71))) (if (memv atom-key871 (quote (c))) ((@ (language tree-il) make-lexical-ref) source868 name869 var870) var870)))) (build-conditional82 (lambda (source872 test-exp873 then-exp874 else-exp875) (let ((atom-key876 (fluid-ref *mode*71))) (if (memv atom-key876 (quote (c))) ((@ (language tree-il) make-conditional) source872 test-exp873 then-exp874 else-exp875) (list (quote if) test-exp873 then-exp874 else-exp875))))) (build-application81 (lambda (source877 fun-exp878 arg-exps879) (let ((atom-key880 (fluid-ref *mode*71))) (if (memv atom-key880 (quote (c))) ((@ (language tree-il) make-application) source877 fun-exp878 arg-exps879) (cons fun-exp878 arg-exps879))))) (build-void80 (lambda (source881) (let ((atom-key882 (fluid-ref *mode*71))) (if (memv atom-key882 (quote (c))) ((@ (language tree-il) make-void) source881) (quote (if #f #f)))))) (get-global-definition-hook79 (lambda (symbol883 module884) (begin (if (if (not module884) (current-module) #f) (warn "module system is booted, we should have a module" symbol883) (if #f #f)) (let ((v885 (module-variable (if module884 (resolve-module (cdr module884)) (current-module)) symbol883))) (if v885 (if (variable-bound? v885) (let ((val886 (variable-ref v885))) (if (macro? val886) (if (syncase-macro-type val886) (cons (syncase-macro-type val886) (syncase-macro-binding val886)) #f) #f)) #f) #f))))) (put-global-definition-hook78 (lambda (symbol887 type888 val889) (let ((existing890 (let ((v891 (module-variable (current-module) symbol887))) (if v891 (if (variable-bound? v891) (let ((val892 (variable-ref v891))) (if (macro? val892) (if (not (syncase-macro-type val892)) val892 #f) #f)) #f) #f)))) (module-define! (current-module) symbol887 (if existing890 (make-extended-syncase-macro existing890 type888 val889) (make-syncase-macro type888 val889)))))) (local-eval-hook77 (lambda (x893 mod894) (primitive-eval (list noexpand70 (let ((atom-key895 (fluid-ref *mode*71))) (if (memv atom-key895 (quote (c))) ((@ (language tree-il) tree-il->scheme) x893) x893)))))) (top-level-eval-hook76 (lambda (x896 mod897) (primitive-eval (list noexpand70 (let ((atom-key898 (fluid-ref *mode*71))) (if (memv atom-key898 (quote (c))) ((@ (language tree-il) tree-il->scheme) x896) x896)))))) (fx<75 <) (fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand")) (begin (global-extend111 (quote local-syntax) (quote letrec-syntax) #t) (global-extend111 (quote local-syntax) (quote let-syntax) #f) (global-extend111 (quote core) (quote fluid-let-syntax) (lambda (e899 r900 w901 s902 mod903) ((lambda (tmp904) ((lambda (tmp905) (if (if tmp905 (apply (lambda (_906 var907 val908 e1909 e2910) (valid-bound-ids?138 var907)) tmp905) #f) (apply (lambda (_912 var913 val914 e1915 e2916) (let ((names917 (map (lambda (x918) (id-var-name135 x918 w901)) var913))) (begin (for-each (lambda (id920 n921) (let ((atom-key922 (binding-type105 (lookup110 n921 r900 mod903)))) (if (memv atom-key922 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e899 (source-wrap142 id920 w901 s902 mod903)) (if #f #f)))) var913 names917) (chi-body153 (cons e1915 e2916) (source-wrap142 e899 w901 s902 mod903) (extend-env107 names917 (let ((trans-r925 (macros-only-env109 r900))) (map (lambda (x926) (cons (quote macro) (eval-local-transformer156 (chi149 x926 trans-r925 w901 mod903) mod903))) val914)) r900) w901 mod903)))) tmp905) ((lambda (_928) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap142 e899 w901 s902 mod903))) tmp904))) ($sc-dispatch tmp904 (quote (any #(each (any any)) any . each-any))))) e899))) (global-extend111 (quote core) (quote quote) (lambda (e929 r930 w931 s932 mod933) ((lambda (tmp934) ((lambda (tmp935) (if tmp935 (apply (lambda (_936 e937) (build-data91 s932 (strip160 e937 w931))) tmp935) ((lambda (_938) (syntax-violation (quote quote) "bad syntax" (source-wrap142 e929 w931 s932 mod933))) tmp934))) ($sc-dispatch tmp934 (quote (any any))))) e929))) (global-extend111 (quote core) (quote syntax) (letrec ((regen946 (lambda (x947) (let ((atom-key948 (car x947))) (if (memv atom-key948 (quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x947) (cadr x947)) (if (memv atom-key948 (quote (primitive))) (build-primref90 #f (cadr x947)) (if (memv atom-key948 (quote (quote))) (build-data91 #f (cadr x947)) (if (memv atom-key948 (quote (lambda))) (build-lambda89 #f (cadr x947) (cadr x947) #f (regen946 (caddr x947))) (if (memv atom-key948 (quote (map))) (let ((ls949 (map regen946 (cdr x947)))) (build-application81 #f (build-primref90 #f (quote map)) ls949)) (build-application81 #f (build-primref90 #f (car x947)) (map regen946 (cdr x947))))))))))) (gen-vector945 (lambda (x950) (if (eq? (car x950) (quote list)) (cons (quote vector) (cdr x950)) (if (eq? (car x950) (quote quote)) (list (quote quote) (list->vector (cadr x950))) (list (quote list->vector) x950))))) (gen-append944 (lambda (x951 y952) (if (equal? y952 (quote (quote ()))) x951 (list (quote append) x951 y952)))) (gen-cons943 (lambda (x953 y954) (let ((atom-key955 (car y954))) (if (memv atom-key955 (quote (quote))) (if (eq? (car x953) (quote quote)) (list (quote quote) (cons (cadr x953) (cadr y954))) (if (eq? (cadr y954) (quote ())) (list (quote list) x953) (list (quote cons) x953 y954))) (if (memv atom-key955 (quote (list))) (cons (quote list) (cons x953 (cdr y954))) (list (quote cons) x953 y954)))))) (gen-map942 (lambda (e956 map-env957) (let ((formals958 (map cdr map-env957)) (actuals959 (map (lambda (x960) (list (quote ref) (car x960))) map-env957))) (if (eq? (car e956) (quote ref)) (car actuals959) (if (and-map (lambda (x961) (if (eq? (car x961) (quote ref)) (memq (cadr x961) formals958) #f)) (cdr e956)) (cons (quote map) (cons (list (quote primitive) (car e956)) (map (let ((r962 (map cons formals958 actuals959))) (lambda (x963) (cdr (assq (cadr x963) r962)))) (cdr e956)))) (cons (quote map) (cons (list (quote lambda) formals958 e956) actuals959))))))) (gen-mappend941 (lambda (e964 map-env965) (list (quote apply) (quote (primitive append)) (gen-map942 e964 map-env965)))) (gen-ref940 (lambda (src966 var967 level968 maps969) (if (fx=74 level968 0) (values var967 maps969) (if (null? maps969) (syntax-violation (quote syntax) "missing ellipsis" src966) (call-with-values (lambda () (gen-ref940 src966 var967 (fx-73 level968 1) (cdr maps969))) (lambda (outer-var970 outer-maps971) (let ((b972 (assq outer-var970 (car maps969)))) (if b972 (values (cdr b972) maps969) (let ((inner-var973 (gen-var161 (quote tmp)))) (values inner-var973 (cons (cons (cons outer-var970 inner-var973) (car maps969)) outer-maps971))))))))))) (gen-syntax939 (lambda (src974 e975 r976 maps977 ellipsis?978 mod979) (if (id?113 e975) (let ((label980 (id-var-name135 e975 (quote (()))))) (let ((b981 (lookup110 label980 r976 mod979))) (if (eq? (binding-type105 b981) (quote syntax)) (call-with-values (lambda () (let ((var.lev982 (binding-value106 b981))) (gen-ref940 src974 (car var.lev982) (cdr var.lev982) maps977))) (lambda (var983 maps984) (values (list (quote ref) var983) maps984))) (if (ellipsis?978 e975) (syntax-violation (quote syntax) "misplaced ellipsis" src974) (values (list (quote quote) e975) maps977))))) ((lambda (tmp985) ((lambda (tmp986) (if (if tmp986 (apply (lambda (dots987 e988) (ellipsis?978 dots987)) tmp986) #f) (apply (lambda (dots989 e990) (gen-syntax939 src974 e990 r976 maps977 (lambda (x991) #f) mod979)) tmp986) ((lambda (tmp992) (if (if tmp992 (apply (lambda (x993 dots994 y995) (ellipsis?978 dots994)) tmp992) #f) (apply (lambda (x996 dots997 y998) (letrec ((f999 (lambda (y1000 k1001) ((lambda (tmp1005) ((lambda (tmp1006) (if (if tmp1006 (apply (lambda (dots1007 y1008) (ellipsis?978 dots1007)) tmp1006) #f) (apply (lambda (dots1009 y1010) (f999 y1010 (lambda (maps1011) (call-with-values (lambda () (k1001 (cons (quote ()) maps1011))) (lambda (x1012 maps1013) (if (null? (car maps1013)) (syntax-violation (quote syntax) "extra ellipsis" src974) (values (gen-mappend941 x1012 (car maps1013)) (cdr maps1013)))))))) tmp1006) ((lambda (_1014) (call-with-values (lambda () (gen-syntax939 src974 y1000 r976 maps977 ellipsis?978 mod979)) (lambda (y1015 maps1016) (call-with-values (lambda () (k1001 maps1016)) (lambda (x1017 maps1018) (values (gen-append944 x1017 y1015) maps1018)))))) tmp1005))) ($sc-dispatch tmp1005 (quote (any . any))))) y1000)))) (f999 y998 (lambda (maps1002) (call-with-values (lambda () (gen-syntax939 src974 x996 r976 (cons (quote ()) maps1002) ellipsis?978 mod979)) (lambda (x1003 maps1004) (if (null? (car maps1004)) (syntax-violation (quote syntax) "extra ellipsis" src974) (values (gen-map942 x1003 (car maps1004)) (cdr maps1004))))))))) tmp992) ((lambda (tmp1019) (if tmp1019 (apply (lambda (x1020 y1021) (call-with-values (lambda () (gen-syntax939 src974 x1020 r976 maps977 ellipsis?978 mod979)) (lambda (x1022 maps1023) (call-with-values (lambda () (gen-syntax939 src974 y1021 r976 maps1023 ellipsis?978 mod979)) (lambda (y1024 maps1025) (values (gen-cons943 x1022 y1024) maps1025)))))) tmp1019) ((lambda (tmp1026) (if tmp1026 (apply (lambda (e11027 e21028) (call-with-values (lambda () (gen-syntax939 src974 (cons e11027 e21028) r976 maps977 ellipsis?978 mod979)) (lambda (e1030 maps1031) (values (gen-vector945 e1030) maps1031)))) tmp1026) ((lambda (_1032) (values (list (quote quote) e975) maps977)) tmp985))) ($sc-dispatch tmp985 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp985 (quote (any . any)))))) ($sc-dispatch tmp985 (quote (any any . any)))))) ($sc-dispatch tmp985 (quote (any any))))) e975))))) (lambda (e1033 r1034 w1035 s1036 mod1037) (let ((e1038 (source-wrap142 e1033 w1035 s1036 mod1037))) ((lambda (tmp1039) ((lambda (tmp1040) (if tmp1040 (apply (lambda (_1041 x1042) (call-with-values (lambda () (gen-syntax939 e1038 x1042 r1034 (quote ()) ellipsis?158 mod1037)) (lambda (e1043 maps1044) (regen946 e1043)))) tmp1040) ((lambda (_1045) (syntax-violation (quote syntax) "bad `syntax' form" e1038)) tmp1039))) ($sc-dispatch tmp1039 (quote (any any))))) e1038))))) (global-extend111 (quote core) (quote lambda) (lambda (e1046 r1047 w1048 s1049 mod1050) ((lambda (tmp1051) ((lambda (tmp1052) (if tmp1052 (apply (lambda (_1053 c1054) (chi-lambda-clause154 (source-wrap142 e1046 w1048 s1049 mod1050) #f c1054 r1047 w1048 mod1050 (lambda (names1055 vars1056 docstring1057 body1058) (build-lambda89 s1049 names1055 vars1056 docstring1057 body1058)))) tmp1052) (syntax-violation #f "source expression failed to match any pattern" tmp1051))) ($sc-dispatch tmp1051 (quote (any . any))))) e1046))) (global-extend111 (quote core) (quote let) (letrec ((chi-let1059 (lambda (e1060 r1061 w1062 s1063 mod1064 constructor1065 ids1066 vals1067 exps1068) (if (not (valid-bound-ids?138 ids1066)) (syntax-violation (quote let) "duplicate bound variable" e1060) (let ((labels1069 (gen-labels119 ids1066)) (new-vars1070 (map gen-var161 ids1066))) (let ((nw1071 (make-binding-wrap130 ids1066 labels1069 w1062)) (nr1072 (extend-var-env108 labels1069 new-vars1070 r1061))) (constructor1065 s1063 (map syntax->datum ids1066) new-vars1070 (map (lambda (x1073) (chi149 x1073 r1061 w1062 mod1064)) vals1067) (chi-body153 exps1068 (source-wrap142 e1060 nw1071 s1063 mod1064) nr1072 nw1071 mod1064)))))))) (lambda (e1074 r1075 w1076 s1077 mod1078) ((lambda (tmp1079) ((lambda (tmp1080) (if tmp1080 (apply (lambda (_1081 id1082 val1083 e11084 e21085) (chi-let1059 e1074 r1075 w1076 s1077 mod1078 build-let93 id1082 val1083 (cons e11084 e21085))) tmp1080) ((lambda (tmp1089) (if (if tmp1089 (apply (lambda (_1090 f1091 id1092 val1093 e11094 e21095) (id?113 f1091)) tmp1089) #f) (apply (lambda (_1096 f1097 id1098 val1099 e11100 e21101) (chi-let1059 e1074 r1075 w1076 s1077 mod1078 build-named-let94 (cons f1097 id1098) val1099 (cons e11100 e21101))) tmp1089) ((lambda (_1105) (syntax-violation (quote let) "bad let" (source-wrap142 e1074 w1076 s1077 mod1078))) tmp1079))) ($sc-dispatch tmp1079 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1079 (quote (any #(each (any any)) any . each-any))))) e1074)))) (global-extend111 (quote core) (quote letrec) (lambda (e1106 r1107 w1108 s1109 mod1110) ((lambda (tmp1111) ((lambda (tmp1112) (if tmp1112 (apply (lambda (_1113 id1114 val1115 e11116 e21117) (let ((ids1118 id1114)) (if (not (valid-bound-ids?138 ids1118)) (syntax-violation (quote letrec) "duplicate bound variable" e1106) (let ((labels1120 (gen-labels119 ids1118)) (new-vars1121 (map gen-var161 ids1118))) (let ((w1122 (make-binding-wrap130 ids1118 labels1120 w1108)) (r1123 (extend-var-env108 labels1120 new-vars1121 r1107))) (build-letrec95 s1109 (map syntax->datum ids1118) new-vars1121 (map (lambda (x1124) (chi149 x1124 r1123 w1122 mod1110)) val1115) (chi-body153 (cons e11116 e21117) (source-wrap142 e1106 w1122 s1109 mod1110) r1123 w1122 mod1110))))))) tmp1112) ((lambda (_1127) (syntax-violation (quote letrec) "bad letrec" (source-wrap142 e1106 w1108 s1109 mod1110))) tmp1111))) ($sc-dispatch tmp1111 (quote (any #(each (any any)) any . each-any))))) e1106))) (global-extend111 (quote core) (quote set!) (lambda (e1128 r1129 w1130 s1131 mod1132) ((lambda (tmp1133) ((lambda (tmp1134) (if (if tmp1134 (apply (lambda (_1135 id1136 val1137) (id?113 id1136)) tmp1134) #f) (apply (lambda (_1138 id1139 val1140) (let ((val1141 (chi149 val1140 r1129 w1130 mod1132)) (n1142 (id-var-name135 id1139 w1130))) (let ((b1143 (lookup110 n1142 r1129 mod1132))) (let ((atom-key1144 (binding-type105 b1143))) (if (memv atom-key1144 (quote (lexical))) (build-lexical-assignment84 s1131 (syntax->datum id1139) (binding-value106 b1143) val1141) (if (memv atom-key1144 (quote (global))) (build-global-assignment87 s1131 n1142 val1141 mod1132) (if (memv atom-key1144 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap141 id1139 w1130 mod1132)) (syntax-violation (quote set!) "bad set!" (source-wrap142 e1128 w1130 s1131 mod1132))))))))) tmp1134) ((lambda (tmp1145) (if tmp1145 (apply (lambda (_1146 head1147 tail1148 val1149) (call-with-values (lambda () (syntax-type147 head1147 r1129 (quote (())) #f #f mod1132)) (lambda (type1150 value1151 ee1152 ww1153 ss1154 modmod1155) (if (memv type1150 (quote (module-ref))) (let ((val1156 (chi149 val1149 r1129 w1130 mod1132))) (call-with-values (lambda () (value1151 (cons head1147 tail1148))) (lambda (id1158 mod1159) (build-global-assignment87 s1131 id1158 val1156 mod1159)))) (build-application81 s1131 (chi149 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1147) r1129 w1130 mod1132) (map (lambda (e1160) (chi149 e1160 r1129 w1130 mod1132)) (append tail1148 (list val1149)))))))) tmp1145) ((lambda (_1162) (syntax-violation (quote set!) "bad set!" (source-wrap142 e1128 w1130 s1131 mod1132))) tmp1133))) ($sc-dispatch tmp1133 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1133 (quote (any any any))))) e1128))) (global-extend111 (quote module-ref) (quote @) (lambda (e1163) ((lambda (tmp1164) ((lambda (tmp1165) (if (if tmp1165 (apply (lambda (_1166 mod1167 id1168) (if (and-map id?113 mod1167) (id?113 id1168) #f)) tmp1165) #f) (apply (lambda (_1170 mod1171 id1172) (values (syntax->datum id1172) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1171)))) tmp1165) (syntax-violation #f "source expression failed to match any pattern" tmp1164))) ($sc-dispatch tmp1164 (quote (any each-any any))))) e1163))) (global-extend111 (quote module-ref) (quote @@) (lambda (e1174) ((lambda (tmp1175) ((lambda (tmp1176) (if (if tmp1176 (apply (lambda (_1177 mod1178 id1179) (if (and-map id?113 mod1178) (id?113 id1179) #f)) tmp1176) #f) (apply (lambda (_1181 mod1182 id1183) (values (syntax->datum id1183) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1182)))) tmp1176) (syntax-violation #f "source expression failed to match any pattern" tmp1175))) ($sc-dispatch tmp1175 (quote (any each-any any))))) e1174))) (global-extend111 (quote core) (quote if) (lambda (e1185 r1186 w1187 s1188 mod1189) ((lambda (tmp1190) ((lambda (tmp1191) (if tmp1191 (apply (lambda (_1192 test1193 then1194) (build-conditional82 s1188 (chi149 test1193 r1186 w1187 mod1189) (chi149 then1194 r1186 w1187 mod1189) (build-void80 #f))) tmp1191) ((lambda (tmp1195) (if tmp1195 (apply (lambda (_1196 test1197 then1198 else1199) (build-conditional82 s1188 (chi149 test1197 r1186 w1187 mod1189) (chi149 then1198 r1186 w1187 mod1189) (chi149 else1199 r1186 w1187 mod1189))) tmp1195) (syntax-violation #f "source expression failed to match any pattern" tmp1190))) ($sc-dispatch tmp1190 (quote (any any any any)))))) ($sc-dispatch tmp1190 (quote (any any any))))) e1185))) (global-extend111 (quote begin) (quote begin) (quote ())) (global-extend111 (quote define) (quote define) (quote ())) (global-extend111 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend111 (quote eval-when) (quote eval-when) (quote ())) (global-extend111 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1203 (lambda (x1204 keys1205 clauses1206 r1207 mod1208) (if (null? clauses1206) (build-application81 #f (build-primref90 #f (quote syntax-violation)) (list (build-data91 #f #f) (build-data91 #f "source expression failed to match any pattern") x1204)) ((lambda (tmp1209) ((lambda (tmp1210) (if tmp1210 (apply (lambda (pat1211 exp1212) (if (if (id?113 pat1211) (and-map (lambda (x1213) (not (free-id=?136 pat1211 x1213))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1205)) #f) (let ((labels1214 (list (gen-label118))) (var1215 (gen-var161 pat1211))) (build-application81 #f (build-lambda89 #f (list (syntax->datum pat1211)) (list var1215) #f (chi149 exp1212 (extend-env107 labels1214 (list (cons (quote syntax) (cons var1215 0))) r1207) (make-binding-wrap130 (list pat1211) labels1214 (quote (()))) mod1208)) (list x1204))) (gen-clause1202 x1204 keys1205 (cdr clauses1206) r1207 pat1211 #t exp1212 mod1208))) tmp1210) ((lambda (tmp1216) (if tmp1216 (apply (lambda (pat1217 fender1218 exp1219) (gen-clause1202 x1204 keys1205 (cdr clauses1206) r1207 pat1217 fender1218 exp1219 mod1208)) tmp1216) ((lambda (_1220) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1206))) tmp1209))) ($sc-dispatch tmp1209 (quote (any any any)))))) ($sc-dispatch tmp1209 (quote (any any))))) (car clauses1206))))) (gen-clause1202 (lambda (x1221 keys1222 clauses1223 r1224 pat1225 fender1226 exp1227 mod1228) (call-with-values (lambda () (convert-pattern1200 pat1225 keys1222)) (lambda (p1229 pvars1230) (if (not (distinct-bound-ids?139 (map car pvars1230))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1225) (if (not (and-map (lambda (x1231) (not (ellipsis?158 (car x1231)))) pvars1230)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1225) (let ((y1232 (gen-var161 (quote tmp)))) (build-application81 #f (build-lambda89 #f (list (quote tmp)) (list y1232) #f (let ((y1233 (build-lexical-reference83 (quote value) #f (quote tmp) y1232))) (build-conditional82 #f ((lambda (tmp1234) ((lambda (tmp1235) (if tmp1235 (apply (lambda () y1233) tmp1235) ((lambda (_1236) (build-conditional82 #f y1233 (build-dispatch-call1201 pvars1230 fender1226 y1233 r1224 mod1228) (build-data91 #f #f))) tmp1234))) ($sc-dispatch tmp1234 (quote #(atom #t))))) fender1226) (build-dispatch-call1201 pvars1230 exp1227 y1233 r1224 mod1228) (gen-syntax-case1203 x1221 keys1222 clauses1223 r1224 mod1228)))) (list (if (eq? p1229 (quote any)) (build-application81 #f (build-primref90 #f (quote list)) (list x1221)) (build-application81 #f (build-primref90 #f (quote $sc-dispatch)) (list x1221 (build-data91 #f p1229))))))))))))) (build-dispatch-call1201 (lambda (pvars1237 exp1238 y1239 r1240 mod1241) (let ((ids1242 (map car pvars1237)) (levels1243 (map cdr pvars1237))) (let ((labels1244 (gen-labels119 ids1242)) (new-vars1245 (map gen-var161 ids1242))) (build-application81 #f (build-primref90 #f (quote apply)) (list (build-lambda89 #f (map syntax->datum ids1242) new-vars1245 #f (chi149 exp1238 (extend-env107 labels1244 (map (lambda (var1246 level1247) (cons (quote syntax) (cons var1246 level1247))) new-vars1245 (map cdr pvars1237)) r1240) (make-binding-wrap130 ids1242 labels1244 (quote (()))) mod1241)) y1239)))))) (convert-pattern1200 (lambda (pattern1248 keys1249) (letrec ((cvt1250 (lambda (p1251 n1252 ids1253) (if (id?113 p1251) (if (bound-id-member?140 p1251 keys1249) (values (vector (quote free-id) p1251) ids1253) (values (quote any) (cons (cons p1251 n1252) ids1253))) ((lambda (tmp1254) ((lambda (tmp1255) (if (if tmp1255 (apply (lambda (x1256 dots1257) (ellipsis?158 dots1257)) tmp1255) #f) (apply (lambda (x1258 dots1259) (call-with-values (lambda () (cvt1250 x1258 (fx+72 n1252 1) ids1253)) (lambda (p1260 ids1261) (values (if (eq? p1260 (quote any)) (quote each-any) (vector (quote each) p1260)) ids1261)))) tmp1255) ((lambda (tmp1262) (if tmp1262 (apply (lambda (x1263 y1264) (call-with-values (lambda () (cvt1250 y1264 n1252 ids1253)) (lambda (y1265 ids1266) (call-with-values (lambda () (cvt1250 x1263 n1252 ids1266)) (lambda (x1267 ids1268) (values (cons x1267 y1265) ids1268)))))) tmp1262) ((lambda (tmp1269) (if tmp1269 (apply (lambda () (values (quote ()) ids1253)) tmp1269) ((lambda (tmp1270) (if tmp1270 (apply (lambda (x1271) (call-with-values (lambda () (cvt1250 x1271 n1252 ids1253)) (lambda (p1273 ids1274) (values (vector (quote vector) p1273) ids1274)))) tmp1270) ((lambda (x1275) (values (vector (quote atom) (strip160 p1251 (quote (())))) ids1253)) tmp1254))) ($sc-dispatch tmp1254 (quote #(vector each-any)))))) ($sc-dispatch tmp1254 (quote ()))))) ($sc-dispatch tmp1254 (quote (any . any)))))) ($sc-dispatch tmp1254 (quote (any any))))) p1251))))) (cvt1250 pattern1248 0 (quote ())))))) (lambda (e1276 r1277 w1278 s1279 mod1280) (let ((e1281 (source-wrap142 e1276 w1278 s1279 mod1280))) ((lambda (tmp1282) ((lambda (tmp1283) (if tmp1283 (apply (lambda (_1284 val1285 key1286 m1287) (if (and-map (lambda (x1288) (if (id?113 x1288) (not (ellipsis?158 x1288)) #f)) key1286) (let ((x1290 (gen-var161 (quote tmp)))) (build-application81 s1279 (build-lambda89 #f (list (quote tmp)) (list x1290) #f (gen-syntax-case1203 (build-lexical-reference83 (quote value) #f (quote tmp) x1290) key1286 m1287 r1277 mod1280)) (list (chi149 val1285 r1277 (quote (())) mod1280)))) (syntax-violation (quote syntax-case) "invalid literals list" e1281))) tmp1283) (syntax-violation #f "source expression failed to match any pattern" tmp1282))) ($sc-dispatch tmp1282 (quote (any any each-any . each-any))))) e1281))))) (set! sc-expand (lambda (x1294 . rest1293) (if (if (pair? x1294) (equal? (car x1294) noexpand70) #f) (cadr x1294) (let ((m1295 (if (null? rest1293) (quote e) (car rest1293))) (esew1296 (if (let ((t1297 (null? rest1293))) (if t1297 t1297 (null? (cdr rest1293)))) (quote (eval)) (cadr rest1293)))) (with-fluid* *mode*71 m1295 (lambda () (chi-top148 x1294 (quote ()) (quote ((top))) m1295 esew1296 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1298) (nonsymbol-id?112 x1298))) (set! datum->syntax (lambda (id1299 datum1300) (make-syntax-object96 datum1300 (syntax-object-wrap99 id1299) #f))) (set! syntax->datum (lambda (x1301) (strip160 x1301 (quote (()))))) (set! generate-temporaries (lambda (ls1302) (begin (let ((x1303 ls1302)) (if (not (list? x1303)) (syntax-violation (quote generate-temporaries) "invalid argument" x1303) (if #f #f))) (map (lambda (x1304) (wrap141 (gensym) (quote ((top))) #f)) ls1302)))) (set! free-identifier=? (lambda (x1305 y1306) (begin (let ((x1307 x1305)) (if (not (nonsymbol-id?112 x1307)) (syntax-violation (quote free-identifier=?) "invalid argument" x1307) (if #f #f))) (let ((x1308 y1306)) (if (not (nonsymbol-id?112 x1308)) (syntax-violation (quote free-identifier=?) "invalid argument" x1308) (if #f #f))) (free-id=?136 x1305 y1306)))) (set! bound-identifier=? (lambda (x1309 y1310) (begin (let ((x1311 x1309)) (if (not (nonsymbol-id?112 x1311)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1311) (if #f #f))) (let ((x1312 y1310)) (if (not (nonsymbol-id?112 x1312)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1312) (if #f #f))) (bound-id=?137 x1309 y1310)))) (set! syntax-violation (lambda (who1316 message1315 form1314 . subform1313) (begin (let ((x1317 who1316)) (if (not ((lambda (x1318) (let ((t1319 (not x1318))) (if t1319 t1319 (let ((t1320 (string? x1318))) (if t1320 t1320 (symbol? x1318)))))) x1317)) (syntax-violation (quote syntax-violation) "invalid argument" x1317) (if #f #f))) (let ((x1321 message1315)) (if (not (string? x1321)) (syntax-violation (quote syntax-violation) "invalid argument" x1321) (if #f #f))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1316 "~a: " "") "~a " (if (null? subform1313) "in ~a" "in subform `~s' of `~s'")) (let ((tail1322 (cons message1315 (map (lambda (x1323) (strip160 x1323 (quote (())))) (append subform1313 (list form1314)))))) (if who1316 (cons who1316 tail1322) tail1322)) #f)))) (letrec ((match1328 (lambda (e1329 p1330 w1331 r1332 mod1333) (if (not r1332) #f (if (eq? p1330 (quote any)) (cons (wrap141 e1329 w1331 mod1333) r1332) (if (syntax-object?97 e1329) (match*1327 (let ((e1334 (syntax-object-expression98 e1329))) (if (annotation? e1334) (annotation-expression e1334) e1334)) p1330 (join-wraps132 w1331 (syntax-object-wrap99 e1329)) r1332 (syntax-object-module100 e1329)) (match*1327 (let ((e1335 e1329)) (if (annotation? e1335) (annotation-expression e1335) e1335)) p1330 w1331 r1332 mod1333)))))) (match*1327 (lambda (e1336 p1337 w1338 r1339 mod1340) (if (null? p1337) (if (null? e1336) r1339 #f) (if (pair? p1337) (if (pair? e1336) (match1328 (car e1336) (car p1337) w1338 (match1328 (cdr e1336) (cdr p1337) w1338 r1339 mod1340) mod1340) #f) (if (eq? p1337 (quote each-any)) (let ((l1341 (match-each-any1325 e1336 w1338 mod1340))) (if l1341 (cons l1341 r1339) #f)) (let ((atom-key1342 (vector-ref p1337 0))) (if (memv atom-key1342 (quote (each))) (if (null? e1336) (match-empty1326 (vector-ref p1337 1) r1339) (let ((l1343 (match-each1324 e1336 (vector-ref p1337 1) w1338 mod1340))) (if l1343 (letrec ((collect1344 (lambda (l1345) (if (null? (car l1345)) r1339 (cons (map car l1345) (collect1344 (map cdr l1345))))))) (collect1344 l1343)) #f))) (if (memv atom-key1342 (quote (free-id))) (if (id?113 e1336) (if (free-id=?136 (wrap141 e1336 w1338 mod1340) (vector-ref p1337 1)) r1339 #f) #f) (if (memv atom-key1342 (quote (atom))) (if (equal? (vector-ref p1337 1) (strip160 e1336 w1338)) r1339 #f) (if (memv atom-key1342 (quote (vector))) (if (vector? e1336) (match1328 (vector->list e1336) (vector-ref p1337 1) w1338 r1339 mod1340) #f) (if #f #f))))))))))) (match-empty1326 (lambda (p1346 r1347) (if (null? p1346) r1347 (if (eq? p1346 (quote any)) (cons (quote ()) r1347) (if (pair? p1346) (match-empty1326 (car p1346) (match-empty1326 (cdr p1346) r1347)) (if (eq? p1346 (quote each-any)) (cons (quote ()) r1347) (let ((atom-key1348 (vector-ref p1346 0))) (if (memv atom-key1348 (quote (each))) (match-empty1326 (vector-ref p1346 1) r1347) (if (memv atom-key1348 (quote (free-id atom))) r1347 (if (memv atom-key1348 (quote (vector))) (match-empty1326 (vector-ref p1346 1) r1347) (if #f #f))))))))))) (match-each-any1325 (lambda (e1349 w1350 mod1351) (if (annotation? e1349) (match-each-any1325 (annotation-expression e1349) w1350 mod1351) (if (pair? e1349) (let ((l1352 (match-each-any1325 (cdr e1349) w1350 mod1351))) (if l1352 (cons (wrap141 (car e1349) w1350 mod1351) l1352) #f)) (if (null? e1349) (quote ()) (if (syntax-object?97 e1349) (match-each-any1325 (syntax-object-expression98 e1349) (join-wraps132 w1350 (syntax-object-wrap99 e1349)) mod1351) #f)))))) (match-each1324 (lambda (e1353 p1354 w1355 mod1356) (if (annotation? e1353) (match-each1324 (annotation-expression e1353) p1354 w1355 mod1356) (if (pair? e1353) (let ((first1357 (match1328 (car e1353) p1354 w1355 (quote ()) mod1356))) (if first1357 (let ((rest1358 (match-each1324 (cdr e1353) p1354 w1355 mod1356))) (if rest1358 (cons first1357 rest1358) #f)) #f)) (if (null? e1353) (quote ()) (if (syntax-object?97 e1353) (match-each1324 (syntax-object-expression98 e1353) p1354 (join-wraps132 w1355 (syntax-object-wrap99 e1353)) (syntax-object-module100 e1353)) #f))))))) (set! $sc-dispatch (lambda (e1359 p1360) (if (eq? p1360 (quote any)) (list e1359) (if (syntax-object?97 e1359) (match*1327 (let ((e1361 (syntax-object-expression98 e1359))) (if (annotation? e1361) (annotation-expression e1361) e1361)) p1360 (syntax-object-wrap99 e1359) (quote ()) (syntax-object-module100 e1359)) (match*1327 (let ((e1362 e1359)) (if (annotation? e1362) (annotation-expression e1362) e1362)) p1360 (quote (())) (quote ()) #f)))))))))
+(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 (vars291) (letrec ((lvl292 (lambda (vars293 ls294 w295) (if (pair? vars293) (lvl292 (cdr vars293) (cons (wrap141 (car vars293) w295 #f) ls294) w295) (if (id?113 vars293) (cons (wrap141 vars293 w295 #f) ls294) (if (null? vars293) ls294 (if (syntax-object?97 vars293) (lvl292 (syntax-object-expression98 vars293) ls294 (join-wraps132 w295 (syntax-object-wrap99 vars293))) (if (annotation? vars293) (lvl292 (annotation-expression vars293) ls294 w295) (cons vars293 ls294))))))))) (lvl292 vars291 (quote ()) (quote (())))))) (gen-var161 (lambda (id296) (let ((id297 (if (syntax-object?97 id296) (syntax-object-expression98 id296) id296))) (if (annotation? id297) (gensym (symbol->string (annotation-expression id297))) (gensym (symbol->string id297)))))) (strip160 (lambda (x298 w299) (if (memq (quote top) (wrap-marks116 w299)) (if (let ((t300 (annotation? x298))) (if t300 t300 (if (pair? x298) (annotation? (car x298)) #f))) (strip-annotation159 x298 #f) x298) (letrec ((f301 (lambda (x302) (if (syntax-object?97 x302) (strip160 (syntax-object-expression98 x302) (syntax-object-wrap99 x302)) (if (pair? x302) (let ((a303 (f301 (car x302))) (d304 (f301 (cdr x302)))) (if (if (eq? a303 (car x302)) (eq? d304 (cdr x302)) #f) x302 (cons a303 d304))) (if (vector? x302) (let ((old305 (vector->list x302))) (let ((new306 (map f301 old305))) (if (and-map*17 eq? old305 new306) x302 (list->vector new306)))) x302)))))) (f301 x298))))) (strip-annotation159 (lambda (x307 parent308) (if (pair? x307) (let ((new309 (cons #f #f))) (begin (if parent308 (set-annotation-stripped! parent308 new309)) (set-car! new309 (strip-annotation159 (car x307) #f)) (set-cdr! new309 (strip-annotation159 (cdr x307) #f)) new309)) (if (annotation? x307) (let ((t310 (annotation-stripped x307))) (if t310 t310 (strip-annotation159 (annotation-expression x307) x307))) (if (vector? x307) (let ((new311 (make-vector (vector-length x307)))) (begin (if parent308 (set-annotation-stripped! parent308 new311)) (letrec ((loop312 (lambda (i313) (unless (fx<75 i313 0) (vector-set! new311 i313 (strip-annotation159 (vector-ref x307 i313) #f)) (loop312 (fx-73 i313 1)))))) (loop312 (- (vector-length x307) 1))) new311)) x307))))) (ellipsis?158 (lambda (x314) (if (nonsymbol-id?112 x314) (free-id=?136 x314 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void157 (lambda () (build-void80 #f))) (eval-local-transformer156 (lambda (expanded315 mod316) (let ((p317 (local-eval-hook77 expanded315 mod316))) (if (procedure? p317) p317 (syntax-violation #f "nonprocedure transformer" p317))))) (chi-local-syntax155 (lambda (rec?318 e319 r320 w321 s322 mod323 k324) ((lambda (tmp325) ((lambda (tmp326) (if tmp326 (apply (lambda (_327 id328 val329 e1330 e2331) (let ((ids332 id328)) (if (not (valid-bound-ids?138 ids332)) (syntax-violation #f "duplicate bound keyword" e319) (let ((labels334 (gen-labels119 ids332))) (let ((new-w335 (make-binding-wrap130 ids332 labels334 w321))) (k324 (cons e1330 e2331) (extend-env107 labels334 (let ((w337 (if rec?318 new-w335 w321)) (trans-r338 (macros-only-env109 r320))) (map (lambda (x339) (cons (quote macro) (eval-local-transformer156 (chi149 x339 trans-r338 w337 mod323) mod323))) val329)) r320) new-w335 s322 mod323)))))) tmp326) ((lambda (_341) (syntax-violation #f "bad local syntax definition" (source-wrap142 e319 w321 s322 mod323))) tmp325))) ($sc-dispatch tmp325 (quote (any #(each (any any)) any . each-any))))) e319))) (chi-lambda-clause154 (lambda (e342 docstring343 c344 r345 w346 mod347 k348) ((lambda (tmp349) ((lambda (tmp350) (if (if tmp350 (apply (lambda (args351 doc352 e1353 e2354) (if (string? (syntax->datum doc352)) (not docstring343) #f)) tmp350) #f) (apply (lambda (args355 doc356 e1357 e2358) (chi-lambda-clause154 e342 doc356 (cons args355 (cons e1357 e2358)) r345 w346 mod347 k348)) tmp350) ((lambda (tmp360) (if tmp360 (apply (lambda (id361 e1362 e2363) (let ((ids364 id361)) (if (not (valid-bound-ids?138 ids364)) (syntax-violation (quote lambda) "invalid parameter list" e342) (let ((labels366 (gen-labels119 ids364)) (new-vars367 (map gen-var161 ids364))) (k348 (map syntax->datum ids364) new-vars367 (if docstring343 (syntax->datum docstring343) #f) (chi-body153 (cons e1362 e2363) e342 (extend-var-env108 labels366 new-vars367 r345) (make-binding-wrap130 ids364 labels366 w346) mod347)))))) tmp360) ((lambda (tmp369) (if tmp369 (apply (lambda (ids370 e1371 e2372) (let ((old-ids373 (lambda-var-list162 ids370))) (if (not (valid-bound-ids?138 old-ids373)) (syntax-violation (quote lambda) "invalid parameter list" e342) (let ((labels374 (gen-labels119 old-ids373)) (new-vars375 (map gen-var161 old-ids373))) (k348 (letrec ((f376 (lambda (ls1377 ls2378) (if (null? ls1377) (syntax->datum ls2378) (f376 (cdr ls1377) (cons (syntax->datum (car ls1377)) ls2378)))))) (f376 (cdr old-ids373) (car old-ids373))) (letrec ((f379 (lambda (ls1380 ls2381) (if (null? ls1380) ls2381 (f379 (cdr ls1380) (cons (car ls1380) ls2381)))))) (f379 (cdr new-vars375) (car new-vars375))) (if docstring343 (syntax->datum docstring343) #f) (chi-body153 (cons e1371 e2372) e342 (extend-var-env108 labels374 new-vars375 r345) (make-binding-wrap130 old-ids373 labels374 w346) mod347)))))) tmp369) ((lambda (_383) (syntax-violation (quote lambda) "bad lambda" e342)) tmp349))) ($sc-dispatch tmp349 (quote (any any . each-any)))))) ($sc-dispatch tmp349 (quote (each-any any . each-any)))))) ($sc-dispatch tmp349 (quote (any any any . each-any))))) c344))) (chi-body153 (lambda (body384 outer-form385 r386 w387 mod388) (let ((r389 (cons (quote ("placeholder" placeholder)) r386))) (let ((ribcage390 (make-ribcage120 (quote ()) (quote ()) (quote ())))) (let ((w391 (make-wrap115 (wrap-marks116 w387) (cons ribcage390 (wrap-subst117 w387))))) (letrec ((parse392 (lambda (body393 ids394 labels395 vars396 vals397 bindings398) (if (null? body393) (syntax-violation #f "no expressions in body" outer-form385) (let ((e400 (cdar body393)) (er401 (caar body393))) (call-with-values (lambda () (syntax-type147 e400 er401 (quote (())) #f ribcage390 mod388)) (lambda (type402 value403 e404 w405 s406 mod407) (if (memv type402 (quote (define-form))) (let ((id408 (wrap141 value403 w405 mod407)) (label409 (gen-label118))) (let ((var410 (gen-var161 id408))) (begin (extend-ribcage!129 ribcage390 id408 label409) (parse392 (cdr body393) (cons id408 ids394) (cons label409 labels395) (cons var410 vars396) (cons (cons er401 (wrap141 e404 w405 mod407)) vals397) (cons (cons (quote lexical) var410) bindings398))))) (if (memv type402 (quote (define-syntax-form))) (let ((id411 (wrap141 value403 w405 mod407)) (label412 (gen-label118))) (begin (extend-ribcage!129 ribcage390 id411 label412) (parse392 (cdr body393) (cons id411 ids394) (cons label412 labels395) vars396 vals397 (cons (cons (quote macro) (cons er401 (wrap141 e404 w405 mod407))) bindings398)))) (if (memv type402 (quote (begin-form))) ((lambda (tmp413) ((lambda (tmp414) (if tmp414 (apply (lambda (_415 e1416) (parse392 (letrec ((f417 (lambda (forms418) (if (null? forms418) (cdr body393) (cons (cons er401 (wrap141 (car forms418) w405 mod407)) (f417 (cdr forms418))))))) (f417 e1416)) ids394 labels395 vars396 vals397 bindings398)) tmp414) (syntax-violation #f "source expression failed to match any pattern" tmp413))) ($sc-dispatch tmp413 (quote (any . each-any))))) e404) (if (memv type402 (quote (local-syntax-form))) (chi-local-syntax155 value403 e404 er401 w405 s406 mod407 (lambda (forms420 er421 w422 s423 mod424) (parse392 (letrec ((f425 (lambda (forms426) (if (null? forms426) (cdr body393) (cons (cons er421 (wrap141 (car forms426) w422 mod424)) (f425 (cdr forms426))))))) (f425 forms420)) ids394 labels395 vars396 vals397 bindings398))) (if (null? ids394) (build-sequence92 #f (map (lambda (x427) (chi149 (cdr x427) (car x427) (quote (())) mod407)) (cons (cons er401 (source-wrap142 e404 w405 s406 mod407)) (cdr body393)))) (begin (if (not (valid-bound-ids?138 ids394)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form385)) (letrec ((loop428 (lambda (bs429 er-cache430 r-cache431) (if (not (null? bs429)) (let ((b432 (car bs429))) (if (eq? (car b432) (quote macro)) (let ((er433 (cadr b432))) (let ((r-cache434 (if (eq? er433 er-cache430) r-cache431 (macros-only-env109 er433)))) (begin (set-cdr! b432 (eval-local-transformer156 (chi149 (cddr b432) r-cache434 (quote (())) mod407) mod407)) (loop428 (cdr bs429) er433 r-cache434)))) (loop428 (cdr bs429) er-cache430 r-cache431))))))) (loop428 bindings398 #f #f)) (set-cdr! r389 (extend-env107 labels395 bindings398 (cdr r389))) (build-letrec95 #f (map syntax->datum ids394) vars396 (map (lambda (x435) (chi149 (cdr x435) (car x435) (quote (())) mod407)) vals397) (build-sequence92 #f (map (lambda (x436) (chi149 (cdr x436) (car x436) (quote (())) mod407)) (cons (cons er401 (source-wrap142 e404 w405 s406 mod407)) (cdr body393)))))))))))))))))) (parse392 (map (lambda (x399) (cons r389 (wrap141 x399 w391 mod388))) body384) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro152 (lambda (p437 e438 r439 w440 rib441 mod442) (letrec ((rebuild-macro-output443 (lambda (x444 m445) (if (pair? x444) (cons (rebuild-macro-output443 (car x444) m445) (rebuild-macro-output443 (cdr x444) m445)) (if (syntax-object?97 x444) (let ((w446 (syntax-object-wrap99 x444))) (let ((ms447 (wrap-marks116 w446)) (s448 (wrap-subst117 w446))) (if (if (pair? ms447) (eq? (car ms447) #f) #f) (make-syntax-object96 (syntax-object-expression98 x444) (make-wrap115 (cdr ms447) (if rib441 (cons rib441 (cdr s448)) (cdr s448))) (syntax-object-module100 x444)) (make-syntax-object96 (syntax-object-expression98 x444) (make-wrap115 (cons m445 ms447) (if rib441 (cons rib441 (cons (quote shift) s448)) (cons (quote shift) s448))) (let ((pmod449 (procedure-module p437))) (if pmod449 (cons (quote hygiene) (module-name pmod449)) (quote (hygiene guile)))))))) (if (vector? x444) (let ((n450 (vector-length x444))) (let ((v451 (make-vector n450))) (letrec ((loop452 (lambda (i453) (if (fx=74 i453 n450) (begin (if #f #f) v451) (begin (vector-set! v451 i453 (rebuild-macro-output443 (vector-ref x444 i453) m445)) (loop452 (fx+72 i453 1))))))) (loop452 0)))) (if (symbol? x444) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap142 e438 w440 s mod442) x444) x444))))))) (rebuild-macro-output443 (p437 (wrap141 e438 (anti-mark128 w440) mod442)) (string #\m))))) (chi-application151 (lambda (x454 e455 r456 w457 s458 mod459) ((lambda (tmp460) ((lambda (tmp461) (if tmp461 (apply (lambda (e0462 e1463) (build-application81 s458 x454 (map (lambda (e464) (chi149 e464 r456 w457 mod459)) e1463))) tmp461) (syntax-violation #f "source expression failed to match any pattern" tmp460))) ($sc-dispatch tmp460 (quote (any . each-any))))) e455))) (chi-expr150 (lambda (type466 value467 e468 r469 w470 s471 mod472) (if (memv type466 (quote (lexical))) (build-lexical-reference83 (quote value) s471 e468 value467) (if (memv type466 (quote (core external-macro))) (value467 e468 r469 w470 s471 mod472) (if (memv type466 (quote (module-ref))) (call-with-values (lambda () (value467 e468)) (lambda (id473 mod474) (build-global-reference86 s471 id473 mod474))) (if (memv type466 (quote (lexical-call))) (chi-application151 (build-lexical-reference83 (quote fun) (source-annotation104 (car e468)) (car e468) value467) e468 r469 w470 s471 mod472) (if (memv type466 (quote (global-call))) (chi-application151 (build-global-reference86 (source-annotation104 (car e468)) value467 (if (syntax-object?97 (car e468)) (syntax-object-module100 (car e468)) mod472)) e468 r469 w470 s471 mod472) (if (memv type466 (quote (constant))) (build-data91 s471 (strip160 (source-wrap142 e468 w470 s471 mod472) (quote (())))) (if (memv type466 (quote (global))) (build-global-reference86 s471 value467 mod472) (if (memv type466 (quote (call))) (chi-application151 (chi149 (car e468) r469 w470 mod472) e468 r469 w470 s471 mod472) (if (memv type466 (quote (begin-form))) ((lambda (tmp475) ((lambda (tmp476) (if tmp476 (apply (lambda (_477 e1478 e2479) (chi-sequence143 (cons e1478 e2479) r469 w470 s471 mod472)) tmp476) (syntax-violation #f "source expression failed to match any pattern" tmp475))) ($sc-dispatch tmp475 (quote (any any . each-any))))) e468) (if (memv type466 (quote (local-syntax-form))) (chi-local-syntax155 value467 e468 r469 w470 s471 mod472 chi-sequence143) (if (memv type466 (quote (eval-when-form))) ((lambda (tmp481) ((lambda (tmp482) (if tmp482 (apply (lambda (_483 x484 e1485 e2486) (let ((when-list487 (chi-when-list146 e468 x484 w470))) (if (memq (quote eval) when-list487) (chi-sequence143 (cons e1485 e2486) r469 w470 s471 mod472) (chi-void157)))) tmp482) (syntax-violation #f "source expression failed to match any pattern" tmp481))) ($sc-dispatch tmp481 (quote (any each-any any . each-any))))) e468) (if (memv type466 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e468 (wrap141 value467 w470 mod472)) (if (memv type466 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap142 e468 w470 s471 mod472)) (if (memv type466 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap142 e468 w470 s471 mod472)) (syntax-violation #f "unexpected syntax" (source-wrap142 e468 w470 s471 mod472)))))))))))))))))) (chi149 (lambda (e490 r491 w492 mod493) (call-with-values (lambda () (syntax-type147 e490 r491 w492 #f #f mod493)) (lambda (type494 value495 e496 w497 s498 mod499) (chi-expr150 type494 value495 e496 r491 w497 s498 mod499))))) (chi-top148 (lambda (e500 r501 w502 m503 esew504 mod505) (call-with-values (lambda () (syntax-type147 e500 r501 w502 #f #f mod505)) (lambda (type513 value514 e515 w516 s517 mod518) (if (memv type513 (quote (begin-form))) ((lambda (tmp519) ((lambda (tmp520) (if tmp520 (apply (lambda (_521) (chi-void157)) tmp520) ((lambda (tmp522) (if tmp522 (apply (lambda (_523 e1524 e2525) (chi-top-sequence144 (cons e1524 e2525) r501 w516 s517 m503 esew504 mod518)) tmp522) (syntax-violation #f "source expression failed to match any pattern" tmp519))) ($sc-dispatch tmp519 (quote (any any . each-any)))))) ($sc-dispatch tmp519 (quote (any))))) e515) (if (memv type513 (quote (local-syntax-form))) (chi-local-syntax155 value514 e515 r501 w516 s517 mod518 (lambda (body527 r528 w529 s530 mod531) (chi-top-sequence144 body527 r528 w529 s530 m503 esew504 mod531))) (if (memv type513 (quote (eval-when-form))) ((lambda (tmp532) ((lambda (tmp533) (if tmp533 (apply (lambda (_534 x535 e1536 e2537) (let ((when-list538 (chi-when-list146 e515 x535 w516)) (body539 (cons e1536 e2537))) (if (eq? m503 (quote e)) (if (memq (quote eval) when-list538) (chi-top-sequence144 body539 r501 w516 s517 (quote e) (quote (eval)) mod518) (chi-void157)) (if (memq (quote load) when-list538) (if (let ((t542 (memq (quote compile) when-list538))) (if t542 t542 (if (eq? m503 (quote c&e)) (memq (quote eval) when-list538) #f))) (chi-top-sequence144 body539 r501 w516 s517 (quote c&e) (quote (compile load)) mod518) (if (memq m503 (quote (c c&e))) (chi-top-sequence144 body539 r501 w516 s517 (quote c) (quote (load)) mod518) (chi-void157))) (if (let ((t543 (memq (quote compile) when-list538))) (if t543 t543 (if (eq? m503 (quote c&e)) (memq (quote eval) when-list538) #f))) (begin (top-level-eval-hook76 (chi-top-sequence144 body539 r501 w516 s517 (quote e) (quote (eval)) mod518) mod518) (chi-void157)) (chi-void157)))))) tmp533) (syntax-violation #f "source expression failed to match any pattern" tmp532))) ($sc-dispatch tmp532 (quote (any each-any any . each-any))))) e515) (if (memv type513 (quote (define-syntax-form))) (let ((n544 (id-var-name135 value514 w516)) (r545 (macros-only-env109 r501))) (if (memv m503 (quote (c))) (if (memq (quote compile) esew504) (let ((e546 (chi-install-global145 n544 (chi149 e515 r545 w516 mod518)))) (begin (top-level-eval-hook76 e546 mod518) (if (memq (quote load) esew504) e546 (chi-void157)))) (if (memq (quote load) esew504) (chi-install-global145 n544 (chi149 e515 r545 w516 mod518)) (chi-void157))) (if (memv m503 (quote (c&e))) (let ((e547 (chi-install-global145 n544 (chi149 e515 r545 w516 mod518)))) (begin (top-level-eval-hook76 e547 mod518) e547)) (begin (if (memq (quote eval) esew504) (top-level-eval-hook76 (chi-install-global145 n544 (chi149 e515 r545 w516 mod518)) mod518)) (chi-void157))))) (if (memv type513 (quote (define-form))) (let ((n548 (id-var-name135 value514 w516))) (let ((type549 (binding-type105 (lookup110 n548 r501 mod518)))) (if (memv type549 (quote (global core macro module-ref))) (let ((x550 (build-global-definition88 s517 n548 (chi149 e515 r501 w516 mod518)))) (begin (if (eq? m503 (quote c&e)) (top-level-eval-hook76 x550 mod518)) x550)) (if (memv type549 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e515 (wrap141 value514 w516 mod518)) (syntax-violation #f "cannot define keyword at top level" e515 (wrap141 value514 w516 mod518)))))) (let ((x551 (chi-expr150 type513 value514 e515 r501 w516 s517 mod518))) (begin (if (eq? m503 (quote c&e)) (top-level-eval-hook76 x551 mod518)) x551))))))))))) (syntax-type147 (lambda (e552 r553 w554 s555 rib556 mod557) (if (symbol? e552) (let ((n558 (id-var-name135 e552 w554))) (let ((b559 (lookup110 n558 r553 mod557))) (let ((type560 (binding-type105 b559))) (if (memv type560 (quote (lexical))) (values type560 (binding-value106 b559) e552 w554 s555 mod557) (if (memv type560 (quote (global))) (values type560 n558 e552 w554 s555 mod557) (if (memv type560 (quote (macro))) (syntax-type147 (chi-macro152 (binding-value106 b559) e552 r553 w554 rib556 mod557) r553 (quote (())) s555 rib556 mod557) (values type560 (binding-value106 b559) e552 w554 s555 mod557))))))) (if (pair? e552) (let ((first561 (car e552))) (if (id?113 first561) (let ((n562 (id-var-name135 first561 w554))) (let ((b563 (lookup110 n562 r553 (let ((t564 (if (syntax-object?97 first561) (syntax-object-module100 first561) #f))) (if t564 t564 mod557))))) (let ((type565 (binding-type105 b563))) (if (memv type565 (quote (lexical))) (values (quote lexical-call) (binding-value106 b563) e552 w554 s555 mod557) (if (memv type565 (quote (global))) (values (quote global-call) n562 e552 w554 s555 mod557) (if (memv type565 (quote (macro))) (syntax-type147 (chi-macro152 (binding-value106 b563) e552 r553 w554 rib556 mod557) r553 (quote (())) s555 rib556 mod557) (if (memv type565 (quote (core external-macro module-ref))) (values type565 (binding-value106 b563) e552 w554 s555 mod557) (if (memv type565 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value106 b563) e552 w554 s555 mod557) (if (memv type565 (quote (begin))) (values (quote begin-form) #f e552 w554 s555 mod557) (if (memv type565 (quote (eval-when))) (values (quote eval-when-form) #f e552 w554 s555 mod557) (if (memv type565 (quote (define))) ((lambda (tmp566) ((lambda (tmp567) (if (if tmp567 (apply (lambda (_568 name569 val570) (id?113 name569)) tmp567) #f) (apply (lambda (_571 name572 val573) (values (quote define-form) name572 val573 w554 s555 mod557)) tmp567) ((lambda (tmp574) (if (if tmp574 (apply (lambda (_575 name576 args577 e1578 e2579) (if (id?113 name576) (valid-bound-ids?138 (lambda-var-list162 args577)) #f)) tmp574) #f) (apply (lambda (_580 name581 args582 e1583 e2584) (values (quote define-form) (wrap141 name581 w554 mod557) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap141 (cons args582 (cons e1583 e2584)) w554 mod557)) (quote (())) s555 mod557)) tmp574) ((lambda (tmp586) (if (if tmp586 (apply (lambda (_587 name588) (id?113 name588)) tmp586) #f) (apply (lambda (_589 name590) (values (quote define-form) (wrap141 name590 w554 mod557) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s555 mod557)) tmp586) (syntax-violation #f "source expression failed to match any pattern" tmp566))) ($sc-dispatch tmp566 (quote (any any)))))) ($sc-dispatch tmp566 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp566 (quote (any any any))))) e552) (if (memv type565 (quote (define-syntax))) ((lambda (tmp591) ((lambda (tmp592) (if (if tmp592 (apply (lambda (_593 name594 val595) (id?113 name594)) tmp592) #f) (apply (lambda (_596 name597 val598) (values (quote define-syntax-form) name597 val598 w554 s555 mod557)) tmp592) (syntax-violation #f "source expression failed to match any pattern" tmp591))) ($sc-dispatch tmp591 (quote (any any any))))) e552) (values (quote call) #f e552 w554 s555 mod557))))))))))))) (values (quote call) #f e552 w554 s555 mod557))) (if (syntax-object?97 e552) (syntax-type147 (syntax-object-expression98 e552) r553 (join-wraps132 w554 (syntax-object-wrap99 e552)) #f rib556 (let ((t599 (syntax-object-module100 e552))) (if t599 t599 mod557))) (if (annotation? e552) (syntax-type147 (annotation-expression e552) r553 w554 (annotation-source e552) rib556 mod557) (if (self-evaluating? e552) (values (quote constant) #f e552 w554 s555 mod557) (values (quote other) #f e552 w554 s555 mod557)))))))) (chi-when-list146 (lambda (e600 when-list601 w602) (letrec ((f603 (lambda (when-list604 situations605) (if (null? when-list604) situations605 (f603 (cdr when-list604) (cons (let ((x606 (car when-list604))) (if (free-id=?136 x606 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?136 x606 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?136 x606 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e600 (wrap141 x606 w602 #f)))))) situations605)))))) (f603 when-list601 (quote ()))))) (chi-install-global145 (lambda (name607 e608) (build-global-definition88 #f name607 (if (let ((v609 (module-variable (current-module) name607))) (if v609 (if (variable-bound? v609) (if (macro? (variable-ref v609)) (not (eq? (macro-type (variable-ref v609)) (quote syncase-macro))) #f) #f) #f)) (build-application81 #f (build-primref90 #f (quote make-extended-syncase-macro)) (list (build-application81 #f (build-primref90 #f (quote module-ref)) (list (build-application81 #f (build-primref90 #f (quote current-module)) (quote ())) (build-data91 #f name607))) (build-data91 #f (quote macro)) e608)) (build-application81 #f (build-primref90 #f (quote make-syncase-macro)) (list (build-data91 #f (quote macro)) e608)))))) (chi-top-sequence144 (lambda (body610 r611 w612 s613 m614 esew615 mod616) (build-sequence92 s613 (letrec ((dobody617 (lambda (body618 r619 w620 m621 esew622 mod623) (if (null? body618) (quote ()) (let ((first624 (chi-top148 (car body618) r619 w620 m621 esew622 mod623))) (cons first624 (dobody617 (cdr body618) r619 w620 m621 esew622 mod623))))))) (dobody617 body610 r611 w612 m614 esew615 mod616))))) (chi-sequence143 (lambda (body625 r626 w627 s628 mod629) (build-sequence92 s628 (letrec ((dobody630 (lambda (body631 r632 w633 mod634) (if (null? body631) (quote ()) (let ((first635 (chi149 (car body631) r632 w633 mod634))) (cons first635 (dobody630 (cdr body631) r632 w633 mod634))))))) (dobody630 body625 r626 w627 mod629))))) (source-wrap142 (lambda (x636 w637 s638 defmod639) (wrap141 (if s638 (make-annotation x636 s638 #f) x636) w637 defmod639))) (wrap141 (lambda (x640 w641 defmod642) (if (if (null? (wrap-marks116 w641)) (null? (wrap-subst117 w641)) #f) x640 (if (syntax-object?97 x640) (make-syntax-object96 (syntax-object-expression98 x640) (join-wraps132 w641 (syntax-object-wrap99 x640)) (syntax-object-module100 x640)) (if (null? x640) x640 (make-syntax-object96 x640 w641 defmod642)))))) (bound-id-member?140 (lambda (x643 list644) (if (not (null? list644)) (let ((t645 (bound-id=?137 x643 (car list644)))) (if t645 t645 (bound-id-member?140 x643 (cdr list644)))) #f))) (distinct-bound-ids?139 (lambda (ids646) (letrec ((distinct?647 (lambda (ids648) (let ((t649 (null? ids648))) (if t649 t649 (if (not (bound-id-member?140 (car ids648) (cdr ids648))) (distinct?647 (cdr ids648)) #f)))))) (distinct?647 ids646)))) (valid-bound-ids?138 (lambda (ids650) (if (letrec ((all-ids?651 (lambda (ids652) (let ((t653 (null? ids652))) (if t653 t653 (if (id?113 (car ids652)) (all-ids?651 (cdr ids652)) #f)))))) (all-ids?651 ids650)) (distinct-bound-ids?139 ids650) #f))) (bound-id=?137 (lambda (i654 j655) (if (if (syntax-object?97 i654) (syntax-object?97 j655) #f) (if (eq? (let ((e656 (syntax-object-expression98 i654))) (if (annotation? e656) (annotation-expression e656) e656)) (let ((e657 (syntax-object-expression98 j655))) (if (annotation? e657) (annotation-expression e657) e657))) (same-marks?134 (wrap-marks116 (syntax-object-wrap99 i654)) (wrap-marks116 (syntax-object-wrap99 j655))) #f) (eq? (let ((e658 i654)) (if (annotation? e658) (annotation-expression e658) e658)) (let ((e659 j655)) (if (annotation? e659) (annotation-expression e659) e659)))))) (free-id=?136 (lambda (i660 j661) (if (eq? (let ((x662 i660)) (let ((e663 (if (syntax-object?97 x662) (syntax-object-expression98 x662) x662))) (if (annotation? e663) (annotation-expression e663) e663))) (let ((x664 j661)) (let ((e665 (if (syntax-object?97 x664) (syntax-object-expression98 x664) x664))) (if (annotation? e665) (annotation-expression e665) e665)))) (eq? (id-var-name135 i660 (quote (()))) (id-var-name135 j661 (quote (())))) #f))) (id-var-name135 (lambda (id666 w667) (letrec ((search-vector-rib670 (lambda (sym676 subst677 marks678 symnames679 ribcage680) (let ((n681 (vector-length symnames679))) (letrec ((f682 (lambda (i683) (if (fx=74 i683 n681) (search668 sym676 (cdr subst677) marks678) (if (if (eq? (vector-ref symnames679 i683) sym676) (same-marks?134 marks678 (vector-ref (ribcage-marks123 ribcage680) i683)) #f) (values (vector-ref (ribcage-labels124 ribcage680) i683) marks678) (f682 (fx+72 i683 1))))))) (f682 0))))) (search-list-rib669 (lambda (sym684 subst685 marks686 symnames687 ribcage688) (letrec ((f689 (lambda (symnames690 i691) (if (null? symnames690) (search668 sym684 (cdr subst685) marks686) (if (if (eq? (car symnames690) sym684) (same-marks?134 marks686 (list-ref (ribcage-marks123 ribcage688) i691)) #f) (values (list-ref (ribcage-labels124 ribcage688) i691) marks686) (f689 (cdr symnames690) (fx+72 i691 1))))))) (f689 symnames687 0)))) (search668 (lambda (sym692 subst693 marks694) (if (null? subst693) (values #f marks694) (let ((fst695 (car subst693))) (if (eq? fst695 (quote shift)) (search668 sym692 (cdr subst693) (cdr marks694)) (let ((symnames696 (ribcage-symnames122 fst695))) (if (vector? symnames696) (search-vector-rib670 sym692 subst693 marks694 symnames696 fst695) (search-list-rib669 sym692 subst693 marks694 symnames696 fst695))))))))) (if (symbol? id666) (let ((t697 (call-with-values (lambda () (search668 id666 (wrap-subst117 w667) (wrap-marks116 w667))) (lambda (x699 . ignore698) x699)))) (if t697 t697 id666)) (if (syntax-object?97 id666) (let ((id700 (let ((e702 (syntax-object-expression98 id666))) (if (annotation? e702) (annotation-expression e702) e702))) (w1701 (syntax-object-wrap99 id666))) (let ((marks703 (join-marks133 (wrap-marks116 w667) (wrap-marks116 w1701)))) (call-with-values (lambda () (search668 id700 (wrap-subst117 w667) marks703)) (lambda (new-id704 marks705) (let ((t706 new-id704)) (if t706 t706 (let ((t707 (call-with-values (lambda () (search668 id700 (wrap-subst117 w1701) marks705)) (lambda (x709 . ignore708) x709)))) (if t707 t707 id700)))))))) (if (annotation? id666) (let ((id710 (let ((e711 id666)) (if (annotation? e711) (annotation-expression e711) e711)))) (let ((t712 (call-with-values (lambda () (search668 id710 (wrap-subst117 w667) (wrap-marks116 w667))) (lambda (x714 . ignore713) x714)))) (if t712 t712 id710))) (syntax-violation (quote id-var-name) "invalid id" id666))))))) (same-marks?134 (lambda (x715 y716) (let ((t717 (eq? x715 y716))) (if t717 t717 (if (not (null? x715)) (if (not (null? y716)) (if (eq? (car x715) (car y716)) (same-marks?134 (cdr x715) (cdr y716)) #f) #f) #f))))) (join-marks133 (lambda (m1718 m2719) (smart-append131 m1718 m2719))) (join-wraps132 (lambda (w1720 w2721) (let ((m1722 (wrap-marks116 w1720)) (s1723 (wrap-subst117 w1720))) (if (null? m1722) (if (null? s1723) w2721 (make-wrap115 (wrap-marks116 w2721) (smart-append131 s1723 (wrap-subst117 w2721)))) (make-wrap115 (smart-append131 m1722 (wrap-marks116 w2721)) (smart-append131 s1723 (wrap-subst117 w2721))))))) (smart-append131 (lambda (m1724 m2725) (if (null? m2725) m1724 (append m1724 m2725)))) (make-binding-wrap130 (lambda (ids726 labels727 w728) (if (null? ids726) w728 (make-wrap115 (wrap-marks116 w728) (cons (let ((labelvec729 (list->vector labels727))) (let ((n730 (vector-length labelvec729))) (let ((symnamevec731 (make-vector n730)) (marksvec732 (make-vector n730))) (begin (letrec ((f733 (lambda (ids734 i735) (if (not (null? ids734)) (call-with-values (lambda () (id-sym-name&marks114 (car ids734) w728)) (lambda (symname736 marks737) (begin (vector-set! symnamevec731 i735 symname736) (vector-set! marksvec732 i735 marks737) (f733 (cdr ids734) (fx+72 i735 1))))))))) (f733 ids726 0)) (make-ribcage120 symnamevec731 marksvec732 labelvec729))))) (wrap-subst117 w728)))))) (extend-ribcage!129 (lambda (ribcage738 id739 label740) (begin (set-ribcage-symnames!125 ribcage738 (cons (let ((e741 (syntax-object-expression98 id739))) (if (annotation? e741) (annotation-expression e741) e741)) (ribcage-symnames122 ribcage738))) (set-ribcage-marks!126 ribcage738 (cons (wrap-marks116 (syntax-object-wrap99 id739)) (ribcage-marks123 ribcage738))) (set-ribcage-labels!127 ribcage738 (cons label740 (ribcage-labels124 ribcage738)))))) (anti-mark128 (lambda (w742) (make-wrap115 (cons #f (wrap-marks116 w742)) (cons (quote shift) (wrap-subst117 w742))))) (set-ribcage-labels!127 (lambda (x743 update744) (vector-set! x743 3 update744))) (set-ribcage-marks!126 (lambda (x745 update746) (vector-set! x745 2 update746))) (set-ribcage-symnames!125 (lambda (x747 update748) (vector-set! x747 1 update748))) (ribcage-labels124 (lambda (x749) (vector-ref x749 3))) (ribcage-marks123 (lambda (x750) (vector-ref x750 2))) (ribcage-symnames122 (lambda (x751) (vector-ref x751 1))) (ribcage?121 (lambda (x752) (if (vector? x752) (if (= (vector-length x752) 4) (eq? (vector-ref x752 0) (quote ribcage)) #f) #f))) (make-ribcage120 (lambda (symnames753 marks754 labels755) (vector (quote ribcage) symnames753 marks754 labels755))) (gen-labels119 (lambda (ls756) (if (null? ls756) (quote ()) (cons (gen-label118) (gen-labels119 (cdr ls756)))))) (gen-label118 (lambda () (string #\i))) (wrap-subst117 cdr) (wrap-marks116 car) (make-wrap115 cons) (id-sym-name&marks114 (lambda (x757 w758) (if (syntax-object?97 x757) (values (let ((e759 (syntax-object-expression98 x757))) (if (annotation? e759) (annotation-expression e759) e759)) (join-marks133 (wrap-marks116 w758) (wrap-marks116 (syntax-object-wrap99 x757)))) (values (let ((e760 x757)) (if (annotation? e760) (annotation-expression e760) e760)) (wrap-marks116 w758))))) (id?113 (lambda (x761) (if (symbol? x761) #t (if (syntax-object?97 x761) (symbol? (let ((e762 (syntax-object-expression98 x761))) (if (annotation? e762) (annotation-expression e762) e762))) (if (annotation? x761) (symbol? (annotation-expression x761)) #f))))) (nonsymbol-id?112 (lambda (x763) (if (syntax-object?97 x763) (symbol? (let ((e764 (syntax-object-expression98 x763))) (if (annotation? e764) (annotation-expression e764) e764))) #f))) (global-extend111 (lambda (type765 sym766 val767) (put-global-definition-hook78 sym766 type765 val767))) (lookup110 (lambda (x768 r769 mod770) (let ((temp771 (assq x768 r769))) (if temp771 (cdr temp771) (if (symbol? x768) (let ((t772 (get-global-definition-hook79 x768 mod770))) (if t772 t772 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env109 (lambda (r773) (if (null? r773) (quote ()) (let ((a774 (car r773))) (if (eq? (cadr a774) (quote macro)) (cons a774 (macros-only-env109 (cdr r773))) (macros-only-env109 (cdr r773))))))) (extend-var-env108 (lambda (labels775 vars776 r777) (if (null? labels775) r777 (extend-var-env108 (cdr labels775) (cdr vars776) (cons (cons (car labels775) (cons (quote lexical) (car vars776))) r777))))) (extend-env107 (lambda (labels778 bindings779 r780) (if (null? labels778) r780 (extend-env107 (cdr labels778) (cdr bindings779) (cons (cons (car labels778) (car bindings779)) r780))))) (binding-value106 cdr) (binding-type105 car) (source-annotation104 (lambda (x781) (if (annotation? x781) (annotation-source x781) (if (syntax-object?97 x781) (source-annotation104 (syntax-object-expression98 x781)) #f)))) (set-syntax-object-module!103 (lambda (x782 update783) (vector-set! x782 3 update783))) (set-syntax-object-wrap!102 (lambda (x784 update785) (vector-set! x784 2 update785))) (set-syntax-object-expression!101 (lambda (x786 update787) (vector-set! x786 1 update787))) (syntax-object-module100 (lambda (x788) (vector-ref x788 3))) (syntax-object-wrap99 (lambda (x789) (vector-ref x789 2))) (syntax-object-expression98 (lambda (x790) (vector-ref x790 1))) (syntax-object?97 (lambda (x791) (if (vector? x791) (if (= (vector-length x791) 4) (eq? (vector-ref x791 0) (quote syntax-object)) #f) #f))) (make-syntax-object96 (lambda (expression792 wrap793 module794) (vector (quote syntax-object) expression792 wrap793 module794))) (build-letrec95 (lambda (src795 ids796 vars797 val-exps798 body-exp799) (if (null? vars797) body-exp799 (let ((atom-key800 (fluid-ref *mode*71))) (if (memv atom-key800 (quote (c))) ((@ (language tree-il) make-letrec) src795 ids796 vars797 val-exps798 body-exp799) (list (quote letrec) (map list vars797 val-exps798) body-exp799)))))) (build-named-let94 (lambda (src801 ids802 vars803 val-exps804 body-exp805) (let ((f806 (car vars803)) (f-name807 (car ids802)) (vars808 (cdr vars803)) (ids809 (cdr ids802))) (let ((atom-key810 (fluid-ref *mode*71))) (if (memv atom-key810 (quote (c))) ((@ (language tree-il) make-letrec) src801 (list f-name807) (list f806) (list (build-lambda89 src801 ids809 vars808 #f body-exp805)) (build-application81 src801 (build-lexical-reference83 (quote fun) src801 f-name807 f806) val-exps804)) (list (quote let) f806 (map list vars808 val-exps804) body-exp805)))))) (build-let93 (lambda (src811 ids812 vars813 val-exps814 body-exp815) (if (null? vars813) body-exp815 (let ((atom-key816 (fluid-ref *mode*71))) (if (memv atom-key816 (quote (c))) ((@ (language tree-il) make-let) src811 ids812 vars813 val-exps814 body-exp815) (list (quote let) (map list vars813 val-exps814) body-exp815)))))) (build-sequence92 (lambda (src817 exps818) (if (null? (cdr exps818)) (car exps818) (let ((atom-key819 (fluid-ref *mode*71))) (if (memv atom-key819 (quote (c))) ((@ (language tree-il) make-sequence) src817 exps818) (cons (quote begin) exps818)))))) (build-data91 (lambda (src820 exp821) (let ((atom-key822 (fluid-ref *mode*71))) (if (memv atom-key822 (quote (c))) ((@ (language tree-il) make-const) src820 exp821) (if (if (self-evaluating? exp821) (not (vector? exp821)) #f) exp821 (list (quote quote) exp821)))))) (build-primref90 (lambda (src823 name824) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key825 (fluid-ref *mode*71))) (if (memv atom-key825 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src823 name824) name824)) (let ((atom-key826 (fluid-ref *mode*71))) (if (memv atom-key826 (quote (c))) ((@ (language tree-il) make-module-ref) src823 (quote (guile)) name824 #f) (list (quote @@) (quote (guile)) name824)))))) (build-lambda89 (lambda (src827 ids828 vars829 docstring830 exp831) (let ((atom-key832 (fluid-ref *mode*71))) (if (memv atom-key832 (quote (c))) ((@ (language tree-il) make-lambda) src827 ids828 vars829 (if docstring830 (list (cons (quote documentation) docstring830)) (quote ())) exp831) (cons (quote lambda) (cons vars829 (append (if docstring830 (list docstring830) (quote ())) (list exp831)))))))) (build-global-definition88 (lambda (source833 var834 exp835) (let ((atom-key836 (fluid-ref *mode*71))) (if (memv atom-key836 (quote (c))) ((@ (language tree-il) make-toplevel-define) source833 var834 exp835) (list (quote define) var834 exp835))))) (build-global-assignment87 (lambda (source837 var838 exp839 mod840) (analyze-variable85 mod840 var838 (lambda (mod841 var842 public?843) (let ((atom-key844 (fluid-ref *mode*71))) (if (memv atom-key844 (quote (c))) ((@ (language tree-il) make-module-set) source837 mod841 var842 public?843 exp839) (list (quote set!) (list (if public?843 (quote @) (quote @@)) mod841 var842) exp839)))) (lambda (var845) (let ((atom-key846 (fluid-ref *mode*71))) (if (memv atom-key846 (quote (c))) ((@ (language tree-il) make-toplevel-set) source837 var845 exp839) (list (quote set!) var845 exp839))))))) (build-global-reference86 (lambda (source847 var848 mod849) (analyze-variable85 mod849 var848 (lambda (mod850 var851 public?852) (let ((atom-key853 (fluid-ref *mode*71))) (if (memv atom-key853 (quote (c))) ((@ (language tree-il) make-module-ref) source847 mod850 var851 public?852) (list (if public?852 (quote @) (quote @@)) mod850 var851)))) (lambda (var854) (let ((atom-key855 (fluid-ref *mode*71))) (if (memv atom-key855 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source847 var854) var854)))))) (analyze-variable85 (lambda (mod856 var857 modref-cont858 bare-cont859) (if (not mod856) (bare-cont859 var857) (let ((kind860 (car mod856)) (mod861 (cdr mod856))) (if (memv kind860 (quote (public))) (modref-cont858 mod861 var857 #t) (if (memv kind860 (quote (private))) (if (not (equal? mod861 (module-name (current-module)))) (modref-cont858 mod861 var857 #f) (bare-cont859 var857)) (if (memv kind860 (quote (bare))) (bare-cont859 var857) (if (memv kind860 (quote (hygiene))) (if (if (not (equal? mod861 (module-name (current-module)))) (module-variable (resolve-module mod861) var857) #f) (modref-cont858 mod861 var857 #f) (bare-cont859 var857)) (syntax-violation #f "bad module kind" var857 mod861))))))))) (build-lexical-assignment84 (lambda (source862 name863 var864 exp865) (let ((atom-key866 (fluid-ref *mode*71))) (if (memv atom-key866 (quote (c))) ((@ (language tree-il) make-lexical-set) source862 name863 var864 exp865) (list (quote set!) var864 exp865))))) (build-lexical-reference83 (lambda (type867 source868 name869 var870) (let ((atom-key871 (fluid-ref *mode*71))) (if (memv atom-key871 (quote (c))) ((@ (language tree-il) make-lexical-ref) source868 name869 var870) var870)))) (build-conditional82 (lambda (source872 test-exp873 then-exp874 else-exp875) (let ((atom-key876 (fluid-ref *mode*71))) (if (memv atom-key876 (quote (c))) ((@ (language tree-il) make-conditional) source872 test-exp873 then-exp874 else-exp875) (if (equal? else-exp875 (quote (if #f #f))) (list (quote if) test-exp873 then-exp874) (list (quote if) test-exp873 then-exp874 else-exp875)))))) (build-application81 (lambda (source877 fun-exp878 arg-exps879) (let ((atom-key880 (fluid-ref *mode*71))) (if (memv atom-key880 (quote (c))) ((@ (language tree-il) make-application) source877 fun-exp878 arg-exps879) (cons fun-exp878 arg-exps879))))) (build-void80 (lambda (source881) (let ((atom-key882 (fluid-ref *mode*71))) (if (memv atom-key882 (quote (c))) ((@ (language tree-il) make-void) source881) (quote (if #f #f)))))) (get-global-definition-hook79 (lambda (symbol883 module884) (begin (if (if (not module884) (current-module) #f) (warn "module system is booted, we should have a module" symbol883)) (let ((v885 (module-variable (if module884 (resolve-module (cdr module884)) (current-module)) symbol883))) (if v885 (if (variable-bound? v885) (let ((val886 (variable-ref v885))) (if (macro? val886) (if (syncase-macro-type val886) (cons (syncase-macro-type val886) (syncase-macro-binding val886)) #f) #f)) #f) #f))))) (put-global-definition-hook78 (lambda (symbol887 type888 val889) (let ((existing890 (let ((v891 (module-variable (current-module) symbol887))) (if v891 (if (variable-bound? v891) (let ((val892 (variable-ref v891))) (if (macro? val892) (if (not (syncase-macro-type val892)) val892 #f) #f)) #f) #f)))) (module-define! (current-module) symbol887 (if existing890 (make-extended-syncase-macro existing890 type888 val889) (make-syncase-macro type888 val889)))))) (local-eval-hook77 (lambda (x893 mod894) (primitive-eval (list noexpand70 (let ((atom-key895 (fluid-ref *mode*71))) (if (memv atom-key895 (quote (c))) ((@ (language tree-il) tree-il->scheme) x893) x893)))))) (top-level-eval-hook76 (lambda (x896 mod897) (primitive-eval (list noexpand70 (let ((atom-key898 (fluid-ref *mode*71))) (if (memv atom-key898 (quote (c))) ((@ (language tree-il) tree-il->scheme) x896) x896)))))) (fx<75 <) (fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand")) (begin (global-extend111 (quote local-syntax) (quote letrec-syntax) #t) (global-extend111 (quote local-syntax) (quote let-syntax) #f) (global-extend111 (quote core) (quote fluid-let-syntax) (lambda (e899 r900 w901 s902 mod903) ((lambda (tmp904) ((lambda (tmp905) (if (if tmp905 (apply (lambda (_906 var907 val908 e1909 e2910) (valid-bound-ids?138 var907)) tmp905) #f) (apply (lambda (_912 var913 val914 e1915 e2916) (let ((names917 (map (lambda (x918) (id-var-name135 x918 w901)) var913))) (begin (for-each (lambda (id920 n921) (let ((atom-key922 (binding-type105 (lookup110 n921 r900 mod903)))) (if (memv atom-key922 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e899 (source-wrap142 id920 w901 s902 mod903))))) var913 names917) (chi-body153 (cons e1915 e2916) (source-wrap142 e899 w901 s902 mod903) (extend-env107 names917 (let ((trans-r925 (macros-only-env109 r900))) (map (lambda (x926) (cons (quote macro) (eval-local-transformer156 (chi149 x926 trans-r925 w901 mod903) mod903))) val914)) r900) w901 mod903)))) tmp905) ((lambda (_928) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap142 e899 w901 s902 mod903))) tmp904))) ($sc-dispatch tmp904 (quote (any #(each (any any)) any . each-any))))) e899))) (global-extend111 (quote core) (quote quote) (lambda (e929 r930 w931 s932 mod933) ((lambda (tmp934) ((lambda (tmp935) (if tmp935 (apply (lambda (_936 e937) (build-data91 s932 (strip160 e937 w931))) tmp935) ((lambda (_938) (syntax-violation (quote quote) "bad syntax" (source-wrap142 e929 w931 s932 mod933))) tmp934))) ($sc-dispatch tmp934 (quote (any any))))) e929))) (global-extend111 (quote core) (quote syntax) (letrec ((regen946 (lambda (x947) (let ((atom-key948 (car x947))) (if (memv atom-key948 (quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x947) (cadr x947)) (if (memv atom-key948 (quote (primitive))) (build-primref90 #f (cadr x947)) (if (memv atom-key948 (quote (quote))) (build-data91 #f (cadr x947)) (if (memv atom-key948 (quote (lambda))) (build-lambda89 #f (cadr x947) (cadr x947) #f (regen946 (caddr x947))) (if (memv atom-key948 (quote (map))) (let ((ls949 (map regen946 (cdr x947)))) (build-application81 #f (build-primref90 #f (quote map)) ls949)) (build-application81 #f (build-primref90 #f (car x947)) (map regen946 (cdr x947))))))))))) (gen-vector945 (lambda (x950) (if (eq? (car x950) (quote list)) (cons (quote vector) (cdr x950)) (if (eq? (car x950) (quote quote)) (list (quote quote) (list->vector (cadr x950))) (list (quote list->vector) x950))))) (gen-append944 (lambda (x951 y952) (if (equal? y952 (quote (quote ()))) x951 (list (quote append) x951 y952)))) (gen-cons943 (lambda (x953 y954) (let ((atom-key955 (car y954))) (if (memv atom-key955 (quote (quote))) (if (eq? (car x953) (quote quote)) (list (quote quote) (cons (cadr x953) (cadr y954))) (if (eq? (cadr y954) (quote ())) (list (quote list) x953) (list (quote cons) x953 y954))) (if (memv atom-key955 (quote (list))) (cons (quote list) (cons x953 (cdr y954))) (list (quote cons) x953 y954)))))) (gen-map942 (lambda (e956 map-env957) (let ((formals958 (map cdr map-env957)) (actuals959 (map (lambda (x960) (list (quote ref) (car x960))) map-env957))) (if (eq? (car e956) (quote ref)) (car actuals959) (if (and-map (lambda (x961) (if (eq? (car x961) (quote ref)) (memq (cadr x961) formals958) #f)) (cdr e956)) (cons (quote map) (cons (list (quote primitive) (car e956)) (map (let ((r962 (map cons formals958 actuals959))) (lambda (x963) (cdr (assq (cadr x963) r962)))) (cdr e956)))) (cons (quote map) (cons (list (quote lambda) formals958 e956) actuals959))))))) (gen-mappend941 (lambda (e964 map-env965) (list (quote apply) (quote (primitive append)) (gen-map942 e964 map-env965)))) (gen-ref940 (lambda (src966 var967 level968 maps969) (if (fx=74 level968 0) (values var967 maps969) (if (null? maps969) (syntax-violation (quote syntax) "missing ellipsis" src966) (call-with-values (lambda () (gen-ref940 src966 var967 (fx-73 level968 1) (cdr maps969))) (lambda (outer-var970 outer-maps971) (let ((b972 (assq outer-var970 (car maps969)))) (if b972 (values (cdr b972) maps969) (let ((inner-var973 (gen-var161 (quote tmp)))) (values inner-var973 (cons (cons (cons outer-var970 inner-var973) (car maps969)) outer-maps971))))))))))) (gen-syntax939 (lambda (src974 e975 r976 maps977 ellipsis?978 mod979) (if (id?113 e975) (let ((label980 (id-var-name135 e975 (quote (()))))) (let ((b981 (lookup110 label980 r976 mod979))) (if (eq? (binding-type105 b981) (quote syntax)) (call-with-values (lambda () (let ((var.lev982 (binding-value106 b981))) (gen-ref940 src974 (car var.lev982) (cdr var.lev982) maps977))) (lambda (var983 maps984) (values (list (quote ref) var983) maps984))) (if (ellipsis?978 e975) (syntax-violation (quote syntax) "misplaced ellipsis" src974) (values (list (quote quote) e975) maps977))))) ((lambda (tmp985) ((lambda (tmp986) (if (if tmp986 (apply (lambda (dots987 e988) (ellipsis?978 dots987)) tmp986) #f) (apply (lambda (dots989 e990) (gen-syntax939 src974 e990 r976 maps977 (lambda (x991) #f) mod979)) tmp986) ((lambda (tmp992) (if (if tmp992 (apply (lambda (x993 dots994 y995) (ellipsis?978 dots994)) tmp992) #f) (apply (lambda (x996 dots997 y998) (letrec ((f999 (lambda (y1000 k1001) ((lambda (tmp1005) ((lambda (tmp1006) (if (if tmp1006 (apply (lambda (dots1007 y1008) (ellipsis?978 dots1007)) tmp1006) #f) (apply (lambda (dots1009 y1010) (f999 y1010 (lambda (maps1011) (call-with-values (lambda () (k1001 (cons (quote ()) maps1011))) (lambda (x1012 maps1013) (if (null? (car maps1013)) (syntax-violation (quote syntax) "extra ellipsis" src974) (values (gen-mappend941 x1012 (car maps1013)) (cdr maps1013)))))))) tmp1006) ((lambda (_1014) (call-with-values (lambda () (gen-syntax939 src974 y1000 r976 maps977 ellipsis?978 mod979)) (lambda (y1015 maps1016) (call-with-values (lambda () (k1001 maps1016)) (lambda (x1017 maps1018) (values (gen-append944 x1017 y1015) maps1018)))))) tmp1005))) ($sc-dispatch tmp1005 (quote (any . any))))) y1000)))) (f999 y998 (lambda (maps1002) (call-with-values (lambda () (gen-syntax939 src974 x996 r976 (cons (quote ()) maps1002) ellipsis?978 mod979)) (lambda (x1003 maps1004) (if (null? (car maps1004)) (syntax-violation (quote syntax) "extra ellipsis" src974) (values (gen-map942 x1003 (car maps1004)) (cdr maps1004))))))))) tmp992) ((lambda (tmp1019) (if tmp1019 (apply (lambda (x1020 y1021) (call-with-values (lambda () (gen-syntax939 src974 x1020 r976 maps977 ellipsis?978 mod979)) (lambda (x1022 maps1023) (call-with-values (lambda () (gen-syntax939 src974 y1021 r976 maps1023 ellipsis?978 mod979)) (lambda (y1024 maps1025) (values (gen-cons943 x1022 y1024) maps1025)))))) tmp1019) ((lambda (tmp1026) (if tmp1026 (apply (lambda (e11027 e21028) (call-with-values (lambda () (gen-syntax939 src974 (cons e11027 e21028) r976 maps977 ellipsis?978 mod979)) (lambda (e1030 maps1031) (values (gen-vector945 e1030) maps1031)))) tmp1026) ((lambda (_1032) (values (list (quote quote) e975) maps977)) tmp985))) ($sc-dispatch tmp985 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp985 (quote (any . any)))))) ($sc-dispatch tmp985 (quote (any any . any)))))) ($sc-dispatch tmp985 (quote (any any))))) e975))))) (lambda (e1033 r1034 w1035 s1036 mod1037) (let ((e1038 (source-wrap142 e1033 w1035 s1036 mod1037))) ((lambda (tmp1039) ((lambda (tmp1040) (if tmp1040 (apply (lambda (_1041 x1042) (call-with-values (lambda () (gen-syntax939 e1038 x1042 r1034 (quote ()) ellipsis?158 mod1037)) (lambda (e1043 maps1044) (regen946 e1043)))) tmp1040) ((lambda (_1045) (syntax-violation (quote syntax) "bad `syntax' form" e1038)) tmp1039))) ($sc-dispatch tmp1039 (quote (any any))))) e1038))))) (global-extend111 (quote core) (quote lambda) (lambda (e1046 r1047 w1048 s1049 mod1050) ((lambda (tmp1051) ((lambda (tmp1052) (if tmp1052 (apply (lambda (_1053 c1054) (chi-lambda-clause154 (source-wrap142 e1046 w1048 s1049 mod1050) #f c1054 r1047 w1048 mod1050 (lambda (names1055 vars1056 docstring1057 body1058) (build-lambda89 s1049 names1055 vars1056 docstring1057 body1058)))) tmp1052) (syntax-violation #f "source expression failed to match any pattern" tmp1051))) ($sc-dispatch tmp1051 (quote (any . any))))) e1046))) (global-extend111 (quote core) (quote let) (letrec ((chi-let1059 (lambda (e1060 r1061 w1062 s1063 mod1064 constructor1065 ids1066 vals1067 exps1068) (if (not (valid-bound-ids?138 ids1066)) (syntax-violation (quote let) "duplicate bound variable" e1060) (let ((labels1069 (gen-labels119 ids1066)) (new-vars1070 (map gen-var161 ids1066))) (let ((nw1071 (make-binding-wrap130 ids1066 labels1069 w1062)) (nr1072 (extend-var-env108 labels1069 new-vars1070 r1061))) (constructor1065 s1063 (map syntax->datum ids1066) new-vars1070 (map (lambda (x1073) (chi149 x1073 r1061 w1062 mod1064)) vals1067) (chi-body153 exps1068 (source-wrap142 e1060 nw1071 s1063 mod1064) nr1072 nw1071 mod1064)))))))) (lambda (e1074 r1075 w1076 s1077 mod1078) ((lambda (tmp1079) ((lambda (tmp1080) (if tmp1080 (apply (lambda (_1081 id1082 val1083 e11084 e21085) (chi-let1059 e1074 r1075 w1076 s1077 mod1078 build-let93 id1082 val1083 (cons e11084 e21085))) tmp1080) ((lambda (tmp1089) (if (if tmp1089 (apply (lambda (_1090 f1091 id1092 val1093 e11094 e21095) (id?113 f1091)) tmp1089) #f) (apply (lambda (_1096 f1097 id1098 val1099 e11100 e21101) (chi-let1059 e1074 r1075 w1076 s1077 mod1078 build-named-let94 (cons f1097 id1098) val1099 (cons e11100 e21101))) tmp1089) ((lambda (_1105) (syntax-violation (quote let) "bad let" (source-wrap142 e1074 w1076 s1077 mod1078))) tmp1079))) ($sc-dispatch tmp1079 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1079 (quote (any #(each (any any)) any . each-any))))) e1074)))) (global-extend111 (quote core) (quote letrec) (lambda (e1106 r1107 w1108 s1109 mod1110) ((lambda (tmp1111) ((lambda (tmp1112) (if tmp1112 (apply (lambda (_1113 id1114 val1115 e11116 e21117) (let ((ids1118 id1114)) (if (not (valid-bound-ids?138 ids1118)) (syntax-violation (quote letrec) "duplicate bound variable" e1106) (let ((labels1120 (gen-labels119 ids1118)) (new-vars1121 (map gen-var161 ids1118))) (let ((w1122 (make-binding-wrap130 ids1118 labels1120 w1108)) (r1123 (extend-var-env108 labels1120 new-vars1121 r1107))) (build-letrec95 s1109 (map syntax->datum ids1118) new-vars1121 (map (lambda (x1124) (chi149 x1124 r1123 w1122 mod1110)) val1115) (chi-body153 (cons e11116 e21117) (source-wrap142 e1106 w1122 s1109 mod1110) r1123 w1122 mod1110))))))) tmp1112) ((lambda (_1127) (syntax-violation (quote letrec) "bad letrec" (source-wrap142 e1106 w1108 s1109 mod1110))) tmp1111))) ($sc-dispatch tmp1111 (quote (any #(each (any any)) any . each-any))))) e1106))) (global-extend111 (quote core) (quote set!) (lambda (e1128 r1129 w1130 s1131 mod1132) ((lambda (tmp1133) ((lambda (tmp1134) (if (if tmp1134 (apply (lambda (_1135 id1136 val1137) (id?113 id1136)) tmp1134) #f) (apply (lambda (_1138 id1139 val1140) (let ((val1141 (chi149 val1140 r1129 w1130 mod1132)) (n1142 (id-var-name135 id1139 w1130))) (let ((b1143 (lookup110 n1142 r1129 mod1132))) (let ((atom-key1144 (binding-type105 b1143))) (if (memv atom-key1144 (quote (lexical))) (build-lexical-assignment84 s1131 (syntax->datum id1139) (binding-value106 b1143) val1141) (if (memv atom-key1144 (quote (global))) (build-global-assignment87 s1131 n1142 val1141 mod1132) (if (memv atom-key1144 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap141 id1139 w1130 mod1132)) (syntax-violation (quote set!) "bad set!" (source-wrap142 e1128 w1130 s1131 mod1132))))))))) tmp1134) ((lambda (tmp1145) (if tmp1145 (apply (lambda (_1146 head1147 tail1148 val1149) (call-with-values (lambda () (syntax-type147 head1147 r1129 (quote (())) #f #f mod1132)) (lambda (type1150 value1151 ee1152 ww1153 ss1154 modmod1155) (if (memv type1150 (quote (module-ref))) (let ((val1156 (chi149 val1149 r1129 w1130 mod1132))) (call-with-values (lambda () (value1151 (cons head1147 tail1148))) (lambda (id1158 mod1159) (build-global-assignment87 s1131 id1158 val1156 mod1159)))) (build-application81 s1131 (chi149 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1147) r1129 w1130 mod1132) (map (lambda (e1160) (chi149 e1160 r1129 w1130 mod1132)) (append tail1148 (list val1149)))))))) tmp1145) ((lambda (_1162) (syntax-violation (quote set!) "bad set!" (source-wrap142 e1128 w1130 s1131 mod1132))) tmp1133))) ($sc-dispatch tmp1133 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1133 (quote (any any any))))) e1128))) (global-extend111 (quote module-ref) (quote @) (lambda (e1163) ((lambda (tmp1164) ((lambda (tmp1165) (if (if tmp1165 (apply (lambda (_1166 mod1167 id1168) (if (and-map id?113 mod1167) (id?113 id1168) #f)) tmp1165) #f) (apply (lambda (_1170 mod1171 id1172) (values (syntax->datum id1172) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1171)))) tmp1165) (syntax-violation #f "source expression failed to match any pattern" tmp1164))) ($sc-dispatch tmp1164 (quote (any each-any any))))) e1163))) (global-extend111 (quote module-ref) (quote @@) (lambda (e1174) ((lambda (tmp1175) ((lambda (tmp1176) (if (if tmp1176 (apply (lambda (_1177 mod1178 id1179) (if (and-map id?113 mod1178) (id?113 id1179) #f)) tmp1176) #f) (apply (lambda (_1181 mod1182 id1183) (values (syntax->datum id1183) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1182)))) tmp1176) (syntax-violation #f "source expression failed to match any pattern" tmp1175))) ($sc-dispatch tmp1175 (quote (any each-any any))))) e1174))) (global-extend111 (quote core) (quote if) (lambda (e1185 r1186 w1187 s1188 mod1189) ((lambda (tmp1190) ((lambda (tmp1191) (if tmp1191 (apply (lambda (_1192 test1193 then1194) (build-conditional82 s1188 (chi149 test1193 r1186 w1187 mod1189) (chi149 then1194 r1186 w1187 mod1189) (build-void80 #f))) tmp1191) ((lambda (tmp1195) (if tmp1195 (apply (lambda (_1196 test1197 then1198 else1199) (build-conditional82 s1188 (chi149 test1197 r1186 w1187 mod1189) (chi149 then1198 r1186 w1187 mod1189) (chi149 else1199 r1186 w1187 mod1189))) tmp1195) (syntax-violation #f "source expression failed to match any pattern" tmp1190))) ($sc-dispatch tmp1190 (quote (any any any any)))))) ($sc-dispatch tmp1190 (quote (any any any))))) e1185))) (global-extend111 (quote begin) (quote begin) (quote ())) (global-extend111 (quote define) (quote define) (quote ())) (global-extend111 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend111 (quote eval-when) (quote eval-when) (quote ())) (global-extend111 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1203 (lambda (x1204 keys1205 clauses1206 r1207 mod1208) (if (null? clauses1206) (build-application81 #f (build-primref90 #f (quote syntax-violation)) (list (build-data91 #f #f) (build-data91 #f "source expression failed to match any pattern") x1204)) ((lambda (tmp1209) ((lambda (tmp1210) (if tmp1210 (apply (lambda (pat1211 exp1212) (if (if (id?113 pat1211) (and-map (lambda (x1213) (not (free-id=?136 pat1211 x1213))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1205)) #f) (let ((labels1214 (list (gen-label118))) (var1215 (gen-var161 pat1211))) (build-application81 #f (build-lambda89 #f (list (syntax->datum pat1211)) (list var1215) #f (chi149 exp1212 (extend-env107 labels1214 (list (cons (quote syntax) (cons var1215 0))) r1207) (make-binding-wrap130 (list pat1211) labels1214 (quote (()))) mod1208)) (list x1204))) (gen-clause1202 x1204 keys1205 (cdr clauses1206) r1207 pat1211 #t exp1212 mod1208))) tmp1210) ((lambda (tmp1216) (if tmp1216 (apply (lambda (pat1217 fender1218 exp1219) (gen-clause1202 x1204 keys1205 (cdr clauses1206) r1207 pat1217 fender1218 exp1219 mod1208)) tmp1216) ((lambda (_1220) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1206))) tmp1209))) ($sc-dispatch tmp1209 (quote (any any any)))))) ($sc-dispatch tmp1209 (quote (any any))))) (car clauses1206))))) (gen-clause1202 (lambda (x1221 keys1222 clauses1223 r1224 pat1225 fender1226 exp1227 mod1228) (call-with-values (lambda () (convert-pattern1200 pat1225 keys1222)) (lambda (p1229 pvars1230) (if (not (distinct-bound-ids?139 (map car pvars1230))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1225) (if (not (and-map (lambda (x1231) (not (ellipsis?158 (car x1231)))) pvars1230)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1225) (let ((y1232 (gen-var161 (quote tmp)))) (build-application81 #f (build-lambda89 #f (list (quote tmp)) (list y1232) #f (let ((y1233 (build-lexical-reference83 (quote value) #f (quote tmp) y1232))) (build-conditional82 #f ((lambda (tmp1234) ((lambda (tmp1235) (if tmp1235 (apply (lambda () y1233) tmp1235) ((lambda (_1236) (build-conditional82 #f y1233 (build-dispatch-call1201 pvars1230 fender1226 y1233 r1224 mod1228) (build-data91 #f #f))) tmp1234))) ($sc-dispatch tmp1234 (quote #(atom #t))))) fender1226) (build-dispatch-call1201 pvars1230 exp1227 y1233 r1224 mod1228) (gen-syntax-case1203 x1221 keys1222 clauses1223 r1224 mod1228)))) (list (if (eq? p1229 (quote any)) (build-application81 #f (build-primref90 #f (quote list)) (list x1221)) (build-application81 #f (build-primref90 #f (quote $sc-dispatch)) (list x1221 (build-data91 #f p1229))))))))))))) (build-dispatch-call1201 (lambda (pvars1237 exp1238 y1239 r1240 mod1241) (let ((ids1242 (map car pvars1237)) (levels1243 (map cdr pvars1237))) (let ((labels1244 (gen-labels119 ids1242)) (new-vars1245 (map gen-var161 ids1242))) (build-application81 #f (build-primref90 #f (quote apply)) (list (build-lambda89 #f (map syntax->datum ids1242) new-vars1245 #f (chi149 exp1238 (extend-env107 labels1244 (map (lambda (var1246 level1247) (cons (quote syntax) (cons var1246 level1247))) new-vars1245 (map cdr pvars1237)) r1240) (make-binding-wrap130 ids1242 labels1244 (quote (()))) mod1241)) y1239)))))) (convert-pattern1200 (lambda (pattern1248 keys1249) (letrec ((cvt1250 (lambda (p1251 n1252 ids1253) (if (id?113 p1251) (if (bound-id-member?140 p1251 keys1249) (values (vector (quote free-id) p1251) ids1253) (values (quote any) (cons (cons p1251 n1252) ids1253))) ((lambda (tmp1254) ((lambda (tmp1255) (if (if tmp1255 (apply (lambda (x1256 dots1257) (ellipsis?158 dots1257)) tmp1255) #f) (apply (lambda (x1258 dots1259) (call-with-values (lambda () (cvt1250 x1258 (fx+72 n1252 1) ids1253)) (lambda (p1260 ids1261) (values (if (eq? p1260 (quote any)) (quote each-any) (vector (quote each) p1260)) ids1261)))) tmp1255) ((lambda (tmp1262) (if tmp1262 (apply (lambda (x1263 y1264) (call-with-values (lambda () (cvt1250 y1264 n1252 ids1253)) (lambda (y1265 ids1266) (call-with-values (lambda () (cvt1250 x1263 n1252 ids1266)) (lambda (x1267 ids1268) (values (cons x1267 y1265) ids1268)))))) tmp1262) ((lambda (tmp1269) (if tmp1269 (apply (lambda () (values (quote ()) ids1253)) tmp1269) ((lambda (tmp1270) (if tmp1270 (apply (lambda (x1271) (call-with-values (lambda () (cvt1250 x1271 n1252 ids1253)) (lambda (p1273 ids1274) (values (vector (quote vector) p1273) ids1274)))) tmp1270) ((lambda (x1275) (values (vector (quote atom) (strip160 p1251 (quote (())))) ids1253)) tmp1254))) ($sc-dispatch tmp1254 (quote #(vector each-any)))))) ($sc-dispatch tmp1254 (quote ()))))) ($sc-dispatch tmp1254 (quote (any . any)))))) ($sc-dispatch tmp1254 (quote (any any))))) p1251))))) (cvt1250 pattern1248 0 (quote ())))))) (lambda (e1276 r1277 w1278 s1279 mod1280) (let ((e1281 (source-wrap142 e1276 w1278 s1279 mod1280))) ((lambda (tmp1282) ((lambda (tmp1283) (if tmp1283 (apply (lambda (_1284 val1285 key1286 m1287) (if (and-map (lambda (x1288) (if (id?113 x1288) (not (ellipsis?158 x1288)) #f)) key1286) (let ((x1290 (gen-var161 (quote tmp)))) (build-application81 s1279 (build-lambda89 #f (list (quote tmp)) (list x1290) #f (gen-syntax-case1203 (build-lexical-reference83 (quote value) #f (quote tmp) x1290) key1286 m1287 r1277 mod1280)) (list (chi149 val1285 r1277 (quote (())) mod1280)))) (syntax-violation (quote syntax-case) "invalid literals list" e1281))) tmp1283) (syntax-violation #f "source expression failed to match any pattern" tmp1282))) ($sc-dispatch tmp1282 (quote (any any each-any . each-any))))) e1281))))) (set! sc-expand (lambda (x1294 . rest1293) (if (if (pair? x1294) (equal? (car x1294) noexpand70) #f) (cadr x1294) (let ((m1295 (if (null? rest1293) (quote e) (car rest1293))) (esew1296 (if (let ((t1297 (null? rest1293))) (if t1297 t1297 (null? (cdr rest1293)))) (quote (eval)) (cadr rest1293)))) (with-fluid* *mode*71 m1295 (lambda () (chi-top148 x1294 (quote ()) (quote ((top))) m1295 esew1296 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1298) (nonsymbol-id?112 x1298))) (set! datum->syntax (lambda (id1299 datum1300) (make-syntax-object96 datum1300 (syntax-object-wrap99 id1299) #f))) (set! syntax->datum (lambda (x1301) (strip160 x1301 (quote (()))))) (set! generate-temporaries (lambda (ls1302) (begin (let ((x1303 ls1302)) (if (not (list? x1303)) (syntax-violation (quote generate-temporaries) "invalid argument" x1303))) (map (lambda (x1304) (wrap141 (gensym) (quote ((top))) #f)) ls1302)))) (set! free-identifier=? (lambda (x1305 y1306) (begin (let ((x1307 x1305)) (if (not (nonsymbol-id?112 x1307)) (syntax-violation (quote free-identifier=?) "invalid argument" x1307))) (let ((x1308 y1306)) (if (not (nonsymbol-id?112 x1308)) (syntax-violation (quote free-identifier=?) "invalid argument" x1308))) (free-id=?136 x1305 y1306)))) (set! bound-identifier=? (lambda (x1309 y1310) (begin (let ((x1311 x1309)) (if (not (nonsymbol-id?112 x1311)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1311))) (let ((x1312 y1310)) (if (not (nonsymbol-id?112 x1312)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1312))) (bound-id=?137 x1309 y1310)))) (set! syntax-violation (lambda (who1316 message1315 form1314 . subform1313) (begin (let ((x1317 who1316)) (if (not ((lambda (x1318) (let ((t1319 (not x1318))) (if t1319 t1319 (let ((t1320 (string? x1318))) (if t1320 t1320 (symbol? x1318)))))) x1317)) (syntax-violation (quote syntax-violation) "invalid argument" x1317))) (let ((x1321 message1315)) (if (not (string? x1321)) (syntax-violation (quote syntax-violation) "invalid argument" x1321))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1316 "~a: " "") "~a " (if (null? subform1313) "in ~a" "in subform `~s' of `~s'")) (let ((tail1322 (cons message1315 (map (lambda (x1323) (strip160 x1323 (quote (())))) (append subform1313 (list form1314)))))) (if who1316 (cons who1316 tail1322) tail1322)) #f)))) (letrec ((match1328 (lambda (e1329 p1330 w1331 r1332 mod1333) (if (not r1332) #f (if (eq? p1330 (quote any)) (cons (wrap141 e1329 w1331 mod1333) r1332) (if (syntax-object?97 e1329) (match*1327 (let ((e1334 (syntax-object-expression98 e1329))) (if (annotation? e1334) (annotation-expression e1334) e1334)) p1330 (join-wraps132 w1331 (syntax-object-wrap99 e1329)) r1332 (syntax-object-module100 e1329)) (match*1327 (let ((e1335 e1329)) (if (annotation? e1335) (annotation-expression e1335) e1335)) p1330 w1331 r1332 mod1333)))))) (match*1327 (lambda (e1336 p1337 w1338 r1339 mod1340) (if (null? p1337) (if (null? e1336) r1339 #f) (if (pair? p1337) (if (pair? e1336) (match1328 (car e1336) (car p1337) w1338 (match1328 (cdr e1336) (cdr p1337) w1338 r1339 mod1340) mod1340) #f) (if (eq? p1337 (quote each-any)) (let ((l1341 (match-each-any1325 e1336 w1338 mod1340))) (if l1341 (cons l1341 r1339) #f)) (let ((atom-key1342 (vector-ref p1337 0))) (if (memv atom-key1342 (quote (each))) (if (null? e1336) (match-empty1326 (vector-ref p1337 1) r1339) (let ((l1343 (match-each1324 e1336 (vector-ref p1337 1) w1338 mod1340))) (if l1343 (letrec ((collect1344 (lambda (l1345) (if (null? (car l1345)) r1339 (cons (map car l1345) (collect1344 (map cdr l1345))))))) (collect1344 l1343)) #f))) (if (memv atom-key1342 (quote (free-id))) (if (id?113 e1336) (if (free-id=?136 (wrap141 e1336 w1338 mod1340) (vector-ref p1337 1)) r1339 #f) #f) (if (memv atom-key1342 (quote (atom))) (if (equal? (vector-ref p1337 1) (strip160 e1336 w1338)) r1339 #f) (if (memv atom-key1342 (quote (vector))) (if (vector? e1336) (match1328 (vector->list e1336) (vector-ref p1337 1) w1338 r1339 mod1340) #f))))))))))) (match-empty1326 (lambda (p1346 r1347) (if (null? p1346) r1347 (if (eq? p1346 (quote any)) (cons (quote ()) r1347) (if (pair? p1346) (match-empty1326 (car p1346) (match-empty1326 (cdr p1346) r1347)) (if (eq? p1346 (quote each-any)) (cons (quote ()) r1347) (let ((atom-key1348 (vector-ref p1346 0))) (if (memv atom-key1348 (quote (each))) (match-empty1326 (vector-ref p1346 1) r1347) (if (memv atom-key1348 (quote (free-id atom))) r1347 (if (memv atom-key1348 (quote (vector))) (match-empty1326 (vector-ref p1346 1) r1347))))))))))) (match-each-any1325 (lambda (e1349 w1350 mod1351) (if (annotation? e1349) (match-each-any1325 (annotation-expression e1349) w1350 mod1351) (if (pair? e1349) (let ((l1352 (match-each-any1325 (cdr e1349) w1350 mod1351))) (if l1352 (cons (wrap141 (car e1349) w1350 mod1351) l1352) #f)) (if (null? e1349) (quote ()) (if (syntax-object?97 e1349) (match-each-any1325 (syntax-object-expression98 e1349) (join-wraps132 w1350 (syntax-object-wrap99 e1349)) mod1351) #f)))))) (match-each1324 (lambda (e1353 p1354 w1355 mod1356) (if (annotation? e1353) (match-each1324 (annotation-expression e1353) p1354 w1355 mod1356) (if (pair? e1353) (let ((first1357 (match1328 (car e1353) p1354 w1355 (quote ()) mod1356))) (if first1357 (let ((rest1358 (match-each1324 (cdr e1353) p1354 w1355 mod1356))) (if rest1358 (cons first1357 rest1358) #f)) #f)) (if (null? e1353) (quote ()) (if (syntax-object?97 e1353) (match-each1324 (syntax-object-expression98 e1353) p1354 (join-wraps132 w1355 (syntax-object-wrap99 e1353)) (syntax-object-module100 e1353)) #f))))))) (set! $sc-dispatch (lambda (e1359 p1360) (if (eq? p1360 (quote any)) (list e1359) (if (syntax-object?97 e1359) (match*1327 (let ((e1361 (syntax-object-expression98 e1359))) (if (annotation? e1361) (annotation-expression e1361) e1361)) p1360 (syntax-object-wrap99 e1359) (quote ()) (syntax-object-module100 e1359)) (match*1327 (let ((e1362 e1359)) (if (annotation? e1362) (annotation-expression e1362) e1362)) p1360 (quote (())) (quote ()) #f)))))))))
 (define with-syntax (make-syncase-macro (quote macro) (lambda (x1363) ((lambda (tmp1364) ((lambda (tmp1365) (if tmp1365 (apply (lambda (_1366 e11367 e21368) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11367 e21368))) tmp1365) ((lambda (tmp1370) (if tmp1370 (apply (lambda (_1371 out1372 in1373 e11374 e21375) (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))) in1373 (quote ()) (list out1372 (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 e11374 e21375))))) tmp1370) ((lambda (tmp1377) (if tmp1377 (apply (lambda (_1378 out1379 in1380 e11381 e21382) (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))) in1380) (quote ()) (list out1379 (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 e11381 e21382))))) tmp1377) (syntax-violation #f "source expression failed to match any pattern" tmp1364))) ($sc-dispatch tmp1364 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1364 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1364 (quote (any () any . each-any))))) x1363))))
 (define syntax-rules (make-syncase-macro (quote macro) (lambda (x1386) ((lambda (tmp1387) ((lambda (tmp1388) (if tmp1388 (apply (lambda (_1389 k1390 keyword1391 pattern1392 template1393) (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 k1390 (map (lambda (tmp1396 tmp1395) (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))) tmp1395) (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))) tmp1396))) template1393 pattern1392)))))) tmp1388) (syntax-violation #f "source expression failed to match any pattern" tmp1387))) ($sc-dispatch tmp1387 (quote (any each-any . #(each ((any . any) any))))))) x1386))))
 (define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1397) ((lambda (tmp1398) ((lambda (tmp1399) (if (if tmp1399 (apply (lambda (let*1400 x1401 v1402 e11403 e21404) (and-map identifier? x1401)) tmp1399) #f) (apply (lambda (let*1406 x1407 v1408 e11409 e21410) (letrec ((f1411 (lambda (bindings1412) (if (null? bindings1412) (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 e11409 e21410))) ((lambda (tmp1416) ((lambda (tmp1417) (if tmp1417 (apply (lambda (body1418 binding1419) (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 binding1419) body1418)) tmp1417) (syntax-violation #f "source expression failed to match any pattern" tmp1416))) ($sc-dispatch tmp1416 (quote (any any))))) (list (f1411 (cdr bindings1412)) (car bindings1412))))))) (f1411 (map list x1407 v1408)))) tmp1399) (syntax-violation #f "source expression failed to match any pattern" tmp1398))) ($sc-dispatch tmp1398 (quote (any #(each (any any)) any . each-any))))) x1397))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 0ce74a790..bbae73b3c 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -368,7 +368,9 @@
     (case (fluid-ref *mode*)
       ((c) ((@ (language tree-il) make-conditional)
             source test-exp then-exp else-exp))
-      (else `(if ,test-exp ,then-exp ,else-exp)))))
+      (else (if (equal? else-exp '(if #f #f))
+                `(if ,test-exp ,then-exp)
+                `(if ,test-exp ,then-exp ,else-exp))))))
 
 (define build-lexical-reference
   (lambda (type source name var)
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index a89d8cfd6..a81947749 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -215,7 +215,9 @@
             `(,(tree-il->scheme proc) ,@(map tree-il->scheme args)))
 
            ((<conditional> test then else)
-            `(if ,(tree-il->scheme test) ,(tree-il->scheme then) ,(tree-il->scheme else)))
+            (if (void? else)
+                `(if ,(tree-il->scheme test) ,(tree-il->scheme then))
+                `(if ,(tree-il->scheme test) ,(tree-il->scheme then) ,(tree-il->scheme else))))
 
            ((<primitive-ref> name)
             name)
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 9176a3c4e..69c8fbf46 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -22,7 +22,7 @@
 
 
 (define exception:generic-syncase-error
-  (cons 'syntax-error "Source expression failed to match"))
+  (cons 'syntax-error "source expression failed to match"))
 (define exception:unexpected-syntax
   (cons 'syntax-error "unexpected syntax"))
 
@@ -111,8 +111,9 @@
   (with-test-prefix "unquote-splicing"
 
     (pass-if-exception "extra arguments"
-      exception:missing/extra-expr
-      (quasiquote ((unquote-splicing (list 1 2) (list 3 4)))))))
+      '(syntax-error . "unquote-splicing takes exactly one argument")
+      (eval '(quasiquote ((unquote-splicing (list 1 2) (list 3 4))))
+            (interaction-environment)))))
 
 (with-test-prefix "begin"
 
@@ -121,17 +122,21 @@
 
   (with-test-prefix "unmemoization"
 
+    ;; FIXME. I have no idea why, but the expander is filling in (if #f
+    ;; #f) as the second arm of the if, if the second arm is missing. I
+    ;; thought I made it not do that. But in the meantime, let's adapt,
+    ;; since that's not what we're testing.
+
     (pass-if "normal begin"
-      (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (+ 2))))))
-        (foo) ; make sure, memoization has been performed
+      (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (+ 2)) #f))))
         (equal? (procedure-source foo)
-                '(lambda () (if (= 1 1) (begin (+ 1) (+ 2)))))))
+                '(lambda () (if (= 1 1) (begin (+ 1) (+ 2)) #f)))))
 
     (pass-if "redundant nested begin"
-      (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3)))))))
+      (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3))) #f))))
         (foo) ; make sure, memoization has been performed
         (equal? (procedure-source foo)
-                '(lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3))))))))
+                '(lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3))) #f)))))
 
     (pass-if "redundant begin at start of body"
       (let ((foo (lambda () (begin (+ 1) (+ 2))))) ; should be optimized
@@ -139,25 +144,34 @@
         (equal? (procedure-source foo)
                 '(lambda () (begin (+ 1) (+ 2)))))))
 
-  (expect-fail-exception "illegal (begin)"
-    exception:bad-body
+  (pass-if-exception "illegal (begin)"
+    exception:generic-syncase-error
     (eval '(begin (if #t (begin)) #t) (interaction-environment))))
 
+(define-syntax matches?
+  (syntax-rules (_)
+    ((_ (op arg ...) pat)   (let ((x (op arg ...)))
+                              (matches? x pat)))
+    ((_ x ())               (null? x))
+    ((_ x (a . b))          (and (pair? x)
+                                 (matches? (car x) a)
+                                 (matches? (cdr x) b)))
+    ((_ x _)                #t) 
+    ((_ x pat)              (equal? x 'pat))))
+
 (with-test-prefix "lambda"
 
   (with-test-prefix "unmemoization"
 
     (pass-if "normal lambda"
       (let ((foo (lambda () (lambda (x y) (+ x y)))))
-        ((foo) 1 2) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (lambda (x y) (+ x y))))))
+        (matches? (procedure-source foo)
+                  (lambda () (lambda (_ _) (+ _ _))))))
 
     (pass-if "lambda with documentation"
       (let ((foo (lambda () (lambda (x y) "docstring" (+ x y)))))
-        ((foo) 1 2) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (lambda (x y) "docstring" (+ x y)))))))
+        (matches? (procedure-source foo)
+                  (lambda () (lambda (_ _) "docstring" (+ _ _)))))))
 
   (with-test-prefix "bad formals"