summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-05-22 21:12:42 +0200
committerAndy Wingo <wingo@pobox.com>2009-05-22 21:12:42 +0200
commit0e7b72a8fefc27d67623b11659372b7ac37b7a58 (patch)
treef356fe01ab1c31b1c0ec9ed18fe531a6c34d109b
parentb40d023067b54f1085f194c521c2d046fceb9444 (diff)
downloadguile-0e7b72a8fefc27d67623b11659372b7ac37b7a58.tar.gz
source location tracking in psyntax, booya!
* module/ice-9/psyntax.scm (source-annotation): Return #f if source-properties returns null. (source-wrap): Rework a bit. (syntax-type): Don't throw away source info for wrapped expressions. Can has source location info, fools! (chi-body): Correctly propagate source info for body subforms. (syntax): Remove special case for map, it doesn't apply (ahem) for Guile. * module/ice-9/psyntax-pp.scm: Regenerate.
-rw-r--r--module/ice-9/psyntax-pp.scm22
-rw-r--r--module/ice-9/psyntax.scm28
2 files changed, 20 insertions, 30 deletions
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index b1646fe9d..f33f49286 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,13 +1,13 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
-(letrec ((and-map*17 (lambda (f57 first56 . rest55) (let ((t58 (null? first56))) (if t58 t58 (if (null? rest55) (letrec ((andmap59 (lambda (first60) (let ((x61 (car first60)) (first62 (cdr first60))) (if (null? first62) (f57 x61) (if (f57 x61) (andmap59 first62) #f)))))) (andmap59 first56)) (letrec ((andmap63 (lambda (first64 rest65) (let ((x66 (car first64)) (xr67 (map car rest65)) (first68 (cdr first64)) (rest69 (map cdr rest65))) (if (null? first68) (apply f57 (cons x66 xr67)) (if (apply f57 (cons x66 xr67)) (andmap63 first68 rest69) #f)))))) (andmap63 first56 rest55)))))))) (letrec ((lambda-var-list162 (lambda (vars286) (letrec ((lvl287 (lambda (vars288 ls289 w290) (if (pair? vars288) (lvl287 (cdr vars288) (cons (wrap142 (car vars288) w290 #f) ls289) w290) (if (id?114 vars288) (cons (wrap142 vars288 w290 #f) ls289) (if (null? vars288) ls289 (if (syntax-object?98 vars288) (lvl287 (syntax-object-expression99 vars288) ls289 (join-wraps133 w290 (syntax-object-wrap100 vars288))) (cons vars288 ls289)))))))) (lvl287 vars286 (quote ()) (quote (())))))) (gen-var161 (lambda (id291) (let ((id292 (if (syntax-object?98 id291) (syntax-object-expression99 id291) id291))) (gensym (symbol->string id292))))) (strip160 (lambda (x293 w294) (if (memq (quote top) (wrap-marks117 w294)) x293 (letrec ((f295 (lambda (x296) (if (syntax-object?98 x296) (strip160 (syntax-object-expression99 x296) (syntax-object-wrap100 x296)) (if (pair? x296) (let ((a297 (f295 (car x296))) (d298 (f295 (cdr x296)))) (if (if (eq? a297 (car x296)) (eq? d298 (cdr x296)) #f) x296 (cons a297 d298))) (if (vector? x296) (let ((old299 (vector->list x296))) (let ((new300 (map f295 old299))) (if (and-map*17 eq? old299 new300) x296 (list->vector new300)))) x296)))))) (f295 x293))))) (ellipsis?159 (lambda (x301) (if (nonsymbol-id?113 x301) (free-id=?137 x301 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void158 (lambda () (build-void80 #f))) (eval-local-transformer157 (lambda (expanded302 mod303) (let ((p304 (local-eval-hook77 expanded302 mod303))) (if (procedure? p304) p304 (syntax-violation #f "nonprocedure transformer" p304))))) (chi-local-syntax156 (lambda (rec?305 e306 r307 w308 s309 mod310 k311) ((lambda (tmp312) ((lambda (tmp313) (if tmp313 (apply (lambda (_314 id315 val316 e1317 e2318) (let ((ids319 id315)) (if (not (valid-bound-ids?139 ids319)) (syntax-violation #f "duplicate bound keyword" e306) (let ((labels321 (gen-labels120 ids319))) (let ((new-w322 (make-binding-wrap131 ids319 labels321 w308))) (k311 (cons e1317 e2318) (extend-env108 labels321 (let ((w324 (if rec?305 new-w322 w308)) (trans-r325 (macros-only-env110 r307))) (map (lambda (x326) (cons (quote macro) (eval-local-transformer157 (chi150 x326 trans-r325 w324 mod310) mod310))) val316)) r307) new-w322 s309 mod310)))))) tmp313) ((lambda (_328) (syntax-violation #f "bad local syntax definition" (source-wrap143 e306 w308 s309 mod310))) tmp312))) ($sc-dispatch tmp312 (quote (any #(each (any any)) any . each-any))))) e306))) (chi-lambda-clause155 (lambda (e329 docstring330 c331 r332 w333 mod334 k335) ((lambda (tmp336) ((lambda (tmp337) (if (if tmp337 (apply (lambda (args338 doc339 e1340 e2341) (if (string? (syntax->datum doc339)) (not docstring330) #f)) tmp337) #f) (apply (lambda (args342 doc343 e1344 e2345) (chi-lambda-clause155 e329 doc343 (cons args342 (cons e1344 e2345)) r332 w333 mod334 k335)) tmp337) ((lambda (tmp347) (if tmp347 (apply (lambda (id348 e1349 e2350) (let ((ids351 id348)) (if (not (valid-bound-ids?139 ids351)) (syntax-violation (quote lambda) "invalid parameter list" e329) (let ((labels353 (gen-labels120 ids351)) (new-vars354 (map gen-var161 ids351))) (k335 (map syntax->datum ids351) new-vars354 (if docstring330 (syntax->datum docstring330) #f) (chi-body154 (cons e1349 e2350) e329 (extend-var-env109 labels353 new-vars354 r332) (make-binding-wrap131 ids351 labels353 w333) mod334)))))) tmp347) ((lambda (tmp356) (if tmp356 (apply (lambda (ids357 e1358 e2359) (let ((old-ids360 (lambda-var-list162 ids357))) (if (not (valid-bound-ids?139 old-ids360)) (syntax-violation (quote lambda) "invalid parameter list" e329) (let ((labels361 (gen-labels120 old-ids360)) (new-vars362 (map gen-var161 old-ids360))) (k335 (letrec ((f363 (lambda (ls1364 ls2365) (if (null? ls1364) (syntax->datum ls2365) (f363 (cdr ls1364) (cons (syntax->datum (car ls1364)) ls2365)))))) (f363 (cdr old-ids360) (car old-ids360))) (letrec ((f366 (lambda (ls1367 ls2368) (if (null? ls1367) ls2368 (f366 (cdr ls1367) (cons (car ls1367) ls2368)))))) (f366 (cdr new-vars362) (car new-vars362))) (if docstring330 (syntax->datum docstring330) #f) (chi-body154 (cons e1358 e2359) e329 (extend-var-env109 labels361 new-vars362 r332) (make-binding-wrap131 old-ids360 labels361 w333) mod334)))))) tmp356) ((lambda (_370) (syntax-violation (quote lambda) "bad lambda" e329)) tmp336))) ($sc-dispatch tmp336 (quote (any any . each-any)))))) ($sc-dispatch tmp336 (quote (each-any any . each-any)))))) ($sc-dispatch tmp336 (quote (any any any . each-any))))) c331))) (chi-body154 (lambda (body371 outer-form372 r373 w374 mod375) (let ((r376 (cons (quote ("placeholder" placeholder)) r373))) (let ((ribcage377 (make-ribcage121 (quote ()) (quote ()) (quote ())))) (let ((w378 (make-wrap116 (wrap-marks117 w374) (cons ribcage377 (wrap-subst118 w374))))) (letrec ((parse379 (lambda (body380 ids381 labels382 var-ids383 vars384 vals385 bindings386) (if (null? body380) (syntax-violation #f "no expressions in body" outer-form372) (let ((e388 (cdar body380)) (er389 (caar body380))) (call-with-values (lambda () (syntax-type148 e388 er389 (quote (())) (source-annotation105 e388) ribcage377 mod375)) (lambda (type390 value391 e392 w393 s394 mod395) (if (memv type390 (quote (define-form))) (let ((id396 (wrap142 value391 w393 mod395)) (label397 (gen-label119))) (let ((var398 (gen-var161 id396))) (begin (extend-ribcage!130 ribcage377 id396 label397) (parse379 (cdr body380) (cons id396 ids381) (cons label397 labels382) (cons id396 var-ids383) (cons var398 vars384) (cons (cons er389 (wrap142 e392 w393 mod395)) vals385) (cons (cons (quote lexical) var398) bindings386))))) (if (memv type390 (quote (define-syntax-form))) (let ((id399 (wrap142 value391 w393 mod395)) (label400 (gen-label119))) (begin (extend-ribcage!130 ribcage377 id399 label400) (parse379 (cdr body380) (cons id399 ids381) (cons label400 labels382) var-ids383 vars384 vals385 (cons (cons (quote macro) (cons er389 (wrap142 e392 w393 mod395))) bindings386)))) (if (memv type390 (quote (begin-form))) ((lambda (tmp401) ((lambda (tmp402) (if tmp402 (apply (lambda (_403 e1404) (parse379 (letrec ((f405 (lambda (forms406) (if (null? forms406) (cdr body380) (cons (cons er389 (wrap142 (car forms406) w393 mod395)) (f405 (cdr forms406))))))) (f405 e1404)) ids381 labels382 var-ids383 vars384 vals385 bindings386)) tmp402) (syntax-violation #f "source expression failed to match any pattern" tmp401))) ($sc-dispatch tmp401 (quote (any . each-any))))) e392) (if (memv type390 (quote (local-syntax-form))) (chi-local-syntax156 value391 e392 er389 w393 s394 mod395 (lambda (forms408 er409 w410 s411 mod412) (parse379 (letrec ((f413 (lambda (forms414) (if (null? forms414) (cdr body380) (cons (cons er409 (wrap142 (car forms414) w410 mod412)) (f413 (cdr forms414))))))) (f413 forms408)) ids381 labels382 var-ids383 vars384 vals385 bindings386))) (if (null? ids381) (build-sequence93 #f (map (lambda (x415) (chi150 (cdr x415) (car x415) (quote (())) mod395)) (cons (cons er389 (source-wrap143 e392 w393 s394 mod395)) (cdr body380)))) (begin (if (not (valid-bound-ids?139 ids381)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form372)) (letrec ((loop416 (lambda (bs417 er-cache418 r-cache419) (if (not (null? bs417)) (let ((b420 (car bs417))) (if (eq? (car b420) (quote macro)) (let ((er421 (cadr b420))) (let ((r-cache422 (if (eq? er421 er-cache418) r-cache419 (macros-only-env110 er421)))) (begin (set-cdr! b420 (eval-local-transformer157 (chi150 (cddr b420) r-cache422 (quote (())) mod395) mod395)) (loop416 (cdr bs417) er421 r-cache422)))) (loop416 (cdr bs417) er-cache418 r-cache419))))))) (loop416 bindings386 #f #f)) (set-cdr! r376 (extend-env108 labels382 bindings386 (cdr r376))) (build-letrec96 #f (map syntax->datum var-ids383) vars384 (map (lambda (x423) (chi150 (cdr x423) (car x423) (quote (())) mod395)) vals385) (build-sequence93 #f (map (lambda (x424) (chi150 (cdr x424) (car x424) (quote (())) mod395)) (cons (cons er389 (source-wrap143 e392 w393 s394 mod395)) (cdr body380)))))))))))))))))) (parse379 (map (lambda (x387) (cons r376 (wrap142 x387 w378 mod375))) body371) (quote ()) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro153 (lambda (p425 e426 r427 w428 rib429 mod430) (letrec ((rebuild-macro-output431 (lambda (x432 m433) (if (pair? x432) (cons (rebuild-macro-output431 (car x432) m433) (rebuild-macro-output431 (cdr x432) m433)) (if (syntax-object?98 x432) (let ((w434 (syntax-object-wrap100 x432))) (let ((ms435 (wrap-marks117 w434)) (s436 (wrap-subst118 w434))) (if (if (pair? ms435) (eq? (car ms435) #f) #f) (make-syntax-object97 (syntax-object-expression99 x432) (make-wrap116 (cdr ms435) (if rib429 (cons rib429 (cdr s436)) (cdr s436))) (syntax-object-module101 x432)) (make-syntax-object97 (syntax-object-expression99 x432) (make-wrap116 (cons m433 ms435) (if rib429 (cons rib429 (cons (quote shift) s436)) (cons (quote shift) s436))) (let ((pmod437 (procedure-module p425))) (if pmod437 (cons (quote hygiene) (module-name pmod437)) (quote (hygiene guile)))))))) (if (vector? x432) (let ((n438 (vector-length x432))) (let ((v439 (make-vector n438))) (letrec ((loop440 (lambda (i441) (if (fx=74 i441 n438) (begin (if #f #f) v439) (begin (vector-set! v439 i441 (rebuild-macro-output431 (vector-ref x432 i441) m433)) (loop440 (fx+72 i441 1))))))) (loop440 0)))) (if (symbol? x432) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap143 e426 w428 s mod430) x432) x432))))))) (rebuild-macro-output431 (p425 (wrap142 e426 (anti-mark129 w428) mod430)) (string #\m))))) (chi-application152 (lambda (x442 e443 r444 w445 s446 mod447) ((lambda (tmp448) ((lambda (tmp449) (if tmp449 (apply (lambda (e0450 e1451) (build-application81 s446 x442 (map (lambda (e452) (chi150 e452 r444 w445 mod447)) e1451))) tmp449) (syntax-violation #f "source expression failed to match any pattern" tmp448))) ($sc-dispatch tmp448 (quote (any . each-any))))) e443))) (chi-expr151 (lambda (type454 value455 e456 r457 w458 s459 mod460) (if (memv type454 (quote (lexical))) (build-lexical-reference83 (quote value) s459 e456 value455) (if (memv type454 (quote (core external-macro))) (value455 e456 r457 w458 s459 mod460) (if (memv type454 (quote (module-ref))) (call-with-values (lambda () (value455 e456)) (lambda (id461 mod462) (build-global-reference86 s459 id461 mod462))) (if (memv type454 (quote (lexical-call))) (chi-application152 (build-lexical-reference83 (quote fun) (source-annotation105 (car e456)) (car e456) value455) e456 r457 w458 s459 mod460) (if (memv type454 (quote (global-call))) (chi-application152 (build-global-reference86 (source-annotation105 (car e456)) value455 (if (syntax-object?98 (car e456)) (syntax-object-module101 (car e456)) mod460)) e456 r457 w458 s459 mod460) (if (memv type454 (quote (constant))) (build-data92 s459 (strip160 (source-wrap143 e456 w458 s459 mod460) (quote (())))) (if (memv type454 (quote (global))) (build-global-reference86 s459 value455 mod460) (if (memv type454 (quote (call))) (chi-application152 (chi150 (car e456) r457 w458 mod460) e456 r457 w458 s459 mod460) (if (memv type454 (quote (begin-form))) ((lambda (tmp463) ((lambda (tmp464) (if tmp464 (apply (lambda (_465 e1466 e2467) (chi-sequence144 (cons e1466 e2467) r457 w458 s459 mod460)) tmp464) (syntax-violation #f "source expression failed to match any pattern" tmp463))) ($sc-dispatch tmp463 (quote (any any . each-any))))) e456) (if (memv type454 (quote (local-syntax-form))) (chi-local-syntax156 value455 e456 r457 w458 s459 mod460 chi-sequence144) (if (memv type454 (quote (eval-when-form))) ((lambda (tmp469) ((lambda (tmp470) (if tmp470 (apply (lambda (_471 x472 e1473 e2474) (let ((when-list475 (chi-when-list147 e456 x472 w458))) (if (memq (quote eval) when-list475) (chi-sequence144 (cons e1473 e2474) r457 w458 s459 mod460) (chi-void158)))) tmp470) (syntax-violation #f "source expression failed to match any pattern" tmp469))) ($sc-dispatch tmp469 (quote (any each-any any . each-any))))) e456) (if (memv type454 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e456 (wrap142 value455 w458 mod460)) (if (memv type454 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap143 e456 w458 s459 mod460)) (if (memv type454 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap143 e456 w458 s459 mod460)) (syntax-violation #f "unexpected syntax" (source-wrap143 e456 w458 s459 mod460)))))))))))))))))) (chi150 (lambda (e478 r479 w480 mod481) (call-with-values (lambda () (syntax-type148 e478 r479 w480 (source-annotation105 e478) #f mod481)) (lambda (type482 value483 e484 w485 s486 mod487) (chi-expr151 type482 value483 e484 r479 w485 s486 mod487))))) (chi-top149 (lambda (e488 r489 w490 m491 esew492 mod493) (call-with-values (lambda () (syntax-type148 e488 r489 w490 (source-annotation105 e488) #f mod493)) (lambda (type501 value502 e503 w504 s505 mod506) (if (memv type501 (quote (begin-form))) ((lambda (tmp507) ((lambda (tmp508) (if tmp508 (apply (lambda (_509) (chi-void158)) tmp508) ((lambda (tmp510) (if tmp510 (apply (lambda (_511 e1512 e2513) (chi-top-sequence145 (cons e1512 e2513) r489 w504 s505 m491 esew492 mod506)) tmp510) (syntax-violation #f "source expression failed to match any pattern" tmp507))) ($sc-dispatch tmp507 (quote (any any . each-any)))))) ($sc-dispatch tmp507 (quote (any))))) e503) (if (memv type501 (quote (local-syntax-form))) (chi-local-syntax156 value502 e503 r489 w504 s505 mod506 (lambda (body515 r516 w517 s518 mod519) (chi-top-sequence145 body515 r516 w517 s518 m491 esew492 mod519))) (if (memv type501 (quote (eval-when-form))) ((lambda (tmp520) ((lambda (tmp521) (if tmp521 (apply (lambda (_522 x523 e1524 e2525) (let ((when-list526 (chi-when-list147 e503 x523 w504)) (body527 (cons e1524 e2525))) (if (eq? m491 (quote e)) (if (memq (quote eval) when-list526) (chi-top-sequence145 body527 r489 w504 s505 (quote e) (quote (eval)) mod506) (chi-void158)) (if (memq (quote load) when-list526) (if (let ((t530 (memq (quote compile) when-list526))) (if t530 t530 (if (eq? m491 (quote c&e)) (memq (quote eval) when-list526) #f))) (chi-top-sequence145 body527 r489 w504 s505 (quote c&e) (quote (compile load)) mod506) (if (memq m491 (quote (c c&e))) (chi-top-sequence145 body527 r489 w504 s505 (quote c) (quote (load)) mod506) (chi-void158))) (if (let ((t531 (memq (quote compile) when-list526))) (if t531 t531 (if (eq? m491 (quote c&e)) (memq (quote eval) when-list526) #f))) (begin (top-level-eval-hook76 (chi-top-sequence145 body527 r489 w504 s505 (quote e) (quote (eval)) mod506) mod506) (chi-void158)) (chi-void158)))))) tmp521) (syntax-violation #f "source expression failed to match any pattern" tmp520))) ($sc-dispatch tmp520 (quote (any each-any any . each-any))))) e503) (if (memv type501 (quote (define-syntax-form))) (let ((n532 (id-var-name136 value502 w504)) (r533 (macros-only-env110 r489))) (if (memv m491 (quote (c))) (if (memq (quote compile) esew492) (let ((e534 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)))) (begin (top-level-eval-hook76 e534 mod506) (if (memq (quote load) esew492) e534 (chi-void158)))) (if (memq (quote load) esew492) (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)) (chi-void158))) (if (memv m491 (quote (c&e))) (let ((e535 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)))) (begin (top-level-eval-hook76 e535 mod506) e535)) (begin (if (memq (quote eval) esew492) (top-level-eval-hook76 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506)) mod506)) (chi-void158))))) (if (memv type501 (quote (define-form))) (let ((n536 (id-var-name136 value502 w504))) (let ((type537 (binding-type106 (lookup111 n536 r489 mod506)))) (if (memv type537 (quote (global core macro module-ref))) (let ((x538 (build-global-definition89 s505 n536 (chi150 e503 r489 w504 mod506)))) (begin (if (eq? m491 (quote c&e)) (top-level-eval-hook76 x538 mod506)) x538)) (if (memv type537 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e503 (wrap142 value502 w504 mod506)) (syntax-violation #f "cannot define keyword at top level" e503 (wrap142 value502 w504 mod506)))))) (let ((x539 (chi-expr151 type501 value502 e503 r489 w504 s505 mod506))) (begin (if (eq? m491 (quote c&e)) (top-level-eval-hook76 x539 mod506)) x539))))))))))) (syntax-type148 (lambda (e540 r541 w542 s543 rib544 mod545) (if (symbol? e540) (let ((n546 (id-var-name136 e540 w542))) (let ((b547 (lookup111 n546 r541 mod545))) (let ((type548 (binding-type106 b547))) (if (memv type548 (quote (lexical))) (values type548 (binding-value107 b547) e540 w542 s543 mod545) (if (memv type548 (quote (global))) (values type548 n546 e540 w542 s543 mod545) (if (memv type548 (quote (macro))) (syntax-type148 (chi-macro153 (binding-value107 b547) e540 r541 w542 rib544 mod545) r541 (quote (())) s543 rib544 mod545) (values type548 (binding-value107 b547) e540 w542 s543 mod545))))))) (if (pair? e540) (let ((first549 (car e540))) (if (id?114 first549) (let ((n550 (id-var-name136 first549 w542))) (let ((b551 (lookup111 n550 r541 (let ((t552 (if (syntax-object?98 first549) (syntax-object-module101 first549) #f))) (if t552 t552 mod545))))) (let ((type553 (binding-type106 b551))) (if (memv type553 (quote (lexical))) (values (quote lexical-call) (binding-value107 b551) e540 w542 s543 mod545) (if (memv type553 (quote (global))) (values (quote global-call) n550 e540 w542 s543 mod545) (if (memv type553 (quote (macro))) (syntax-type148 (chi-macro153 (binding-value107 b551) e540 r541 w542 rib544 mod545) r541 (quote (())) s543 rib544 mod545) (if (memv type553 (quote (core external-macro module-ref))) (values type553 (binding-value107 b551) e540 w542 s543 mod545) (if (memv type553 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value107 b551) e540 w542 s543 mod545) (if (memv type553 (quote (begin))) (values (quote begin-form) #f e540 w542 s543 mod545) (if (memv type553 (quote (eval-when))) (values (quote eval-when-form) #f e540 w542 s543 mod545) (if (memv type553 (quote (define))) ((lambda (tmp554) ((lambda (tmp555) (if (if tmp555 (apply (lambda (_556 name557 val558) (id?114 name557)) tmp555) #f) (apply (lambda (_559 name560 val561) (values (quote define-form) name560 val561 w542 s543 mod545)) tmp555) ((lambda (tmp562) (if (if tmp562 (apply (lambda (_563 name564 args565 e1566 e2567) (if (id?114 name564) (valid-bound-ids?139 (lambda-var-list162 args565)) #f)) tmp562) #f) (apply (lambda (_568 name569 args570 e1571 e2572) (values (quote define-form) (wrap142 name569 w542 mod545) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap142 (cons args570 (cons e1571 e2572)) w542 mod545)) (quote (())) s543 mod545)) tmp562) ((lambda (tmp574) (if (if tmp574 (apply (lambda (_575 name576) (id?114 name576)) tmp574) #f) (apply (lambda (_577 name578) (values (quote define-form) (wrap142 name578 w542 mod545) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s543 mod545)) tmp574) (syntax-violation #f "source expression failed to match any pattern" tmp554))) ($sc-dispatch tmp554 (quote (any any)))))) ($sc-dispatch tmp554 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp554 (quote (any any any))))) e540) (if (memv type553 (quote (define-syntax))) ((lambda (tmp579) ((lambda (tmp580) (if (if tmp580 (apply (lambda (_581 name582 val583) (id?114 name582)) tmp580) #f) (apply (lambda (_584 name585 val586) (values (quote define-syntax-form) name585 val586 w542 s543 mod545)) tmp580) (syntax-violation #f "source expression failed to match any pattern" tmp579))) ($sc-dispatch tmp579 (quote (any any any))))) e540) (values (quote call) #f e540 w542 s543 mod545))))))))))))) (values (quote call) #f e540 w542 s543 mod545))) (if (syntax-object?98 e540) (syntax-type148 (syntax-object-expression99 e540) r541 (join-wraps133 w542 (syntax-object-wrap100 e540)) #f rib544 (let ((t587 (syntax-object-module101 e540))) (if t587 t587 mod545))) (if (self-evaluating? e540) (values (quote constant) #f e540 w542 s543 mod545) (values (quote other) #f e540 w542 s543 mod545))))))) (chi-when-list147 (lambda (e588 when-list589 w590) (letrec ((f591 (lambda (when-list592 situations593) (if (null? when-list592) situations593 (f591 (cdr when-list592) (cons (let ((x594 (car when-list592))) (if (free-id=?137 x594 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?137 x594 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?137 x594 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e588 (wrap142 x594 w590 #f)))))) situations593)))))) (f591 when-list589 (quote ()))))) (chi-install-global146 (lambda (name595 e596) (build-global-definition89 #f name595 (if (let ((v597 (module-variable (current-module) name595))) (if v597 (if (variable-bound? v597) (if (macro? (variable-ref v597)) (not (eq? (macro-type (variable-ref v597)) (quote syncase-macro))) #f) #f) #f)) (build-application81 #f (build-primref91 #f (quote make-extended-syncase-macro)) (list (build-application81 #f (build-primref91 #f (quote module-ref)) (list (build-application81 #f (build-primref91 #f (quote current-module)) (quote ())) (build-data92 #f name595))) (build-data92 #f (quote macro)) e596)) (build-application81 #f (build-primref91 #f (quote make-syncase-macro)) (list (build-data92 #f (quote macro)) e596)))))) (chi-top-sequence145 (lambda (body598 r599 w600 s601 m602 esew603 mod604) (build-sequence93 s601 (letrec ((dobody605 (lambda (body606 r607 w608 m609 esew610 mod611) (if (null? body606) (quote ()) (let ((first612 (chi-top149 (car body606) r607 w608 m609 esew610 mod611))) (cons first612 (dobody605 (cdr body606) r607 w608 m609 esew610 mod611))))))) (dobody605 body598 r599 w600 m602 esew603 mod604))))) (chi-sequence144 (lambda (body613 r614 w615 s616 mod617) (build-sequence93 s616 (letrec ((dobody618 (lambda (body619 r620 w621 mod622) (if (null? body619) (quote ()) (let ((first623 (chi150 (car body619) r620 w621 mod622))) (cons first623 (dobody618 (cdr body619) r620 w621 mod622))))))) (dobody618 body613 r614 w615 mod617))))) (source-wrap143 (lambda (x624 w625 s626 defmod627) (wrap142 (if s626 (begin (if (not (pair? x624)) (error "bad source-wrap!!!" x624 s626)) (set-source-properties! x624 s626) x624) x624) w625 defmod627))) (wrap142 (lambda (x628 w629 defmod630) (if (if (null? (wrap-marks117 w629)) (null? (wrap-subst118 w629)) #f) x628 (if (syntax-object?98 x628) (make-syntax-object97 (syntax-object-expression99 x628) (join-wraps133 w629 (syntax-object-wrap100 x628)) (syntax-object-module101 x628)) (if (null? x628) x628 (make-syntax-object97 x628 w629 defmod630)))))) (bound-id-member?141 (lambda (x631 list632) (if (not (null? list632)) (let ((t633 (bound-id=?138 x631 (car list632)))) (if t633 t633 (bound-id-member?141 x631 (cdr list632)))) #f))) (distinct-bound-ids?140 (lambda (ids634) (letrec ((distinct?635 (lambda (ids636) (let ((t637 (null? ids636))) (if t637 t637 (if (not (bound-id-member?141 (car ids636) (cdr ids636))) (distinct?635 (cdr ids636)) #f)))))) (distinct?635 ids634)))) (valid-bound-ids?139 (lambda (ids638) (if (letrec ((all-ids?639 (lambda (ids640) (let ((t641 (null? ids640))) (if t641 t641 (if (id?114 (car ids640)) (all-ids?639 (cdr ids640)) #f)))))) (all-ids?639 ids638)) (distinct-bound-ids?140 ids638) #f))) (bound-id=?138 (lambda (i642 j643) (if (if (syntax-object?98 i642) (syntax-object?98 j643) #f) (if (eq? (syntax-object-expression99 i642) (syntax-object-expression99 j643)) (same-marks?135 (wrap-marks117 (syntax-object-wrap100 i642)) (wrap-marks117 (syntax-object-wrap100 j643))) #f) (eq? i642 j643)))) (free-id=?137 (lambda (i644 j645) (if (eq? (let ((x646 i644)) (if (syntax-object?98 x646) (syntax-object-expression99 x646) x646)) (let ((x647 j645)) (if (syntax-object?98 x647) (syntax-object-expression99 x647) x647))) (eq? (id-var-name136 i644 (quote (()))) (id-var-name136 j645 (quote (())))) #f))) (id-var-name136 (lambda (id648 w649) (letrec ((search-vector-rib652 (lambda (sym658 subst659 marks660 symnames661 ribcage662) (let ((n663 (vector-length symnames661))) (letrec ((f664 (lambda (i665) (if (fx=74 i665 n663) (search650 sym658 (cdr subst659) marks660) (if (if (eq? (vector-ref symnames661 i665) sym658) (same-marks?135 marks660 (vector-ref (ribcage-marks124 ribcage662) i665)) #f) (values (vector-ref (ribcage-labels125 ribcage662) i665) marks660) (f664 (fx+72 i665 1))))))) (f664 0))))) (search-list-rib651 (lambda (sym666 subst667 marks668 symnames669 ribcage670) (letrec ((f671 (lambda (symnames672 i673) (if (null? symnames672) (search650 sym666 (cdr subst667) marks668) (if (if (eq? (car symnames672) sym666) (same-marks?135 marks668 (list-ref (ribcage-marks124 ribcage670) i673)) #f) (values (list-ref (ribcage-labels125 ribcage670) i673) marks668) (f671 (cdr symnames672) (fx+72 i673 1))))))) (f671 symnames669 0)))) (search650 (lambda (sym674 subst675 marks676) (if (null? subst675) (values #f marks676) (let ((fst677 (car subst675))) (if (eq? fst677 (quote shift)) (search650 sym674 (cdr subst675) (cdr marks676)) (let ((symnames678 (ribcage-symnames123 fst677))) (if (vector? symnames678) (search-vector-rib652 sym674 subst675 marks676 symnames678 fst677) (search-list-rib651 sym674 subst675 marks676 symnames678 fst677))))))))) (if (symbol? id648) (let ((t679 (call-with-values (lambda () (search650 id648 (wrap-subst118 w649) (wrap-marks117 w649))) (lambda (x681 . ignore680) x681)))) (if t679 t679 id648)) (if (syntax-object?98 id648) (let ((id682 (syntax-object-expression99 id648)) (w1683 (syntax-object-wrap100 id648))) (let ((marks684 (join-marks134 (wrap-marks117 w649) (wrap-marks117 w1683)))) (call-with-values (lambda () (search650 id682 (wrap-subst118 w649) marks684)) (lambda (new-id685 marks686) (let ((t687 new-id685)) (if t687 t687 (let ((t688 (call-with-values (lambda () (search650 id682 (wrap-subst118 w1683) marks686)) (lambda (x690 . ignore689) x690)))) (if t688 t688 id682)))))))) (syntax-violation (quote id-var-name) "invalid id" id648)))))) (same-marks?135 (lambda (x691 y692) (let ((t693 (eq? x691 y692))) (if t693 t693 (if (not (null? x691)) (if (not (null? y692)) (if (eq? (car x691) (car y692)) (same-marks?135 (cdr x691) (cdr y692)) #f) #f) #f))))) (join-marks134 (lambda (m1694 m2695) (smart-append132 m1694 m2695))) (join-wraps133 (lambda (w1696 w2697) (let ((m1698 (wrap-marks117 w1696)) (s1699 (wrap-subst118 w1696))) (if (null? m1698) (if (null? s1699) w2697 (make-wrap116 (wrap-marks117 w2697) (smart-append132 s1699 (wrap-subst118 w2697)))) (make-wrap116 (smart-append132 m1698 (wrap-marks117 w2697)) (smart-append132 s1699 (wrap-subst118 w2697))))))) (smart-append132 (lambda (m1700 m2701) (if (null? m2701) m1700 (append m1700 m2701)))) (make-binding-wrap131 (lambda (ids702 labels703 w704) (if (null? ids702) w704 (make-wrap116 (wrap-marks117 w704) (cons (let ((labelvec705 (list->vector labels703))) (let ((n706 (vector-length labelvec705))) (let ((symnamevec707 (make-vector n706)) (marksvec708 (make-vector n706))) (begin (letrec ((f709 (lambda (ids710 i711) (if (not (null? ids710)) (call-with-values (lambda () (id-sym-name&marks115 (car ids710) w704)) (lambda (symname712 marks713) (begin (vector-set! symnamevec707 i711 symname712) (vector-set! marksvec708 i711 marks713) (f709 (cdr ids710) (fx+72 i711 1))))))))) (f709 ids702 0)) (make-ribcage121 symnamevec707 marksvec708 labelvec705))))) (wrap-subst118 w704)))))) (extend-ribcage!130 (lambda (ribcage714 id715 label716) (begin (set-ribcage-symnames!126 ribcage714 (cons (syntax-object-expression99 id715) (ribcage-symnames123 ribcage714))) (set-ribcage-marks!127 ribcage714 (cons (wrap-marks117 (syntax-object-wrap100 id715)) (ribcage-marks124 ribcage714))) (set-ribcage-labels!128 ribcage714 (cons label716 (ribcage-labels125 ribcage714)))))) (anti-mark129 (lambda (w717) (make-wrap116 (cons #f (wrap-marks117 w717)) (cons (quote shift) (wrap-subst118 w717))))) (set-ribcage-labels!128 (lambda (x718 update719) (vector-set! x718 3 update719))) (set-ribcage-marks!127 (lambda (x720 update721) (vector-set! x720 2 update721))) (set-ribcage-symnames!126 (lambda (x722 update723) (vector-set! x722 1 update723))) (ribcage-labels125 (lambda (x724) (vector-ref x724 3))) (ribcage-marks124 (lambda (x725) (vector-ref x725 2))) (ribcage-symnames123 (lambda (x726) (vector-ref x726 1))) (ribcage?122 (lambda (x727) (if (vector? x727) (if (= (vector-length x727) 4) (eq? (vector-ref x727 0) (quote ribcage)) #f) #f))) (make-ribcage121 (lambda (symnames728 marks729 labels730) (vector (quote ribcage) symnames728 marks729 labels730))) (gen-labels120 (lambda (ls731) (if (null? ls731) (quote ()) (cons (gen-label119) (gen-labels120 (cdr ls731)))))) (gen-label119 (lambda () (string #\i))) (wrap-subst118 cdr) (wrap-marks117 car) (make-wrap116 cons) (id-sym-name&marks115 (lambda (x732 w733) (if (syntax-object?98 x732) (values (syntax-object-expression99 x732) (join-marks134 (wrap-marks117 w733) (wrap-marks117 (syntax-object-wrap100 x732)))) (values x732 (wrap-marks117 w733))))) (id?114 (lambda (x734) (if (symbol? x734) #t (if (syntax-object?98 x734) (symbol? (syntax-object-expression99 x734)) #f)))) (nonsymbol-id?113 (lambda (x735) (if (syntax-object?98 x735) (symbol? (syntax-object-expression99 x735)) #f))) (global-extend112 (lambda (type736 sym737 val738) (put-global-definition-hook78 sym737 type736 val738))) (lookup111 (lambda (x739 r740 mod741) (let ((t742 (assq x739 r740))) (if t742 (cdr t742) (if (symbol? x739) (let ((t743 (get-global-definition-hook79 x739 mod741))) (if t743 t743 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env110 (lambda (r744) (if (null? r744) (quote ()) (let ((a745 (car r744))) (if (eq? (cadr a745) (quote macro)) (cons a745 (macros-only-env110 (cdr r744))) (macros-only-env110 (cdr r744))))))) (extend-var-env109 (lambda (labels746 vars747 r748) (if (null? labels746) r748 (extend-var-env109 (cdr labels746) (cdr vars747) (cons (cons (car labels746) (cons (quote lexical) (car vars747))) r748))))) (extend-env108 (lambda (labels749 bindings750 r751) (if (null? labels749) r751 (extend-env108 (cdr labels749) (cdr bindings750) (cons (cons (car labels749) (car bindings750)) r751))))) (binding-value107 cdr) (binding-type106 car) (source-annotation105 (lambda (x752) (if (syntax-object?98 x752) (source-annotation105 (syntax-object-expression99 x752)) (if (pair? x752) (source-properties x752) #f)))) (set-syntax-object-module!104 (lambda (x753 update754) (vector-set! x753 3 update754))) (set-syntax-object-wrap!103 (lambda (x755 update756) (vector-set! x755 2 update756))) (set-syntax-object-expression!102 (lambda (x757 update758) (vector-set! x757 1 update758))) (syntax-object-module101 (lambda (x759) (vector-ref x759 3))) (syntax-object-wrap100 (lambda (x760) (vector-ref x760 2))) (syntax-object-expression99 (lambda (x761) (vector-ref x761 1))) (syntax-object?98 (lambda (x762) (if (vector? x762) (if (= (vector-length x762) 4) (eq? (vector-ref x762 0) (quote syntax-object)) #f) #f))) (make-syntax-object97 (lambda (expression763 wrap764 module765) (vector (quote syntax-object) expression763 wrap764 module765))) (build-letrec96 (lambda (src766 ids767 vars768 val-exps769 body-exp770) (if (null? vars768) body-exp770 (let ((atom-key771 (fluid-ref *mode*71))) (if (memv atom-key771 (quote (c))) (begin (for-each maybe-name-value!88 ids767 val-exps769) ((@ (language tree-il) make-letrec) src766 ids767 vars768 val-exps769 body-exp770)) (list (quote letrec) (map list vars768 val-exps769) body-exp770)))))) (build-named-let95 (lambda (src772 ids773 vars774 val-exps775 body-exp776) (let ((f777 (car vars774)) (f-name778 (car ids773)) (vars779 (cdr vars774)) (ids780 (cdr ids773))) (let ((atom-key781 (fluid-ref *mode*71))) (if (memv atom-key781 (quote (c))) (let ((proc782 (build-lambda90 src772 ids780 vars779 #f body-exp776))) (begin (maybe-name-value!88 f-name778 proc782) (for-each maybe-name-value!88 ids780 val-exps775) ((@ (language tree-il) make-letrec) src772 (list f-name778) (list f777) (list proc782) (build-application81 src772 (build-lexical-reference83 (quote fun) src772 f-name778 f777) val-exps775)))) (list (quote let) f777 (map list vars779 val-exps775) body-exp776)))))) (build-let94 (lambda (src783 ids784 vars785 val-exps786 body-exp787) (if (null? vars785) body-exp787 (let ((atom-key788 (fluid-ref *mode*71))) (if (memv atom-key788 (quote (c))) (begin (for-each maybe-name-value!88 ids784 val-exps786) ((@ (language tree-il) make-let) src783 ids784 vars785 val-exps786 body-exp787)) (list (quote let) (map list vars785 val-exps786) body-exp787)))))) (build-sequence93 (lambda (src789 exps790) (if (null? (cdr exps790)) (car exps790) (let ((atom-key791 (fluid-ref *mode*71))) (if (memv atom-key791 (quote (c))) ((@ (language tree-il) make-sequence) src789 exps790) (cons (quote begin) exps790)))))) (build-data92 (lambda (src792 exp793) (let ((atom-key794 (fluid-ref *mode*71))) (if (memv atom-key794 (quote (c))) ((@ (language tree-il) make-const) src792 exp793) (if (if (self-evaluating? exp793) (not (vector? exp793)) #f) exp793 (list (quote quote) exp793)))))) (build-primref91 (lambda (src795 name796) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key797 (fluid-ref *mode*71))) (if (memv atom-key797 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src795 name796) name796)) (let ((atom-key798 (fluid-ref *mode*71))) (if (memv atom-key798 (quote (c))) ((@ (language tree-il) make-module-ref) src795 (quote (guile)) name796 #f) (list (quote @@) (quote (guile)) name796)))))) (build-lambda90 (lambda (src799 ids800 vars801 docstring802 exp803) (let ((atom-key804 (fluid-ref *mode*71))) (if (memv atom-key804 (quote (c))) ((@ (language tree-il) make-lambda) src799 ids800 vars801 (if docstring802 (list (cons (quote documentation) docstring802)) (quote ())) exp803) (cons (quote lambda) (cons vars801 (append (if docstring802 (list docstring802) (quote ())) (list exp803)))))))) (build-global-definition89 (lambda (source805 var806 exp807) (let ((atom-key808 (fluid-ref *mode*71))) (if (memv atom-key808 (quote (c))) (begin (maybe-name-value!88 var806 exp807) ((@ (language tree-il) make-toplevel-define) source805 var806 exp807)) (list (quote define) var806 exp807))))) (maybe-name-value!88 (lambda (name809 val810) (if ((@ (language tree-il) lambda?) val810) (let ((meta811 ((@ (language tree-il) lambda-meta) val810))) (if (not (assq (quote name) meta811)) ((setter (@ (language tree-il) lambda-meta)) val810 (acons (quote name) name809 meta811))))))) (build-global-assignment87 (lambda (source812 var813 exp814 mod815) (analyze-variable85 mod815 var813 (lambda (mod816 var817 public?818) (let ((atom-key819 (fluid-ref *mode*71))) (if (memv atom-key819 (quote (c))) ((@ (language tree-il) make-module-set) source812 mod816 var817 public?818 exp814) (list (quote set!) (list (if public?818 (quote @) (quote @@)) mod816 var817) exp814)))) (lambda (var820) (let ((atom-key821 (fluid-ref *mode*71))) (if (memv atom-key821 (quote (c))) ((@ (language tree-il) make-toplevel-set) source812 var820 exp814) (list (quote set!) var820 exp814))))))) (build-global-reference86 (lambda (source822 var823 mod824) (analyze-variable85 mod824 var823 (lambda (mod825 var826 public?827) (let ((atom-key828 (fluid-ref *mode*71))) (if (memv atom-key828 (quote (c))) ((@ (language tree-il) make-module-ref) source822 mod825 var826 public?827) (list (if public?827 (quote @) (quote @@)) mod825 var826)))) (lambda (var829) (let ((atom-key830 (fluid-ref *mode*71))) (if (memv atom-key830 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source822 var829) var829)))))) (analyze-variable85 (lambda (mod831 var832 modref-cont833 bare-cont834) (if (not mod831) (bare-cont834 var832) (let ((kind835 (car mod831)) (mod836 (cdr mod831))) (if (memv kind835 (quote (public))) (modref-cont833 mod836 var832 #t) (if (memv kind835 (quote (private))) (if (not (equal? mod836 (module-name (current-module)))) (modref-cont833 mod836 var832 #f) (bare-cont834 var832)) (if (memv kind835 (quote (bare))) (bare-cont834 var832) (if (memv kind835 (quote (hygiene))) (if (if (not (equal? mod836 (module-name (current-module)))) (module-variable (resolve-module mod836) var832) #f) (modref-cont833 mod836 var832 #f) (bare-cont834 var832)) (syntax-violation #f "bad module kind" var832 mod836))))))))) (build-lexical-assignment84 (lambda (source837 name838 var839 exp840) (let ((atom-key841 (fluid-ref *mode*71))) (if (memv atom-key841 (quote (c))) ((@ (language tree-il) make-lexical-set) source837 name838 var839 exp840) (list (quote set!) var839 exp840))))) (build-lexical-reference83 (lambda (type842 source843 name844 var845) (let ((atom-key846 (fluid-ref *mode*71))) (if (memv atom-key846 (quote (c))) ((@ (language tree-il) make-lexical-ref) source843 name844 var845) var845)))) (build-conditional82 (lambda (source847 test-exp848 then-exp849 else-exp850) (let ((atom-key851 (fluid-ref *mode*71))) (if (memv atom-key851 (quote (c))) ((@ (language tree-il) make-conditional) source847 test-exp848 then-exp849 else-exp850) (if (equal? else-exp850 (quote (if #f #f))) (list (quote if) test-exp848 then-exp849) (list (quote if) test-exp848 then-exp849 else-exp850)))))) (build-application81 (lambda (source852 fun-exp853 arg-exps854) (let ((atom-key855 (fluid-ref *mode*71))) (if (memv atom-key855 (quote (c))) ((@ (language tree-il) make-application) source852 fun-exp853 arg-exps854) (cons fun-exp853 arg-exps854))))) (build-void80 (lambda (source856) (let ((atom-key857 (fluid-ref *mode*71))) (if (memv atom-key857 (quote (c))) ((@ (language tree-il) make-void) source856) (quote (if #f #f)))))) (get-global-definition-hook79 (lambda (symbol858 module859) (begin (if (if (not module859) (current-module) #f) (warn "module system is booted, we should have a module" symbol858)) (let ((v860 (module-variable (if module859 (resolve-module (cdr module859)) (current-module)) symbol858))) (if v860 (if (variable-bound? v860) (let ((val861 (variable-ref v860))) (if (macro? val861) (if (syncase-macro-type val861) (cons (syncase-macro-type val861) (syncase-macro-binding val861)) #f) #f)) #f) #f))))) (put-global-definition-hook78 (lambda (symbol862 type863 val864) (let ((existing865 (let ((v866 (module-variable (current-module) symbol862))) (if v866 (if (variable-bound? v866) (let ((val867 (variable-ref v866))) (if (macro? val867) (if (not (syncase-macro-type val867)) val867 #f) #f)) #f) #f)))) (module-define! (current-module) symbol862 (if existing865 (make-extended-syncase-macro existing865 type863 val864) (make-syncase-macro type863 val864)))))) (local-eval-hook77 (lambda (x868 mod869) (primitive-eval (list noexpand70 (let ((atom-key870 (fluid-ref *mode*71))) (if (memv atom-key870 (quote (c))) ((@ (language tree-il) tree-il->scheme) x868) x868)))))) (top-level-eval-hook76 (lambda (x871 mod872) (primitive-eval (list noexpand70 (let ((atom-key873 (fluid-ref *mode*71))) (if (memv atom-key873 (quote (c))) ((@ (language tree-il) tree-il->scheme) x871) x871)))))) (fx<75 <) (fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand")) (begin (global-extend112 (quote local-syntax) (quote letrec-syntax) #t) (global-extend112 (quote local-syntax) (quote let-syntax) #f) (global-extend112 (quote core) (quote fluid-let-syntax) (lambda (e874 r875 w876 s877 mod878) ((lambda (tmp879) ((lambda (tmp880) (if (if tmp880 (apply (lambda (_881 var882 val883 e1884 e2885) (valid-bound-ids?139 var882)) tmp880) #f) (apply (lambda (_887 var888 val889 e1890 e2891) (let ((names892 (map (lambda (x893) (id-var-name136 x893 w876)) var888))) (begin (for-each (lambda (id895 n896) (let ((atom-key897 (binding-type106 (lookup111 n896 r875 mod878)))) (if (memv atom-key897 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e874 (source-wrap143 id895 w876 s877 mod878))))) var888 names892) (chi-body154 (cons e1890 e2891) (source-wrap143 e874 w876 s877 mod878) (extend-env108 names892 (let ((trans-r900 (macros-only-env110 r875))) (map (lambda (x901) (cons (quote macro) (eval-local-transformer157 (chi150 x901 trans-r900 w876 mod878) mod878))) val889)) r875) w876 mod878)))) tmp880) ((lambda (_903) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap143 e874 w876 s877 mod878))) tmp879))) ($sc-dispatch tmp879 (quote (any #(each (any any)) any . each-any))))) e874))) (global-extend112 (quote core) (quote quote) (lambda (e904 r905 w906 s907 mod908) ((lambda (tmp909) ((lambda (tmp910) (if tmp910 (apply (lambda (_911 e912) (build-data92 s907 (strip160 e912 w906))) tmp910) ((lambda (_913) (syntax-violation (quote quote) "bad syntax" (source-wrap143 e904 w906 s907 mod908))) tmp909))) ($sc-dispatch tmp909 (quote (any any))))) e904))) (global-extend112 (quote core) (quote syntax) (letrec ((regen921 (lambda (x922) (let ((atom-key923 (car x922))) (if (memv atom-key923 (quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x922) (cadr x922)) (if (memv atom-key923 (quote (primitive))) (build-primref91 #f (cadr x922)) (if (memv atom-key923 (quote (quote))) (build-data92 #f (cadr x922)) (if (memv atom-key923 (quote (lambda))) (build-lambda90 #f (cadr x922) (cadr x922) #f (regen921 (caddr x922))) (if (memv atom-key923 (quote (map))) (let ((ls924 (map regen921 (cdr x922)))) (build-application81 #f (build-primref91 #f (quote map)) ls924)) (build-application81 #f (build-primref91 #f (car x922)) (map regen921 (cdr x922))))))))))) (gen-vector920 (lambda (x925) (if (eq? (car x925) (quote list)) (cons (quote vector) (cdr x925)) (if (eq? (car x925) (quote quote)) (list (quote quote) (list->vector (cadr x925))) (list (quote list->vector) x925))))) (gen-append919 (lambda (x926 y927) (if (equal? y927 (quote (quote ()))) x926 (list (quote append) x926 y927)))) (gen-cons918 (lambda (x928 y929) (let ((atom-key930 (car y929))) (if (memv atom-key930 (quote (quote))) (if (eq? (car x928) (quote quote)) (list (quote quote) (cons (cadr x928) (cadr y929))) (if (eq? (cadr y929) (quote ())) (list (quote list) x928) (list (quote cons) x928 y929))) (if (memv atom-key930 (quote (list))) (cons (quote list) (cons x928 (cdr y929))) (list (quote cons) x928 y929)))))) (gen-map917 (lambda (e931 map-env932) (let ((formals933 (map cdr map-env932)) (actuals934 (map (lambda (x935) (list (quote ref) (car x935))) map-env932))) (if (eq? (car e931) (quote ref)) (car actuals934) (if (and-map (lambda (x936) (if (eq? (car x936) (quote ref)) (memq (cadr x936) formals933) #f)) (cdr e931)) (cons (quote map) (cons (list (quote primitive) (car e931)) (map (let ((r937 (map cons formals933 actuals934))) (lambda (x938) (cdr (assq (cadr x938) r937)))) (cdr e931)))) (cons (quote map) (cons (list (quote lambda) formals933 e931) actuals934))))))) (gen-mappend916 (lambda (e939 map-env940) (list (quote apply) (quote (primitive append)) (gen-map917 e939 map-env940)))) (gen-ref915 (lambda (src941 var942 level943 maps944) (if (fx=74 level943 0) (values var942 maps944) (if (null? maps944) (syntax-violation (quote syntax) "missing ellipsis" src941) (call-with-values (lambda () (gen-ref915 src941 var942 (fx-73 level943 1) (cdr maps944))) (lambda (outer-var945 outer-maps946) (let ((b947 (assq outer-var945 (car maps944)))) (if b947 (values (cdr b947) maps944) (let ((inner-var948 (gen-var161 (quote tmp)))) (values inner-var948 (cons (cons (cons outer-var945 inner-var948) (car maps944)) outer-maps946))))))))))) (gen-syntax914 (lambda (src949 e950 r951 maps952 ellipsis?953 mod954) (if (id?114 e950) (let ((label955 (id-var-name136 e950 (quote (()))))) (let ((b956 (lookup111 label955 r951 mod954))) (if (eq? (binding-type106 b956) (quote syntax)) (call-with-values (lambda () (let ((var.lev957 (binding-value107 b956))) (gen-ref915 src949 (car var.lev957) (cdr var.lev957) maps952))) (lambda (var958 maps959) (values (list (quote ref) var958) maps959))) (if (ellipsis?953 e950) (syntax-violation (quote syntax) "misplaced ellipsis" src949) (values (list (quote quote) e950) maps952))))) ((lambda (tmp960) ((lambda (tmp961) (if (if tmp961 (apply (lambda (dots962 e963) (ellipsis?953 dots962)) tmp961) #f) (apply (lambda (dots964 e965) (gen-syntax914 src949 e965 r951 maps952 (lambda (x966) #f) mod954)) tmp961) ((lambda (tmp967) (if (if tmp967 (apply (lambda (x968 dots969 y970) (ellipsis?953 dots969)) tmp967) #f) (apply (lambda (x971 dots972 y973) (letrec ((f974 (lambda (y975 k976) ((lambda (tmp980) ((lambda (tmp981) (if (if tmp981 (apply (lambda (dots982 y983) (ellipsis?953 dots982)) tmp981) #f) (apply (lambda (dots984 y985) (f974 y985 (lambda (maps986) (call-with-values (lambda () (k976 (cons (quote ()) maps986))) (lambda (x987 maps988) (if (null? (car maps988)) (syntax-violation (quote syntax) "extra ellipsis" src949) (values (gen-mappend916 x987 (car maps988)) (cdr maps988)))))))) tmp981) ((lambda (_989) (call-with-values (lambda () (gen-syntax914 src949 y975 r951 maps952 ellipsis?953 mod954)) (lambda (y990 maps991) (call-with-values (lambda () (k976 maps991)) (lambda (x992 maps993) (values (gen-append919 x992 y990) maps993)))))) tmp980))) ($sc-dispatch tmp980 (quote (any . any))))) y975)))) (f974 y973 (lambda (maps977) (call-with-values (lambda () (gen-syntax914 src949 x971 r951 (cons (quote ()) maps977) ellipsis?953 mod954)) (lambda (x978 maps979) (if (null? (car maps979)) (syntax-violation (quote syntax) "extra ellipsis" src949) (values (gen-map917 x978 (car maps979)) (cdr maps979))))))))) tmp967) ((lambda (tmp994) (if tmp994 (apply (lambda (x995 y996) (call-with-values (lambda () (gen-syntax914 src949 x995 r951 maps952 ellipsis?953 mod954)) (lambda (x997 maps998) (call-with-values (lambda () (gen-syntax914 src949 y996 r951 maps998 ellipsis?953 mod954)) (lambda (y999 maps1000) (values (gen-cons918 x997 y999) maps1000)))))) tmp994) ((lambda (tmp1001) (if tmp1001 (apply (lambda (e11002 e21003) (call-with-values (lambda () (gen-syntax914 src949 (cons e11002 e21003) r951 maps952 ellipsis?953 mod954)) (lambda (e1005 maps1006) (values (gen-vector920 e1005) maps1006)))) tmp1001) ((lambda (_1007) (values (list (quote quote) e950) maps952)) tmp960))) ($sc-dispatch tmp960 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp960 (quote (any . any)))))) ($sc-dispatch tmp960 (quote (any any . any)))))) ($sc-dispatch tmp960 (quote (any any))))) e950))))) (lambda (e1008 r1009 w1010 s1011 mod1012) (let ((e1013 (source-wrap143 e1008 w1010 s1011 mod1012))) ((lambda (tmp1014) ((lambda (tmp1015) (if tmp1015 (apply (lambda (_1016 x1017) (call-with-values (lambda () (gen-syntax914 e1013 x1017 r1009 (quote ()) ellipsis?159 mod1012)) (lambda (e1018 maps1019) (regen921 e1018)))) tmp1015) ((lambda (_1020) (syntax-violation (quote syntax) "bad `syntax' form" e1013)) tmp1014))) ($sc-dispatch tmp1014 (quote (any any))))) e1013))))) (global-extend112 (quote core) (quote lambda) (lambda (e1021 r1022 w1023 s1024 mod1025) ((lambda (tmp1026) ((lambda (tmp1027) (if tmp1027 (apply (lambda (_1028 c1029) (chi-lambda-clause155 (source-wrap143 e1021 w1023 s1024 mod1025) #f c1029 r1022 w1023 mod1025 (lambda (names1030 vars1031 docstring1032 body1033) (build-lambda90 s1024 names1030 vars1031 docstring1032 body1033)))) tmp1027) (syntax-violation #f "source expression failed to match any pattern" tmp1026))) ($sc-dispatch tmp1026 (quote (any . any))))) e1021))) (global-extend112 (quote core) (quote let) (letrec ((chi-let1034 (lambda (e1035 r1036 w1037 s1038 mod1039 constructor1040 ids1041 vals1042 exps1043) (if (not (valid-bound-ids?139 ids1041)) (syntax-violation (quote let) "duplicate bound variable" e1035) (let ((labels1044 (gen-labels120 ids1041)) (new-vars1045 (map gen-var161 ids1041))) (let ((nw1046 (make-binding-wrap131 ids1041 labels1044 w1037)) (nr1047 (extend-var-env109 labels1044 new-vars1045 r1036))) (constructor1040 s1038 (map syntax->datum ids1041) new-vars1045 (map (lambda (x1048) (chi150 x1048 r1036 w1037 mod1039)) vals1042) (chi-body154 exps1043 (source-wrap143 e1035 nw1046 s1038 mod1039) nr1047 nw1046 mod1039)))))))) (lambda (e1049 r1050 w1051 s1052 mod1053) ((lambda (tmp1054) ((lambda (tmp1055) (if (if tmp1055 (apply (lambda (_1056 id1057 val1058 e11059 e21060) (and-map id?114 id1057)) tmp1055) #f) (apply (lambda (_1062 id1063 val1064 e11065 e21066) (chi-let1034 e1049 r1050 w1051 s1052 mod1053 build-let94 id1063 val1064 (cons e11065 e21066))) tmp1055) ((lambda (tmp1070) (if (if tmp1070 (apply (lambda (_1071 f1072 id1073 val1074 e11075 e21076) (if (id?114 f1072) (and-map id?114 id1073) #f)) tmp1070) #f) (apply (lambda (_1078 f1079 id1080 val1081 e11082 e21083) (chi-let1034 e1049 r1050 w1051 s1052 mod1053 build-named-let95 (cons f1079 id1080) val1081 (cons e11082 e21083))) tmp1070) ((lambda (_1087) (syntax-violation (quote let) "bad let" (source-wrap143 e1049 w1051 s1052 mod1053))) tmp1054))) ($sc-dispatch tmp1054 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1054 (quote (any #(each (any any)) any . each-any))))) e1049)))) (global-extend112 (quote core) (quote letrec) (lambda (e1088 r1089 w1090 s1091 mod1092) ((lambda (tmp1093) ((lambda (tmp1094) (if (if tmp1094 (apply (lambda (_1095 id1096 val1097 e11098 e21099) (and-map id?114 id1096)) tmp1094) #f) (apply (lambda (_1101 id1102 val1103 e11104 e21105) (let ((ids1106 id1102)) (if (not (valid-bound-ids?139 ids1106)) (syntax-violation (quote letrec) "duplicate bound variable" e1088) (let ((labels1108 (gen-labels120 ids1106)) (new-vars1109 (map gen-var161 ids1106))) (let ((w1110 (make-binding-wrap131 ids1106 labels1108 w1090)) (r1111 (extend-var-env109 labels1108 new-vars1109 r1089))) (build-letrec96 s1091 (map syntax->datum ids1106) new-vars1109 (map (lambda (x1112) (chi150 x1112 r1111 w1110 mod1092)) val1103) (chi-body154 (cons e11104 e21105) (source-wrap143 e1088 w1110 s1091 mod1092) r1111 w1110 mod1092))))))) tmp1094) ((lambda (_1115) (syntax-violation (quote letrec) "bad letrec" (source-wrap143 e1088 w1090 s1091 mod1092))) tmp1093))) ($sc-dispatch tmp1093 (quote (any #(each (any any)) any . each-any))))) e1088))) (global-extend112 (quote core) (quote set!) (lambda (e1116 r1117 w1118 s1119 mod1120) ((lambda (tmp1121) ((lambda (tmp1122) (if (if tmp1122 (apply (lambda (_1123 id1124 val1125) (id?114 id1124)) tmp1122) #f) (apply (lambda (_1126 id1127 val1128) (let ((val1129 (chi150 val1128 r1117 w1118 mod1120)) (n1130 (id-var-name136 id1127 w1118))) (let ((b1131 (lookup111 n1130 r1117 mod1120))) (let ((atom-key1132 (binding-type106 b1131))) (if (memv atom-key1132 (quote (lexical))) (build-lexical-assignment84 s1119 (syntax->datum id1127) (binding-value107 b1131) val1129) (if (memv atom-key1132 (quote (global))) (build-global-assignment87 s1119 n1130 val1129 mod1120) (if (memv atom-key1132 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap142 id1127 w1118 mod1120)) (syntax-violation (quote set!) "bad set!" (source-wrap143 e1116 w1118 s1119 mod1120))))))))) tmp1122) ((lambda (tmp1133) (if tmp1133 (apply (lambda (_1134 head1135 tail1136 val1137) (call-with-values (lambda () (syntax-type148 head1135 r1117 (quote (())) #f #f mod1120)) (lambda (type1138 value1139 ee1140 ww1141 ss1142 modmod1143) (if (memv type1138 (quote (module-ref))) (let ((val1144 (chi150 val1137 r1117 w1118 mod1120))) (call-with-values (lambda () (value1139 (cons head1135 tail1136))) (lambda (id1146 mod1147) (build-global-assignment87 s1119 id1146 val1144 mod1147)))) (build-application81 s1119 (chi150 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1135) r1117 w1118 mod1120) (map (lambda (e1148) (chi150 e1148 r1117 w1118 mod1120)) (append tail1136 (list val1137)))))))) tmp1133) ((lambda (_1150) (syntax-violation (quote set!) "bad set!" (source-wrap143 e1116 w1118 s1119 mod1120))) tmp1121))) ($sc-dispatch tmp1121 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1121 (quote (any any any))))) e1116))) (global-extend112 (quote module-ref) (quote @) (lambda (e1151) ((lambda (tmp1152) ((lambda (tmp1153) (if (if tmp1153 (apply (lambda (_1154 mod1155 id1156) (if (and-map id?114 mod1155) (id?114 id1156) #f)) tmp1153) #f) (apply (lambda (_1158 mod1159 id1160) (values (syntax->datum id1160) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1159)))) tmp1153) (syntax-violation #f "source expression failed to match any pattern" tmp1152))) ($sc-dispatch tmp1152 (quote (any each-any any))))) e1151))) (global-extend112 (quote module-ref) (quote @@) (lambda (e1162) ((lambda (tmp1163) ((lambda (tmp1164) (if (if tmp1164 (apply (lambda (_1165 mod1166 id1167) (if (and-map id?114 mod1166) (id?114 id1167) #f)) tmp1164) #f) (apply (lambda (_1169 mod1170 id1171) (values (syntax->datum id1171) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1170)))) tmp1164) (syntax-violation #f "source expression failed to match any pattern" tmp1163))) ($sc-dispatch tmp1163 (quote (any each-any any))))) e1162))) (global-extend112 (quote core) (quote if) (lambda (e1173 r1174 w1175 s1176 mod1177) ((lambda (tmp1178) ((lambda (tmp1179) (if tmp1179 (apply (lambda (_1180 test1181 then1182) (build-conditional82 s1176 (chi150 test1181 r1174 w1175 mod1177) (chi150 then1182 r1174 w1175 mod1177) (build-void80 #f))) tmp1179) ((lambda (tmp1183) (if tmp1183 (apply (lambda (_1184 test1185 then1186 else1187) (build-conditional82 s1176 (chi150 test1185 r1174 w1175 mod1177) (chi150 then1186 r1174 w1175 mod1177) (chi150 else1187 r1174 w1175 mod1177))) tmp1183) (syntax-violation #f "source expression failed to match any pattern" tmp1178))) ($sc-dispatch tmp1178 (quote (any any any any)))))) ($sc-dispatch tmp1178 (quote (any any any))))) e1173))) (global-extend112 (quote begin) (quote begin) (quote ())) (global-extend112 (quote define) (quote define) (quote ())) (global-extend112 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend112 (quote eval-when) (quote eval-when) (quote ())) (global-extend112 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1191 (lambda (x1192 keys1193 clauses1194 r1195 mod1196) (if (null? clauses1194) (build-application81 #f (build-primref91 #f (quote syntax-violation)) (list (build-data92 #f #f) (build-data92 #f "source expression failed to match any pattern") x1192)) ((lambda (tmp1197) ((lambda (tmp1198) (if tmp1198 (apply (lambda (pat1199 exp1200) (if (if (id?114 pat1199) (and-map (lambda (x1201) (not (free-id=?137 pat1199 x1201))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1193)) #f) (let ((labels1202 (list (gen-label119))) (var1203 (gen-var161 pat1199))) (build-application81 #f (build-lambda90 #f (list (syntax->datum pat1199)) (list var1203) #f (chi150 exp1200 (extend-env108 labels1202 (list (cons (quote syntax) (cons var1203 0))) r1195) (make-binding-wrap131 (list pat1199) labels1202 (quote (()))) mod1196)) (list x1192))) (gen-clause1190 x1192 keys1193 (cdr clauses1194) r1195 pat1199 #t exp1200 mod1196))) tmp1198) ((lambda (tmp1204) (if tmp1204 (apply (lambda (pat1205 fender1206 exp1207) (gen-clause1190 x1192 keys1193 (cdr clauses1194) r1195 pat1205 fender1206 exp1207 mod1196)) tmp1204) ((lambda (_1208) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1194))) tmp1197))) ($sc-dispatch tmp1197 (quote (any any any)))))) ($sc-dispatch tmp1197 (quote (any any))))) (car clauses1194))))) (gen-clause1190 (lambda (x1209 keys1210 clauses1211 r1212 pat1213 fender1214 exp1215 mod1216) (call-with-values (lambda () (convert-pattern1188 pat1213 keys1210)) (lambda (p1217 pvars1218) (if (not (distinct-bound-ids?140 (map car pvars1218))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1213) (if (not (and-map (lambda (x1219) (not (ellipsis?159 (car x1219)))) pvars1218)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1213) (let ((y1220 (gen-var161 (quote tmp)))) (build-application81 #f (build-lambda90 #f (list (quote tmp)) (list y1220) #f (let ((y1221 (build-lexical-reference83 (quote value) #f (quote tmp) y1220))) (build-conditional82 #f ((lambda (tmp1222) ((lambda (tmp1223) (if tmp1223 (apply (lambda () y1221) tmp1223) ((lambda (_1224) (build-conditional82 #f y1221 (build-dispatch-call1189 pvars1218 fender1214 y1221 r1212 mod1216) (build-data92 #f #f))) tmp1222))) ($sc-dispatch tmp1222 (quote #(atom #t))))) fender1214) (build-dispatch-call1189 pvars1218 exp1215 y1221 r1212 mod1216) (gen-syntax-case1191 x1209 keys1210 clauses1211 r1212 mod1216)))) (list (if (eq? p1217 (quote any)) (build-application81 #f (build-primref91 #f (quote list)) (list x1209)) (build-application81 #f (build-primref91 #f (quote $sc-dispatch)) (list x1209 (build-data92 #f p1217))))))))))))) (build-dispatch-call1189 (lambda (pvars1225 exp1226 y1227 r1228 mod1229) (let ((ids1230 (map car pvars1225)) (levels1231 (map cdr pvars1225))) (let ((labels1232 (gen-labels120 ids1230)) (new-vars1233 (map gen-var161 ids1230))) (build-application81 #f (build-primref91 #f (quote apply)) (list (build-lambda90 #f (map syntax->datum ids1230) new-vars1233 #f (chi150 exp1226 (extend-env108 labels1232 (map (lambda (var1234 level1235) (cons (quote syntax) (cons var1234 level1235))) new-vars1233 (map cdr pvars1225)) r1228) (make-binding-wrap131 ids1230 labels1232 (quote (()))) mod1229)) y1227)))))) (convert-pattern1188 (lambda (pattern1236 keys1237) (letrec ((cvt1238 (lambda (p1239 n1240 ids1241) (if (id?114 p1239) (if (bound-id-member?141 p1239 keys1237) (values (vector (quote free-id) p1239) ids1241) (values (quote any) (cons (cons p1239 n1240) ids1241))) ((lambda (tmp1242) ((lambda (tmp1243) (if (if tmp1243 (apply (lambda (x1244 dots1245) (ellipsis?159 dots1245)) tmp1243) #f) (apply (lambda (x1246 dots1247) (call-with-values (lambda () (cvt1238 x1246 (fx+72 n1240 1) ids1241)) (lambda (p1248 ids1249) (values (if (eq? p1248 (quote any)) (quote each-any) (vector (quote each) p1248)) ids1249)))) tmp1243) ((lambda (tmp1250) (if tmp1250 (apply (lambda (x1251 y1252) (call-with-values (lambda () (cvt1238 y1252 n1240 ids1241)) (lambda (y1253 ids1254) (call-with-values (lambda () (cvt1238 x1251 n1240 ids1254)) (lambda (x1255 ids1256) (values (cons x1255 y1253) ids1256)))))) tmp1250) ((lambda (tmp1257) (if tmp1257 (apply (lambda () (values (quote ()) ids1241)) tmp1257) ((lambda (tmp1258) (if tmp1258 (apply (lambda (x1259) (call-with-values (lambda () (cvt1238 x1259 n1240 ids1241)) (lambda (p1261 ids1262) (values (vector (quote vector) p1261) ids1262)))) tmp1258) ((lambda (x1263) (values (vector (quote atom) (strip160 p1239 (quote (())))) ids1241)) tmp1242))) ($sc-dispatch tmp1242 (quote #(vector each-any)))))) ($sc-dispatch tmp1242 (quote ()))))) ($sc-dispatch tmp1242 (quote (any . any)))))) ($sc-dispatch tmp1242 (quote (any any))))) p1239))))) (cvt1238 pattern1236 0 (quote ())))))) (lambda (e1264 r1265 w1266 s1267 mod1268) (let ((e1269 (source-wrap143 e1264 w1266 s1267 mod1268))) ((lambda (tmp1270) ((lambda (tmp1271) (if tmp1271 (apply (lambda (_1272 val1273 key1274 m1275) (if (and-map (lambda (x1276) (if (id?114 x1276) (not (ellipsis?159 x1276)) #f)) key1274) (let ((x1278 (gen-var161 (quote tmp)))) (build-application81 s1267 (build-lambda90 #f (list (quote tmp)) (list x1278) #f (gen-syntax-case1191 (build-lexical-reference83 (quote value) #f (quote tmp) x1278) key1274 m1275 r1265 mod1268)) (list (chi150 val1273 r1265 (quote (())) mod1268)))) (syntax-violation (quote syntax-case) "invalid literals list" e1269))) tmp1271) (syntax-violation #f "source expression failed to match any pattern" tmp1270))) ($sc-dispatch tmp1270 (quote (any any each-any . each-any))))) e1269))))) (set! sc-expand (lambda (x1282 . rest1281) (if (if (pair? x1282) (equal? (car x1282) noexpand70) #f) (cadr x1282) (let ((m1283 (if (null? rest1281) (quote e) (car rest1281))) (esew1284 (if (let ((t1285 (null? rest1281))) (if t1285 t1285 (null? (cdr rest1281)))) (quote (eval)) (cadr rest1281)))) (with-fluid* *mode*71 m1283 (lambda () (chi-top149 x1282 (quote ()) (quote ((top))) m1283 esew1284 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1286) (nonsymbol-id?113 x1286))) (set! datum->syntax (lambda (id1287 datum1288) (make-syntax-object97 datum1288 (syntax-object-wrap100 id1287) #f))) (set! syntax->datum (lambda (x1289) (strip160 x1289 (quote (()))))) (set! generate-temporaries (lambda (ls1290) (begin (let ((x1291 ls1290)) (if (not (list? x1291)) (syntax-violation (quote generate-temporaries) "invalid argument" x1291))) (map (lambda (x1292) (wrap142 (gensym) (quote ((top))) #f)) ls1290)))) (set! free-identifier=? (lambda (x1293 y1294) (begin (let ((x1295 x1293)) (if (not (nonsymbol-id?113 x1295)) (syntax-violation (quote free-identifier=?) "invalid argument" x1295))) (let ((x1296 y1294)) (if (not (nonsymbol-id?113 x1296)) (syntax-violation (quote free-identifier=?) "invalid argument" x1296))) (free-id=?137 x1293 y1294)))) (set! bound-identifier=? (lambda (x1297 y1298) (begin (let ((x1299 x1297)) (if (not (nonsymbol-id?113 x1299)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1299))) (let ((x1300 y1298)) (if (not (nonsymbol-id?113 x1300)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1300))) (bound-id=?138 x1297 y1298)))) (set! syntax-violation (lambda (who1304 message1303 form1302 . subform1301) (begin (let ((x1305 who1304)) (if (not ((lambda (x1306) (let ((t1307 (not x1306))) (if t1307 t1307 (let ((t1308 (string? x1306))) (if t1308 t1308 (symbol? x1306)))))) x1305)) (syntax-violation (quote syntax-violation) "invalid argument" x1305))) (let ((x1309 message1303)) (if (not (string? x1309)) (syntax-violation (quote syntax-violation) "invalid argument" x1309))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1304 "~a: " "") "~a " (if (null? subform1301) "in ~a" "in subform `~s' of `~s'")) (let ((tail1310 (cons message1303 (map (lambda (x1311) (strip160 x1311 (quote (())))) (append subform1301 (list form1302)))))) (if who1304 (cons who1304 tail1310) tail1310)) #f)))) (letrec ((match1316 (lambda (e1317 p1318 w1319 r1320 mod1321) (if (not r1320) #f (if (eq? p1318 (quote any)) (cons (wrap142 e1317 w1319 mod1321) r1320) (if (syntax-object?98 e1317) (match*1315 (syntax-object-expression99 e1317) p1318 (join-wraps133 w1319 (syntax-object-wrap100 e1317)) r1320 (syntax-object-module101 e1317)) (match*1315 e1317 p1318 w1319 r1320 mod1321)))))) (match*1315 (lambda (e1322 p1323 w1324 r1325 mod1326) (if (null? p1323) (if (null? e1322) r1325 #f) (if (pair? p1323) (if (pair? e1322) (match1316 (car e1322) (car p1323) w1324 (match1316 (cdr e1322) (cdr p1323) w1324 r1325 mod1326) mod1326) #f) (if (eq? p1323 (quote each-any)) (let ((l1327 (match-each-any1313 e1322 w1324 mod1326))) (if l1327 (cons l1327 r1325) #f)) (let ((atom-key1328 (vector-ref p1323 0))) (if (memv atom-key1328 (quote (each))) (if (null? e1322) (match-empty1314 (vector-ref p1323 1) r1325) (let ((l1329 (match-each1312 e1322 (vector-ref p1323 1) w1324 mod1326))) (if l1329 (letrec ((collect1330 (lambda (l1331) (if (null? (car l1331)) r1325 (cons (map car l1331) (collect1330 (map cdr l1331))))))) (collect1330 l1329)) #f))) (if (memv atom-key1328 (quote (free-id))) (if (id?114 e1322) (if (free-id=?137 (wrap142 e1322 w1324 mod1326) (vector-ref p1323 1)) r1325 #f) #f) (if (memv atom-key1328 (quote (atom))) (if (equal? (vector-ref p1323 1) (strip160 e1322 w1324)) r1325 #f) (if (memv atom-key1328 (quote (vector))) (if (vector? e1322) (match1316 (vector->list e1322) (vector-ref p1323 1) w1324 r1325 mod1326) #f))))))))))) (match-empty1314 (lambda (p1332 r1333) (if (null? p1332) r1333 (if (eq? p1332 (quote any)) (cons (quote ()) r1333) (if (pair? p1332) (match-empty1314 (car p1332) (match-empty1314 (cdr p1332) r1333)) (if (eq? p1332 (quote each-any)) (cons (quote ()) r1333) (let ((atom-key1334 (vector-ref p1332 0))) (if (memv atom-key1334 (quote (each))) (match-empty1314 (vector-ref p1332 1) r1333) (if (memv atom-key1334 (quote (free-id atom))) r1333 (if (memv atom-key1334 (quote (vector))) (match-empty1314 (vector-ref p1332 1) r1333))))))))))) (match-each-any1313 (lambda (e1335 w1336 mod1337) (if (pair? e1335) (let ((l1338 (match-each-any1313 (cdr e1335) w1336 mod1337))) (if l1338 (cons (wrap142 (car e1335) w1336 mod1337) l1338) #f)) (if (null? e1335) (quote ()) (if (syntax-object?98 e1335) (match-each-any1313 (syntax-object-expression99 e1335) (join-wraps133 w1336 (syntax-object-wrap100 e1335)) mod1337) #f))))) (match-each1312 (lambda (e1339 p1340 w1341 mod1342) (if (pair? e1339) (let ((first1343 (match1316 (car e1339) p1340 w1341 (quote ()) mod1342))) (if first1343 (let ((rest1344 (match-each1312 (cdr e1339) p1340 w1341 mod1342))) (if rest1344 (cons first1343 rest1344) #f)) #f)) (if (null? e1339) (quote ()) (if (syntax-object?98 e1339) (match-each1312 (syntax-object-expression99 e1339) p1340 (join-wraps133 w1341 (syntax-object-wrap100 e1339)) (syntax-object-module101 e1339)) #f)))))) (set! $sc-dispatch (lambda (e1345 p1346) (if (eq? p1346 (quote any)) (list e1345) (if (syntax-object?98 e1345) (match*1315 (syntax-object-expression99 e1345) p1346 (syntax-object-wrap100 e1345) (quote ()) (syntax-object-module101 e1345)) (match*1315 e1345 p1346 (quote (())) (quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x1347) ((lambda (tmp1348) ((lambda (tmp1349) (if tmp1349 (apply (lambda (_1350 e11351 e21352) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11351 e21352))) tmp1349) ((lambda (tmp1354) (if tmp1354 (apply (lambda (_1355 out1356 in1357 e11358 e21359) (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))) in1357 (quote ()) (list out1356 (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 e11358 e21359))))) tmp1354) ((lambda (tmp1361) (if tmp1361 (apply (lambda (_1362 out1363 in1364 e11365 e21366) (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))) in1364) (quote ()) (list out1363 (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 e11365 e21366))))) tmp1361) (syntax-violation #f "source expression failed to match any pattern" tmp1348))) ($sc-dispatch tmp1348 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1348 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1348 (quote (any () any . each-any))))) x1347))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1370) ((lambda (tmp1371) ((lambda (tmp1372) (if tmp1372 (apply (lambda (_1373 k1374 keyword1375 pattern1376 template1377) (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 k1374 (map (lambda (tmp1380 tmp1379) (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))) tmp1379) (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))) tmp1380))) template1377 pattern1376)))))) tmp1372) (syntax-violation #f "source expression failed to match any pattern" tmp1371))) ($sc-dispatch tmp1371 (quote (any each-any . #(each ((any . any) any))))))) x1370))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1381) ((lambda (tmp1382) ((lambda (tmp1383) (if (if tmp1383 (apply (lambda (let*1384 x1385 v1386 e11387 e21388) (and-map identifier? x1385)) tmp1383) #f) (apply (lambda (let*1390 x1391 v1392 e11393 e21394) (letrec ((f1395 (lambda (bindings1396) (if (null? bindings1396) (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 e11393 e21394))) ((lambda (tmp1400) ((lambda (tmp1401) (if tmp1401 (apply (lambda (body1402 binding1403) (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 binding1403) body1402)) tmp1401) (syntax-violation #f "source expression failed to match any pattern" tmp1400))) ($sc-dispatch tmp1400 (quote (any any))))) (list (f1395 (cdr bindings1396)) (car bindings1396))))))) (f1395 (map list x1391 v1392)))) tmp1383) (syntax-violation #f "source expression failed to match any pattern" tmp1382))) ($sc-dispatch tmp1382 (quote (any #(each (any any)) any . each-any))))) x1381))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1404) ((lambda (tmp1405) ((lambda (tmp1406) (if tmp1406 (apply (lambda (_1407 var1408 init1409 step1410 e01411 e11412 c1413) ((lambda (tmp1414) ((lambda (tmp1415) (if tmp1415 (apply (lambda (step1416) ((lambda (tmp1417) ((lambda (tmp1418) (if tmp1418 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1408 init1409) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01411) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1413 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1416))))))) tmp1418) ((lambda (tmp1423) (if tmp1423 (apply (lambda (e11424 e21425) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1408 init1409) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01411 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e11424 e21425)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1413 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1416))))))) tmp1423) (syntax-violation #f "source expression failed to match any pattern" tmp1417))) ($sc-dispatch tmp1417 (quote (any . each-any)))))) ($sc-dispatch tmp1417 (quote ())))) e11412)) tmp1415) (syntax-violation #f "source expression failed to match any pattern" tmp1414))) ($sc-dispatch tmp1414 (quote each-any)))) (map (lambda (v1432 s1433) ((lambda (tmp1434) ((lambda (tmp1435) (if tmp1435 (apply (lambda () v1432) tmp1435) ((lambda (tmp1436) (if tmp1436 (apply (lambda (e1437) e1437) tmp1436) ((lambda (_1438) (syntax-violation (quote do) "bad step expression" orig-x1404 s1433)) tmp1434))) ($sc-dispatch tmp1434 (quote (any)))))) ($sc-dispatch tmp1434 (quote ())))) s1433)) var1408 step1410))) tmp1406) (syntax-violation #f "source expression failed to match any pattern" tmp1405))) ($sc-dispatch tmp1405 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1404))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1441 (lambda (x1445 y1446) ((lambda (tmp1447) ((lambda (tmp1448) (if tmp1448 (apply (lambda (x1449 y1450) ((lambda (tmp1451) ((lambda (tmp1452) (if tmp1452 (apply (lambda (dy1453) ((lambda (tmp1454) ((lambda (tmp1455) (if tmp1455 (apply (lambda (dx1456) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx1456 dy1453))) tmp1455) ((lambda (_1457) (if (null? dy1453) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1449) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1449 y1450))) tmp1454))) ($sc-dispatch tmp1454 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x1449)) tmp1452) ((lambda (tmp1458) (if tmp1458 (apply (lambda (stuff1459) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1449 stuff1459))) tmp1458) ((lambda (else1460) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1449 y1450)) tmp1451))) ($sc-dispatch tmp1451 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1451 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y1450)) tmp1448) (syntax-violation #f "source expression failed to match any pattern" tmp1447))) ($sc-dispatch tmp1447 (quote (any any))))) (list x1445 y1446)))) (quasiappend1442 (lambda (x1461 y1462) ((lambda (tmp1463) ((lambda (tmp1464) (if tmp1464 (apply (lambda (x1465 y1466) ((lambda (tmp1467) ((lambda (tmp1468) (if tmp1468 (apply (lambda () x1465) tmp1468) ((lambda (_1469) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1465 y1466)) tmp1467))) ($sc-dispatch tmp1467 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1466)) tmp1464) (syntax-violation #f "source expression failed to match any pattern" tmp1463))) ($sc-dispatch tmp1463 (quote (any any))))) (list x1461 y1462)))) (quasivector1443 (lambda (x1470) ((lambda (tmp1471) ((lambda (x1472) ((lambda (tmp1473) ((lambda (tmp1474) (if tmp1474 (apply (lambda (x1475) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x1475))) tmp1474) ((lambda (tmp1477) (if tmp1477 (apply (lambda (x1478) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1478)) tmp1477) ((lambda (_1480) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1472)) tmp1473))) ($sc-dispatch tmp1473 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp1473 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x1472)) tmp1471)) x1470))) (quasi1444 (lambda (p1481 lev1482) ((lambda (tmp1483) ((lambda (tmp1484) (if tmp1484 (apply (lambda (p1485) (if (= lev1482 0) p1485 (quasicons1441 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1444 (list p1485) (- lev1482 1))))) tmp1484) ((lambda (tmp1486) (if (if tmp1486 (apply (lambda (args1487) (= lev1482 0)) tmp1486) #f) (apply (lambda (args1488) (syntax-violation (quote unquote) "unquote takes exactly one argument" p1481 (cons (quote #(syntax-object unquote ((top) #(ribcage #(args) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1488))) tmp1486) ((lambda (tmp1489) (if tmp1489 (apply (lambda (p1490 q1491) (if (= lev1482 0) (quasiappend1442 p1490 (quasi1444 q1491 lev1482)) (quasicons1441 (quasicons1441 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1444 (list p1490) (- lev1482 1))) (quasi1444 q1491 lev1482)))) tmp1489) ((lambda (tmp1492) (if (if tmp1492 (apply (lambda (args1493 q1494) (= lev1482 0)) tmp1492) #f) (apply (lambda (args1495 q1496) (syntax-violation (quote unquote-splicing) "unquote-splicing takes exactly one argument" p1481 (cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1495))) tmp1492) ((lambda (tmp1497) (if tmp1497 (apply (lambda (p1498) (quasicons1441 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1444 (list p1498) (+ lev1482 1)))) tmp1497) ((lambda (tmp1499) (if tmp1499 (apply (lambda (p1500 q1501) (quasicons1441 (quasi1444 p1500 lev1482) (quasi1444 q1501 lev1482))) tmp1499) ((lambda (tmp1502) (if tmp1502 (apply (lambda (x1503) (quasivector1443 (quasi1444 x1503 lev1482))) tmp1502) ((lambda (p1505) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p1505)) tmp1483))) ($sc-dispatch tmp1483 (quote #(vector each-any)))))) ($sc-dispatch tmp1483 (quote (any . any)))))) ($sc-dispatch tmp1483 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp1483 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any) . any)))))) ($sc-dispatch tmp1483 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1483 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1483 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p1481)))) (lambda (x1506) ((lambda (tmp1507) ((lambda (tmp1508) (if tmp1508 (apply (lambda (_1509 e1510) (quasi1444 e1510 0)) tmp1508) (syntax-violation #f "source expression failed to match any pattern" tmp1507))) ($sc-dispatch tmp1507 (quote (any any))))) x1506)))))
-(define include (make-syncase-macro (quote macro) (lambda (x1511) (letrec ((read-file1512 (lambda (fn1513 k1514) (let ((p1515 (open-input-file fn1513))) (letrec ((f1516 (lambda (x1517) (if (eof-object? x1517) (begin (close-input-port p1515) (quote ())) (cons (datum->syntax k1514 x1517) (f1516 (read p1515))))))) (f1516 (read p1515))))))) ((lambda (tmp1518) ((lambda (tmp1519) (if tmp1519 (apply (lambda (k1520 filename1521) (let ((fn1522 (syntax->datum filename1521))) ((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (exp1525) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp1525)) tmp1524) (syntax-violation #f "source expression failed to match any pattern" tmp1523))) ($sc-dispatch tmp1523 (quote each-any)))) (read-file1512 fn1522 k1520)))) tmp1519) (syntax-violation #f "source expression failed to match any pattern" tmp1518))) ($sc-dispatch tmp1518 (quote (any any))))) x1511)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x1527) ((lambda (tmp1528) ((lambda (tmp1529) (if tmp1529 (apply (lambda (_1530 e1531) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1527)) tmp1529) (syntax-violation #f "source expression failed to match any pattern" tmp1528))) ($sc-dispatch tmp1528 (quote (any any))))) x1527))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1532) ((lambda (tmp1533) ((lambda (tmp1534) (if tmp1534 (apply (lambda (_1535 e1536) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1532)) tmp1534) (syntax-violation #f "source expression failed to match any pattern" tmp1533))) ($sc-dispatch tmp1533 (quote (any any))))) x1532))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1537) ((lambda (tmp1538) ((lambda (tmp1539) (if tmp1539 (apply (lambda (_1540 e1541 m11542 m21543) ((lambda (tmp1544) ((lambda (body1545) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1541)) body1545)) tmp1544)) (letrec ((f1546 (lambda (clause1547 clauses1548) (if (null? clauses1548) ((lambda (tmp1550) ((lambda (tmp1551) (if tmp1551 (apply (lambda (e11552 e21553) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11552 e21553))) tmp1551) ((lambda (tmp1555) (if tmp1555 (apply (lambda (k1556 e11557 e21558) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1556)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11557 e21558)))) tmp1555) ((lambda (_1561) (syntax-violation (quote case) "bad clause" x1537 clause1547)) tmp1550))) ($sc-dispatch tmp1550 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1550 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause1547) ((lambda (tmp1562) ((lambda (rest1563) ((lambda (tmp1564) ((lambda (tmp1565) (if tmp1565 (apply (lambda (k1566 e11567 e21568) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1566)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11567 e21568)) rest1563)) tmp1565) ((lambda (_1571) (syntax-violation (quote case) "bad clause" x1537 clause1547)) tmp1564))) ($sc-dispatch tmp1564 (quote (each-any any . each-any))))) clause1547)) tmp1562)) (f1546 (car clauses1548) (cdr clauses1548))))))) (f1546 m11542 m21543)))) tmp1539) (syntax-violation #f "source expression failed to match any pattern" tmp1538))) ($sc-dispatch tmp1538 (quote (any any any . each-any))))) x1537))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1572) ((lambda (tmp1573) ((lambda (tmp1574) (if tmp1574 (apply (lambda (_1575 e1576) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1576)) (list (cons _1575 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e1576 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp1574) (syntax-violation #f "source expression failed to match any pattern" tmp1573))) ($sc-dispatch tmp1573 (quote (any any))))) x1572))))
+(letrec ((and-map*151 (lambda (f191 first190 . rest189) (let ((t192 (null? first190))) (if t192 t192 (if (null? rest189) (letrec ((andmap193 (lambda (first194) (let ((x195 (car first194)) (first196 (cdr first194))) (if (null? first196) (f191 x195) (if (f191 x195) (andmap193 first196) #f)))))) (andmap193 first190)) (letrec ((andmap197 (lambda (first198 rest199) (let ((x200 (car first198)) (xr201 (map car rest199)) (first202 (cdr first198)) (rest203 (map cdr rest199))) (if (null? first202) (apply f191 (cons x200 xr201)) (if (apply f191 (cons x200 xr201)) (andmap197 first202 rest203) #f)))))) (andmap197 first190 rest189)))))))) (letrec ((lambda-var-list296 (lambda (vars420) (letrec ((lvl421 (lambda (vars422 ls423 w424) (if (pair? vars422) (lvl421 (cdr vars422) (cons (wrap276 (car vars422) w424 #f) ls423) w424) (if (id?248 vars422) (cons (wrap276 vars422 w424 #f) ls423) (if (null? vars422) ls423 (if (syntax-object?232 vars422) (lvl421 (syntax-object-expression233 vars422) ls423 (join-wraps267 w424 (syntax-object-wrap234 vars422))) (cons vars422 ls423)))))))) (lvl421 vars420 (quote ()) (quote (())))))) (gen-var295 (lambda (id425) (let ((id426 (if (syntax-object?232 id425) (syntax-object-expression233 id425) id425))) (gensym (symbol->string id426))))) (strip294 (lambda (x427 w428) (if (memq (quote top) (wrap-marks251 w428)) x427 (letrec ((f429 (lambda (x430) (if (syntax-object?232 x430) (strip294 (syntax-object-expression233 x430) (syntax-object-wrap234 x430)) (if (pair? x430) (let ((a431 (f429 (car x430))) (d432 (f429 (cdr x430)))) (if (if (eq? a431 (car x430)) (eq? d432 (cdr x430)) #f) x430 (cons a431 d432))) (if (vector? x430) (let ((old433 (vector->list x430))) (let ((new434 (map f429 old433))) (if (and-map*151 eq? old433 new434) x430 (list->vector new434)))) x430)))))) (f429 x427))))) (ellipsis?293 (lambda (x435) (if (nonsymbol-id?247 x435) (free-id=?271 x435 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void292 (lambda () (build-void214 #f))) (eval-local-transformer291 (lambda (expanded436 mod437) (let ((p438 (local-eval-hook211 expanded436 mod437))) (if (procedure? p438) p438 (syntax-violation #f "nonprocedure transformer" p438))))) (chi-local-syntax290 (lambda (rec?439 e440 r441 w442 s443 mod444 k445) ((lambda (tmp446) ((lambda (tmp447) (if tmp447 (apply (lambda (_448 id449 val450 e1451 e2452) (let ((ids453 id449)) (if (not (valid-bound-ids?273 ids453)) (syntax-violation #f "duplicate bound keyword" e440) (let ((labels455 (gen-labels254 ids453))) (let ((new-w456 (make-binding-wrap265 ids453 labels455 w442))) (k445 (cons e1451 e2452) (extend-env242 labels455 (let ((w458 (if rec?439 new-w456 w442)) (trans-r459 (macros-only-env244 r441))) (map (lambda (x460) (cons (quote macro) (eval-local-transformer291 (chi284 x460 trans-r459 w458 mod444) mod444))) val450)) r441) new-w456 s443 mod444)))))) tmp447) ((lambda (_462) (syntax-violation #f "bad local syntax definition" (source-wrap277 e440 w442 s443 mod444))) tmp446))) ($sc-dispatch tmp446 (quote (any #(each (any any)) any . each-any))))) e440))) (chi-lambda-clause289 (lambda (e463 docstring464 c465 r466 w467 mod468 k469) ((lambda (tmp470) ((lambda (tmp471) (if (if tmp471 (apply (lambda (args472 doc473 e1474 e2475) (if (string? (syntax->datum doc473)) (not docstring464) #f)) tmp471) #f) (apply (lambda (args476 doc477 e1478 e2479) (chi-lambda-clause289 e463 doc477 (cons args476 (cons e1478 e2479)) r466 w467 mod468 k469)) tmp471) ((lambda (tmp481) (if tmp481 (apply (lambda (id482 e1483 e2484) (let ((ids485 id482)) (if (not (valid-bound-ids?273 ids485)) (syntax-violation (quote lambda) "invalid parameter list" e463) (let ((labels487 (gen-labels254 ids485)) (new-vars488 (map gen-var295 ids485))) (k469 (map syntax->datum ids485) new-vars488 (if docstring464 (syntax->datum docstring464) #f) (chi-body288 (cons e1483 e2484) e463 (extend-var-env243 labels487 new-vars488 r466) (make-binding-wrap265 ids485 labels487 w467) mod468)))))) tmp481) ((lambda (tmp490) (if tmp490 (apply (lambda (ids491 e1492 e2493) (let ((old-ids494 (lambda-var-list296 ids491))) (if (not (valid-bound-ids?273 old-ids494)) (syntax-violation (quote lambda) "invalid parameter list" e463) (let ((labels495 (gen-labels254 old-ids494)) (new-vars496 (map gen-var295 old-ids494))) (k469 (letrec ((f497 (lambda (ls1498 ls2499) (if (null? ls1498) (syntax->datum ls2499) (f497 (cdr ls1498) (cons (syntax->datum (car ls1498)) ls2499)))))) (f497 (cdr old-ids494) (car old-ids494))) (letrec ((f500 (lambda (ls1501 ls2502) (if (null? ls1501) ls2502 (f500 (cdr ls1501) (cons (car ls1501) ls2502)))))) (f500 (cdr new-vars496) (car new-vars496))) (if docstring464 (syntax->datum docstring464) #f) (chi-body288 (cons e1492 e2493) e463 (extend-var-env243 labels495 new-vars496 r466) (make-binding-wrap265 old-ids494 labels495 w467) mod468)))))) tmp490) ((lambda (_504) (syntax-violation (quote lambda) "bad lambda" e463)) tmp470))) ($sc-dispatch tmp470 (quote (any any . each-any)))))) ($sc-dispatch tmp470 (quote (each-any any . each-any)))))) ($sc-dispatch tmp470 (quote (any any any . each-any))))) c465))) (chi-body288 (lambda (body505 outer-form506 r507 w508 mod509) (let ((r510 (cons (quote ("placeholder" placeholder)) r507))) (let ((ribcage511 (make-ribcage255 (quote ()) (quote ()) (quote ())))) (let ((w512 (make-wrap250 (wrap-marks251 w508) (cons ribcage511 (wrap-subst252 w508))))) (letrec ((parse513 (lambda (body514 ids515 labels516 var-ids517 vars518 vals519 bindings520) (if (null? body514) (syntax-violation #f "no expressions in body" outer-form506) (let ((e522 (cdar body514)) (er523 (caar body514))) (call-with-values (lambda () (syntax-type282 e522 er523 (quote (())) (source-annotation239 er523) ribcage511 mod509)) (lambda (type524 value525 e526 w527 s528 mod529) (if (memv type524 (quote (define-form))) (let ((id530 (wrap276 value525 w527 mod529)) (label531 (gen-label253))) (let ((var532 (gen-var295 id530))) (begin (extend-ribcage!264 ribcage511 id530 label531) (parse513 (cdr body514) (cons id530 ids515) (cons label531 labels516) (cons id530 var-ids517) (cons var532 vars518) (cons (cons er523 (wrap276 e526 w527 mod529)) vals519) (cons (cons (quote lexical) var532) bindings520))))) (if (memv type524 (quote (define-syntax-form))) (let ((id533 (wrap276 value525 w527 mod529)) (label534 (gen-label253))) (begin (extend-ribcage!264 ribcage511 id533 label534) (parse513 (cdr body514) (cons id533 ids515) (cons label534 labels516) var-ids517 vars518 vals519 (cons (cons (quote macro) (cons er523 (wrap276 e526 w527 mod529))) bindings520)))) (if (memv type524 (quote (begin-form))) ((lambda (tmp535) ((lambda (tmp536) (if tmp536 (apply (lambda (_537 e1538) (parse513 (letrec ((f539 (lambda (forms540) (if (null? forms540) (cdr body514) (cons (cons er523 (wrap276 (car forms540) w527 mod529)) (f539 (cdr forms540))))))) (f539 e1538)) ids515 labels516 var-ids517 vars518 vals519 bindings520)) tmp536) (syntax-violation #f "source expression failed to match any pattern" tmp535))) ($sc-dispatch tmp535 (quote (any . each-any))))) e526) (if (memv type524 (quote (local-syntax-form))) (chi-local-syntax290 value525 e526 er523 w527 s528 mod529 (lambda (forms542 er543 w544 s545 mod546) (parse513 (letrec ((f547 (lambda (forms548) (if (null? forms548) (cdr body514) (cons (cons er543 (wrap276 (car forms548) w544 mod546)) (f547 (cdr forms548))))))) (f547 forms542)) ids515 labels516 var-ids517 vars518 vals519 bindings520))) (if (null? ids515) (build-sequence227 #f (map (lambda (x549) (chi284 (cdr x549) (car x549) (quote (())) mod529)) (cons (cons er523 (source-wrap277 e526 w527 s528 mod529)) (cdr body514)))) (begin (if (not (valid-bound-ids?273 ids515)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form506)) (letrec ((loop550 (lambda (bs551 er-cache552 r-cache553) (if (not (null? bs551)) (let ((b554 (car bs551))) (if (eq? (car b554) (quote macro)) (let ((er555 (cadr b554))) (let ((r-cache556 (if (eq? er555 er-cache552) r-cache553 (macros-only-env244 er555)))) (begin (set-cdr! b554 (eval-local-transformer291 (chi284 (cddr b554) r-cache556 (quote (())) mod529) mod529)) (loop550 (cdr bs551) er555 r-cache556)))) (loop550 (cdr bs551) er-cache552 r-cache553))))))) (loop550 bindings520 #f #f)) (set-cdr! r510 (extend-env242 labels516 bindings520 (cdr r510))) (build-letrec230 #f (map syntax->datum var-ids517) vars518 (map (lambda (x557) (chi284 (cdr x557) (car x557) (quote (())) mod529)) vals519) (build-sequence227 #f (map (lambda (x558) (chi284 (cdr x558) (car x558) (quote (())) mod529)) (cons (cons er523 (source-wrap277 e526 w527 s528 mod529)) (cdr body514)))))))))))))))))) (parse513 (map (lambda (x521) (cons r510 (wrap276 x521 w512 mod509))) body505) (quote ()) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro287 (lambda (p559 e560 r561 w562 rib563 mod564) (letrec ((rebuild-macro-output565 (lambda (x566 m567) (if (pair? x566) (cons (rebuild-macro-output565 (car x566) m567) (rebuild-macro-output565 (cdr x566) m567)) (if (syntax-object?232 x566) (let ((w568 (syntax-object-wrap234 x566))) (let ((ms569 (wrap-marks251 w568)) (s570 (wrap-subst252 w568))) (if (if (pair? ms569) (eq? (car ms569) #f) #f) (make-syntax-object231 (syntax-object-expression233 x566) (make-wrap250 (cdr ms569) (if rib563 (cons rib563 (cdr s570)) (cdr s570))) (syntax-object-module235 x566)) (make-syntax-object231 (syntax-object-expression233 x566) (make-wrap250 (cons m567 ms569) (if rib563 (cons rib563 (cons (quote shift) s570)) (cons (quote shift) s570))) (let ((pmod571 (procedure-module p559))) (if pmod571 (cons (quote hygiene) (module-name pmod571)) (quote (hygiene guile)))))))) (if (vector? x566) (let ((n572 (vector-length x566))) (let ((v573 (make-vector n572))) (letrec ((loop574 (lambda (i575) (if (fx=208 i575 n572) (begin (if #f #f) v573) (begin (vector-set! v573 i575 (rebuild-macro-output565 (vector-ref x566 i575) m567)) (loop574 (fx+206 i575 1))))))) (loop574 0)))) (if (symbol? x566) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap277 e560 w562 s mod564) x566) x566))))))) (rebuild-macro-output565 (p559 (wrap276 e560 (anti-mark263 w562) mod564)) (string #\m))))) (chi-application286 (lambda (x576 e577 r578 w579 s580 mod581) ((lambda (tmp582) ((lambda (tmp583) (if tmp583 (apply (lambda (e0584 e1585) (build-application215 s580 x576 (map (lambda (e586) (chi284 e586 r578 w579 mod581)) e1585))) tmp583) (syntax-violation #f "source expression failed to match any pattern" tmp582))) ($sc-dispatch tmp582 (quote (any . each-any))))) e577))) (chi-expr285 (lambda (type588 value589 e590 r591 w592 s593 mod594) (if (memv type588 (quote (lexical))) (build-lexical-reference217 (quote value) s593 e590 value589) (if (memv type588 (quote (core external-macro))) (value589 e590 r591 w592 s593 mod594) (if (memv type588 (quote (module-ref))) (call-with-values (lambda () (value589 e590)) (lambda (id595 mod596) (build-global-reference220 s593 id595 mod596))) (if (memv type588 (quote (lexical-call))) (chi-application286 (build-lexical-reference217 (quote fun) (source-annotation239 (car e590)) (car e590) value589) e590 r591 w592 s593 mod594) (if (memv type588 (quote (global-call))) (chi-application286 (build-global-reference220 (source-annotation239 (car e590)) value589 (if (syntax-object?232 (car e590)) (syntax-object-module235 (car e590)) mod594)) e590 r591 w592 s593 mod594) (if (memv type588 (quote (constant))) (build-data226 s593 (strip294 (source-wrap277 e590 w592 s593 mod594) (quote (())))) (if (memv type588 (quote (global))) (build-global-reference220 s593 value589 mod594) (if (memv type588 (quote (call))) (chi-application286 (chi284 (car e590) r591 w592 mod594) e590 r591 w592 s593 mod594) (if (memv type588 (quote (begin-form))) ((lambda (tmp597) ((lambda (tmp598) (if tmp598 (apply (lambda (_599 e1600 e2601) (chi-sequence278 (cons e1600 e2601) r591 w592 s593 mod594)) tmp598) (syntax-violation #f "source expression failed to match any pattern" tmp597))) ($sc-dispatch tmp597 (quote (any any . each-any))))) e590) (if (memv type588 (quote (local-syntax-form))) (chi-local-syntax290 value589 e590 r591 w592 s593 mod594 chi-sequence278) (if (memv type588 (quote (eval-when-form))) ((lambda (tmp603) ((lambda (tmp604) (if tmp604 (apply (lambda (_605 x606 e1607 e2608) (let ((when-list609 (chi-when-list281 e590 x606 w592))) (if (memq (quote eval) when-list609) (chi-sequence278 (cons e1607 e2608) r591 w592 s593 mod594) (chi-void292)))) tmp604) (syntax-violation #f "source expression failed to match any pattern" tmp603))) ($sc-dispatch tmp603 (quote (any each-any any . each-any))))) e590) (if (memv type588 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e590 (wrap276 value589 w592 mod594)) (if (memv type588 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap277 e590 w592 s593 mod594)) (if (memv type588 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap277 e590 w592 s593 mod594)) (syntax-violation #f "unexpected syntax" (source-wrap277 e590 w592 s593 mod594)))))))))))))))))) (chi284 (lambda (e612 r613 w614 mod615) (call-with-values (lambda () (syntax-type282 e612 r613 w614 (source-annotation239 e612) #f mod615)) (lambda (type616 value617 e618 w619 s620 mod621) (chi-expr285 type616 value617 e618 r613 w619 s620 mod621))))) (chi-top283 (lambda (e622 r623 w624 m625 esew626 mod627) (call-with-values (lambda () (syntax-type282 e622 r623 w624 (source-annotation239 e622) #f mod627)) (lambda (type635 value636 e637 w638 s639 mod640) (if (memv type635 (quote (begin-form))) ((lambda (tmp641) ((lambda (tmp642) (if tmp642 (apply (lambda (_643) (chi-void292)) tmp642) ((lambda (tmp644) (if tmp644 (apply (lambda (_645 e1646 e2647) (chi-top-sequence279 (cons e1646 e2647) r623 w638 s639 m625 esew626 mod640)) tmp644) (syntax-violation #f "source expression failed to match any pattern" tmp641))) ($sc-dispatch tmp641 (quote (any any . each-any)))))) ($sc-dispatch tmp641 (quote (any))))) e637) (if (memv type635 (quote (local-syntax-form))) (chi-local-syntax290 value636 e637 r623 w638 s639 mod640 (lambda (body649 r650 w651 s652 mod653) (chi-top-sequence279 body649 r650 w651 s652 m625 esew626 mod653))) (if (memv type635 (quote (eval-when-form))) ((lambda (tmp654) ((lambda (tmp655) (if tmp655 (apply (lambda (_656 x657 e1658 e2659) (let ((when-list660 (chi-when-list281 e637 x657 w638)) (body661 (cons e1658 e2659))) (if (eq? m625 (quote e)) (if (memq (quote eval) when-list660) (chi-top-sequence279 body661 r623 w638 s639 (quote e) (quote (eval)) mod640) (chi-void292)) (if (memq (quote load) when-list660) (if (let ((t664 (memq (quote compile) when-list660))) (if t664 t664 (if (eq? m625 (quote c&e)) (memq (quote eval) when-list660) #f))) (chi-top-sequence279 body661 r623 w638 s639 (quote c&e) (quote (compile load)) mod640) (if (memq m625 (quote (c c&e))) (chi-top-sequence279 body661 r623 w638 s639 (quote c) (quote (load)) mod640) (chi-void292))) (if (let ((t665 (memq (quote compile) when-list660))) (if t665 t665 (if (eq? m625 (quote c&e)) (memq (quote eval) when-list660) #f))) (begin (top-level-eval-hook210 (chi-top-sequence279 body661 r623 w638 s639 (quote e) (quote (eval)) mod640) mod640) (chi-void292)) (chi-void292)))))) tmp655) (syntax-violation #f "source expression failed to match any pattern" tmp654))) ($sc-dispatch tmp654 (quote (any each-any any . each-any))))) e637) (if (memv type635 (quote (define-syntax-form))) (let ((n666 (id-var-name270 value636 w638)) (r667 (macros-only-env244 r623))) (if (memv m625 (quote (c))) (if (memq (quote compile) esew626) (let ((e668 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)))) (begin (top-level-eval-hook210 e668 mod640) (if (memq (quote load) esew626) e668 (chi-void292)))) (if (memq (quote load) esew626) (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)) (chi-void292))) (if (memv m625 (quote (c&e))) (let ((e669 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)))) (begin (top-level-eval-hook210 e669 mod640) e669)) (begin (if (memq (quote eval) esew626) (top-level-eval-hook210 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640)) mod640)) (chi-void292))))) (if (memv type635 (quote (define-form))) (let ((n670 (id-var-name270 value636 w638))) (let ((type671 (binding-type240 (lookup245 n670 r623 mod640)))) (if (memv type671 (quote (global core macro module-ref))) (let ((x672 (build-global-definition223 s639 n670 (chi284 e637 r623 w638 mod640)))) (begin (if (eq? m625 (quote c&e)) (top-level-eval-hook210 x672 mod640)) x672)) (if (memv type671 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e637 (wrap276 value636 w638 mod640)) (syntax-violation #f "cannot define keyword at top level" e637 (wrap276 value636 w638 mod640)))))) (let ((x673 (chi-expr285 type635 value636 e637 r623 w638 s639 mod640))) (begin (if (eq? m625 (quote c&e)) (top-level-eval-hook210 x673 mod640)) x673))))))))))) (syntax-type282 (lambda (e674 r675 w676 s677 rib678 mod679) (if (symbol? e674) (let ((n680 (id-var-name270 e674 w676))) (let ((b681 (lookup245 n680 r675 mod679))) (let ((type682 (binding-type240 b681))) (if (memv type682 (quote (lexical))) (values type682 (binding-value241 b681) e674 w676 s677 mod679) (if (memv type682 (quote (global))) (values type682 n680 e674 w676 s677 mod679) (if (memv type682 (quote (macro))) (syntax-type282 (chi-macro287 (binding-value241 b681) e674 r675 w676 rib678 mod679) r675 (quote (())) s677 rib678 mod679) (values type682 (binding-value241 b681) e674 w676 s677 mod679))))))) (if (pair? e674) (let ((first683 (car e674))) (if (id?248 first683) (let ((n684 (id-var-name270 first683 w676))) (let ((b685 (lookup245 n684 r675 (let ((t686 (if (syntax-object?232 first683) (syntax-object-module235 first683) #f))) (if t686 t686 mod679))))) (let ((type687 (binding-type240 b685))) (if (memv type687 (quote (lexical))) (values (quote lexical-call) (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (global))) (values (quote global-call) n684 e674 w676 s677 mod679) (if (memv type687 (quote (macro))) (syntax-type282 (chi-macro287 (binding-value241 b685) e674 r675 w676 rib678 mod679) r675 (quote (())) s677 rib678 mod679) (if (memv type687 (quote (core external-macro module-ref))) (values type687 (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value241 b685) e674 w676 s677 mod679) (if (memv type687 (quote (begin))) (values (quote begin-form) #f e674 w676 s677 mod679) (if (memv type687 (quote (eval-when))) (values (quote eval-when-form) #f e674 w676 s677 mod679) (if (memv type687 (quote (define))) ((lambda (tmp688) ((lambda (tmp689) (if (if tmp689 (apply (lambda (_690 name691 val692) (id?248 name691)) tmp689) #f) (apply (lambda (_693 name694 val695) (values (quote define-form) name694 val695 w676 s677 mod679)) tmp689) ((lambda (tmp696) (if (if tmp696 (apply (lambda (_697 name698 args699 e1700 e2701) (if (id?248 name698) (valid-bound-ids?273 (lambda-var-list296 args699)) #f)) tmp696) #f) (apply (lambda (_702 name703 args704 e1705 e2706) (values (quote define-form) (wrap276 name703 w676 mod679) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap276 (cons args704 (cons e1705 e2706)) w676 mod679)) (quote (())) s677 mod679)) tmp696) ((lambda (tmp708) (if (if tmp708 (apply (lambda (_709 name710) (id?248 name710)) tmp708) #f) (apply (lambda (_711 name712) (values (quote define-form) (wrap276 name712 w676 mod679) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s677 mod679)) tmp708) (syntax-violation #f "source expression failed to match any pattern" tmp688))) ($sc-dispatch tmp688 (quote (any any)))))) ($sc-dispatch tmp688 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp688 (quote (any any any))))) e674) (if (memv type687 (quote (define-syntax))) ((lambda (tmp713) ((lambda (tmp714) (if (if tmp714 (apply (lambda (_715 name716 val717) (id?248 name716)) tmp714) #f) (apply (lambda (_718 name719 val720) (values (quote define-syntax-form) name719 val720 w676 s677 mod679)) tmp714) (syntax-violation #f "source expression failed to match any pattern" tmp713))) ($sc-dispatch tmp713 (quote (any any any))))) e674) (values (quote call) #f e674 w676 s677 mod679))))))))))))) (values (quote call) #f e674 w676 s677 mod679))) (if (syntax-object?232 e674) (syntax-type282 (syntax-object-expression233 e674) r675 (join-wraps267 w676 (syntax-object-wrap234 e674)) s677 rib678 (let ((t721 (syntax-object-module235 e674))) (if t721 t721 mod679))) (if (self-evaluating? e674) (values (quote constant) #f e674 w676 s677 mod679) (values (quote other) #f e674 w676 s677 mod679))))))) (chi-when-list281 (lambda (e722 when-list723 w724) (letrec ((f725 (lambda (when-list726 situations727) (if (null? when-list726) situations727 (f725 (cdr when-list726) (cons (let ((x728 (car when-list726))) (if (free-id=?271 x728 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?271 x728 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?271 x728 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e722 (wrap276 x728 w724 #f)))))) situations727)))))) (f725 when-list723 (quote ()))))) (chi-install-global280 (lambda (name729 e730) (build-global-definition223 #f name729 (if (let ((v731 (module-variable (current-module) name729))) (if v731 (if (variable-bound? v731) (if (macro? (variable-ref v731)) (not (eq? (macro-type (variable-ref v731)) (quote syncase-macro))) #f) #f) #f)) (build-application215 #f (build-primref225 #f (quote make-extended-syncase-macro)) (list (build-application215 #f (build-primref225 #f (quote module-ref)) (list (build-application215 #f (build-primref225 #f (quote current-module)) (quote ())) (build-data226 #f name729))) (build-data226 #f (quote macro)) e730)) (build-application215 #f (build-primref225 #f (quote make-syncase-macro)) (list (build-data226 #f (quote macro)) e730)))))) (chi-top-sequence279 (lambda (body732 r733 w734 s735 m736 esew737 mod738) (build-sequence227 s735 (letrec ((dobody739 (lambda (body740 r741 w742 m743 esew744 mod745) (if (null? body740) (quote ()) (let ((first746 (chi-top283 (car body740) r741 w742 m743 esew744 mod745))) (cons first746 (dobody739 (cdr body740) r741 w742 m743 esew744 mod745))))))) (dobody739 body732 r733 w734 m736 esew737 mod738))))) (chi-sequence278 (lambda (body747 r748 w749 s750 mod751) (build-sequence227 s750 (letrec ((dobody752 (lambda (body753 r754 w755 mod756) (if (null? body753) (quote ()) (let ((first757 (chi284 (car body753) r754 w755 mod756))) (cons first757 (dobody752 (cdr body753) r754 w755 mod756))))))) (dobody752 body747 r748 w749 mod751))))) (source-wrap277 (lambda (x758 w759 s760 defmod761) (begin (if (if s760 (pair? x758) #f) (set-source-properties! x758 s760)) (wrap276 x758 w759 defmod761)))) (wrap276 (lambda (x762 w763 defmod764) (if (if (null? (wrap-marks251 w763)) (null? (wrap-subst252 w763)) #f) x762 (if (syntax-object?232 x762) (make-syntax-object231 (syntax-object-expression233 x762) (join-wraps267 w763 (syntax-object-wrap234 x762)) (syntax-object-module235 x762)) (if (null? x762) x762 (make-syntax-object231 x762 w763 defmod764)))))) (bound-id-member?275 (lambda (x765 list766) (if (not (null? list766)) (let ((t767 (bound-id=?272 x765 (car list766)))) (if t767 t767 (bound-id-member?275 x765 (cdr list766)))) #f))) (distinct-bound-ids?274 (lambda (ids768) (letrec ((distinct?769 (lambda (ids770) (let ((t771 (null? ids770))) (if t771 t771 (if (not (bound-id-member?275 (car ids770) (cdr ids770))) (distinct?769 (cdr ids770)) #f)))))) (distinct?769 ids768)))) (valid-bound-ids?273 (lambda (ids772) (if (letrec ((all-ids?773 (lambda (ids774) (let ((t775 (null? ids774))) (if t775 t775 (if (id?248 (car ids774)) (all-ids?773 (cdr ids774)) #f)))))) (all-ids?773 ids772)) (distinct-bound-ids?274 ids772) #f))) (bound-id=?272 (lambda (i776 j777) (if (if (syntax-object?232 i776) (syntax-object?232 j777) #f) (if (eq? (syntax-object-expression233 i776) (syntax-object-expression233 j777)) (same-marks?269 (wrap-marks251 (syntax-object-wrap234 i776)) (wrap-marks251 (syntax-object-wrap234 j777))) #f) (eq? i776 j777)))) (free-id=?271 (lambda (i778 j779) (if (eq? (let ((x780 i778)) (if (syntax-object?232 x780) (syntax-object-expression233 x780) x780)) (let ((x781 j779)) (if (syntax-object?232 x781) (syntax-object-expression233 x781) x781))) (eq? (id-var-name270 i778 (quote (()))) (id-var-name270 j779 (quote (())))) #f))) (id-var-name270 (lambda (id782 w783) (letrec ((search-vector-rib786 (lambda (sym792 subst793 marks794 symnames795 ribcage796) (let ((n797 (vector-length symnames795))) (letrec ((f798 (lambda (i799) (if (fx=208 i799 n797) (search784 sym792 (cdr subst793) marks794) (if (if (eq? (vector-ref symnames795 i799) sym792) (same-marks?269 marks794 (vector-ref (ribcage-marks258 ribcage796) i799)) #f) (values (vector-ref (ribcage-labels259 ribcage796) i799) marks794) (f798 (fx+206 i799 1))))))) (f798 0))))) (search-list-rib785 (lambda (sym800 subst801 marks802 symnames803 ribcage804) (letrec ((f805 (lambda (symnames806 i807) (if (null? symnames806) (search784 sym800 (cdr subst801) marks802) (if (if (eq? (car symnames806) sym800) (same-marks?269 marks802 (list-ref (ribcage-marks258 ribcage804) i807)) #f) (values (list-ref (ribcage-labels259 ribcage804) i807) marks802) (f805 (cdr symnames806) (fx+206 i807 1))))))) (f805 symnames803 0)))) (search784 (lambda (sym808 subst809 marks810) (if (null? subst809) (values #f marks810) (let ((fst811 (car subst809))) (if (eq? fst811 (quote shift)) (search784 sym808 (cdr subst809) (cdr marks810)) (let ((symnames812 (ribcage-symnames257 fst811))) (if (vector? symnames812) (search-vector-rib786 sym808 subst809 marks810 symnames812 fst811) (search-list-rib785 sym808 subst809 marks810 symnames812 fst811))))))))) (if (symbol? id782) (let ((t813 (call-with-values (lambda () (search784 id782 (wrap-subst252 w783) (wrap-marks251 w783))) (lambda (x815 . ignore814) x815)))) (if t813 t813 id782)) (if (syntax-object?232 id782) (let ((id816 (syntax-object-expression233 id782)) (w1817 (syntax-object-wrap234 id782))) (let ((marks818 (join-marks268 (wrap-marks251 w783) (wrap-marks251 w1817)))) (call-with-values (lambda () (search784 id816 (wrap-subst252 w783) marks818)) (lambda (new-id819 marks820) (let ((t821 new-id819)) (if t821 t821 (let ((t822 (call-with-values (lambda () (search784 id816 (wrap-subst252 w1817) marks820)) (lambda (x824 . ignore823) x824)))) (if t822 t822 id816)))))))) (syntax-violation (quote id-var-name) "invalid id" id782)))))) (same-marks?269 (lambda (x825 y826) (let ((t827 (eq? x825 y826))) (if t827 t827 (if (not (null? x825)) (if (not (null? y826)) (if (eq? (car x825) (car y826)) (same-marks?269 (cdr x825) (cdr y826)) #f) #f) #f))))) (join-marks268 (lambda (m1828 m2829) (smart-append266 m1828 m2829))) (join-wraps267 (lambda (w1830 w2831) (let ((m1832 (wrap-marks251 w1830)) (s1833 (wrap-subst252 w1830))) (if (null? m1832) (if (null? s1833) w2831 (make-wrap250 (wrap-marks251 w2831) (smart-append266 s1833 (wrap-subst252 w2831)))) (make-wrap250 (smart-append266 m1832 (wrap-marks251 w2831)) (smart-append266 s1833 (wrap-subst252 w2831))))))) (smart-append266 (lambda (m1834 m2835) (if (null? m2835) m1834 (append m1834 m2835)))) (make-binding-wrap265 (lambda (ids836 labels837 w838) (if (null? ids836) w838 (make-wrap250 (wrap-marks251 w838) (cons (let ((labelvec839 (list->vector labels837))) (let ((n840 (vector-length labelvec839))) (let ((symnamevec841 (make-vector n840)) (marksvec842 (make-vector n840))) (begin (letrec ((f843 (lambda (ids844 i845) (if (not (null? ids844)) (call-with-values (lambda () (id-sym-name&marks249 (car ids844) w838)) (lambda (symname846 marks847) (begin (vector-set! symnamevec841 i845 symname846) (vector-set! marksvec842 i845 marks847) (f843 (cdr ids844) (fx+206 i845 1))))))))) (f843 ids836 0)) (make-ribcage255 symnamevec841 marksvec842 labelvec839))))) (wrap-subst252 w838)))))) (extend-ribcage!264 (lambda (ribcage848 id849 label850) (begin (set-ribcage-symnames!260 ribcage848 (cons (syntax-object-expression233 id849) (ribcage-symnames257 ribcage848))) (set-ribcage-marks!261 ribcage848 (cons (wrap-marks251 (syntax-object-wrap234 id849)) (ribcage-marks258 ribcage848))) (set-ribcage-labels!262 ribcage848 (cons label850 (ribcage-labels259 ribcage848)))))) (anti-mark263 (lambda (w851) (make-wrap250 (cons #f (wrap-marks251 w851)) (cons (quote shift) (wrap-subst252 w851))))) (set-ribcage-labels!262 (lambda (x852 update853) (vector-set! x852 3 update853))) (set-ribcage-marks!261 (lambda (x854 update855) (vector-set! x854 2 update855))) (set-ribcage-symnames!260 (lambda (x856 update857) (vector-set! x856 1 update857))) (ribcage-labels259 (lambda (x858) (vector-ref x858 3))) (ribcage-marks258 (lambda (x859) (vector-ref x859 2))) (ribcage-symnames257 (lambda (x860) (vector-ref x860 1))) (ribcage?256 (lambda (x861) (if (vector? x861) (if (= (vector-length x861) 4) (eq? (vector-ref x861 0) (quote ribcage)) #f) #f))) (make-ribcage255 (lambda (symnames862 marks863 labels864) (vector (quote ribcage) symnames862 marks863 labels864))) (gen-labels254 (lambda (ls865) (if (null? ls865) (quote ()) (cons (gen-label253) (gen-labels254 (cdr ls865)))))) (gen-label253 (lambda () (string #\i))) (wrap-subst252 cdr) (wrap-marks251 car) (make-wrap250 cons) (id-sym-name&marks249 (lambda (x866 w867) (if (syntax-object?232 x866) (values (syntax-object-expression233 x866) (join-marks268 (wrap-marks251 w867) (wrap-marks251 (syntax-object-wrap234 x866)))) (values x866 (wrap-marks251 w867))))) (id?248 (lambda (x868) (if (symbol? x868) #t (if (syntax-object?232 x868) (symbol? (syntax-object-expression233 x868)) #f)))) (nonsymbol-id?247 (lambda (x869) (if (syntax-object?232 x869) (symbol? (syntax-object-expression233 x869)) #f))) (global-extend246 (lambda (type870 sym871 val872) (put-global-definition-hook212 sym871 type870 val872))) (lookup245 (lambda (x873 r874 mod875) (let ((t876 (assq x873 r874))) (if t876 (cdr t876) (if (symbol? x873) (let ((t877 (get-global-definition-hook213 x873 mod875))) (if t877 t877 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env244 (lambda (r878) (if (null? r878) (quote ()) (let ((a879 (car r878))) (if (eq? (cadr a879) (quote macro)) (cons a879 (macros-only-env244 (cdr r878))) (macros-only-env244 (cdr r878))))))) (extend-var-env243 (lambda (labels880 vars881 r882) (if (null? labels880) r882 (extend-var-env243 (cdr labels880) (cdr vars881) (cons (cons (car labels880) (cons (quote lexical) (car vars881))) r882))))) (extend-env242 (lambda (labels883 bindings884 r885) (if (null? labels883) r885 (extend-env242 (cdr labels883) (cdr bindings884) (cons (cons (car labels883) (car bindings884)) r885))))) (binding-value241 cdr) (binding-type240 car) (source-annotation239 (lambda (x886) (if (syntax-object?232 x886) (source-annotation239 (syntax-object-expression233 x886)) (if (pair? x886) (let ((props887 (source-properties x886))) (if (pair? props887) props887 #f)) #f)))) (set-syntax-object-module!238 (lambda (x888 update889) (vector-set! x888 3 update889))) (set-syntax-object-wrap!237 (lambda (x890 update891) (vector-set! x890 2 update891))) (set-syntax-object-expression!236 (lambda (x892 update893) (vector-set! x892 1 update893))) (syntax-object-module235 (lambda (x894) (vector-ref x894 3))) (syntax-object-wrap234 (lambda (x895) (vector-ref x895 2))) (syntax-object-expression233 (lambda (x896) (vector-ref x896 1))) (syntax-object?232 (lambda (x897) (if (vector? x897) (if (= (vector-length x897) 4) (eq? (vector-ref x897 0) (quote syntax-object)) #f) #f))) (make-syntax-object231 (lambda (expression898 wrap899 module900) (vector (quote syntax-object) expression898 wrap899 module900))) (build-letrec230 (lambda (src901 ids902 vars903 val-exps904 body-exp905) (if (null? vars903) body-exp905 (let ((atom-key906 (fluid-ref *mode*205))) (if (memv atom-key906 (quote (c))) (begin (for-each maybe-name-value!222 ids902 val-exps904) ((@ (language tree-il) make-letrec) src901 ids902 vars903 val-exps904 body-exp905)) (list (quote letrec) (map list vars903 val-exps904) body-exp905)))))) (build-named-let229 (lambda (src907 ids908 vars909 val-exps910 body-exp911) (let ((f912 (car vars909)) (f-name913 (car ids908)) (vars914 (cdr vars909)) (ids915 (cdr ids908))) (let ((atom-key916 (fluid-ref *mode*205))) (if (memv atom-key916 (quote (c))) (let ((proc917 (build-lambda224 src907 ids915 vars914 #f body-exp911))) (begin (maybe-name-value!222 f-name913 proc917) (for-each maybe-name-value!222 ids915 val-exps910) ((@ (language tree-il) make-letrec) src907 (list f-name913) (list f912) (list proc917) (build-application215 src907 (build-lexical-reference217 (quote fun) src907 f-name913 f912) val-exps910)))) (list (quote let) f912 (map list vars914 val-exps910) body-exp911)))))) (build-let228 (lambda (src918 ids919 vars920 val-exps921 body-exp922) (if (null? vars920) body-exp922 (let ((atom-key923 (fluid-ref *mode*205))) (if (memv atom-key923 (quote (c))) (begin (for-each maybe-name-value!222 ids919 val-exps921) ((@ (language tree-il) make-let) src918 ids919 vars920 val-exps921 body-exp922)) (list (quote let) (map list vars920 val-exps921) body-exp922)))))) (build-sequence227 (lambda (src924 exps925) (if (null? (cdr exps925)) (car exps925) (let ((atom-key926 (fluid-ref *mode*205))) (if (memv atom-key926 (quote (c))) ((@ (language tree-il) make-sequence) src924 exps925) (cons (quote begin) exps925)))))) (build-data226 (lambda (src927 exp928) (let ((atom-key929 (fluid-ref *mode*205))) (if (memv atom-key929 (quote (c))) ((@ (language tree-il) make-const) src927 exp928) (if (if (self-evaluating? exp928) (not (vector? exp928)) #f) exp928 (list (quote quote) exp928)))))) (build-primref225 (lambda (src930 name931) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key932 (fluid-ref *mode*205))) (if (memv atom-key932 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src930 name931) name931)) (let ((atom-key933 (fluid-ref *mode*205))) (if (memv atom-key933 (quote (c))) ((@ (language tree-il) make-module-ref) src930 (quote (guile)) name931 #f) (list (quote @@) (quote (guile)) name931)))))) (build-lambda224 (lambda (src934 ids935 vars936 docstring937 exp938) (let ((atom-key939 (fluid-ref *mode*205))) (if (memv atom-key939 (quote (c))) ((@ (language tree-il) make-lambda) src934 ids935 vars936 (if docstring937 (list (cons (quote documentation) docstring937)) (quote ())) exp938) (cons (quote lambda) (cons vars936 (append (if docstring937 (list docstring937) (quote ())) (list exp938)))))))) (build-global-definition223 (lambda (source940 var941 exp942) (let ((atom-key943 (fluid-ref *mode*205))) (if (memv atom-key943 (quote (c))) (begin (maybe-name-value!222 var941 exp942) ((@ (language tree-il) make-toplevel-define) source940 var941 exp942)) (list (quote define) var941 exp942))))) (maybe-name-value!222 (lambda (name944 val945) (if ((@ (language tree-il) lambda?) val945) (let ((meta946 ((@ (language tree-il) lambda-meta) val945))) (if (not (assq (quote name) meta946)) ((setter (@ (language tree-il) lambda-meta)) val945 (acons (quote name) name944 meta946))))))) (build-global-assignment221 (lambda (source947 var948 exp949 mod950) (analyze-variable219 mod950 var948 (lambda (mod951 var952 public?953) (let ((atom-key954 (fluid-ref *mode*205))) (if (memv atom-key954 (quote (c))) ((@ (language tree-il) make-module-set) source947 mod951 var952 public?953 exp949) (list (quote set!) (list (if public?953 (quote @) (quote @@)) mod951 var952) exp949)))) (lambda (var955) (let ((atom-key956 (fluid-ref *mode*205))) (if (memv atom-key956 (quote (c))) ((@ (language tree-il) make-toplevel-set) source947 var955 exp949) (list (quote set!) var955 exp949))))))) (build-global-reference220 (lambda (source957 var958 mod959) (analyze-variable219 mod959 var958 (lambda (mod960 var961 public?962) (let ((atom-key963 (fluid-ref *mode*205))) (if (memv atom-key963 (quote (c))) ((@ (language tree-il) make-module-ref) source957 mod960 var961 public?962) (list (if public?962 (quote @) (quote @@)) mod960 var961)))) (lambda (var964) (let ((atom-key965 (fluid-ref *mode*205))) (if (memv atom-key965 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source957 var964) var964)))))) (analyze-variable219 (lambda (mod966 var967 modref-cont968 bare-cont969) (if (not mod966) (bare-cont969 var967) (let ((kind970 (car mod966)) (mod971 (cdr mod966))) (if (memv kind970 (quote (public))) (modref-cont968 mod971 var967 #t) (if (memv kind970 (quote (private))) (if (not (equal? mod971 (module-name (current-module)))) (modref-cont968 mod971 var967 #f) (bare-cont969 var967)) (if (memv kind970 (quote (bare))) (bare-cont969 var967) (if (memv kind970 (quote (hygiene))) (if (if (not (equal? mod971 (module-name (current-module)))) (module-variable (resolve-module mod971) var967) #f) (modref-cont968 mod971 var967 #f) (bare-cont969 var967)) (syntax-violation #f "bad module kind" var967 mod971))))))))) (build-lexical-assignment218 (lambda (source972 name973 var974 exp975) (let ((atom-key976 (fluid-ref *mode*205))) (if (memv atom-key976 (quote (c))) ((@ (language tree-il) make-lexical-set) source972 name973 var974 exp975) (list (quote set!) var974 exp975))))) (build-lexical-reference217 (lambda (type977 source978 name979 var980) (let ((atom-key981 (fluid-ref *mode*205))) (if (memv atom-key981 (quote (c))) ((@ (language tree-il) make-lexical-ref) source978 name979 var980) var980)))) (build-conditional216 (lambda (source982 test-exp983 then-exp984 else-exp985) (let ((atom-key986 (fluid-ref *mode*205))) (if (memv atom-key986 (quote (c))) ((@ (language tree-il) make-conditional) source982 test-exp983 then-exp984 else-exp985) (if (equal? else-exp985 (quote (if #f #f))) (list (quote if) test-exp983 then-exp984) (list (quote if) test-exp983 then-exp984 else-exp985)))))) (build-application215 (lambda (source987 fun-exp988 arg-exps989) (let ((atom-key990 (fluid-ref *mode*205))) (if (memv atom-key990 (quote (c))) ((@ (language tree-il) make-application) source987 fun-exp988 arg-exps989) (cons fun-exp988 arg-exps989))))) (build-void214 (lambda (source991) (let ((atom-key992 (fluid-ref *mode*205))) (if (memv atom-key992 (quote (c))) ((@ (language tree-il) make-void) source991) (quote (if #f #f)))))) (get-global-definition-hook213 (lambda (symbol993 module994) (begin (if (if (not module994) (current-module) #f) (warn "module system is booted, we should have a module" symbol993)) (let ((v995 (module-variable (if module994 (resolve-module (cdr module994)) (current-module)) symbol993))) (if v995 (if (variable-bound? v995) (let ((val996 (variable-ref v995))) (if (macro? val996) (if (syncase-macro-type val996) (cons (syncase-macro-type val996) (syncase-macro-binding val996)) #f) #f)) #f) #f))))) (put-global-definition-hook212 (lambda (symbol997 type998 val999) (let ((existing1000 (let ((v1001 (module-variable (current-module) symbol997))) (if v1001 (if (variable-bound? v1001) (let ((val1002 (variable-ref v1001))) (if (macro? val1002) (if (not (syncase-macro-type val1002)) val1002 #f) #f)) #f) #f)))) (module-define! (current-module) symbol997 (if existing1000 (make-extended-syncase-macro existing1000 type998 val999) (make-syncase-macro type998 val999)))))) (local-eval-hook211 (lambda (x1003 mod1004) (primitive-eval (list noexpand204 (let ((atom-key1005 (fluid-ref *mode*205))) (if (memv atom-key1005 (quote (c))) ((@ (language tree-il) tree-il->scheme) x1003) x1003)))))) (top-level-eval-hook210 (lambda (x1006 mod1007) (primitive-eval (list noexpand204 (let ((atom-key1008 (fluid-ref *mode*205))) (if (memv atom-key1008 (quote (c))) ((@ (language tree-il) tree-il->scheme) x1006) x1006)))))) (fx<209 <) (fx=208 =) (fx-207 -) (fx+206 +) (*mode*205 (make-fluid)) (noexpand204 "noexpand")) (begin (global-extend246 (quote local-syntax) (quote letrec-syntax) #t) (global-extend246 (quote local-syntax) (quote let-syntax) #f) (global-extend246 (quote core) (quote fluid-let-syntax) (lambda (e1009 r1010 w1011 s1012 mod1013) ((lambda (tmp1014) ((lambda (tmp1015) (if (if tmp1015 (apply (lambda (_1016 var1017 val1018 e11019 e21020) (valid-bound-ids?273 var1017)) tmp1015) #f) (apply (lambda (_1022 var1023 val1024 e11025 e21026) (let ((names1027 (map (lambda (x1028) (id-var-name270 x1028 w1011)) var1023))) (begin (for-each (lambda (id1030 n1031) (let ((atom-key1032 (binding-type240 (lookup245 n1031 r1010 mod1013)))) (if (memv atom-key1032 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1009 (source-wrap277 id1030 w1011 s1012 mod1013))))) var1023 names1027) (chi-body288 (cons e11025 e21026) (source-wrap277 e1009 w1011 s1012 mod1013) (extend-env242 names1027 (let ((trans-r1035 (macros-only-env244 r1010))) (map (lambda (x1036) (cons (quote macro) (eval-local-transformer291 (chi284 x1036 trans-r1035 w1011 mod1013) mod1013))) val1024)) r1010) w1011 mod1013)))) tmp1015) ((lambda (_1038) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap277 e1009 w1011 s1012 mod1013))) tmp1014))) ($sc-dispatch tmp1014 (quote (any #(each (any any)) any . each-any))))) e1009))) (global-extend246 (quote core) (quote quote) (lambda (e1039 r1040 w1041 s1042 mod1043) ((lambda (tmp1044) ((lambda (tmp1045) (if tmp1045 (apply (lambda (_1046 e1047) (build-data226 s1042 (strip294 e1047 w1041))) tmp1045) ((lambda (_1048) (syntax-violation (quote quote) "bad syntax" (source-wrap277 e1039 w1041 s1042 mod1043))) tmp1044))) ($sc-dispatch tmp1044 (quote (any any))))) e1039))) (global-extend246 (quote core) (quote syntax) (letrec ((regen1056 (lambda (x1057) (let ((atom-key1058 (car x1057))) (if (memv atom-key1058 (quote (ref))) (build-lexical-reference217 (quote value) #f (cadr x1057) (cadr x1057)) (if (memv atom-key1058 (quote (primitive))) (build-primref225 #f (cadr x1057)) (if (memv atom-key1058 (quote (quote))) (build-data226 #f (cadr x1057)) (if (memv atom-key1058 (quote (lambda))) (build-lambda224 #f (cadr x1057) (cadr x1057) #f (regen1056 (caddr x1057))) (build-application215 #f (build-primref225 #f (car x1057)) (map regen1056 (cdr x1057)))))))))) (gen-vector1055 (lambda (x1059) (if (eq? (car x1059) (quote list)) (cons (quote vector) (cdr x1059)) (if (eq? (car x1059) (quote quote)) (list (quote quote) (list->vector (cadr x1059))) (list (quote list->vector) x1059))))) (gen-append1054 (lambda (x1060 y1061) (if (equal? y1061 (quote (quote ()))) x1060 (list (quote append) x1060 y1061)))) (gen-cons1053 (lambda (x1062 y1063) (let ((atom-key1064 (car y1063))) (if (memv atom-key1064 (quote (quote))) (if (eq? (car x1062) (quote quote)) (list (quote quote) (cons (cadr x1062) (cadr y1063))) (if (eq? (cadr y1063) (quote ())) (list (quote list) x1062) (list (quote cons) x1062 y1063))) (if (memv atom-key1064 (quote (list))) (cons (quote list) (cons x1062 (cdr y1063))) (list (quote cons) x1062 y1063)))))) (gen-map1052 (lambda (e1065 map-env1066) (let ((formals1067 (map cdr map-env1066)) (actuals1068 (map (lambda (x1069) (list (quote ref) (car x1069))) map-env1066))) (if (eq? (car e1065) (quote ref)) (car actuals1068) (if (and-map (lambda (x1070) (if (eq? (car x1070) (quote ref)) (memq (cadr x1070) formals1067) #f)) (cdr e1065)) (cons (quote map) (cons (list (quote primitive) (car e1065)) (map (let ((r1071 (map cons formals1067 actuals1068))) (lambda (x1072) (cdr (assq (cadr x1072) r1071)))) (cdr e1065)))) (cons (quote map) (cons (list (quote lambda) formals1067 e1065) actuals1068))))))) (gen-mappend1051 (lambda (e1073 map-env1074) (list (quote apply) (quote (primitive append)) (gen-map1052 e1073 map-env1074)))) (gen-ref1050 (lambda (src1075 var1076 level1077 maps1078) (if (fx=208 level1077 0) (values var1076 maps1078) (if (null? maps1078) (syntax-violation (quote syntax) "missing ellipsis" src1075) (call-with-values (lambda () (gen-ref1050 src1075 var1076 (fx-207 level1077 1) (cdr maps1078))) (lambda (outer-var1079 outer-maps1080) (let ((b1081 (assq outer-var1079 (car maps1078)))) (if b1081 (values (cdr b1081) maps1078) (let ((inner-var1082 (gen-var295 (quote tmp)))) (values inner-var1082 (cons (cons (cons outer-var1079 inner-var1082) (car maps1078)) outer-maps1080))))))))))) (gen-syntax1049 (lambda (src1083 e1084 r1085 maps1086 ellipsis?1087 mod1088) (if (id?248 e1084) (let ((label1089 (id-var-name270 e1084 (quote (()))))) (let ((b1090 (lookup245 label1089 r1085 mod1088))) (if (eq? (binding-type240 b1090) (quote syntax)) (call-with-values (lambda () (let ((var.lev1091 (binding-value241 b1090))) (gen-ref1050 src1083 (car var.lev1091) (cdr var.lev1091) maps1086))) (lambda (var1092 maps1093) (values (list (quote ref) var1092) maps1093))) (if (ellipsis?1087 e1084) (syntax-violation (quote syntax) "misplaced ellipsis" src1083) (values (list (quote quote) e1084) maps1086))))) ((lambda (tmp1094) ((lambda (tmp1095) (if (if tmp1095 (apply (lambda (dots1096 e1097) (ellipsis?1087 dots1096)) tmp1095) #f) (apply (lambda (dots1098 e1099) (gen-syntax1049 src1083 e1099 r1085 maps1086 (lambda (x1100) #f) mod1088)) tmp1095) ((lambda (tmp1101) (if (if tmp1101 (apply (lambda (x1102 dots1103 y1104) (ellipsis?1087 dots1103)) tmp1101) #f) (apply (lambda (x1105 dots1106 y1107) (letrec ((f1108 (lambda (y1109 k1110) ((lambda (tmp1114) ((lambda (tmp1115) (if (if tmp1115 (apply (lambda (dots1116 y1117) (ellipsis?1087 dots1116)) tmp1115) #f) (apply (lambda (dots1118 y1119) (f1108 y1119 (lambda (maps1120) (call-with-values (lambda () (k1110 (cons (quote ()) maps1120))) (lambda (x1121 maps1122) (if (null? (car maps1122)) (syntax-violation (quote syntax) "extra ellipsis" src1083) (values (gen-mappend1051 x1121 (car maps1122)) (cdr maps1122)))))))) tmp1115) ((lambda (_1123) (call-with-values (lambda () (gen-syntax1049 src1083 y1109 r1085 maps1086 ellipsis?1087 mod1088)) (lambda (y1124 maps1125) (call-with-values (lambda () (k1110 maps1125)) (lambda (x1126 maps1127) (values (gen-append1054 x1126 y1124) maps1127)))))) tmp1114))) ($sc-dispatch tmp1114 (quote (any . any))))) y1109)))) (f1108 y1107 (lambda (maps1111) (call-with-values (lambda () (gen-syntax1049 src1083 x1105 r1085 (cons (quote ()) maps1111) ellipsis?1087 mod1088)) (lambda (x1112 maps1113) (if (null? (car maps1113)) (syntax-violation (quote syntax) "extra ellipsis" src1083) (values (gen-map1052 x1112 (car maps1113)) (cdr maps1113))))))))) tmp1101) ((lambda (tmp1128) (if tmp1128 (apply (lambda (x1129 y1130) (call-with-values (lambda () (gen-syntax1049 src1083 x1129 r1085 maps1086 ellipsis?1087 mod1088)) (lambda (x1131 maps1132) (call-with-values (lambda () (gen-syntax1049 src1083 y1130 r1085 maps1132 ellipsis?1087 mod1088)) (lambda (y1133 maps1134) (values (gen-cons1053 x1131 y1133) maps1134)))))) tmp1128) ((lambda (tmp1135) (if tmp1135 (apply (lambda (e11136 e21137) (call-with-values (lambda () (gen-syntax1049 src1083 (cons e11136 e21137) r1085 maps1086 ellipsis?1087 mod1088)) (lambda (e1139 maps1140) (values (gen-vector1055 e1139) maps1140)))) tmp1135) ((lambda (_1141) (values (list (quote quote) e1084) maps1086)) tmp1094))) ($sc-dispatch tmp1094 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1094 (quote (any . any)))))) ($sc-dispatch tmp1094 (quote (any any . any)))))) ($sc-dispatch tmp1094 (quote (any any))))) e1084))))) (lambda (e1142 r1143 w1144 s1145 mod1146) (let ((e1147 (source-wrap277 e1142 w1144 s1145 mod1146))) ((lambda (tmp1148) ((lambda (tmp1149) (if tmp1149 (apply (lambda (_1150 x1151) (call-with-values (lambda () (gen-syntax1049 e1147 x1151 r1143 (quote ()) ellipsis?293 mod1146)) (lambda (e1152 maps1153) (regen1056 e1152)))) tmp1149) ((lambda (_1154) (syntax-violation (quote syntax) "bad `syntax' form" e1147)) tmp1148))) ($sc-dispatch tmp1148 (quote (any any))))) e1147))))) (global-extend246 (quote core) (quote lambda) (lambda (e1155 r1156 w1157 s1158 mod1159) ((lambda (tmp1160) ((lambda (tmp1161) (if tmp1161 (apply (lambda (_1162 c1163) (chi-lambda-clause289 (source-wrap277 e1155 w1157 s1158 mod1159) #f c1163 r1156 w1157 mod1159 (lambda (names1164 vars1165 docstring1166 body1167) (build-lambda224 s1158 names1164 vars1165 docstring1166 body1167)))) tmp1161) (syntax-violation #f "source expression failed to match any pattern" tmp1160))) ($sc-dispatch tmp1160 (quote (any . any))))) e1155))) (global-extend246 (quote core) (quote let) (letrec ((chi-let1168 (lambda (e1169 r1170 w1171 s1172 mod1173 constructor1174 ids1175 vals1176 exps1177) (if (not (valid-bound-ids?273 ids1175)) (syntax-violation (quote let) "duplicate bound variable" e1169) (let ((labels1178 (gen-labels254 ids1175)) (new-vars1179 (map gen-var295 ids1175))) (let ((nw1180 (make-binding-wrap265 ids1175 labels1178 w1171)) (nr1181 (extend-var-env243 labels1178 new-vars1179 r1170))) (constructor1174 s1172 (map syntax->datum ids1175) new-vars1179 (map (lambda (x1182) (chi284 x1182 r1170 w1171 mod1173)) vals1176) (chi-body288 exps1177 (source-wrap277 e1169 nw1180 s1172 mod1173) nr1181 nw1180 mod1173)))))))) (lambda (e1183 r1184 w1185 s1186 mod1187) ((lambda (tmp1188) ((lambda (tmp1189) (if (if tmp1189 (apply (lambda (_1190 id1191 val1192 e11193 e21194) (and-map id?248 id1191)) tmp1189) #f) (apply (lambda (_1196 id1197 val1198 e11199 e21200) (chi-let1168 e1183 r1184 w1185 s1186 mod1187 build-let228 id1197 val1198 (cons e11199 e21200))) tmp1189) ((lambda (tmp1204) (if (if tmp1204 (apply (lambda (_1205 f1206 id1207 val1208 e11209 e21210) (if (id?248 f1206) (and-map id?248 id1207) #f)) tmp1204) #f) (apply (lambda (_1212 f1213 id1214 val1215 e11216 e21217) (chi-let1168 e1183 r1184 w1185 s1186 mod1187 build-named-let229 (cons f1213 id1214) val1215 (cons e11216 e21217))) tmp1204) ((lambda (_1221) (syntax-violation (quote let) "bad let" (source-wrap277 e1183 w1185 s1186 mod1187))) tmp1188))) ($sc-dispatch tmp1188 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1188 (quote (any #(each (any any)) any . each-any))))) e1183)))) (global-extend246 (quote core) (quote letrec) (lambda (e1222 r1223 w1224 s1225 mod1226) ((lambda (tmp1227) ((lambda (tmp1228) (if (if tmp1228 (apply (lambda (_1229 id1230 val1231 e11232 e21233) (and-map id?248 id1230)) tmp1228) #f) (apply (lambda (_1235 id1236 val1237 e11238 e21239) (let ((ids1240 id1236)) (if (not (valid-bound-ids?273 ids1240)) (syntax-violation (quote letrec) "duplicate bound variable" e1222) (let ((labels1242 (gen-labels254 ids1240)) (new-vars1243 (map gen-var295 ids1240))) (let ((w1244 (make-binding-wrap265 ids1240 labels1242 w1224)) (r1245 (extend-var-env243 labels1242 new-vars1243 r1223))) (build-letrec230 s1225 (map syntax->datum ids1240) new-vars1243 (map (lambda (x1246) (chi284 x1246 r1245 w1244 mod1226)) val1237) (chi-body288 (cons e11238 e21239) (source-wrap277 e1222 w1244 s1225 mod1226) r1245 w1244 mod1226))))))) tmp1228) ((lambda (_1249) (syntax-violation (quote letrec) "bad letrec" (source-wrap277 e1222 w1224 s1225 mod1226))) tmp1227))) ($sc-dispatch tmp1227 (quote (any #(each (any any)) any . each-any))))) e1222))) (global-extend246 (quote core) (quote set!) (lambda (e1250 r1251 w1252 s1253 mod1254) ((lambda (tmp1255) ((lambda (tmp1256) (if (if tmp1256 (apply (lambda (_1257 id1258 val1259) (id?248 id1258)) tmp1256) #f) (apply (lambda (_1260 id1261 val1262) (let ((val1263 (chi284 val1262 r1251 w1252 mod1254)) (n1264 (id-var-name270 id1261 w1252))) (let ((b1265 (lookup245 n1264 r1251 mod1254))) (let ((atom-key1266 (binding-type240 b1265))) (if (memv atom-key1266 (quote (lexical))) (build-lexical-assignment218 s1253 (syntax->datum id1261) (binding-value241 b1265) val1263) (if (memv atom-key1266 (quote (global))) (build-global-assignment221 s1253 n1264 val1263 mod1254) (if (memv atom-key1266 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap276 id1261 w1252 mod1254)) (syntax-violation (quote set!) "bad set!" (source-wrap277 e1250 w1252 s1253 mod1254))))))))) tmp1256) ((lambda (tmp1267) (if tmp1267 (apply (lambda (_1268 head1269 tail1270 val1271) (call-with-values (lambda () (syntax-type282 head1269 r1251 (quote (())) #f #f mod1254)) (lambda (type1272 value1273 ee1274 ww1275 ss1276 modmod1277) (if (memv type1272 (quote (module-ref))) (let ((val1278 (chi284 val1271 r1251 w1252 mod1254))) (call-with-values (lambda () (value1273 (cons head1269 tail1270))) (lambda (id1280 mod1281) (build-global-assignment221 s1253 id1280 val1278 mod1281)))) (build-application215 s1253 (chi284 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1269) r1251 w1252 mod1254) (map (lambda (e1282) (chi284 e1282 r1251 w1252 mod1254)) (append tail1270 (list val1271)))))))) tmp1267) ((lambda (_1284) (syntax-violation (quote set!) "bad set!" (source-wrap277 e1250 w1252 s1253 mod1254))) tmp1255))) ($sc-dispatch tmp1255 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1255 (quote (any any any))))) e1250))) (global-extend246 (quote module-ref) (quote @) (lambda (e1285) ((lambda (tmp1286) ((lambda (tmp1287) (if (if tmp1287 (apply (lambda (_1288 mod1289 id1290) (if (and-map id?248 mod1289) (id?248 id1290) #f)) tmp1287) #f) (apply (lambda (_1292 mod1293 id1294) (values (syntax->datum id1294) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1293)))) tmp1287) (syntax-violation #f "source expression failed to match any pattern" tmp1286))) ($sc-dispatch tmp1286 (quote (any each-any any))))) e1285))) (global-extend246 (quote module-ref) (quote @@) (lambda (e1296) ((lambda (tmp1297) ((lambda (tmp1298) (if (if tmp1298 (apply (lambda (_1299 mod1300 id1301) (if (and-map id?248 mod1300) (id?248 id1301) #f)) tmp1298) #f) (apply (lambda (_1303 mod1304 id1305) (values (syntax->datum id1305) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1304)))) tmp1298) (syntax-violation #f "source expression failed to match any pattern" tmp1297))) ($sc-dispatch tmp1297 (quote (any each-any any))))) e1296))) (global-extend246 (quote core) (quote if) (lambda (e1307 r1308 w1309 s1310 mod1311) ((lambda (tmp1312) ((lambda (tmp1313) (if tmp1313 (apply (lambda (_1314 test1315 then1316) (build-conditional216 s1310 (chi284 test1315 r1308 w1309 mod1311) (chi284 then1316 r1308 w1309 mod1311) (build-void214 #f))) tmp1313) ((lambda (tmp1317) (if tmp1317 (apply (lambda (_1318 test1319 then1320 else1321) (build-conditional216 s1310 (chi284 test1319 r1308 w1309 mod1311) (chi284 then1320 r1308 w1309 mod1311) (chi284 else1321 r1308 w1309 mod1311))) tmp1317) (syntax-violation #f "source expression failed to match any pattern" tmp1312))) ($sc-dispatch tmp1312 (quote (any any any any)))))) ($sc-dispatch tmp1312 (quote (any any any))))) e1307))) (global-extend246 (quote begin) (quote begin) (quote ())) (global-extend246 (quote define) (quote define) (quote ())) (global-extend246 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend246 (quote eval-when) (quote eval-when) (quote ())) (global-extend246 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1325 (lambda (x1326 keys1327 clauses1328 r1329 mod1330) (if (null? clauses1328) (build-application215 #f (build-primref225 #f (quote syntax-violation)) (list (build-data226 #f #f) (build-data226 #f "source expression failed to match any pattern") x1326)) ((lambda (tmp1331) ((lambda (tmp1332) (if tmp1332 (apply (lambda (pat1333 exp1334) (if (if (id?248 pat1333) (and-map (lambda (x1335) (not (free-id=?271 pat1333 x1335))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1327)) #f) (let ((labels1336 (list (gen-label253))) (var1337 (gen-var295 pat1333))) (build-application215 #f (build-lambda224 #f (list (syntax->datum pat1333)) (list var1337) #f (chi284 exp1334 (extend-env242 labels1336 (list (cons (quote syntax) (cons var1337 0))) r1329) (make-binding-wrap265 (list pat1333) labels1336 (quote (()))) mod1330)) (list x1326))) (gen-clause1324 x1326 keys1327 (cdr clauses1328) r1329 pat1333 #t exp1334 mod1330))) tmp1332) ((lambda (tmp1338) (if tmp1338 (apply (lambda (pat1339 fender1340 exp1341) (gen-clause1324 x1326 keys1327 (cdr clauses1328) r1329 pat1339 fender1340 exp1341 mod1330)) tmp1338) ((lambda (_1342) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1328))) tmp1331))) ($sc-dispatch tmp1331 (quote (any any any)))))) ($sc-dispatch tmp1331 (quote (any any))))) (car clauses1328))))) (gen-clause1324 (lambda (x1343 keys1344 clauses1345 r1346 pat1347 fender1348 exp1349 mod1350) (call-with-values (lambda () (convert-pattern1322 pat1347 keys1344)) (lambda (p1351 pvars1352) (if (not (distinct-bound-ids?274 (map car pvars1352))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1347) (if (not (and-map (lambda (x1353) (not (ellipsis?293 (car x1353)))) pvars1352)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1347) (let ((y1354 (gen-var295 (quote tmp)))) (build-application215 #f (build-lambda224 #f (list (quote tmp)) (list y1354) #f (let ((y1355 (build-lexical-reference217 (quote value) #f (quote tmp) y1354))) (build-conditional216 #f ((lambda (tmp1356) ((lambda (tmp1357) (if tmp1357 (apply (lambda () y1355) tmp1357) ((lambda (_1358) (build-conditional216 #f y1355 (build-dispatch-call1323 pvars1352 fender1348 y1355 r1346 mod1350) (build-data226 #f #f))) tmp1356))) ($sc-dispatch tmp1356 (quote #(atom #t))))) fender1348) (build-dispatch-call1323 pvars1352 exp1349 y1355 r1346 mod1350) (gen-syntax-case1325 x1343 keys1344 clauses1345 r1346 mod1350)))) (list (if (eq? p1351 (quote any)) (build-application215 #f (build-primref225 #f (quote list)) (list x1343)) (build-application215 #f (build-primref225 #f (quote $sc-dispatch)) (list x1343 (build-data226 #f p1351))))))))))))) (build-dispatch-call1323 (lambda (pvars1359 exp1360 y1361 r1362 mod1363) (let ((ids1364 (map car pvars1359)) (levels1365 (map cdr pvars1359))) (let ((labels1366 (gen-labels254 ids1364)) (new-vars1367 (map gen-var295 ids1364))) (build-application215 #f (build-primref225 #f (quote apply)) (list (build-lambda224 #f (map syntax->datum ids1364) new-vars1367 #f (chi284 exp1360 (extend-env242 labels1366 (map (lambda (var1368 level1369) (cons (quote syntax) (cons var1368 level1369))) new-vars1367 (map cdr pvars1359)) r1362) (make-binding-wrap265 ids1364 labels1366 (quote (()))) mod1363)) y1361)))))) (convert-pattern1322 (lambda (pattern1370 keys1371) (letrec ((cvt1372 (lambda (p1373 n1374 ids1375) (if (id?248 p1373) (if (bound-id-member?275 p1373 keys1371) (values (vector (quote free-id) p1373) ids1375) (values (quote any) (cons (cons p1373 n1374) ids1375))) ((lambda (tmp1376) ((lambda (tmp1377) (if (if tmp1377 (apply (lambda (x1378 dots1379) (ellipsis?293 dots1379)) tmp1377) #f) (apply (lambda (x1380 dots1381) (call-with-values (lambda () (cvt1372 x1380 (fx+206 n1374 1) ids1375)) (lambda (p1382 ids1383) (values (if (eq? p1382 (quote any)) (quote each-any) (vector (quote each) p1382)) ids1383)))) tmp1377) ((lambda (tmp1384) (if tmp1384 (apply (lambda (x1385 y1386) (call-with-values (lambda () (cvt1372 y1386 n1374 ids1375)) (lambda (y1387 ids1388) (call-with-values (lambda () (cvt1372 x1385 n1374 ids1388)) (lambda (x1389 ids1390) (values (cons x1389 y1387) ids1390)))))) tmp1384) ((lambda (tmp1391) (if tmp1391 (apply (lambda () (values (quote ()) ids1375)) tmp1391) ((lambda (tmp1392) (if tmp1392 (apply (lambda (x1393) (call-with-values (lambda () (cvt1372 x1393 n1374 ids1375)) (lambda (p1395 ids1396) (values (vector (quote vector) p1395) ids1396)))) tmp1392) ((lambda (x1397) (values (vector (quote atom) (strip294 p1373 (quote (())))) ids1375)) tmp1376))) ($sc-dispatch tmp1376 (quote #(vector each-any)))))) ($sc-dispatch tmp1376 (quote ()))))) ($sc-dispatch tmp1376 (quote (any . any)))))) ($sc-dispatch tmp1376 (quote (any any))))) p1373))))) (cvt1372 pattern1370 0 (quote ())))))) (lambda (e1398 r1399 w1400 s1401 mod1402) (let ((e1403 (source-wrap277 e1398 w1400 s1401 mod1402))) ((lambda (tmp1404) ((lambda (tmp1405) (if tmp1405 (apply (lambda (_1406 val1407 key1408 m1409) (if (and-map (lambda (x1410) (if (id?248 x1410) (not (ellipsis?293 x1410)) #f)) key1408) (let ((x1412 (gen-var295 (quote tmp)))) (build-application215 s1401 (build-lambda224 #f (list (quote tmp)) (list x1412) #f (gen-syntax-case1325 (build-lexical-reference217 (quote value) #f (quote tmp) x1412) key1408 m1409 r1399 mod1402)) (list (chi284 val1407 r1399 (quote (())) mod1402)))) (syntax-violation (quote syntax-case) "invalid literals list" e1403))) tmp1405) (syntax-violation #f "source expression failed to match any pattern" tmp1404))) ($sc-dispatch tmp1404 (quote (any any each-any . each-any))))) e1403))))) (set! sc-expand (lambda (x1416 . rest1415) (if (if (pair? x1416) (equal? (car x1416) noexpand204) #f) (cadr x1416) (let ((m1417 (if (null? rest1415) (quote e) (car rest1415))) (esew1418 (if (let ((t1419 (null? rest1415))) (if t1419 t1419 (null? (cdr rest1415)))) (quote (eval)) (cadr rest1415)))) (with-fluid* *mode*205 m1417 (lambda () (chi-top283 x1416 (quote ()) (quote ((top))) m1417 esew1418 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1420) (nonsymbol-id?247 x1420))) (set! datum->syntax (lambda (id1421 datum1422) (make-syntax-object231 datum1422 (syntax-object-wrap234 id1421) #f))) (set! syntax->datum (lambda (x1423) (strip294 x1423 (quote (()))))) (set! generate-temporaries (lambda (ls1424) (begin (let ((x1425 ls1424)) (if (not (list? x1425)) (syntax-violation (quote generate-temporaries) "invalid argument" x1425))) (map (lambda (x1426) (wrap276 (gensym) (quote ((top))) #f)) ls1424)))) (set! free-identifier=? (lambda (x1427 y1428) (begin (let ((x1429 x1427)) (if (not (nonsymbol-id?247 x1429)) (syntax-violation (quote free-identifier=?) "invalid argument" x1429))) (let ((x1430 y1428)) (if (not (nonsymbol-id?247 x1430)) (syntax-violation (quote free-identifier=?) "invalid argument" x1430))) (free-id=?271 x1427 y1428)))) (set! bound-identifier=? (lambda (x1431 y1432) (begin (let ((x1433 x1431)) (if (not (nonsymbol-id?247 x1433)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1433))) (let ((x1434 y1432)) (if (not (nonsymbol-id?247 x1434)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1434))) (bound-id=?272 x1431 y1432)))) (set! syntax-violation (lambda (who1438 message1437 form1436 . subform1435) (begin (let ((x1439 who1438)) (if (not ((lambda (x1440) (let ((t1441 (not x1440))) (if t1441 t1441 (let ((t1442 (string? x1440))) (if t1442 t1442 (symbol? x1440)))))) x1439)) (syntax-violation (quote syntax-violation) "invalid argument" x1439))) (let ((x1443 message1437)) (if (not (string? x1443)) (syntax-violation (quote syntax-violation) "invalid argument" x1443))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1438 "~a: " "") "~a " (if (null? subform1435) "in ~a" "in subform `~s' of `~s'")) (let ((tail1444 (cons message1437 (map (lambda (x1445) (strip294 x1445 (quote (())))) (append subform1435 (list form1436)))))) (if who1438 (cons who1438 tail1444) tail1444)) #f)))) (letrec ((match1450 (lambda (e1451 p1452 w1453 r1454 mod1455) (if (not r1454) #f (if (eq? p1452 (quote any)) (cons (wrap276 e1451 w1453 mod1455) r1454) (if (syntax-object?232 e1451) (match*1449 (syntax-object-expression233 e1451) p1452 (join-wraps267 w1453 (syntax-object-wrap234 e1451)) r1454 (syntax-object-module235 e1451)) (match*1449 e1451 p1452 w1453 r1454 mod1455)))))) (match*1449 (lambda (e1456 p1457 w1458 r1459 mod1460) (if (null? p1457) (if (null? e1456) r1459 #f) (if (pair? p1457) (if (pair? e1456) (match1450 (car e1456) (car p1457) w1458 (match1450 (cdr e1456) (cdr p1457) w1458 r1459 mod1460) mod1460) #f) (if (eq? p1457 (quote each-any)) (let ((l1461 (match-each-any1447 e1456 w1458 mod1460))) (if l1461 (cons l1461 r1459) #f)) (let ((atom-key1462 (vector-ref p1457 0))) (if (memv atom-key1462 (quote (each))) (if (null? e1456) (match-empty1448 (vector-ref p1457 1) r1459) (let ((l1463 (match-each1446 e1456 (vector-ref p1457 1) w1458 mod1460))) (if l1463 (letrec ((collect1464 (lambda (l1465) (if (null? (car l1465)) r1459 (cons (map car l1465) (collect1464 (map cdr l1465))))))) (collect1464 l1463)) #f))) (if (memv atom-key1462 (quote (free-id))) (if (id?248 e1456) (if (free-id=?271 (wrap276 e1456 w1458 mod1460) (vector-ref p1457 1)) r1459 #f) #f) (if (memv atom-key1462 (quote (atom))) (if (equal? (vector-ref p1457 1) (strip294 e1456 w1458)) r1459 #f) (if (memv atom-key1462 (quote (vector))) (if (vector? e1456) (match1450 (vector->list e1456) (vector-ref p1457 1) w1458 r1459 mod1460) #f))))))))))) (match-empty1448 (lambda (p1466 r1467) (if (null? p1466) r1467 (if (eq? p1466 (quote any)) (cons (quote ()) r1467) (if (pair? p1466) (match-empty1448 (car p1466) (match-empty1448 (cdr p1466) r1467)) (if (eq? p1466 (quote each-any)) (cons (quote ()) r1467) (let ((atom-key1468 (vector-ref p1466 0))) (if (memv atom-key1468 (quote (each))) (match-empty1448 (vector-ref p1466 1) r1467) (if (memv atom-key1468 (quote (free-id atom))) r1467 (if (memv atom-key1468 (quote (vector))) (match-empty1448 (vector-ref p1466 1) r1467))))))))))) (match-each-any1447 (lambda (e1469 w1470 mod1471) (if (pair? e1469) (let ((l1472 (match-each-any1447 (cdr e1469) w1470 mod1471))) (if l1472 (cons (wrap276 (car e1469) w1470 mod1471) l1472) #f)) (if (null? e1469) (quote ()) (if (syntax-object?232 e1469) (match-each-any1447 (syntax-object-expression233 e1469) (join-wraps267 w1470 (syntax-object-wrap234 e1469)) mod1471) #f))))) (match-each1446 (lambda (e1473 p1474 w1475 mod1476) (if (pair? e1473) (let ((first1477 (match1450 (car e1473) p1474 w1475 (quote ()) mod1476))) (if first1477 (let ((rest1478 (match-each1446 (cdr e1473) p1474 w1475 mod1476))) (if rest1478 (cons first1477 rest1478) #f)) #f)) (if (null? e1473) (quote ()) (if (syntax-object?232 e1473) (match-each1446 (syntax-object-expression233 e1473) p1474 (join-wraps267 w1475 (syntax-object-wrap234 e1473)) (syntax-object-module235 e1473)) #f)))))) (set! $sc-dispatch (lambda (e1479 p1480) (if (eq? p1480 (quote any)) (list e1479) (if (syntax-object?232 e1479) (match*1449 (syntax-object-expression233 e1479) p1480 (syntax-object-wrap234 e1479) (quote ()) (syntax-object-module235 e1479)) (match*1449 e1479 p1480 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x1481) ((lambda (tmp1482) ((lambda (tmp1483) (if tmp1483 (apply (lambda (_1484 e11485 e21486) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11485 e21486))) tmp1483) ((lambda (tmp1488) (if tmp1488 (apply (lambda (_1489 out1490 in1491 e11492 e21493) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1491 (quote ()) (list out1490 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11492 e21493))))) tmp1488) ((lambda (tmp1495) (if tmp1495 (apply (lambda (_1496 out1497 in1498 e11499 e21500) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in1498) (quote ()) (list out1497 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11499 e21500))))) tmp1495) (syntax-violation #f "source expression failed to match any pattern" tmp1482))) ($sc-dispatch tmp1482 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1482 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1482 (quote (any () any . each-any))))) x1481))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1504) ((lambda (tmp1505) ((lambda (tmp1506) (if tmp1506 (apply (lambda (_1507 k1508 keyword1509 pattern1510 template1511) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k1508 (map (lambda (tmp1514 tmp1513) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1513) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp1514))) template1511 pattern1510)))))) tmp1506) (syntax-violation #f "source expression failed to match any pattern" tmp1505))) ($sc-dispatch tmp1505 (quote (any each-any . #(each ((any . any) any))))))) x1504))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1515) ((lambda (tmp1516) ((lambda (tmp1517) (if (if tmp1517 (apply (lambda (let*1518 x1519 v1520 e11521 e21522) (and-map identifier? x1519)) tmp1517) #f) (apply (lambda (let*1524 x1525 v1526 e11527 e21528) (letrec ((f1529 (lambda (bindings1530) (if (null? bindings1530) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11527 e21528))) ((lambda (tmp1534) ((lambda (tmp1535) (if tmp1535 (apply (lambda (body1536 binding1537) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding1537) body1536)) tmp1535) (syntax-violation #f "source expression failed to match any pattern" tmp1534))) ($sc-dispatch tmp1534 (quote (any any))))) (list (f1529 (cdr bindings1530)) (car bindings1530))))))) (f1529 (map list x1525 v1526)))) tmp1517) (syntax-violation #f "source expression failed to match any pattern" tmp1516))) ($sc-dispatch tmp1516 (quote (any #(each (any any)) any . each-any))))) x1515))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1538) ((lambda (tmp1539) ((lambda (tmp1540) (if tmp1540 (apply (lambda (_1541 var1542 init1543 step1544 e01545 e11546 c1547) ((lambda (tmp1548) ((lambda (tmp1549) (if tmp1549 (apply (lambda (step1550) ((lambda (tmp1551) ((lambda (tmp1552) (if tmp1552 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1542 init1543) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01545) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1550))))))) tmp1552) ((lambda (tmp1557) (if tmp1557 (apply (lambda (e11558 e21559) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1542 init1543) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01545 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e11558 e21559)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step1550))))))) tmp1557) (syntax-violation #f "source expression failed to match any pattern" tmp1551))) ($sc-dispatch tmp1551 (quote (any . each-any)))))) ($sc-dispatch tmp1551 (quote ())))) e11546)) tmp1549) (syntax-violation #f "source expression failed to match any pattern" tmp1548))) ($sc-dispatch tmp1548 (quote each-any)))) (map (lambda (v1566 s1567) ((lambda (tmp1568) ((lambda (tmp1569) (if tmp1569 (apply (lambda () v1566) tmp1569) ((lambda (tmp1570) (if tmp1570 (apply (lambda (e1571) e1571) tmp1570) ((lambda (_1572) (syntax-violation (quote do) "bad step expression" orig-x1538 s1567)) tmp1568))) ($sc-dispatch tmp1568 (quote (any)))))) ($sc-dispatch tmp1568 (quote ())))) s1567)) var1542 step1544))) tmp1540) (syntax-violation #f "source expression failed to match any pattern" tmp1539))) ($sc-dispatch tmp1539 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1538))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1575 (lambda (x1579 y1580) ((lambda (tmp1581) ((lambda (tmp1582) (if tmp1582 (apply (lambda (x1583 y1584) ((lambda (tmp1585) ((lambda (tmp1586) (if tmp1586 (apply (lambda (dy1587) ((lambda (tmp1588) ((lambda (tmp1589) (if tmp1589 (apply (lambda (dx1590) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx1590 dy1587))) tmp1589) ((lambda (_1591) (if (null? dy1587) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1583) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1583 y1584))) tmp1588))) ($sc-dispatch tmp1588 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x1583)) tmp1586) ((lambda (tmp1592) (if tmp1592 (apply (lambda (stuff1593) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1583 stuff1593))) tmp1592) ((lambda (else1594) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1583 y1584)) tmp1585))) ($sc-dispatch tmp1585 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1585 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y1584)) tmp1582) (syntax-violation #f "source expression failed to match any pattern" tmp1581))) ($sc-dispatch tmp1581 (quote (any any))))) (list x1579 y1580)))) (quasiappend1576 (lambda (x1595 y1596) ((lambda (tmp1597) ((lambda (tmp1598) (if tmp1598 (apply (lambda (x1599 y1600) ((lambda (tmp1601) ((lambda (tmp1602) (if tmp1602 (apply (lambda () x1599) tmp1602) ((lambda (_1603) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1599 y1600)) tmp1601))) ($sc-dispatch tmp1601 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1600)) tmp1598) (syntax-violation #f "source expression failed to match any pattern" tmp1597))) ($sc-dispatch tmp1597 (quote (any any))))) (list x1595 y1596)))) (quasivector1577 (lambda (x1604) ((lambda (tmp1605) ((lambda (x1606) ((lambda (tmp1607) ((lambda (tmp1608) (if tmp1608 (apply (lambda (x1609) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x1609))) tmp1608) ((lambda (tmp1611) (if tmp1611 (apply (lambda (x1612) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1612)) tmp1611) ((lambda (_1614) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1606)) tmp1607))) ($sc-dispatch tmp1607 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp1607 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x1606)) tmp1605)) x1604))) (quasi1578 (lambda (p1615 lev1616) ((lambda (tmp1617) ((lambda (tmp1618) (if tmp1618 (apply (lambda (p1619) (if (= lev1616 0) p1619 (quasicons1575 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1578 (list p1619) (- lev1616 1))))) tmp1618) ((lambda (tmp1620) (if (if tmp1620 (apply (lambda (args1621) (= lev1616 0)) tmp1620) #f) (apply (lambda (args1622) (syntax-violation (quote unquote) "unquote takes exactly one argument" p1615 (cons (quote #(syntax-object unquote ((top) #(ribcage #(args) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1622))) tmp1620) ((lambda (tmp1623) (if tmp1623 (apply (lambda (p1624 q1625) (if (= lev1616 0) (quasiappend1576 p1624 (quasi1578 q1625 lev1616)) (quasicons1575 (quasicons1575 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1578 (list p1624) (- lev1616 1))) (quasi1578 q1625 lev1616)))) tmp1623) ((lambda (tmp1626) (if (if tmp1626 (apply (lambda (args1627 q1628) (= lev1616 0)) tmp1626) #f) (apply (lambda (args1629 q1630) (syntax-violation (quote unquote-splicing) "unquote-splicing takes exactly one argument" p1615 (cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1629))) tmp1626) ((lambda (tmp1631) (if tmp1631 (apply (lambda (p1632) (quasicons1575 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi1578 (list p1632) (+ lev1616 1)))) tmp1631) ((lambda (tmp1633) (if tmp1633 (apply (lambda (p1634 q1635) (quasicons1575 (quasi1578 p1634 lev1616) (quasi1578 q1635 lev1616))) tmp1633) ((lambda (tmp1636) (if tmp1636 (apply (lambda (x1637) (quasivector1577 (quasi1578 x1637 lev1616))) tmp1636) ((lambda (p1639) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p1639)) tmp1617))) ($sc-dispatch tmp1617 (quote #(vector each-any)))))) ($sc-dispatch tmp1617 (quote (any . any)))))) ($sc-dispatch tmp1617 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp1617 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any) . any)))))) ($sc-dispatch tmp1617 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1617 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1617 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p1615)))) (lambda (x1640) ((lambda (tmp1641) ((lambda (tmp1642) (if tmp1642 (apply (lambda (_1643 e1644) (quasi1578 e1644 0)) tmp1642) (syntax-violation #f "source expression failed to match any pattern" tmp1641))) ($sc-dispatch tmp1641 (quote (any any))))) x1640)))))
+(define include (make-syncase-macro (quote macro) (lambda (x1645) (letrec ((read-file1646 (lambda (fn1647 k1648) (let ((p1649 (open-input-file fn1647))) (letrec ((f1650 (lambda (x1651) (if (eof-object? x1651) (begin (close-input-port p1649) (quote ())) (cons (datum->syntax k1648 x1651) (f1650 (read p1649))))))) (f1650 (read p1649))))))) ((lambda (tmp1652) ((lambda (tmp1653) (if tmp1653 (apply (lambda (k1654 filename1655) (let ((fn1656 (syntax->datum filename1655))) ((lambda (tmp1657) ((lambda (tmp1658) (if tmp1658 (apply (lambda (exp1659) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp1659)) tmp1658) (syntax-violation #f "source expression failed to match any pattern" tmp1657))) ($sc-dispatch tmp1657 (quote each-any)))) (read-file1646 fn1656 k1654)))) tmp1653) (syntax-violation #f "source expression failed to match any pattern" tmp1652))) ($sc-dispatch tmp1652 (quote (any any))))) x1645)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x1661) ((lambda (tmp1662) ((lambda (tmp1663) (if tmp1663 (apply (lambda (_1664 e1665) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1661)) tmp1663) (syntax-violation #f "source expression failed to match any pattern" tmp1662))) ($sc-dispatch tmp1662 (quote (any any))))) x1661))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1666) ((lambda (tmp1667) ((lambda (tmp1668) (if tmp1668 (apply (lambda (_1669 e1670) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1666)) tmp1668) (syntax-violation #f "source expression failed to match any pattern" tmp1667))) ($sc-dispatch tmp1667 (quote (any any))))) x1666))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1671) ((lambda (tmp1672) ((lambda (tmp1673) (if tmp1673 (apply (lambda (_1674 e1675 m11676 m21677) ((lambda (tmp1678) ((lambda (body1679) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1675)) body1679)) tmp1678)) (letrec ((f1680 (lambda (clause1681 clauses1682) (if (null? clauses1682) ((lambda (tmp1684) ((lambda (tmp1685) (if tmp1685 (apply (lambda (e11686 e21687) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11686 e21687))) tmp1685) ((lambda (tmp1689) (if tmp1689 (apply (lambda (k1690 e11691 e21692) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1690)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11691 e21692)))) tmp1689) ((lambda (_1695) (syntax-violation (quote case) "bad clause" x1671 clause1681)) tmp1684))) ($sc-dispatch tmp1684 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1684 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause1681) ((lambda (tmp1696) ((lambda (rest1697) ((lambda (tmp1698) ((lambda (tmp1699) (if tmp1699 (apply (lambda (k1700 e11701 e21702) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k1700)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11701 e21702)) rest1697)) tmp1699) ((lambda (_1705) (syntax-violation (quote case) "bad clause" x1671 clause1681)) tmp1698))) ($sc-dispatch tmp1698 (quote (each-any any . each-any))))) clause1681)) tmp1696)) (f1680 (car clauses1682) (cdr clauses1682))))))) (f1680 m11676 m21677)))) tmp1673) (syntax-violation #f "source expression failed to match any pattern" tmp1672))) ($sc-dispatch tmp1672 (quote (any any any . each-any))))) x1671))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1706) ((lambda (tmp1707) ((lambda (tmp1708) (if tmp1708 (apply (lambda (_1709 e1710) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1710)) (list (cons _1709 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e1710 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp1708) (syntax-violation #f "source expression failed to match any pattern" tmp1707))) ($sc-dispatch tmp1707 (quote (any any))))) x1706))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 0398815d1..c2668c0c4 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -526,7 +526,10 @@
(cond
((syntax-object? x)
(source-annotation (syntax-object-expression x)))
- ((pair? x) (source-properties x))
+ ((pair? x) (let ((props (source-properties x)))
+ (if (pair? props)
+ props
+ #f)))
(else #f))))
(define-syntax arg-check
@@ -922,15 +925,9 @@
(define source-wrap
(lambda (x w s defmod)
- (wrap (if s
- (begin
- (if (not (pair? x))
- (error "bad source-wrap!!!" x s))
- (set-source-properties! x s)
- x)
- x)
- w
- defmod)))
+ (if (and s (pair? x))
+ (set-source-properties! x s))
+ (wrap x w defmod)))
;;; expanding
@@ -1098,11 +1095,10 @@
(values 'call #f e w s mod))))
(values 'call #f e w s mod))))
((syntax-object? e)
- ;; s can't be valid source if we've unwrapped
(syntax-type (syntax-object-expression e)
r
(join-wraps w (syntax-object-wrap e))
- no-source rib (or (syntax-object-module e) mod)))
+ s rib (or (syntax-object-module e) mod)))
((self-evaluating? e) (values 'constant #f e w s mod))
(else (values 'other #f e w s mod)))))
@@ -1346,7 +1342,7 @@
(syntax-violation #f "no expressions in body" outer-form)
(let ((e (cdar body)) (er (caar body)))
(call-with-values
- (lambda () (syntax-type e er empty-wrap (source-annotation e) ribcage mod))
+ (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod))
(lambda (type value e w s mod)
(case type
((define-form)
@@ -1747,12 +1743,6 @@
((primitive) (build-primref no-source (cadr x)))
((quote) (build-data no-source (cadr x)))
((lambda) (build-lambda no-source (cadr x) (cadr x) #f (regen (caddr x))))
- ((map) (let ((ls (map regen (cdr x))))
- (build-application no-source
- ;; this check used to be here, not sure what for:
- ;; (if (fx= (length ls) 2)
- (build-primref no-source 'map)
- ls)))
(else (build-application no-source
(build-primref no-source (car x))
(map regen (cdr x)))))))