mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-24 20:30:28 +02:00
1eec95f8de
* module/ice-9/boot-9.scm (delay): Define `delay' in terms of make-promise. * module/ice-9/psyntax-pp.scm (compile): Regenerated with a fully compiled Guile, so that the gensym numbers are the same. * module/language/tree-il/compile-glil.scm: Add some notes about what needs doing to catch up to the old compiler.
13 lines
130 KiB
Scheme
13 lines
130 KiB
Scheme
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
|
|
(if #f #f)
|
|
(letrec ((and-map*17 (lambda (f57 first56 . rest55) (or (null? first56) (if (null? rest55) (letrec ((andmap58 (lambda (first59) (let ((x60 (car first59)) (first61 (cdr first59))) (if (null? first61) (f57 x60) (and (f57 x60) (andmap58 first61))))))) (andmap58 first56)) (letrec ((andmap62 (lambda (first63 rest64) (let ((x65 (car first63)) (xr66 (map car rest64)) (first67 (cdr first63)) (rest68 (map cdr rest64))) (if (null? first67) (apply f57 (cons x65 xr66)) (and (apply f57 (cons x65 xr66)) (andmap62 first67 rest68))))))) (andmap62 first56 rest55))))))) (letrec ((lambda-var-list160 (lambda (vars289) (letrec ((lvl290 (lambda (vars291 ls292 w293) (cond ((pair? vars291) (lvl290 (cdr vars291) (cons (wrap139 (car vars291) w293 #f) ls292) w293)) ((id?111 vars291) (cons (wrap139 vars291 w293 #f) ls292)) ((null? vars291) ls292) ((syntax-object?95 vars291) (lvl290 (syntax-object-expression96 vars291) ls292 (join-wraps130 w293 (syntax-object-wrap97 vars291)))) ((annotation? vars291) (lvl290 (annotation-expression vars291) ls292 w293)) (else (cons vars291 ls292)))))) (lvl290 vars289 (quote ()) (quote (())))))) (gen-var159 (lambda (id294) (let ((id295 (if (syntax-object?95 id294) (syntax-object-expression96 id294) id294))) (if (annotation? id295) (gensym (symbol->string (annotation-expression id295))) (gensym (symbol->string id295)))))) (strip158 (lambda (x296 w297) (if (memq (quote top) (wrap-marks114 w297)) (if (or (annotation? x296) (and (pair? x296) (annotation? (car x296)))) (strip-annotation157 x296 #f) x296) (letrec ((f298 (lambda (x299) (cond ((syntax-object?95 x299) (strip158 (syntax-object-expression96 x299) (syntax-object-wrap97 x299))) ((pair? x299) (let ((a300 (f298 (car x299))) (d301 (f298 (cdr x299)))) (if (and (eq? a300 (car x299)) (eq? d301 (cdr x299))) x299 (cons a300 d301)))) ((vector? x299) (let ((old302 (vector->list x299))) (let ((new303 (map f298 old302))) (if (and-map*17 eq? old302 new303) x299 (list->vector new303))))) (else x299))))) (f298 x296))))) (strip-annotation157 (lambda (x304 parent305) (cond ((pair? x304) (let ((new306 (cons #f #f))) (begin (if parent305 (set-annotation-stripped! parent305 new306)) (set-car! new306 (strip-annotation157 (car x304) #f)) (set-cdr! new306 (strip-annotation157 (cdr x304) #f)) new306))) ((annotation? x304) (or (annotation-stripped x304) (strip-annotation157 (annotation-expression x304) x304))) ((vector? x304) (let ((new307 (make-vector (vector-length x304)))) (begin (if parent305 (set-annotation-stripped! parent305 new307)) (letrec ((loop308 (lambda (i309) (unless (fx<74 i309 0) (vector-set! new307 i309 (strip-annotation157 (vector-ref x304 i309) #f)) (loop308 (fx-72 i309 1)))))) (loop308 (- (vector-length x304) 1))) new307))) (else x304)))) (ellipsis?156 (lambda (x310) (and (nonsymbol-id?110 x310) (free-id=?134 x310 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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))))))) (chi-void155 (lambda () (build-application79 #f (build-primref88 #f (quote if)) (quote (#f #f))))) (eval-local-transformer154 (lambda (expanded311 mod312) (let ((p313 (local-eval-hook76 expanded311 mod312))) (if (procedure? p313) p313 (syntax-violation #f "nonprocedure transformer" p313))))) (chi-local-syntax153 (lambda (rec?314 e315 r316 w317 s318 mod319 k320) ((lambda (tmp321) ((lambda (tmp322) (if tmp322 (apply (lambda (_323 id324 val325 e1326 e2327) (let ((ids328 id324)) (if (not (valid-bound-ids?136 ids328)) (syntax-violation #f "duplicate bound keyword" e315) (let ((labels330 (gen-labels117 ids328))) (let ((new-w331 (make-binding-wrap128 ids328 labels330 w317))) (k320 (cons e1326 e2327) (extend-env105 labels330 (let ((w333 (if rec?314 new-w331 w317)) (trans-r334 (macros-only-env107 r316))) (map (lambda (x335) (cons (quote macro) (eval-local-transformer154 (chi147 x335 trans-r334 w333 mod319) mod319))) val325)) r316) new-w331 s318 mod319)))))) tmp322) ((lambda (_337) (syntax-violation #f "bad local syntax definition" (source-wrap140 e315 w317 s318 mod319))) tmp321))) ($sc-dispatch tmp321 (quote (any #(each (any any)) any . each-any))))) e315))) (chi-lambda-clause152 (lambda (e338 docstring339 c340 r341 w342 mod343 k344) ((lambda (tmp345) ((lambda (tmp346) (if (if tmp346 (apply (lambda (args347 doc348 e1349 e2350) (and (string? (syntax->datum doc348)) (not docstring339))) tmp346) #f) (apply (lambda (args351 doc352 e1353 e2354) (chi-lambda-clause152 e338 doc352 (cons args351 (cons e1353 e2354)) r341 w342 mod343 k344)) tmp346) ((lambda (tmp356) (if tmp356 (apply (lambda (id357 e1358 e2359) (let ((ids360 id357)) (if (not (valid-bound-ids?136 ids360)) (syntax-violation (quote lambda) "invalid parameter list" e338) (let ((labels362 (gen-labels117 ids360)) (new-vars363 (map gen-var159 ids360))) (k344 (map syntax->datum ids360) new-vars363 docstring339 (chi-body151 (cons e1358 e2359) e338 (extend-var-env106 labels362 new-vars363 r341) (make-binding-wrap128 ids360 labels362 w342) mod343)))))) tmp356) ((lambda (tmp365) (if tmp365 (apply (lambda (ids366 e1367 e2368) (let ((old-ids369 (lambda-var-list160 ids366))) (if (not (valid-bound-ids?136 old-ids369)) (syntax-violation (quote lambda) "invalid parameter list" e338) (let ((labels370 (gen-labels117 old-ids369)) (new-vars371 (map gen-var159 old-ids369))) (k344 (letrec ((f372 (lambda (ls1373 ls2374) (if (null? ls1373) (syntax->datum ls2374) (f372 (cdr ls1373) (cons (syntax->datum (car ls1373)) ls2374)))))) (f372 (cdr old-ids369) (car old-ids369))) (letrec ((f375 (lambda (ls1376 ls2377) (if (null? ls1376) ls2377 (f375 (cdr ls1376) (cons (car ls1376) ls2377)))))) (f375 (cdr new-vars371) (car new-vars371))) docstring339 (chi-body151 (cons e1367 e2368) e338 (extend-var-env106 labels370 new-vars371 r341) (make-binding-wrap128 old-ids369 labels370 w342) mod343)))))) tmp365) ((lambda (_379) (syntax-violation (quote lambda) "bad lambda" e338)) tmp345))) ($sc-dispatch tmp345 (quote (any any . each-any)))))) ($sc-dispatch tmp345 (quote (each-any any . each-any)))))) ($sc-dispatch tmp345 (quote (any any any . each-any))))) c340))) (chi-body151 (lambda (body380 outer-form381 r382 w383 mod384) (let ((r385 (cons (quote ("placeholder" placeholder)) r382))) (let ((ribcage386 (make-ribcage118 (quote ()) (quote ()) (quote ())))) (let ((w387 (make-wrap113 (wrap-marks114 w383) (cons ribcage386 (wrap-subst115 w383))))) (letrec ((parse388 (lambda (body389 ids390 labels391 vars392 vals393 bindings394) (if (null? body389) (syntax-violation #f "no expressions in body" outer-form381) (let ((e396 (cdar body389)) (er397 (caar body389))) (call-with-values (lambda () (syntax-type145 e396 er397 (quote (())) #f ribcage386 mod384)) (lambda (type398 value399 e400 w401 s402 mod403) (let ((t404 type398)) (if (memv t404 (quote (define-form))) (let ((id405 (wrap139 value399 w401 mod403)) (label406 (gen-label116))) (let ((var407 (gen-var159 id405))) (begin (extend-ribcage!127 ribcage386 id405 label406) (parse388 (cdr body389) (cons id405 ids390) (cons label406 labels391) (cons var407 vars392) (cons (cons er397 (wrap139 e400 w401 mod403)) vals393) (cons (cons (quote lexical) var407) bindings394))))) (if (memv t404 (quote (define-syntax-form))) (let ((id408 (wrap139 value399 w401 mod403)) (label409 (gen-label116))) (begin (extend-ribcage!127 ribcage386 id408 label409) (parse388 (cdr body389) (cons id408 ids390) (cons label409 labels391) vars392 vals393 (cons (cons (quote macro) (cons er397 (wrap139 e400 w401 mod403))) bindings394)))) (if (memv t404 (quote (begin-form))) ((lambda (tmp410) ((lambda (tmp411) (if tmp411 (apply (lambda (_412 e1413) (parse388 (letrec ((f414 (lambda (forms415) (if (null? forms415) (cdr body389) (cons (cons er397 (wrap139 (car forms415) w401 mod403)) (f414 (cdr forms415))))))) (f414 e1413)) ids390 labels391 vars392 vals393 bindings394)) tmp411) (syntax-violation #f "source expression failed to match any pattern" tmp410))) ($sc-dispatch tmp410 (quote (any . each-any))))) e400) (if (memv t404 (quote (local-syntax-form))) (chi-local-syntax153 value399 e400 er397 w401 s402 mod403 (lambda (forms417 er418 w419 s420 mod421) (parse388 (letrec ((f422 (lambda (forms423) (if (null? forms423) (cdr body389) (cons (cons er418 (wrap139 (car forms423) w419 mod421)) (f422 (cdr forms423))))))) (f422 forms417)) ids390 labels391 vars392 vals393 bindings394))) (if (null? ids390) (build-sequence90 #f (map (lambda (x424) (chi147 (cdr x424) (car x424) (quote (())) mod403)) (cons (cons er397 (source-wrap140 e400 w401 s402 mod403)) (cdr body389)))) (begin (if (not (valid-bound-ids?136 ids390)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form381)) (letrec ((loop425 (lambda (bs426 er-cache427 r-cache428) (if (not (null? bs426)) (let ((b429 (car bs426))) (if (eq? (car b429) (quote macro)) (let ((er430 (cadr b429))) (let ((r-cache431 (if (eq? er430 er-cache427) r-cache428 (macros-only-env107 er430)))) (begin (set-cdr! b429 (eval-local-transformer154 (chi147 (cddr b429) r-cache431 (quote (())) mod403) mod403)) (loop425 (cdr bs426) er430 r-cache431)))) (loop425 (cdr bs426) er-cache427 r-cache428))))))) (loop425 bindings394 #f #f)) (set-cdr! r385 (extend-env105 labels391 bindings394 (cdr r385))) (build-letrec93 #f (map syntax->datum ids390) vars392 (map (lambda (x432) (chi147 (cdr x432) (car x432) (quote (())) mod403)) vals393) (build-sequence90 #f (map (lambda (x433) (chi147 (cdr x433) (car x433) (quote (())) mod403)) (cons (cons er397 (source-wrap140 e400 w401 s402 mod403)) (cdr body389))))))))))))))))))) (parse388 (map (lambda (x395) (cons r385 (wrap139 x395 w387 mod384))) body380) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro150 (lambda (p434 e435 r436 w437 rib438 mod439) (letrec ((rebuild-macro-output440 (lambda (x441 m442) (cond ((pair? x441) (cons (rebuild-macro-output440 (car x441) m442) (rebuild-macro-output440 (cdr x441) m442))) ((syntax-object?95 x441) (let ((w443 (syntax-object-wrap97 x441))) (let ((ms444 (wrap-marks114 w443)) (s445 (wrap-subst115 w443))) (if (and (pair? ms444) (eq? (car ms444) #f)) (make-syntax-object94 (syntax-object-expression96 x441) (make-wrap113 (cdr ms444) (if rib438 (cons rib438 (cdr s445)) (cdr s445))) (syntax-object-module98 x441)) (make-syntax-object94 (syntax-object-expression96 x441) (make-wrap113 (cons m442 ms444) (if rib438 (cons rib438 (cons (quote shift) s445)) (cons (quote shift) s445))) (let ((pmod446 (procedure-module p434))) (if pmod446 (cons (quote hygiene) (module-name pmod446)) (quote (hygiene guile))))))))) ((vector? x441) (let ((n447 (vector-length x441))) (let ((v448 (make-vector n447))) (letrec ((doloop449 (lambda (i450) (if (fx=73 i450 n447) v448 (begin (vector-set! v448 i450 (rebuild-macro-output440 (vector-ref x441 i450) m442)) (doloop449 (fx+71 i450 1))))))) (doloop449 0))))) ((symbol? x441) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap140 e435 w437 s mod439) x441)) (else x441))))) (rebuild-macro-output440 (p434 (wrap139 e435 (anti-mark126 w437) mod439)) (string #\m))))) (chi-application149 (lambda (x451 e452 r453 w454 s455 mod456) ((lambda (tmp457) ((lambda (tmp458) (if tmp458 (apply (lambda (e0459 e1460) (build-application79 s455 x451 (map (lambda (e461) (chi147 e461 r453 w454 mod456)) e1460))) tmp458) (syntax-violation #f "source expression failed to match any pattern" tmp457))) ($sc-dispatch tmp457 (quote (any . each-any))))) e452))) (chi-expr148 (lambda (type463 value464 e465 r466 w467 s468 mod469) (let ((t470 type463)) (if (memv t470 (quote (lexical))) (build-lexical-reference81 (quote value) s468 e465 value464) (if (memv t470 (quote (core external-macro))) (value464 e465 r466 w467 s468 mod469) (if (memv t470 (quote (module-ref))) (call-with-values (lambda () (value464 e465)) (lambda (id471 mod472) (build-global-reference84 s468 id471 mod472))) (if (memv t470 (quote (lexical-call))) (chi-application149 (build-lexical-reference81 (quote fun) (source-annotation102 (car e465)) (car e465) value464) e465 r466 w467 s468 mod469) (if (memv t470 (quote (global-call))) (chi-application149 (build-global-reference84 (source-annotation102 (car e465)) value464 (if (syntax-object?95 (car e465)) (syntax-object-module98 (car e465)) mod469)) e465 r466 w467 s468 mod469) (if (memv t470 (quote (constant))) (build-data89 s468 (strip158 (source-wrap140 e465 w467 s468 mod469) (quote (())))) (if (memv t470 (quote (global))) (build-global-reference84 s468 value464 mod469) (if (memv t470 (quote (call))) (chi-application149 (chi147 (car e465) r466 w467 mod469) e465 r466 w467 s468 mod469) (if (memv t470 (quote (begin-form))) ((lambda (tmp473) ((lambda (tmp474) (if tmp474 (apply (lambda (_475 e1476 e2477) (chi-sequence141 (cons e1476 e2477) r466 w467 s468 mod469)) tmp474) (syntax-violation #f "source expression failed to match any pattern" tmp473))) ($sc-dispatch tmp473 (quote (any any . each-any))))) e465) (if (memv t470 (quote (local-syntax-form))) (chi-local-syntax153 value464 e465 r466 w467 s468 mod469 chi-sequence141) (if (memv t470 (quote (eval-when-form))) ((lambda (tmp479) ((lambda (tmp480) (if tmp480 (apply (lambda (_481 x482 e1483 e2484) (let ((when-list485 (chi-when-list144 e465 x482 w467))) (if (memq (quote eval) when-list485) (chi-sequence141 (cons e1483 e2484) r466 w467 s468 mod469) (chi-void155)))) tmp480) (syntax-violation #f "source expression failed to match any pattern" tmp479))) ($sc-dispatch tmp479 (quote (any each-any any . each-any))))) e465) (if (memv t470 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e465 (wrap139 value464 w467 mod469)) (if (memv t470 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap140 e465 w467 s468 mod469)) (if (memv t470 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap140 e465 w467 s468 mod469)) (syntax-violation #f "unexpected syntax" (source-wrap140 e465 w467 s468 mod469))))))))))))))))))) (chi147 (lambda (e488 r489 w490 mod491) (call-with-values (lambda () (syntax-type145 e488 r489 w490 #f #f mod491)) (lambda (type492 value493 e494 w495 s496 mod497) (chi-expr148 type492 value493 e494 r489 w495 s496 mod497))))) (chi-top146 (lambda (e498 r499 w500 m501 esew502 mod503) (call-with-values (lambda () (syntax-type145 e498 r499 w500 #f #f mod503)) (lambda (type511 value512 e513 w514 s515 mod516) (let ((t517 type511)) (if (memv t517 (quote (begin-form))) ((lambda (tmp518) ((lambda (tmp519) (if tmp519 (apply (lambda (_520) (chi-void155)) tmp519) ((lambda (tmp521) (if tmp521 (apply (lambda (_522 e1523 e2524) (chi-top-sequence142 (cons e1523 e2524) r499 w514 s515 m501 esew502 mod516)) tmp521) (syntax-violation #f "source expression failed to match any pattern" tmp518))) ($sc-dispatch tmp518 (quote (any any . each-any)))))) ($sc-dispatch tmp518 (quote (any))))) e513) (if (memv t517 (quote (local-syntax-form))) (chi-local-syntax153 value512 e513 r499 w514 s515 mod516 (lambda (body526 r527 w528 s529 mod530) (chi-top-sequence142 body526 r527 w528 s529 m501 esew502 mod530))) (if (memv t517 (quote (eval-when-form))) ((lambda (tmp531) ((lambda (tmp532) (if tmp532 (apply (lambda (_533 x534 e1535 e2536) (let ((when-list537 (chi-when-list144 e513 x534 w514)) (body538 (cons e1535 e2536))) (cond ((eq? m501 (quote e)) (if (memq (quote eval) when-list537) (chi-top-sequence142 body538 r499 w514 s515 (quote e) (quote (eval)) mod516) (chi-void155))) ((memq (quote load) when-list537) (if (or (memq (quote compile) when-list537) (and (eq? m501 (quote c&e)) (memq (quote eval) when-list537))) (chi-top-sequence142 body538 r499 w514 s515 (quote c&e) (quote (compile load)) mod516) (if (memq m501 (quote (c c&e))) (chi-top-sequence142 body538 r499 w514 s515 (quote c) (quote (load)) mod516) (chi-void155)))) ((or (memq (quote compile) when-list537) (and (eq? m501 (quote c&e)) (memq (quote eval) when-list537))) (top-level-eval-hook75 (chi-top-sequence142 body538 r499 w514 s515 (quote e) (quote (eval)) mod516) mod516) (chi-void155)) (else (chi-void155))))) tmp532) (syntax-violation #f "source expression failed to match any pattern" tmp531))) ($sc-dispatch tmp531 (quote (any each-any any . each-any))))) e513) (if (memv t517 (quote (define-syntax-form))) (let ((n541 (id-var-name133 value512 w514)) (r542 (macros-only-env107 r499))) (let ((t543 m501)) (if (memv t543 (quote (c))) (if (memq (quote compile) esew502) (let ((e544 (chi-install-global143 n541 (chi147 e513 r542 w514 mod516)))) (begin (top-level-eval-hook75 e544 mod516) (if (memq (quote load) esew502) e544 (chi-void155)))) (if (memq (quote load) esew502) (chi-install-global143 n541 (chi147 e513 r542 w514 mod516)) (chi-void155))) (if (memv t543 (quote (c&e))) (let ((e545 (chi-install-global143 n541 (chi147 e513 r542 w514 mod516)))) (begin (top-level-eval-hook75 e545 mod516) e545)) (begin (if (memq (quote eval) esew502) (top-level-eval-hook75 (chi-install-global143 n541 (chi147 e513 r542 w514 mod516)) mod516)) (chi-void155)))))) (if (memv t517 (quote (define-form))) (let ((n546 (id-var-name133 value512 w514))) (let ((type547 (binding-type103 (lookup108 n546 r499 mod516)))) (let ((t548 type547)) (if (memv t548 (quote (global core macro module-ref))) (let ((x549 (build-global-definition86 s515 n546 (chi147 e513 r499 w514 mod516)))) (begin (if (eq? m501 (quote c&e)) (top-level-eval-hook75 x549 mod516)) x549)) (if (memv t548 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e513 (wrap139 value512 w514 mod516)) (syntax-violation #f "cannot define keyword at top level" e513 (wrap139 value512 w514 mod516))))))) (let ((x550 (chi-expr148 type511 value512 e513 r499 w514 s515 mod516))) (begin (if (eq? m501 (quote c&e)) (top-level-eval-hook75 x550 mod516)) x550)))))))))))) (syntax-type145 (lambda (e551 r552 w553 s554 rib555 mod556) (cond ((symbol? e551) (let ((n557 (id-var-name133 e551 w553))) (let ((b558 (lookup108 n557 r552 mod556))) (let ((type559 (binding-type103 b558))) (let ((t560 type559)) (if (memv t560 (quote (lexical))) (values type559 (binding-value104 b558) e551 w553 s554 mod556) (if (memv t560 (quote (global))) (values type559 n557 e551 w553 s554 mod556) (if (memv t560 (quote (macro))) (syntax-type145 (chi-macro150 (binding-value104 b558) e551 r552 w553 rib555 mod556) r552 (quote (())) s554 rib555 mod556) (values type559 (binding-value104 b558) e551 w553 s554 mod556))))))))) ((pair? e551) (let ((first561 (car e551))) (if (id?111 first561) (let ((n562 (id-var-name133 first561 w553))) (let ((b563 (lookup108 n562 r552 (or (and (syntax-object?95 first561) (syntax-object-module98 first561)) mod556)))) (let ((type564 (binding-type103 b563))) (let ((t565 type564)) (if (memv t565 (quote (lexical))) (values (quote lexical-call) (binding-value104 b563) e551 w553 s554 mod556) (if (memv t565 (quote (global))) (values (quote global-call) n562 e551 w553 s554 mod556) (if (memv t565 (quote (macro))) (syntax-type145 (chi-macro150 (binding-value104 b563) e551 r552 w553 rib555 mod556) r552 (quote (())) s554 rib555 mod556) (if (memv t565 (quote (core external-macro module-ref))) (values type564 (binding-value104 b563) e551 w553 s554 mod556) (if (memv t565 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value104 b563) e551 w553 s554 mod556) (if (memv t565 (quote (begin))) (values (quote begin-form) #f e551 w553 s554 mod556) (if (memv t565 (quote (eval-when))) (values (quote eval-when-form) #f e551 w553 s554 mod556) (if (memv t565 (quote (define))) ((lambda (tmp566) ((lambda (tmp567) (if (if tmp567 (apply (lambda (_568 name569 val570) (id?111 name569)) tmp567) #f) (apply (lambda (_571 name572 val573) (values (quote define-form) name572 val573 w553 s554 mod556)) tmp567) ((lambda (tmp574) (if (if tmp574 (apply (lambda (_575 name576 args577 e1578 e2579) (and (id?111 name576) (valid-bound-ids?136 (lambda-var-list160 args577)))) tmp574) #f) (apply (lambda (_580 name581 args582 e1583 e2584) (values (quote define-form) (wrap139 name581 w553 mod556) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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))) (wrap139 (cons args582 (cons e1583 e2584)) w553 mod556)) (quote (())) s554 mod556)) tmp574) ((lambda (tmp586) (if (if tmp586 (apply (lambda (_587 name588) (id?111 name588)) tmp586) #f) (apply (lambda (_589 name590) (values (quote define-form) (wrap139 name590 w553 mod556) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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 #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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 #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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 (())) s554 mod556)) tmp586) (syntax-violation #f "source expression failed to match any pattern" tmp566))) ($sc-dispatch tmp566 (quote (any any)))))) ($sc-dispatch tmp566 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp566 (quote (any any any))))) e551) (if (memv t565 (quote (define-syntax))) ((lambda (tmp591) ((lambda (tmp592) (if (if tmp592 (apply (lambda (_593 name594 val595) (id?111 name594)) tmp592) #f) (apply (lambda (_596 name597 val598) (values (quote define-syntax-form) name597 val598 w553 s554 mod556)) tmp592) (syntax-violation #f "source expression failed to match any pattern" tmp591))) ($sc-dispatch tmp591 (quote (any any any))))) e551) (values (quote call) #f e551 w553 s554 mod556)))))))))))))) (values (quote call) #f e551 w553 s554 mod556)))) ((syntax-object?95 e551) (syntax-type145 (syntax-object-expression96 e551) r552 (join-wraps130 w553 (syntax-object-wrap97 e551)) #f rib555 (or (syntax-object-module98 e551) mod556))) ((annotation? e551) (syntax-type145 (annotation-expression e551) r552 w553 (annotation-source e551) rib555 mod556)) ((self-evaluating? e551) (values (quote constant) #f e551 w553 s554 mod556)) (else (values (quote other) #f e551 w553 s554 mod556))))) (chi-when-list144 (lambda (e599 when-list600 w601) (letrec ((f602 (lambda (when-list603 situations604) (if (null? when-list603) situations604 (f602 (cdr when-list603) (cons (let ((x605 (car when-list603))) (cond ((free-id=?134 x605 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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)) ((free-id=?134 x605 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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)) ((free-id=?134 x605 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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)) (else (syntax-violation (quote eval-when) "invalid situation" e599 (wrap139 x605 w601 #f))))) situations604)))))) (f602 when-list600 (quote ()))))) (chi-install-global143 (lambda (name606 e607) (build-global-definition86 #f name606 (if (let ((v608 (module-variable (current-module) name606))) (and v608 (variable-bound? v608) (macro? (variable-ref v608)) (not (eq? (macro-type (variable-ref v608)) (quote syncase-macro))))) (build-application79 #f (build-primref88 #f (quote make-extended-syncase-macro)) (list (build-application79 #f (build-primref88 #f (quote module-ref)) (list (build-application79 #f (quote current-module) (quote ())) (build-data89 #f name606))) (build-data89 #f (quote macro)) e607)) (build-application79 #f (build-primref88 #f (quote make-syncase-macro)) (list (build-data89 #f (quote macro)) e607)))))) (chi-top-sequence142 (lambda (body609 r610 w611 s612 m613 esew614 mod615) (build-sequence90 s612 (letrec ((dobody616 (lambda (body617 r618 w619 m620 esew621 mod622) (if (null? body617) (quote ()) (let ((first623 (chi-top146 (car body617) r618 w619 m620 esew621 mod622))) (cons first623 (dobody616 (cdr body617) r618 w619 m620 esew621 mod622))))))) (dobody616 body609 r610 w611 m613 esew614 mod615))))) (chi-sequence141 (lambda (body624 r625 w626 s627 mod628) (build-sequence90 s627 (letrec ((dobody629 (lambda (body630 r631 w632 mod633) (if (null? body630) (quote ()) (let ((first634 (chi147 (car body630) r631 w632 mod633))) (cons first634 (dobody629 (cdr body630) r631 w632 mod633))))))) (dobody629 body624 r625 w626 mod628))))) (source-wrap140 (lambda (x635 w636 s637 defmod638) (wrap139 (if s637 (make-annotation x635 s637 #f) x635) w636 defmod638))) (wrap139 (lambda (x639 w640 defmod641) (cond ((and (null? (wrap-marks114 w640)) (null? (wrap-subst115 w640))) x639) ((syntax-object?95 x639) (make-syntax-object94 (syntax-object-expression96 x639) (join-wraps130 w640 (syntax-object-wrap97 x639)) (syntax-object-module98 x639))) ((null? x639) x639) (else (make-syntax-object94 x639 w640 defmod641))))) (bound-id-member?138 (lambda (x642 list643) (and (not (null? list643)) (or (bound-id=?135 x642 (car list643)) (bound-id-member?138 x642 (cdr list643)))))) (distinct-bound-ids?137 (lambda (ids644) (letrec ((distinct?645 (lambda (ids646) (or (null? ids646) (and (not (bound-id-member?138 (car ids646) (cdr ids646))) (distinct?645 (cdr ids646))))))) (distinct?645 ids644)))) (valid-bound-ids?136 (lambda (ids647) (and (letrec ((all-ids?648 (lambda (ids649) (or (null? ids649) (and (id?111 (car ids649)) (all-ids?648 (cdr ids649))))))) (all-ids?648 ids647)) (distinct-bound-ids?137 ids647)))) (bound-id=?135 (lambda (i650 j651) (if (and (syntax-object?95 i650) (syntax-object?95 j651)) (and (eq? (let ((e652 (syntax-object-expression96 i650))) (if (annotation? e652) (annotation-expression e652) e652)) (let ((e653 (syntax-object-expression96 j651))) (if (annotation? e653) (annotation-expression e653) e653))) (same-marks?132 (wrap-marks114 (syntax-object-wrap97 i650)) (wrap-marks114 (syntax-object-wrap97 j651)))) (eq? (let ((e654 i650)) (if (annotation? e654) (annotation-expression e654) e654)) (let ((e655 j651)) (if (annotation? e655) (annotation-expression e655) e655)))))) (free-id=?134 (lambda (i656 j657) (and (eq? (let ((x658 i656)) (let ((e659 (if (syntax-object?95 x658) (syntax-object-expression96 x658) x658))) (if (annotation? e659) (annotation-expression e659) e659))) (let ((x660 j657)) (let ((e661 (if (syntax-object?95 x660) (syntax-object-expression96 x660) x660))) (if (annotation? e661) (annotation-expression e661) e661)))) (eq? (id-var-name133 i656 (quote (()))) (id-var-name133 j657 (quote (()))))))) (id-var-name133 (lambda (id662 w663) (letrec ((search-vector-rib666 (lambda (sym672 subst673 marks674 symnames675 ribcage676) (let ((n677 (vector-length symnames675))) (letrec ((f678 (lambda (i679) (cond ((fx=73 i679 n677) (search664 sym672 (cdr subst673) marks674)) ((and (eq? (vector-ref symnames675 i679) sym672) (same-marks?132 marks674 (vector-ref (ribcage-marks121 ribcage676) i679))) (values (vector-ref (ribcage-labels122 ribcage676) i679) marks674)) (else (f678 (fx+71 i679 1))))))) (f678 0))))) (search-list-rib665 (lambda (sym680 subst681 marks682 symnames683 ribcage684) (letrec ((f685 (lambda (symnames686 i687) (cond ((null? symnames686) (search664 sym680 (cdr subst681) marks682)) ((and (eq? (car symnames686) sym680) (same-marks?132 marks682 (list-ref (ribcage-marks121 ribcage684) i687))) (values (list-ref (ribcage-labels122 ribcage684) i687) marks682)) (else (f685 (cdr symnames686) (fx+71 i687 1))))))) (f685 symnames683 0)))) (search664 (lambda (sym688 subst689 marks690) (if (null? subst689) (values #f marks690) (let ((fst691 (car subst689))) (if (eq? fst691 (quote shift)) (search664 sym688 (cdr subst689) (cdr marks690)) (let ((symnames692 (ribcage-symnames120 fst691))) (if (vector? symnames692) (search-vector-rib666 sym688 subst689 marks690 symnames692 fst691) (search-list-rib665 sym688 subst689 marks690 symnames692 fst691))))))))) (cond ((symbol? id662) (or (call-with-values (lambda () (search664 id662 (wrap-subst115 w663) (wrap-marks114 w663))) (lambda (x694 . ignore693) x694)) id662)) ((syntax-object?95 id662) (let ((id695 (let ((e697 (syntax-object-expression96 id662))) (if (annotation? e697) (annotation-expression e697) e697))) (w1696 (syntax-object-wrap97 id662))) (let ((marks698 (join-marks131 (wrap-marks114 w663) (wrap-marks114 w1696)))) (call-with-values (lambda () (search664 id695 (wrap-subst115 w663) marks698)) (lambda (new-id699 marks700) (or new-id699 (call-with-values (lambda () (search664 id695 (wrap-subst115 w1696) marks700)) (lambda (x702 . ignore701) x702)) id695)))))) ((annotation? id662) (let ((id703 (let ((e704 id662)) (if (annotation? e704) (annotation-expression e704) e704)))) (or (call-with-values (lambda () (search664 id703 (wrap-subst115 w663) (wrap-marks114 w663))) (lambda (x706 . ignore705) x706)) id703))) (else (syntax-violation (quote id-var-name) "invalid id" id662)))))) (same-marks?132 (lambda (x707 y708) (or (eq? x707 y708) (and (not (null? x707)) (not (null? y708)) (eq? (car x707) (car y708)) (same-marks?132 (cdr x707) (cdr y708)))))) (join-marks131 (lambda (m1709 m2710) (smart-append129 m1709 m2710))) (join-wraps130 (lambda (w1711 w2712) (let ((m1713 (wrap-marks114 w1711)) (s1714 (wrap-subst115 w1711))) (if (null? m1713) (if (null? s1714) w2712 (make-wrap113 (wrap-marks114 w2712) (smart-append129 s1714 (wrap-subst115 w2712)))) (make-wrap113 (smart-append129 m1713 (wrap-marks114 w2712)) (smart-append129 s1714 (wrap-subst115 w2712))))))) (smart-append129 (lambda (m1715 m2716) (if (null? m2716) m1715 (append m1715 m2716)))) (make-binding-wrap128 (lambda (ids717 labels718 w719) (if (null? ids717) w719 (make-wrap113 (wrap-marks114 w719) (cons (let ((labelvec720 (list->vector labels718))) (let ((n721 (vector-length labelvec720))) (let ((symnamevec722 (make-vector n721)) (marksvec723 (make-vector n721))) (begin (letrec ((f724 (lambda (ids725 i726) (if (not (null? ids725)) (call-with-values (lambda () (id-sym-name&marks112 (car ids725) w719)) (lambda (symname727 marks728) (begin (vector-set! symnamevec722 i726 symname727) (vector-set! marksvec723 i726 marks728) (f724 (cdr ids725) (fx+71 i726 1))))))))) (f724 ids717 0)) (make-ribcage118 symnamevec722 marksvec723 labelvec720))))) (wrap-subst115 w719)))))) (extend-ribcage!127 (lambda (ribcage729 id730 label731) (begin (set-ribcage-symnames!123 ribcage729 (cons (let ((e732 (syntax-object-expression96 id730))) (if (annotation? e732) (annotation-expression e732) e732)) (ribcage-symnames120 ribcage729))) (set-ribcage-marks!124 ribcage729 (cons (wrap-marks114 (syntax-object-wrap97 id730)) (ribcage-marks121 ribcage729))) (set-ribcage-labels!125 ribcage729 (cons label731 (ribcage-labels122 ribcage729)))))) (anti-mark126 (lambda (w733) (make-wrap113 (cons #f (wrap-marks114 w733)) (cons (quote shift) (wrap-subst115 w733))))) (set-ribcage-labels!125 (lambda (x734 update735) (vector-set! x734 3 update735))) (set-ribcage-marks!124 (lambda (x736 update737) (vector-set! x736 2 update737))) (set-ribcage-symnames!123 (lambda (x738 update739) (vector-set! x738 1 update739))) (ribcage-labels122 (lambda (x740) (vector-ref x740 3))) (ribcage-marks121 (lambda (x741) (vector-ref x741 2))) (ribcage-symnames120 (lambda (x742) (vector-ref x742 1))) (ribcage?119 (lambda (x743) (and (vector? x743) (= (vector-length x743) 4) (eq? (vector-ref x743 0) (quote ribcage))))) (make-ribcage118 (lambda (symnames744 marks745 labels746) (vector (quote ribcage) symnames744 marks745 labels746))) (gen-labels117 (lambda (ls747) (if (null? ls747) (quote ()) (cons (gen-label116) (gen-labels117 (cdr ls747)))))) (gen-label116 (lambda () (string #\i))) (wrap-subst115 cdr) (wrap-marks114 car) (make-wrap113 cons) (id-sym-name&marks112 (lambda (x748 w749) (if (syntax-object?95 x748) (values (let ((e750 (syntax-object-expression96 x748))) (if (annotation? e750) (annotation-expression e750) e750)) (join-marks131 (wrap-marks114 w749) (wrap-marks114 (syntax-object-wrap97 x748)))) (values (let ((e751 x748)) (if (annotation? e751) (annotation-expression e751) e751)) (wrap-marks114 w749))))) (id?111 (lambda (x752) (cond ((symbol? x752) #t) ((syntax-object?95 x752) (symbol? (let ((e753 (syntax-object-expression96 x752))) (if (annotation? e753) (annotation-expression e753) e753)))) ((annotation? x752) (symbol? (annotation-expression x752))) (else #f)))) (nonsymbol-id?110 (lambda (x754) (and (syntax-object?95 x754) (symbol? (let ((e755 (syntax-object-expression96 x754))) (if (annotation? e755) (annotation-expression e755) e755)))))) (global-extend109 (lambda (type756 sym757 val758) (put-global-definition-hook77 sym757 type756 val758))) (lookup108 (lambda (x759 r760 mod761) (cond ((assq x759 r760) => cdr) ((symbol? x759) (or (get-global-definition-hook78 x759 mod761) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env107 (lambda (r762) (if (null? r762) (quote ()) (let ((a763 (car r762))) (if (eq? (cadr a763) (quote macro)) (cons a763 (macros-only-env107 (cdr r762))) (macros-only-env107 (cdr r762))))))) (extend-var-env106 (lambda (labels764 vars765 r766) (if (null? labels764) r766 (extend-var-env106 (cdr labels764) (cdr vars765) (cons (cons (car labels764) (cons (quote lexical) (car vars765))) r766))))) (extend-env105 (lambda (labels767 bindings768 r769) (if (null? labels767) r769 (extend-env105 (cdr labels767) (cdr bindings768) (cons (cons (car labels767) (car bindings768)) r769))))) (binding-value104 cdr) (binding-type103 car) (source-annotation102 (lambda (x770) (cond ((annotation? x770) (annotation-source x770)) ((syntax-object?95 x770) (source-annotation102 (syntax-object-expression96 x770))) (else #f)))) (set-syntax-object-module!101 (lambda (x771 update772) (vector-set! x771 3 update772))) (set-syntax-object-wrap!100 (lambda (x773 update774) (vector-set! x773 2 update774))) (set-syntax-object-expression!99 (lambda (x775 update776) (vector-set! x775 1 update776))) (syntax-object-module98 (lambda (x777) (vector-ref x777 3))) (syntax-object-wrap97 (lambda (x778) (vector-ref x778 2))) (syntax-object-expression96 (lambda (x779) (vector-ref x779 1))) (syntax-object?95 (lambda (x780) (and (vector? x780) (= (vector-length x780) 4) (eq? (vector-ref x780 0) (quote syntax-object))))) (make-syntax-object94 (lambda (expression781 wrap782 module783) (vector (quote syntax-object) expression781 wrap782 module783))) (build-letrec93 (lambda (src784 ids785 vars786 val-exps787 body-exp788) (if (null? vars786) body-exp788 (let ((t789 (fluid-ref *mode*70))) (if (memv t789 (quote (c))) ((@ (language tree-il) make-letrec) src784 ids785 vars786 val-exps787 body-exp788) (list (quote letrec) (map list vars786 val-exps787) body-exp788)))))) (build-named-let92 (lambda (src790 ids791 vars792 val-exps793 body-exp794) (let ((f795 (car vars792)) (f-name796 (car ids791)) (vars797 (cdr vars792)) (ids798 (cdr ids791))) (let ((t799 (fluid-ref *mode*70))) (if (memv t799 (quote (c))) ((@ (language tree-il) make-letrec) src790 (list f-name796) (list f795) (list (build-lambda87 src790 ids798 vars797 #f body-exp794)) (build-application79 src790 (build-lexical-reference81 (quote fun) src790 f-name796 f795) val-exps793)) (list (quote let) f795 (map list vars797 val-exps793) body-exp794)))))) (build-let91 (lambda (src800 ids801 vars802 val-exps803 body-exp804) (if (null? vars802) body-exp804 (let ((t805 (fluid-ref *mode*70))) (if (memv t805 (quote (c))) ((@ (language tree-il) make-let) src800 ids801 vars802 val-exps803 body-exp804) (list (quote let) (map list vars802 val-exps803) body-exp804)))))) (build-sequence90 (lambda (src806 exps807) (if (null? (cdr exps807)) (car exps807) (let ((t808 (fluid-ref *mode*70))) (if (memv t808 (quote (c))) ((@ (language tree-il) make-sequence) src806 exps807) (cons (quote begin) exps807)))))) (build-data89 (lambda (src809 exp810) (let ((t811 (fluid-ref *mode*70))) (if (memv t811 (quote (c))) ((@ (language tree-il) make-const) src809 exp810) (if (and (self-evaluating? exp810) (not (vector? exp810))) exp810 (list (quote quote) exp810)))))) (build-primref88 (lambda (src812 name813) (let ((t814 (fluid-ref *mode*70))) (if (memv t814 (quote (c))) ((@ (language tree-il) make-primitive-ref) src812 name813) (build-global-reference84 src812 name813 (quote (hygiene guile))))))) (build-lambda87 (lambda (src815 ids816 vars817 docstring818 exp819) (let ((t820 (fluid-ref *mode*70))) (if (memv t820 (quote (c))) ((@ (language tree-il) make-lambda) src815 ids816 vars817 (if docstring818 (list (cons (quote documentation) docstring818)) (quote ())) exp819) (cons (quote lambda) (cons vars817 (append (if docstring818 (list docstring818) (quote ())) (list exp819)))))))) (build-global-definition86 (lambda (source821 var822 exp823) (let ((t824 (fluid-ref *mode*70))) (if (memv t824 (quote (c))) ((@ (language tree-il) make-toplevel-define) source821 var822 exp823) (list (quote define) var822 exp823))))) (build-global-assignment85 (lambda (source825 var826 exp827 mod828) (analyze-variable83 mod828 var826 (lambda (mod829 var830 public?831) (let ((t832 (fluid-ref *mode*70))) (if (memv t832 (quote (c))) ((@ (language tree-il) make-module-set) source825 mod829 var830 public?831 exp827) (list (quote set!) (list (if public?831 (quote @) (quote @@)) mod829 var830) exp827)))) (lambda (var833) (let ((t834 (fluid-ref *mode*70))) (if (memv t834 (quote (c))) ((@ (language tree-il) make-toplevel-set) source825 var833 exp827) (list (quote set!) var833 exp827))))))) (build-global-reference84 (lambda (source835 var836 mod837) (analyze-variable83 mod837 var836 (lambda (mod838 var839 public?840) (let ((t841 (fluid-ref *mode*70))) (if (memv t841 (quote (c))) ((@ (language tree-il) make-module-ref) source835 mod838 var839 public?840) (list (if public?840 (quote @) (quote @@)) mod838 var839)))) (lambda (var842) (let ((t843 (fluid-ref *mode*70))) (if (memv t843 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source835 var842) var842)))))) (analyze-variable83 (lambda (mod844 var845 modref-cont846 bare-cont847) (if (not mod844) (bare-cont847 var845) (let ((kind848 (car mod844)) (mod849 (cdr mod844))) (let ((t850 kind848)) (if (memv t850 (quote (public))) (modref-cont846 mod849 var845 #t) (if (memv t850 (quote (private))) (if (not (equal? mod849 (module-name (current-module)))) (modref-cont846 mod849 var845 #f) (bare-cont847 var845)) (if (memv t850 (quote (bare))) (bare-cont847 var845) (if (memv t850 (quote (hygiene))) (if (and (not (equal? mod849 (module-name (current-module)))) (module-variable (resolve-module mod849) var845)) (modref-cont846 mod849 var845 #f) (bare-cont847 var845)) (syntax-violation #f "bad module kind" var845 mod849)))))))))) (build-lexical-assignment82 (lambda (source851 name852 var853 exp854) (let ((t855 (fluid-ref *mode*70))) (if (memv t855 (quote (c))) ((@ (language tree-il) make-lexical-set) source851 name852 var853 exp854) (list (quote set!) var853 exp854))))) (build-lexical-reference81 (lambda (type856 source857 name858 var859) (let ((t860 (fluid-ref *mode*70))) (if (memv t860 (quote (c))) ((@ (language tree-il) make-lexical-ref) source857 name858 var859) var859)))) (build-conditional80 (lambda (source861 test-exp862 then-exp863 else-exp864) (let ((t865 (fluid-ref *mode*70))) (if (memv t865 (quote (c))) ((@ (language tree-il) make-conditional) source861 test-exp862 then-exp863 else-exp864) (list (quote if) test-exp862 then-exp863 else-exp864))))) (build-application79 (lambda (source866 fun-exp867 arg-exps868) (let ((t869 (fluid-ref *mode*70))) (if (memv t869 (quote (c))) ((@ (language tree-il) make-application) source866 fun-exp867 arg-exps868) (cons fun-exp867 arg-exps868))))) (get-global-definition-hook78 (lambda (symbol870 module871) (begin (if (and (not module871) (current-module)) (warn "module system is booted, we should have a module" symbol870)) (let ((v872 (module-variable (if module871 (resolve-module (cdr module871)) (current-module)) symbol870))) (and v872 (variable-bound? v872) (let ((val873 (variable-ref v872))) (and (macro? val873) (syncase-macro-type val873) (cons (syncase-macro-type val873) (syncase-macro-binding val873))))))))) (put-global-definition-hook77 (lambda (symbol874 type875 val876) (let ((existing877 (let ((v878 (module-variable (current-module) symbol874))) (and v878 (variable-bound? v878) (let ((val879 (variable-ref v878))) (and (macro? val879) (not (syncase-macro-type val879)) val879)))))) (module-define! (current-module) symbol874 (if existing877 (make-extended-syncase-macro existing877 type875 val876) (make-syncase-macro type875 val876)))))) (local-eval-hook76 (lambda (x880 mod881) (primitive-eval (list noexpand69 (let ((t882 (fluid-ref *mode*70))) (if (memv t882 (quote (c))) ((@ (language tree-il) tree-il->scheme) x880) x880)))))) (top-level-eval-hook75 (lambda (x883 mod884) (primitive-eval (list noexpand69 (let ((t885 (fluid-ref *mode*70))) (if (memv t885 (quote (c))) ((@ (language tree-il) tree-il->scheme) x883) x883)))))) (fx<74 <) (fx=73 =) (fx-72 -) (fx+71 +) (*mode*70 (make-fluid)) (noexpand69 "noexpand")) (begin (global-extend109 (quote local-syntax) (quote letrec-syntax) #t) (global-extend109 (quote local-syntax) (quote let-syntax) #f) (global-extend109 (quote core) (quote fluid-let-syntax) (lambda (e886 r887 w888 s889 mod890) ((lambda (tmp891) ((lambda (tmp892) (if (if tmp892 (apply (lambda (_893 var894 val895 e1896 e2897) (valid-bound-ids?136 var894)) tmp892) #f) (apply (lambda (_899 var900 val901 e1902 e2903) (let ((names904 (map (lambda (x905) (id-var-name133 x905 w888)) var900))) (begin (for-each (lambda (id907 n908) (let ((t909 (binding-type103 (lookup108 n908 r887 mod890)))) (if (memv t909 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e886 (source-wrap140 id907 w888 s889 mod890))))) var900 names904) (chi-body151 (cons e1902 e2903) (source-wrap140 e886 w888 s889 mod890) (extend-env105 names904 (let ((trans-r912 (macros-only-env107 r887))) (map (lambda (x913) (cons (quote macro) (eval-local-transformer154 (chi147 x913 trans-r912 w888 mod890) mod890))) val901)) r887) w888 mod890)))) tmp892) ((lambda (_915) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap140 e886 w888 s889 mod890))) tmp891))) ($sc-dispatch tmp891 (quote (any #(each (any any)) any . each-any))))) e886))) (global-extend109 (quote core) (quote quote) (lambda (e916 r917 w918 s919 mod920) ((lambda (tmp921) ((lambda (tmp922) (if tmp922 (apply (lambda (_923 e924) (build-data89 s919 (strip158 e924 w918))) tmp922) ((lambda (_925) (syntax-violation (quote quote) "bad syntax" (source-wrap140 e916 w918 s919 mod920))) tmp921))) ($sc-dispatch tmp921 (quote (any any))))) e916))) (global-extend109 (quote core) (quote syntax) (letrec ((regen933 (lambda (x934) (let ((t935 (car x934))) (if (memv t935 (quote (ref))) (build-lexical-reference81 (quote value) #f (cadr x934) (cadr x934)) (if (memv t935 (quote (primitive))) (build-primref88 #f (cadr x934)) (if (memv t935 (quote (quote))) (build-data89 #f (cadr x934)) (if (memv t935 (quote (lambda))) (build-lambda87 #f (cadr x934) (cadr x934) #f (regen933 (caddr x934))) (if (memv t935 (quote (map))) (let ((ls936 (map regen933 (cdr x934)))) (build-application79 #f (build-primref88 #f (quote map)) ls936)) (build-application79 #f (build-primref88 #f (car x934)) (map regen933 (cdr x934))))))))))) (gen-vector932 (lambda (x937) (cond ((eq? (car x937) (quote list)) (cons (quote vector) (cdr x937))) ((eq? (car x937) (quote quote)) (list (quote quote) (list->vector (cadr x937)))) (else (list (quote list->vector) x937))))) (gen-append931 (lambda (x938 y939) (if (equal? y939 (quote (quote ()))) x938 (list (quote append) x938 y939)))) (gen-cons930 (lambda (x940 y941) (let ((t942 (car y941))) (if (memv t942 (quote (quote))) (if (eq? (car x940) (quote quote)) (list (quote quote) (cons (cadr x940) (cadr y941))) (if (eq? (cadr y941) (quote ())) (list (quote list) x940) (list (quote cons) x940 y941))) (if (memv t942 (quote (list))) (cons (quote list) (cons x940 (cdr y941))) (list (quote cons) x940 y941)))))) (gen-map929 (lambda (e943 map-env944) (let ((formals945 (map cdr map-env944)) (actuals946 (map (lambda (x947) (list (quote ref) (car x947))) map-env944))) (cond ((eq? (car e943) (quote ref)) (car actuals946)) ((and-map (lambda (x948) (and (eq? (car x948) (quote ref)) (memq (cadr x948) formals945))) (cdr e943)) (cons (quote map) (cons (list (quote primitive) (car e943)) (map (let ((r949 (map cons formals945 actuals946))) (lambda (x950) (cdr (assq (cadr x950) r949)))) (cdr e943))))) (else (cons (quote map) (cons (list (quote lambda) formals945 e943) actuals946))))))) (gen-mappend928 (lambda (e951 map-env952) (list (quote apply) (quote (primitive append)) (gen-map929 e951 map-env952)))) (gen-ref927 (lambda (src953 var954 level955 maps956) (if (fx=73 level955 0) (values var954 maps956) (if (null? maps956) (syntax-violation (quote syntax) "missing ellipsis" src953) (call-with-values (lambda () (gen-ref927 src953 var954 (fx-72 level955 1) (cdr maps956))) (lambda (outer-var957 outer-maps958) (let ((b959 (assq outer-var957 (car maps956)))) (if b959 (values (cdr b959) maps956) (let ((inner-var960 (gen-var159 (quote tmp)))) (values inner-var960 (cons (cons (cons outer-var957 inner-var960) (car maps956)) outer-maps958))))))))))) (gen-syntax926 (lambda (src961 e962 r963 maps964 ellipsis?965 mod966) (if (id?111 e962) (let ((label967 (id-var-name133 e962 (quote (()))))) (let ((b968 (lookup108 label967 r963 mod966))) (if (eq? (binding-type103 b968) (quote syntax)) (call-with-values (lambda () (let ((var.lev969 (binding-value104 b968))) (gen-ref927 src961 (car var.lev969) (cdr var.lev969) maps964))) (lambda (var970 maps971) (values (list (quote ref) var970) maps971))) (if (ellipsis?965 e962) (syntax-violation (quote syntax) "misplaced ellipsis" src961) (values (list (quote quote) e962) maps964))))) ((lambda (tmp972) ((lambda (tmp973) (if (if tmp973 (apply (lambda (dots974 e975) (ellipsis?965 dots974)) tmp973) #f) (apply (lambda (dots976 e977) (gen-syntax926 src961 e977 r963 maps964 (lambda (x978) #f) mod966)) tmp973) ((lambda (tmp979) (if (if tmp979 (apply (lambda (x980 dots981 y982) (ellipsis?965 dots981)) tmp979) #f) (apply (lambda (x983 dots984 y985) (letrec ((f986 (lambda (y987 k988) ((lambda (tmp992) ((lambda (tmp993) (if (if tmp993 (apply (lambda (dots994 y995) (ellipsis?965 dots994)) tmp993) #f) (apply (lambda (dots996 y997) (f986 y997 (lambda (maps998) (call-with-values (lambda () (k988 (cons (quote ()) maps998))) (lambda (x999 maps1000) (if (null? (car maps1000)) (syntax-violation (quote syntax) "extra ellipsis" src961) (values (gen-mappend928 x999 (car maps1000)) (cdr maps1000)))))))) tmp993) ((lambda (_1001) (call-with-values (lambda () (gen-syntax926 src961 y987 r963 maps964 ellipsis?965 mod966)) (lambda (y1002 maps1003) (call-with-values (lambda () (k988 maps1003)) (lambda (x1004 maps1005) (values (gen-append931 x1004 y1002) maps1005)))))) tmp992))) ($sc-dispatch tmp992 (quote (any . any))))) y987)))) (f986 y985 (lambda (maps989) (call-with-values (lambda () (gen-syntax926 src961 x983 r963 (cons (quote ()) maps989) ellipsis?965 mod966)) (lambda (x990 maps991) (if (null? (car maps991)) (syntax-violation (quote syntax) "extra ellipsis" src961) (values (gen-map929 x990 (car maps991)) (cdr maps991))))))))) tmp979) ((lambda (tmp1006) (if tmp1006 (apply (lambda (x1007 y1008) (call-with-values (lambda () (gen-syntax926 src961 x1007 r963 maps964 ellipsis?965 mod966)) (lambda (x1009 maps1010) (call-with-values (lambda () (gen-syntax926 src961 y1008 r963 maps1010 ellipsis?965 mod966)) (lambda (y1011 maps1012) (values (gen-cons930 x1009 y1011) maps1012)))))) tmp1006) ((lambda (tmp1013) (if tmp1013 (apply (lambda (e11014 e21015) (call-with-values (lambda () (gen-syntax926 src961 (cons e11014 e21015) r963 maps964 ellipsis?965 mod966)) (lambda (e1017 maps1018) (values (gen-vector932 e1017) maps1018)))) tmp1013) ((lambda (_1019) (values (list (quote quote) e962) maps964)) tmp972))) ($sc-dispatch tmp972 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp972 (quote (any . any)))))) ($sc-dispatch tmp972 (quote (any any . any)))))) ($sc-dispatch tmp972 (quote (any any))))) e962))))) (lambda (e1020 r1021 w1022 s1023 mod1024) (let ((e1025 (source-wrap140 e1020 w1022 s1023 mod1024))) ((lambda (tmp1026) ((lambda (tmp1027) (if tmp1027 (apply (lambda (_1028 x1029) (call-with-values (lambda () (gen-syntax926 e1025 x1029 r1021 (quote ()) ellipsis?156 mod1024)) (lambda (e1030 maps1031) (regen933 e1030)))) tmp1027) ((lambda (_1032) (syntax-violation (quote syntax) "bad `syntax' form" e1025)) tmp1026))) ($sc-dispatch tmp1026 (quote (any any))))) e1025))))) (global-extend109 (quote core) (quote lambda) (lambda (e1033 r1034 w1035 s1036 mod1037) ((lambda (tmp1038) ((lambda (tmp1039) (if tmp1039 (apply (lambda (_1040 c1041) (chi-lambda-clause152 (source-wrap140 e1033 w1035 s1036 mod1037) #f c1041 r1034 w1035 mod1037 (lambda (names1042 vars1043 docstring1044 body1045) (build-lambda87 s1036 names1042 vars1043 docstring1044 body1045)))) tmp1039) (syntax-violation #f "source expression failed to match any pattern" tmp1038))) ($sc-dispatch tmp1038 (quote (any . any))))) e1033))) (global-extend109 (quote core) (quote let) (letrec ((chi-let1046 (lambda (e1047 r1048 w1049 s1050 mod1051 constructor1052 ids1053 vals1054 exps1055) (if (not (valid-bound-ids?136 ids1053)) (syntax-violation (quote let) "duplicate bound variable" e1047) (let ((labels1056 (gen-labels117 ids1053)) (new-vars1057 (map gen-var159 ids1053))) (let ((nw1058 (make-binding-wrap128 ids1053 labels1056 w1049)) (nr1059 (extend-var-env106 labels1056 new-vars1057 r1048))) (constructor1052 s1050 (map syntax->datum ids1053) new-vars1057 (map (lambda (x1060) (chi147 x1060 r1048 w1049 mod1051)) vals1054) (chi-body151 exps1055 (source-wrap140 e1047 nw1058 s1050 mod1051) nr1059 nw1058 mod1051)))))))) (lambda (e1061 r1062 w1063 s1064 mod1065) ((lambda (tmp1066) ((lambda (tmp1067) (if tmp1067 (apply (lambda (_1068 id1069 val1070 e11071 e21072) (chi-let1046 e1061 r1062 w1063 s1064 mod1065 build-let91 id1069 val1070 (cons e11071 e21072))) tmp1067) ((lambda (tmp1076) (if (if tmp1076 (apply (lambda (_1077 f1078 id1079 val1080 e11081 e21082) (id?111 f1078)) tmp1076) #f) (apply (lambda (_1083 f1084 id1085 val1086 e11087 e21088) (chi-let1046 e1061 r1062 w1063 s1064 mod1065 build-named-let92 (cons f1084 id1085) val1086 (cons e11087 e21088))) tmp1076) ((lambda (_1092) (syntax-violation (quote let) "bad let" (source-wrap140 e1061 w1063 s1064 mod1065))) tmp1066))) ($sc-dispatch tmp1066 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1066 (quote (any #(each (any any)) any . each-any))))) e1061)))) (global-extend109 (quote core) (quote letrec) (lambda (e1093 r1094 w1095 s1096 mod1097) ((lambda (tmp1098) ((lambda (tmp1099) (if tmp1099 (apply (lambda (_1100 id1101 val1102 e11103 e21104) (let ((ids1105 id1101)) (if (not (valid-bound-ids?136 ids1105)) (syntax-violation (quote letrec) "duplicate bound variable" e1093) (let ((labels1107 (gen-labels117 ids1105)) (new-vars1108 (map gen-var159 ids1105))) (let ((w1109 (make-binding-wrap128 ids1105 labels1107 w1095)) (r1110 (extend-var-env106 labels1107 new-vars1108 r1094))) (build-letrec93 s1096 (map syntax->datum ids1105) new-vars1108 (map (lambda (x1111) (chi147 x1111 r1110 w1109 mod1097)) val1102) (chi-body151 (cons e11103 e21104) (source-wrap140 e1093 w1109 s1096 mod1097) r1110 w1109 mod1097))))))) tmp1099) ((lambda (_1114) (syntax-violation (quote letrec) "bad letrec" (source-wrap140 e1093 w1095 s1096 mod1097))) tmp1098))) ($sc-dispatch tmp1098 (quote (any #(each (any any)) any . each-any))))) e1093))) (global-extend109 (quote core) (quote set!) (lambda (e1115 r1116 w1117 s1118 mod1119) ((lambda (tmp1120) ((lambda (tmp1121) (if (if tmp1121 (apply (lambda (_1122 id1123 val1124) (id?111 id1123)) tmp1121) #f) (apply (lambda (_1125 id1126 val1127) (let ((val1128 (chi147 val1127 r1116 w1117 mod1119)) (n1129 (id-var-name133 id1126 w1117))) (let ((b1130 (lookup108 n1129 r1116 mod1119))) (let ((t1131 (binding-type103 b1130))) (if (memv t1131 (quote (lexical))) (build-lexical-assignment82 s1118 (syntax->datum id1126) (binding-value104 b1130) val1128) (if (memv t1131 (quote (global))) (build-global-assignment85 s1118 n1129 val1128 mod1119) (if (memv t1131 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap139 id1126 w1117 mod1119)) (syntax-violation (quote set!) "bad set!" (source-wrap140 e1115 w1117 s1118 mod1119))))))))) tmp1121) ((lambda (tmp1132) (if tmp1132 (apply (lambda (_1133 head1134 tail1135 val1136) (call-with-values (lambda () (syntax-type145 head1134 r1116 (quote (())) #f #f mod1119)) (lambda (type1137 value1138 ee1139 ww1140 ss1141 modmod1142) (let ((t1143 type1137)) (if (memv t1143 (quote (module-ref))) (let ((val1144 (chi147 val1136 r1116 w1117 mod1119))) (call-with-values (lambda () (value1138 (cons head1134 tail1135))) (lambda (id1146 mod1147) (build-global-assignment85 s1118 id1146 val1144 mod1147)))) (build-application79 s1118 (chi147 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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))) head1134) r1116 w1117 mod1119) (map (lambda (e1148) (chi147 e1148 r1116 w1117 mod1119)) (append tail1135 (list val1136))))))))) tmp1132) ((lambda (_1150) (syntax-violation (quote set!) "bad set!" (source-wrap140 e1115 w1117 s1118 mod1119))) tmp1120))) ($sc-dispatch tmp1120 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1120 (quote (any any any))))) e1115))) (global-extend109 (quote module-ref) (quote @) (lambda (e1151) ((lambda (tmp1152) ((lambda (tmp1153) (if (if tmp1153 (apply (lambda (_1154 mod1155 id1156) (and (and-map id?111 mod1155) (id?111 id1156))) 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 strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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-extend109 (quote module-ref) (quote @@) (lambda (e1162) ((lambda (tmp1163) ((lambda (tmp1164) (if (if tmp1164 (apply (lambda (_1165 mod1166 id1167) (and (and-map id?111 mod1166) (id?111 id1167))) 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 strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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-extend109 (quote begin) (quote begin) (quote ())) (global-extend109 (quote define) (quote define) (quote ())) (global-extend109 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend109 (quote eval-when) (quote eval-when) (quote ())) (global-extend109 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1176 (lambda (x1177 keys1178 clauses1179 r1180 mod1181) (if (null? clauses1179) (build-application79 #f (build-primref88 #f (quote syntax-violation)) (list #f "source expression failed to match any pattern" x1177)) ((lambda (tmp1182) ((lambda (tmp1183) (if tmp1183 (apply (lambda (pat1184 exp1185) (if (and (id?111 pat1184) (and-map (lambda (x1186) (not (free-id=?134 pat1184 x1186))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application 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))) keys1178))) (let ((labels1187 (list (gen-label116))) (var1188 (gen-var159 pat1184))) (build-application79 #f (build-lambda87 #f (list (syntax->datum pat1184)) (list var1188) #f (chi147 exp1185 (extend-env105 labels1187 (list (cons (quote syntax) (cons var1188 0))) r1180) (make-binding-wrap128 (list pat1184) labels1187 (quote (()))) mod1181)) (list x1177))) (gen-clause1175 x1177 keys1178 (cdr clauses1179) r1180 pat1184 #t exp1185 mod1181))) tmp1183) ((lambda (tmp1189) (if tmp1189 (apply (lambda (pat1190 fender1191 exp1192) (gen-clause1175 x1177 keys1178 (cdr clauses1179) r1180 pat1190 fender1191 exp1192 mod1181)) tmp1189) ((lambda (_1193) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1179))) tmp1182))) ($sc-dispatch tmp1182 (quote (any any any)))))) ($sc-dispatch tmp1182 (quote (any any))))) (car clauses1179))))) (gen-clause1175 (lambda (x1194 keys1195 clauses1196 r1197 pat1198 fender1199 exp1200 mod1201) (call-with-values (lambda () (convert-pattern1173 pat1198 keys1195)) (lambda (p1202 pvars1203) (cond ((not (distinct-bound-ids?137 (map car pvars1203))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1198)) ((not (and-map (lambda (x1204) (not (ellipsis?156 (car x1204)))) pvars1203)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1198)) (else (let ((y1205 (gen-var159 (quote tmp)))) (build-application79 #f (build-lambda87 #f (list (quote tmp)) (list y1205) #f (let ((y1206 (build-lexical-reference81 (quote value) #f (quote tmp) y1205))) (build-conditional80 #f ((lambda (tmp1207) ((lambda (tmp1208) (if tmp1208 (apply (lambda () y1206) tmp1208) ((lambda (_1209) (build-conditional80 #f y1206 (build-dispatch-call1174 pvars1203 fender1199 y1206 r1197 mod1201) (build-data89 #f #f))) tmp1207))) ($sc-dispatch tmp1207 (quote #(atom #t))))) fender1199) (build-dispatch-call1174 pvars1203 exp1200 y1206 r1197 mod1201) (gen-syntax-case1176 x1194 keys1195 clauses1196 r1197 mod1201)))) (list (if (eq? p1202 (quote any)) (build-application79 #f (build-primref88 #f (quote list)) (list x1194)) (build-application79 #f (build-primref88 #f (quote $sc-dispatch)) (list x1194 (build-data89 #f p1202))))))))))))) (build-dispatch-call1174 (lambda (pvars1210 exp1211 y1212 r1213 mod1214) (let ((ids1215 (map car pvars1210)) (levels1216 (map cdr pvars1210))) (let ((labels1217 (gen-labels117 ids1215)) (new-vars1218 (map gen-var159 ids1215))) (build-application79 #f (build-primref88 #f (quote apply)) (list (build-lambda87 #f (map syntax->datum ids1215) new-vars1218 #f (chi147 exp1211 (extend-env105 labels1217 (map (lambda (var1219 level1220) (cons (quote syntax) (cons var1219 level1220))) new-vars1218 (map cdr pvars1210)) r1213) (make-binding-wrap128 ids1215 labels1217 (quote (()))) mod1214)) y1212)))))) (convert-pattern1173 (lambda (pattern1221 keys1222) (letrec ((cvt1223 (lambda (p1224 n1225 ids1226) (if (id?111 p1224) (if (bound-id-member?138 p1224 keys1222) (values (vector (quote free-id) p1224) ids1226) (values (quote any) (cons (cons p1224 n1225) ids1226))) ((lambda (tmp1227) ((lambda (tmp1228) (if (if tmp1228 (apply (lambda (x1229 dots1230) (ellipsis?156 dots1230)) tmp1228) #f) (apply (lambda (x1231 dots1232) (call-with-values (lambda () (cvt1223 x1231 (fx+71 n1225 1) ids1226)) (lambda (p1233 ids1234) (values (if (eq? p1233 (quote any)) (quote each-any) (vector (quote each) p1233)) ids1234)))) tmp1228) ((lambda (tmp1235) (if tmp1235 (apply (lambda (x1236 y1237) (call-with-values (lambda () (cvt1223 y1237 n1225 ids1226)) (lambda (y1238 ids1239) (call-with-values (lambda () (cvt1223 x1236 n1225 ids1239)) (lambda (x1240 ids1241) (values (cons x1240 y1238) ids1241)))))) tmp1235) ((lambda (tmp1242) (if tmp1242 (apply (lambda () (values (quote ()) ids1226)) tmp1242) ((lambda (tmp1243) (if tmp1243 (apply (lambda (x1244) (call-with-values (lambda () (cvt1223 x1244 n1225 ids1226)) (lambda (p1246 ids1247) (values (vector (quote vector) p1246) ids1247)))) tmp1243) ((lambda (x1248) (values (vector (quote atom) (strip158 p1224 (quote (())))) ids1226)) tmp1227))) ($sc-dispatch tmp1227 (quote #(vector each-any)))))) ($sc-dispatch tmp1227 (quote ()))))) ($sc-dispatch tmp1227 (quote (any . any)))))) ($sc-dispatch tmp1227 (quote (any any))))) p1224))))) (cvt1223 pattern1221 0 (quote ())))))) (lambda (e1249 r1250 w1251 s1252 mod1253) (let ((e1254 (source-wrap140 e1249 w1251 s1252 mod1253))) ((lambda (tmp1255) ((lambda (tmp1256) (if tmp1256 (apply (lambda (_1257 val1258 key1259 m1260) (if (and-map (lambda (x1261) (and (id?111 x1261) (not (ellipsis?156 x1261)))) key1259) (let ((x1263 (gen-var159 (quote tmp)))) (build-application79 s1252 (build-lambda87 #f (list (quote tmp)) (list x1263) #f (gen-syntax-case1176 (build-lexical-reference81 (quote value) #f (quote tmp) x1263) key1259 m1260 r1250 mod1253)) (list (chi147 val1258 r1250 (quote (())) mod1253)))) (syntax-violation (quote syntax-case) "invalid literals list" e1254))) tmp1256) (syntax-violation #f "source expression failed to match any pattern" tmp1255))) ($sc-dispatch tmp1255 (quote (any any each-any . each-any))))) e1254))))) (set! sc-expand (lambda (x1267 . rest1266) (if (and (pair? x1267) (equal? (car x1267) noexpand69)) (cadr x1267) (let ((m1268 (if (null? rest1266) (quote e) (car rest1266))) (esew1269 (if (or (null? rest1266) (null? (cdr rest1266))) (quote (eval)) (cadr rest1266)))) (with-fluid* *mode*70 m1268 (lambda () (chi-top146 x1267 (quote ()) (quote ((top))) m1268 esew1269 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1270) (nonsymbol-id?110 x1270))) (set! datum->syntax (lambda (id1271 datum1272) (make-syntax-object94 datum1272 (syntax-object-wrap97 id1271) #f))) (set! syntax->datum (lambda (x1273) (strip158 x1273 (quote (()))))) (set! generate-temporaries (lambda (ls1274) (begin (let ((x1275 ls1274)) (if (not (list? x1275)) (syntax-violation (quote generate-temporaries) "invalid argument" x1275))) (map (lambda (x1276) (wrap139 (gensym) (quote ((top))) #f)) ls1274)))) (set! free-identifier=? (lambda (x1277 y1278) (begin (let ((x1279 x1277)) (if (not (nonsymbol-id?110 x1279)) (syntax-violation (quote free-identifier=?) "invalid argument" x1279))) (let ((x1280 y1278)) (if (not (nonsymbol-id?110 x1280)) (syntax-violation (quote free-identifier=?) "invalid argument" x1280))) (free-id=?134 x1277 y1278)))) (set! bound-identifier=? (lambda (x1281 y1282) (begin (let ((x1283 x1281)) (if (not (nonsymbol-id?110 x1283)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1283))) (let ((x1284 y1282)) (if (not (nonsymbol-id?110 x1284)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1284))) (bound-id=?135 x1281 y1282)))) (set! syntax-violation (lambda (who1288 message1287 form1286 . subform1285) (begin (let ((x1289 who1288)) (if (not ((lambda (x1290) (or (not x1290) (string? x1290) (symbol? x1290))) x1289)) (syntax-violation (quote syntax-violation) "invalid argument" x1289))) (let ((x1291 message1287)) (if (not (string? x1291)) (syntax-violation (quote syntax-violation) "invalid argument" x1291))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1288 "~a: " "") "~a " (if (null? subform1285) "in ~a" "in subform `~s' of `~s'")) (let ((tail1292 (cons message1287 (map (lambda (x1293) (strip158 x1293 (quote (())))) (append subform1285 (list form1286)))))) (if who1288 (cons who1288 tail1292) tail1292)) #f)))) (letrec ((match1298 (lambda (e1299 p1300 w1301 r1302 mod1303) (cond ((not r1302) #f) ((eq? p1300 (quote any)) (cons (wrap139 e1299 w1301 mod1303) r1302)) ((syntax-object?95 e1299) (match*1297 (let ((e1304 (syntax-object-expression96 e1299))) (if (annotation? e1304) (annotation-expression e1304) e1304)) p1300 (join-wraps130 w1301 (syntax-object-wrap97 e1299)) r1302 (syntax-object-module98 e1299))) (else (match*1297 (let ((e1305 e1299)) (if (annotation? e1305) (annotation-expression e1305) e1305)) p1300 w1301 r1302 mod1303))))) (match*1297 (lambda (e1306 p1307 w1308 r1309 mod1310) (cond ((null? p1307) (and (null? e1306) r1309)) ((pair? p1307) (and (pair? e1306) (match1298 (car e1306) (car p1307) w1308 (match1298 (cdr e1306) (cdr p1307) w1308 r1309 mod1310) mod1310))) ((eq? p1307 (quote each-any)) (let ((l1311 (match-each-any1295 e1306 w1308 mod1310))) (and l1311 (cons l1311 r1309)))) (else (let ((t1312 (vector-ref p1307 0))) (if (memv t1312 (quote (each))) (if (null? e1306) (match-empty1296 (vector-ref p1307 1) r1309) (let ((l1313 (match-each1294 e1306 (vector-ref p1307 1) w1308 mod1310))) (and l1313 (letrec ((collect1314 (lambda (l1315) (if (null? (car l1315)) r1309 (cons (map car l1315) (collect1314 (map cdr l1315))))))) (collect1314 l1313))))) (if (memv t1312 (quote (free-id))) (and (id?111 e1306) (free-id=?134 (wrap139 e1306 w1308 mod1310) (vector-ref p1307 1)) r1309) (if (memv t1312 (quote (atom))) (and (equal? (vector-ref p1307 1) (strip158 e1306 w1308)) r1309) (if (memv t1312 (quote (vector))) (and (vector? e1306) (match1298 (vector->list e1306) (vector-ref p1307 1) w1308 r1309 mod1310))))))))))) (match-empty1296 (lambda (p1316 r1317) (cond ((null? p1316) r1317) ((eq? p1316 (quote any)) (cons (quote ()) r1317)) ((pair? p1316) (match-empty1296 (car p1316) (match-empty1296 (cdr p1316) r1317))) ((eq? p1316 (quote each-any)) (cons (quote ()) r1317)) (else (let ((t1318 (vector-ref p1316 0))) (if (memv t1318 (quote (each))) (match-empty1296 (vector-ref p1316 1) r1317) (if (memv t1318 (quote (free-id atom))) r1317 (if (memv t1318 (quote (vector))) (match-empty1296 (vector-ref p1316 1) r1317))))))))) (match-each-any1295 (lambda (e1319 w1320 mod1321) (cond ((annotation? e1319) (match-each-any1295 (annotation-expression e1319) w1320 mod1321)) ((pair? e1319) (let ((l1322 (match-each-any1295 (cdr e1319) w1320 mod1321))) (and l1322 (cons (wrap139 (car e1319) w1320 mod1321) l1322)))) ((null? e1319) (quote ())) ((syntax-object?95 e1319) (match-each-any1295 (syntax-object-expression96 e1319) (join-wraps130 w1320 (syntax-object-wrap97 e1319)) mod1321)) (else #f)))) (match-each1294 (lambda (e1323 p1324 w1325 mod1326) (cond ((annotation? e1323) (match-each1294 (annotation-expression e1323) p1324 w1325 mod1326)) ((pair? e1323) (let ((first1327 (match1298 (car e1323) p1324 w1325 (quote ()) mod1326))) (and first1327 (let ((rest1328 (match-each1294 (cdr e1323) p1324 w1325 mod1326))) (and rest1328 (cons first1327 rest1328)))))) ((null? e1323) (quote ())) ((syntax-object?95 e1323) (match-each1294 (syntax-object-expression96 e1323) p1324 (join-wraps130 w1325 (syntax-object-wrap97 e1323)) (syntax-object-module98 e1323))) (else #f))))) (set! $sc-dispatch (lambda (e1329 p1330) (cond ((eq? p1330 (quote any)) (list e1329)) ((syntax-object?95 e1329) (match*1297 (let ((e1331 (syntax-object-expression96 e1329))) (if (annotation? e1331) (annotation-expression e1331) e1331)) p1330 (syntax-object-wrap97 e1329) (quote ()) (syntax-object-module98 e1329))) (else (match*1297 (let ((e1332 e1329)) (if (annotation? e1332) (annotation-expression e1332) e1332)) p1330 (quote (())) (quote ()) #f)))))))))
|
|
(define with-syntax (make-syncase-macro (quote macro) (lambda (x1333) ((lambda (tmp1334) ((lambda (tmp1335) (if tmp1335 (apply (lambda (_1336 e11337 e21338) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11337 e21338))) tmp1335) ((lambda (tmp1340) (if tmp1340 (apply (lambda (_1341 out1342 in1343 e11344 e21345) (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))) in1343 (quote ()) (list out1342 (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 e11344 e21345))))) tmp1340) ((lambda (tmp1347) (if tmp1347 (apply (lambda (_1348 out1349 in1350 e11351 e21352) (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))) in1350) (quote ()) (list out1349 (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 e11351 e21352))))) tmp1347) (syntax-violation #f "source expression failed to match any pattern" tmp1334))) ($sc-dispatch tmp1334 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1334 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1334 (quote (any () any . each-any))))) x1333))))
|
|
(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1356) ((lambda (tmp1357) ((lambda (tmp1358) (if tmp1358 (apply (lambda (_1359 k1360 keyword1361 pattern1362 template1363) (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 k1360 (map (lambda (tmp1366 tmp1365) (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))) tmp1365) (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))) tmp1366))) template1363 pattern1362)))))) tmp1358) (syntax-violation #f "source expression failed to match any pattern" tmp1357))) ($sc-dispatch tmp1357 (quote (any each-any . #(each ((any . any) any))))))) x1356))))
|
|
(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1367) ((lambda (tmp1368) ((lambda (tmp1369) (if (if tmp1369 (apply (lambda (let*1370 x1371 v1372 e11373 e21374) (and-map identifier? x1371)) tmp1369) #f) (apply (lambda (let*1376 x1377 v1378 e11379 e21380) (letrec ((f1381 (lambda (bindings1382) (if (null? bindings1382) (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 e11379 e21380))) ((lambda (tmp1386) ((lambda (tmp1387) (if tmp1387 (apply (lambda (body1388 binding1389) (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 binding1389) body1388)) tmp1387) (syntax-violation #f "source expression failed to match any pattern" tmp1386))) ($sc-dispatch tmp1386 (quote (any any))))) (list (f1381 (cdr bindings1382)) (car bindings1382))))))) (f1381 (map list x1377 v1378)))) tmp1369) (syntax-violation #f "source expression failed to match any pattern" tmp1368))) ($sc-dispatch tmp1368 (quote (any #(each (any any)) any . each-any))))) x1367))))
|
|
(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1390) ((lambda (tmp1391) ((lambda (tmp1392) (if tmp1392 (apply (lambda (_1393 var1394 init1395 step1396 e01397 e11398 c1399) ((lambda (tmp1400) ((lambda (tmp1401) (if tmp1401 (apply (lambda (step1402) ((lambda (tmp1403) ((lambda (tmp1404) (if tmp1404 (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 var1394 init1395) (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))) e01397) (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 c1399 (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))) step1402))))))) tmp1404) ((lambda (tmp1409) (if tmp1409 (apply (lambda (e11410 e21411) (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 var1394 init1395) (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))) e01397 (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 e11410 e21411)) (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 c1399 (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))) step1402))))))) tmp1409) (syntax-violation #f "source expression failed to match any pattern" tmp1403))) ($sc-dispatch tmp1403 (quote (any . each-any)))))) ($sc-dispatch tmp1403 (quote ())))) e11398)) tmp1401) (syntax-violation #f "source expression failed to match any pattern" tmp1400))) ($sc-dispatch tmp1400 (quote each-any)))) (map (lambda (v1418 s1419) ((lambda (tmp1420) ((lambda (tmp1421) (if tmp1421 (apply (lambda () v1418) tmp1421) ((lambda (tmp1422) (if tmp1422 (apply (lambda (e1423) e1423) tmp1422) ((lambda (_1424) (syntax-violation (quote do) "bad step expression" orig-x1390 s1419)) tmp1420))) ($sc-dispatch tmp1420 (quote (any)))))) ($sc-dispatch tmp1420 (quote ())))) s1419)) var1394 step1396))) tmp1392) (syntax-violation #f "source expression failed to match any pattern" tmp1391))) ($sc-dispatch tmp1391 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1390))))
|
|
(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1427 (lambda (x1431 y1432) ((lambda (tmp1433) ((lambda (tmp1434) (if tmp1434 (apply (lambda (x1435 y1436) ((lambda (tmp1437) ((lambda (tmp1438) (if tmp1438 (apply (lambda (dy1439) ((lambda (tmp1440) ((lambda (tmp1441) (if tmp1441 (apply (lambda (dx1442) (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 dx1442 dy1439))) tmp1441) ((lambda (_1443) (if (null? dy1439) (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))) x1435) (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))) x1435 y1436))) tmp1440))) ($sc-dispatch tmp1440 (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))))) x1435)) tmp1438) ((lambda (tmp1444) (if tmp1444 (apply (lambda (stuff1445) (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 x1435 stuff1445))) tmp1444) ((lambda (else1446) (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))) x1435 y1436)) tmp1437))) ($sc-dispatch tmp1437 (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 tmp1437 (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))))) y1436)) tmp1434) (syntax-violation #f "source expression failed to match any pattern" tmp1433))) ($sc-dispatch tmp1433 (quote (any any))))) (list x1431 y1432)))) (quasiappend1428 (lambda (x1447 y1448) ((lambda (tmp1449) ((lambda (tmp1450) (if tmp1450 (apply (lambda (x1451 y1452) ((lambda (tmp1453) ((lambda (tmp1454) (if tmp1454 (apply (lambda () x1451) tmp1454) ((lambda (_1455) (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))) x1451 y1452)) tmp1453))) ($sc-dispatch tmp1453 (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))) ()))))) y1452)) tmp1450) (syntax-violation #f "source expression failed to match any pattern" tmp1449))) ($sc-dispatch tmp1449 (quote (any any))))) (list x1447 y1448)))) (quasivector1429 (lambda (x1456) ((lambda (tmp1457) ((lambda (x1458) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (x1461) (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 x1461))) tmp1460) ((lambda (tmp1463) (if tmp1463 (apply (lambda (x1464) (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))) x1464)) tmp1463) ((lambda (_1466) (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))) x1458)) tmp1459))) ($sc-dispatch tmp1459 (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 tmp1459 (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))))) x1458)) tmp1457)) x1456))) (quasi1430 (lambda (p1467 lev1468) ((lambda (tmp1469) ((lambda (tmp1470) (if tmp1470 (apply (lambda (p1471) (if (= lev1468 0) p1471 (quasicons1427 (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)))) (quasi1430 (list p1471) (- lev1468 1))))) tmp1470) ((lambda (tmp1472) (if tmp1472 (apply (lambda (p1473 q1474) (if (= lev1468 0) (quasiappend1428 p1473 (quasi1430 q1474 lev1468)) (quasicons1427 (quasicons1427 (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)))) (quasi1430 (list p1473) (- lev1468 1))) (quasi1430 q1474 lev1468)))) tmp1472) ((lambda (tmp1475) (if tmp1475 (apply (lambda (p1476) (quasicons1427 (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)))) (quasi1430 (list p1476) (+ lev1468 1)))) tmp1475) ((lambda (tmp1477) (if tmp1477 (apply (lambda (p1478 q1479) (quasicons1427 (quasi1430 p1478 lev1468) (quasi1430 q1479 lev1468))) tmp1477) ((lambda (tmp1480) (if tmp1480 (apply (lambda (x1481) (quasivector1429 (quasi1430 x1481 lev1468))) tmp1480) ((lambda (p1483) (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))) p1483)) tmp1469))) ($sc-dispatch tmp1469 (quote #(vector each-any)))))) ($sc-dispatch tmp1469 (quote (any . any)))))) ($sc-dispatch tmp1469 (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 tmp1469 (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 tmp1469 (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))))) p1467)))) (lambda (x1484) ((lambda (tmp1485) ((lambda (tmp1486) (if tmp1486 (apply (lambda (_1487 e1488) (quasi1430 e1488 0)) tmp1486) (syntax-violation #f "source expression failed to match any pattern" tmp1485))) ($sc-dispatch tmp1485 (quote (any any))))) x1484)))))
|
|
(define include (make-syncase-macro (quote macro) (lambda (x1489) (letrec ((read-file1490 (lambda (fn1491 k1492) (let ((p1493 (open-input-file fn1491))) (letrec ((f1494 (lambda (x1495) (if (eof-object? x1495) (begin (close-input-port p1493) (quote ())) (cons (datum->syntax k1492 x1495) (f1494 (read p1493))))))) (f1494 (read p1493))))))) ((lambda (tmp1496) ((lambda (tmp1497) (if tmp1497 (apply (lambda (k1498 filename1499) (let ((fn1500 (syntax->datum filename1499))) ((lambda (tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda (exp1503) (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))) exp1503)) tmp1502) (syntax-violation #f "source expression failed to match any pattern" tmp1501))) ($sc-dispatch tmp1501 (quote each-any)))) (read-file1490 fn1500 k1498)))) tmp1497) (syntax-violation #f "source expression failed to match any pattern" tmp1496))) ($sc-dispatch tmp1496 (quote (any any))))) x1489)))))
|
|
(define unquote (make-syncase-macro (quote macro) (lambda (x1505) ((lambda (tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (_1508 e1509) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1505)) tmp1507) (syntax-violation #f "source expression failed to match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any any))))) x1505))))
|
|
(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1510) ((lambda (tmp1511) ((lambda (tmp1512) (if tmp1512 (apply (lambda (_1513 e1514) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1510)) tmp1512) (syntax-violation #f "source expression failed to match any pattern" tmp1511))) ($sc-dispatch tmp1511 (quote (any any))))) x1510))))
|
|
(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1515) ((lambda (tmp1516) ((lambda (tmp1517) (if tmp1517 (apply (lambda (_1518 e1519 m11520 m21521) ((lambda (tmp1522) ((lambda (body1523) (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))) e1519)) body1523)) tmp1522)) (letrec ((f1524 (lambda (clause1525 clauses1526) (if (null? clauses1526) ((lambda (tmp1528) ((lambda (tmp1529) (if tmp1529 (apply (lambda (e11530 e21531) (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 e11530 e21531))) tmp1529) ((lambda (tmp1533) (if tmp1533 (apply (lambda (k1534 e11535 e21536) (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))) k1534)) (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 e11535 e21536)))) tmp1533) ((lambda (_1539) (syntax-violation (quote case) "bad clause" x1515 clause1525)) tmp1528))) ($sc-dispatch tmp1528 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1528 (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))))) clause1525) ((lambda (tmp1540) ((lambda (rest1541) ((lambda (tmp1542) ((lambda (tmp1543) (if tmp1543 (apply (lambda (k1544 e11545 e21546) (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))) k1544)) (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 e11545 e21546)) rest1541)) tmp1543) ((lambda (_1549) (syntax-violation (quote case) "bad clause" x1515 clause1525)) tmp1542))) ($sc-dispatch tmp1542 (quote (each-any any . each-any))))) clause1525)) tmp1540)) (f1524 (car clauses1526) (cdr clauses1526))))))) (f1524 m11520 m21521)))) tmp1517) (syntax-violation #f "source expression failed to match any pattern" tmp1516))) ($sc-dispatch tmp1516 (quote (any any any . each-any))))) x1515))))
|
|
(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1550) ((lambda (tmp1551) ((lambda (tmp1552) (if tmp1552 (apply (lambda (_1553 e1554) (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))) e1554)) (list (cons _1553 (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 e1554 (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)))))))))) tmp1552) (syntax-violation #f "source expression failed to match any pattern" tmp1551))) ($sc-dispatch tmp1551 (quote (any any))))) x1550))))
|