-(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))))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(if #f #f)
+(letrec ((and-map*2008 (lambda (f2048 first2047 . rest2046) (let ((t2049 (null? first2047))) (if t2049 t2049 (if (null? rest2046) (letrec ((andmap2050 (lambda (first2051) (let ((x2052 (car first2051)) (first2053 (cdr first2051))) (if (null? first2053) (f2048 x2052) (if (f2048 x2052) (andmap2050 first2053) #f)))))) (andmap2050 first2047)) (letrec ((andmap2054 (lambda (first2055 rest2056) (let ((x2057 (car first2055)) (xr2058 (map car rest2056)) (first2059 (cdr first2055)) (rest2060 (map cdr rest2056))) (if (null? first2059) (apply f2048 (cons x2057 xr2058)) (if (apply f2048 (cons x2057 xr2058)) (andmap2054 first2059 rest2060) #f)))))) (andmap2054 first2047 rest2046)))))))) (letrec ((lambda-var-list2153 (lambda (vars2282) (letrec ((lvl2283 (lambda (vars2284 ls2285 w2286) (if (pair? vars2284) (lvl2283 (cdr vars2284) (cons (wrap2132 (car vars2284) w2286 #f) ls2285) w2286) (if (id?2104 vars2284) (cons (wrap2132 vars2284 w2286 #f) ls2285) (if (null? vars2284) ls2285 (if (syntax-object?2088 vars2284) (lvl2283 (syntax-object-expression2089 vars2284) ls2285 (join-wraps2123 w2286 (syntax-object-wrap2090 vars2284))) (if (annotation? vars2284) (lvl2283 (annotation-expression vars2284) ls2285 w2286) (cons vars2284 ls2285))))))))) (lvl2283 vars2282 (quote ()) (quote (())))))) (gen-var2152 (lambda (id2287) (let ((id2288 (if (syntax-object?2088 id2287) (syntax-object-expression2089 id2287) id2287))) (if (annotation? id2288) (gensym (symbol->string (annotation-expression id2288))) (gensym (symbol->string id2288)))))) (strip2151 (lambda (x2289 w2290) (if (memq (quote top) (wrap-marks2107 w2290)) (if (let ((t2291 (annotation? x2289))) (if t2291 t2291 (if (pair? x2289) (annotation? (car x2289)) #f))) (strip-annotation2150 x2289 #f) x2289) (letrec ((f2292 (lambda (x2293) (if (syntax-object?2088 x2293) (strip2151 (syntax-object-expression2089 x2293) (syntax-object-wrap2090 x2293)) (if (pair? x2293) (let ((a2294 (f2292 (car x2293))) (d2295 (f2292 (cdr x2293)))) (if (if (eq? a2294 (car x2293)) (eq? d2295 (cdr x2293)) #f) x2293 (cons a2294 d2295))) (if (vector? x2293) (let ((old2296 (vector->list x2293))) (let ((new2297 (map f2292 old2296))) (if (and-map*2008 eq? old2296 new2297) x2293 (list->vector new2297)))) x2293)))))) (f2292 x2289))))) (strip-annotation2150 (lambda (x2298 parent2299) (if (pair? x2298) (let ((new2300 (cons #f #f))) (begin (if parent2299 (set-annotation-stripped! parent2299 new2300) (if #f #f)) (set-car! new2300 (strip-annotation2150 (car x2298) #f)) (set-cdr! new2300 (strip-annotation2150 (cdr x2298) #f)) new2300)) (if (annotation? x2298) (let ((t2301 (annotation-stripped x2298))) (if t2301 t2301 (strip-annotation2150 (annotation-expression x2298) x2298))) (if (vector? x2298) (let ((new2302 (make-vector (vector-length x2298)))) (begin (if parent2299 (set-annotation-stripped! parent2299 new2302) (if #f #f)) (letrec ((loop2303 (lambda (i2304) (unless (fx<2066 i2304 0) (vector-set! new2302 i2304 (strip-annotation2150 (vector-ref x2298 i2304) #f)) (loop2303 (fx-2064 i2304 1)))))) (loop2303 (- (vector-length x2298) 1))) new2302)) x2298))))) (ellipsis?2149 (lambda (x2305) (if (nonsymbol-id?2103 x2305) (free-id=?2127 x2305 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void2148 (lambda () (build-void2071 #f))) (eval-local-transformer2147 (lambda (expanded2306 mod2307) (let ((p2308 (local-eval-hook2068 expanded2306 mod2307))) (if (procedure? p2308) p2308 (syntax-violation #f "nonprocedure transformer" p2308))))) (chi-local-syntax2146 (lambda (rec?2309 e2310 r2311 w2312 s2313 mod2314 k2315) ((lambda (tmp2316) ((lambda (tmp2317) (if tmp2317 (apply (lambda (_2318 id2319 val2320 e12321 e22322) (let ((ids2323 id2319)) (if (not (valid-bound-ids?2129 ids2323)) (syntax-violation #f "duplicate bound keyword" e2310) (let ((labels2325 (gen-labels2110 ids2323))) (let ((new-w2326 (make-binding-wrap2121 ids2323 labels2325 w2312))) (k2315 (cons e12321 e22322) (extend-env2098 labels2325 (let ((w2328 (if rec?2309 new-w2326 w2312)) (trans-r2329 (macros-only-env2100 r2311))) (map (lambda (x2330) (cons (quote macro) (eval-local-transformer2147 (chi2140 x2330 trans-r2329 w2328 mod2314) mod2314))) val2320)) r2311) new-w2326 s2313 mod2314)))))) tmp2317) ((lambda (_2332) (syntax-violation #f "bad local syntax definition" (source-wrap2133 e2310 w2312 s2313 mod2314))) tmp2316))) ($sc-dispatch tmp2316 (quote (any #(each (any any)) any . each-any))))) e2310))) (chi-lambda-clause2145 (lambda (e2333 docstring2334 c2335 r2336 w2337 mod2338 k2339) ((lambda (tmp2340) ((lambda (tmp2341) (if (if tmp2341 (apply (lambda (args2342 doc2343 e12344 e22345) (if (string? (syntax->datum doc2343)) (not docstring2334) #f)) tmp2341) #f) (apply (lambda (args2346 doc2347 e12348 e22349) (chi-lambda-clause2145 e2333 doc2347 (cons args2346 (cons e12348 e22349)) r2336 w2337 mod2338 k2339)) tmp2341) ((lambda (tmp2351) (if tmp2351 (apply (lambda (id2352 e12353 e22354) (let ((ids2355 id2352)) (if (not (valid-bound-ids?2129 ids2355)) (syntax-violation (quote lambda) "invalid parameter list" e2333) (let ((labels2357 (gen-labels2110 ids2355)) (new-vars2358 (map gen-var2152 ids2355))) (k2339 (map syntax->datum ids2355) new-vars2358 docstring2334 (chi-body2144 (cons e12353 e22354) e2333 (extend-var-env2099 labels2357 new-vars2358 r2336) (make-binding-wrap2121 ids2355 labels2357 w2337) mod2338)))))) tmp2351) ((lambda (tmp2360) (if tmp2360 (apply (lambda (ids2361 e12362 e22363) (let ((old-ids2364 (lambda-var-list2153 ids2361))) (if (not (valid-bound-ids?2129 old-ids2364)) (syntax-violation (quote lambda) "invalid parameter list" e2333) (let ((labels2365 (gen-labels2110 old-ids2364)) (new-vars2366 (map gen-var2152 old-ids2364))) (k2339 (letrec ((f2367 (lambda (ls12368 ls22369) (if (null? ls12368) (syntax->datum ls22369) (f2367 (cdr ls12368) (cons (syntax->datum (car ls12368)) ls22369)))))) (f2367 (cdr old-ids2364) (car old-ids2364))) (letrec ((f2370 (lambda (ls12371 ls22372) (if (null? ls12371) ls22372 (f2370 (cdr ls12371) (cons (car ls12371) ls22372)))))) (f2370 (cdr new-vars2366) (car new-vars2366))) docstring2334 (chi-body2144 (cons e12362 e22363) e2333 (extend-var-env2099 labels2365 new-vars2366 r2336) (make-binding-wrap2121 old-ids2364 labels2365 w2337) mod2338)))))) tmp2360) ((lambda (_2374) (syntax-violation (quote lambda) "bad lambda" e2333)) tmp2340))) ($sc-dispatch tmp2340 (quote (any any . each-any)))))) ($sc-dispatch tmp2340 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2340 (quote (any any any . each-any))))) c2335))) (chi-body2144 (lambda (body2375 outer-form2376 r2377 w2378 mod2379) (let ((r2380 (cons (quote ("placeholder" placeholder)) r2377))) (let ((ribcage2381 (make-ribcage2111 (quote ()) (quote ()) (quote ())))) (let ((w2382 (make-wrap2106 (wrap-marks2107 w2378) (cons ribcage2381 (wrap-subst2108 w2378))))) (letrec ((parse2383 (lambda (body2384 ids2385 labels2386 vars2387 vals2388 bindings2389) (if (null? body2384) (syntax-violation #f "no expressions in body" outer-form2376) (let ((e2391 (cdar body2384)) (er2392 (caar body2384))) (call-with-values (lambda () (syntax-type2138 e2391 er2392 (quote (())) #f ribcage2381 mod2379)) (lambda (type2393 value2394 e2395 w2396 s2397 mod2398) (if (memv type2393 (quote (define-form))) (let ((id2399 (wrap2132 value2394 w2396 mod2398)) (label2400 (gen-label2109))) (let ((var2401 (gen-var2152 id2399))) (begin (extend-ribcage!2120 ribcage2381 id2399 label2400) (parse2383 (cdr body2384) (cons id2399 ids2385) (cons label2400 labels2386) (cons var2401 vars2387) (cons (cons er2392 (wrap2132 e2395 w2396 mod2398)) vals2388) (cons (cons (quote lexical) var2401) bindings2389))))) (if (memv type2393 (quote (define-syntax-form))) (let ((id2402 (wrap2132 value2394 w2396 mod2398)) (label2403 (gen-label2109))) (begin (extend-ribcage!2120 ribcage2381 id2402 label2403) (parse2383 (cdr body2384) (cons id2402 ids2385) (cons label2403 labels2386) vars2387 vals2388 (cons (cons (quote macro) (cons er2392 (wrap2132 e2395 w2396 mod2398))) bindings2389)))) (if (memv type2393 (quote (begin-form))) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda (_2406 e12407) (parse2383 (letrec ((f2408 (lambda (forms2409) (if (null? forms2409) (cdr body2384) (cons (cons er2392 (wrap2132 (car forms2409) w2396 mod2398)) (f2408 (cdr forms2409))))))) (f2408 e12407)) ids2385 labels2386 vars2387 vals2388 bindings2389)) tmp2405) (syntax-violation #f "source expression failed to match any pattern" tmp2404))) ($sc-dispatch tmp2404 (quote (any . each-any))))) e2395) (if (memv type2393 (quote (local-syntax-form))) (chi-local-syntax2146 value2394 e2395 er2392 w2396 s2397 mod2398 (lambda (forms2411 er2412 w2413 s2414 mod2415) (parse2383 (letrec ((f2416 (lambda (forms2417) (if (null? forms2417) (cdr body2384) (cons (cons er2412 (wrap2132 (car forms2417) w2413 mod2415)) (f2416 (cdr forms2417))))))) (f2416 forms2411)) ids2385 labels2386 vars2387 vals2388 bindings2389))) (if (null? ids2385) (build-sequence2083 #f (map (lambda (x2418) (chi2140 (cdr x2418) (car x2418) (quote (())) mod2398)) (cons (cons er2392 (source-wrap2133 e2395 w2396 s2397 mod2398)) (cdr body2384)))) (begin (if (not (valid-bound-ids?2129 ids2385)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form2376) (if #f #f)) (letrec ((loop2419 (lambda (bs2420 er-cache2421 r-cache2422) (if (not (null? bs2420)) (let ((b2423 (car bs2420))) (if (eq? (car b2423) (quote macro)) (let ((er2424 (cadr b2423))) (let ((r-cache2425 (if (eq? er2424 er-cache2421) r-cache2422 (macros-only-env2100 er2424)))) (begin (set-cdr! b2423 (eval-local-transformer2147 (chi2140 (cddr b2423) r-cache2425 (quote (())) mod2398) mod2398)) (loop2419 (cdr bs2420) er2424 r-cache2425)))) (loop2419 (cdr bs2420) er-cache2421 r-cache2422))) (if #f #f))))) (loop2419 bindings2389 #f #f)) (set-cdr! r2380 (extend-env2098 labels2386 bindings2389 (cdr r2380))) (build-letrec2086 #f (map syntax->datum ids2385) vars2387 (map (lambda (x2426) (chi2140 (cdr x2426) (car x2426) (quote (())) mod2398)) vals2388) (build-sequence2083 #f (map (lambda (x2427) (chi2140 (cdr x2427) (car x2427) (quote (())) mod2398)) (cons (cons er2392 (source-wrap2133 e2395 w2396 s2397 mod2398)) (cdr body2384)))))))))))))))))) (parse2383 (map (lambda (x2390) (cons r2380 (wrap2132 x2390 w2382 mod2379))) body2375) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro2143 (lambda (p2428 e2429 r2430 w2431 rib2432 mod2433) (letrec ((rebuild-macro-output2434 (lambda (x2435 m2436) (if (pair? x2435) (cons (rebuild-macro-output2434 (car x2435) m2436) (rebuild-macro-output2434 (cdr x2435) m2436)) (if (syntax-object?2088 x2435) (let ((w2437 (syntax-object-wrap2090 x2435))) (let ((ms2438 (wrap-marks2107 w2437)) (s2439 (wrap-subst2108 w2437))) (if (if (pair? ms2438) (eq? (car ms2438) #f) #f) (make-syntax-object2087 (syntax-object-expression2089 x2435) (make-wrap2106 (cdr ms2438) (if rib2432 (cons rib2432 (cdr s2439)) (cdr s2439))) (syntax-object-module2091 x2435)) (make-syntax-object2087 (syntax-object-expression2089 x2435) (make-wrap2106 (cons m2436 ms2438) (if rib2432 (cons rib2432 (cons (quote shift) s2439)) (cons (quote shift) s2439))) (let ((pmod2440 (procedure-module p2428))) (if pmod2440 (cons (quote hygiene) (module-name pmod2440)) (quote (hygiene guile)))))))) (if (vector? x2435) (let ((n2441 (vector-length x2435))) (let ((v2442 (make-vector n2441))) (letrec ((loop2443 (lambda (i2444) (if (fx=2065 i2444 n2441) (begin (if #f #f (if #f #f)) v2442) (begin (vector-set! v2442 i2444 (rebuild-macro-output2434 (vector-ref x2435 i2444) m2436)) (loop2443 (fx+2063 i2444 1))))))) (loop2443 0)))) (if (symbol? x2435) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap2133 e2429 w2431 s mod2433) x2435) x2435))))))) (rebuild-macro-output2434 (p2428 (wrap2132 e2429 (anti-mark2119 w2431) mod2433)) (string #\m))))) (chi-application2142 (lambda (x2445 e2446 r2447 w2448 s2449 mod2450) ((lambda (tmp2451) ((lambda (tmp2452) (if tmp2452 (apply (lambda (e02453 e12454) (build-application2072 s2449 x2445 (map (lambda (e2455) (chi2140 e2455 r2447 w2448 mod2450)) e12454))) tmp2452) (syntax-violation #f "source expression failed to match any pattern" tmp2451))) ($sc-dispatch tmp2451 (quote (any . each-any))))) e2446))) (chi-expr2141 (lambda (type2457 value2458 e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (lexical))) (build-lexical-reference2074 (quote value) s2462 e2459 value2458) (if (memv type2457 (quote (core external-macro))) (value2458 e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (module-ref))) (call-with-values (lambda () (value2458 e2459)) (lambda (id2464 mod2465) (build-global-reference2077 s2462 id2464 mod2465))) (if (memv type2457 (quote (lexical-call))) (chi-application2142 (build-lexical-reference2074 (quote fun) (source-annotation2095 (car e2459)) (car e2459) value2458) e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (global-call))) (chi-application2142 (build-global-reference2077 (source-annotation2095 (car e2459)) value2458 (if (syntax-object?2088 (car e2459)) (syntax-object-module2091 (car e2459)) mod2463)) e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (constant))) (build-data2082 s2462 (strip2151 (source-wrap2133 e2459 w2461 s2462 mod2463) (quote (())))) (if (memv type2457 (quote (global))) (build-global-reference2077 s2462 value2458 mod2463) (if (memv type2457 (quote (call))) (chi-application2142 (chi2140 (car e2459) r2460 w2461 mod2463) e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (begin-form))) ((lambda (tmp2466) ((lambda (tmp2467) (if tmp2467 (apply (lambda (_2468 e12469 e22470) (chi-sequence2134 (cons e12469 e22470) r2460 w2461 s2462 mod2463)) tmp2467) (syntax-violation #f "source expression failed to match any pattern" tmp2466))) ($sc-dispatch tmp2466 (quote (any any . each-any))))) e2459) (if (memv type2457 (quote (local-syntax-form))) (chi-local-syntax2146 value2458 e2459 r2460 w2461 s2462 mod2463 chi-sequence2134) (if (memv type2457 (quote (eval-when-form))) ((lambda (tmp2472) ((lambda (tmp2473) (if tmp2473 (apply (lambda (_2474 x2475 e12476 e22477) (let ((when-list2478 (chi-when-list2137 e2459 x2475 w2461))) (if (memq (quote eval) when-list2478) (chi-sequence2134 (cons e12476 e22477) r2460 w2461 s2462 mod2463) (chi-void2148)))) tmp2473) (syntax-violation #f "source expression failed to match any pattern" tmp2472))) ($sc-dispatch tmp2472 (quote (any each-any any . each-any))))) e2459) (if (memv type2457 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e2459 (wrap2132 value2458 w2461 mod2463)) (if (memv type2457 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap2133 e2459 w2461 s2462 mod2463)) (if (memv type2457 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap2133 e2459 w2461 s2462 mod2463)) (syntax-violation #f "unexpected syntax" (source-wrap2133 e2459 w2461 s2462 mod2463)))))))))))))))))) (chi2140 (lambda (e2481 r2482 w2483 mod2484) (call-with-values (lambda () (syntax-type2138 e2481 r2482 w2483 #f #f mod2484)) (lambda (type2485 value2486 e2487 w2488 s2489 mod2490) (chi-expr2141 type2485 value2486 e2487 r2482 w2488 s2489 mod2490))))) (chi-top2139 (lambda (e2491 r2492 w2493 m2494 esew2495 mod2496) (call-with-values (lambda () (syntax-type2138 e2491 r2492 w2493 #f #f mod2496)) (lambda (type2504 value2505 e2506 w2507 s2508 mod2509) (if (memv type2504 (quote (begin-form))) ((lambda (tmp2510) ((lambda (tmp2511) (if tmp2511 (apply (lambda (_2512) (chi-void2148)) tmp2511) ((lambda (tmp2513) (if tmp2513 (apply (lambda (_2514 e12515 e22516) (chi-top-sequence2135 (cons e12515 e22516) r2492 w2507 s2508 m2494 esew2495 mod2509)) tmp2513) (syntax-violation #f "source expression failed to match any pattern" tmp2510))) ($sc-dispatch tmp2510 (quote (any any . each-any)))))) ($sc-dispatch tmp2510 (quote (any))))) e2506) (if (memv type2504 (quote (local-syntax-form))) (chi-local-syntax2146 value2505 e2506 r2492 w2507 s2508 mod2509 (lambda (body2518 r2519 w2520 s2521 mod2522) (chi-top-sequence2135 body2518 r2519 w2520 s2521 m2494 esew2495 mod2522))) (if (memv type2504 (quote (eval-when-form))) ((lambda (tmp2523) ((lambda (tmp2524) (if tmp2524 (apply (lambda (_2525 x2526 e12527 e22528) (let ((when-list2529 (chi-when-list2137 e2506 x2526 w2507)) (body2530 (cons e12527 e22528))) (if (eq? m2494 (quote e)) (if (memq (quote eval) when-list2529) (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote e) (quote (eval)) mod2509) (chi-void2148)) (if (memq (quote load) when-list2529) (if (let ((t2533 (memq (quote compile) when-list2529))) (if t2533 t2533 (if (eq? m2494 (quote c&e)) (memq (quote eval) when-list2529) #f))) (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote c&e) (quote (compile load)) mod2509) (if (memq m2494 (quote (c c&e))) (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote c) (quote (load)) mod2509) (chi-void2148))) (if (let ((t2534 (memq (quote compile) when-list2529))) (if t2534 t2534 (if (eq? m2494 (quote c&e)) (memq (quote eval) when-list2529) #f))) (begin (top-level-eval-hook2067 (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote e) (quote (eval)) mod2509) mod2509) (chi-void2148)) (chi-void2148)))))) tmp2524) (syntax-violation #f "source expression failed to match any pattern" tmp2523))) ($sc-dispatch tmp2523 (quote (any each-any any . each-any))))) e2506) (if (memv type2504 (quote (define-syntax-form))) (let ((n2535 (id-var-name2126 value2505 w2507)) (r2536 (macros-only-env2100 r2492))) (if (memv m2494 (quote (c))) (if (memq (quote compile) esew2495) (let ((e2537 (chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)))) (begin (top-level-eval-hook2067 e2537 mod2509) (if (memq (quote load) esew2495) e2537 (chi-void2148)))) (if (memq (quote load) esew2495) (chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)) (chi-void2148))) (if (memv m2494 (quote (c&e))) (let ((e2538 (chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)))) (begin (top-level-eval-hook2067 e2538 mod2509) e2538)) (begin (if (memq (quote eval) esew2495) (top-level-eval-hook2067 (chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)) mod2509) (if #f #f)) (chi-void2148))))) (if (memv type2504 (quote (define-form))) (let ((n2539 (id-var-name2126 value2505 w2507))) (let ((type2540 (binding-type2096 (lookup2101 n2539 r2492 mod2509)))) (if (memv type2540 (quote (global core macro module-ref))) (let ((x2541 (build-global-definition2079 s2508 n2539 (chi2140 e2506 r2492 w2507 mod2509)))) (begin (if (eq? m2494 (quote c&e)) (top-level-eval-hook2067 x2541 mod2509) (if #f #f)) x2541)) (if (memv type2540 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e2506 (wrap2132 value2505 w2507 mod2509)) (syntax-violation #f "cannot define keyword at top level" e2506 (wrap2132 value2505 w2507 mod2509)))))) (let ((x2542 (chi-expr2141 type2504 value2505 e2506 r2492 w2507 s2508 mod2509))) (begin (if (eq? m2494 (quote c&e)) (top-level-eval-hook2067 x2542 mod2509) (if #f #f)) x2542))))))))))) (syntax-type2138 (lambda (e2543 r2544 w2545 s2546 rib2547 mod2548) (if (symbol? e2543) (let ((n2549 (id-var-name2126 e2543 w2545))) (let ((b2550 (lookup2101 n2549 r2544 mod2548))) (let ((type2551 (binding-type2096 b2550))) (if (memv type2551 (quote (lexical))) (values type2551 (binding-value2097 b2550) e2543 w2545 s2546 mod2548) (if (memv type2551 (quote (global))) (values type2551 n2549 e2543 w2545 s2546 mod2548) (if (memv type2551 (quote (macro))) (syntax-type2138 (chi-macro2143 (binding-value2097 b2550) e2543 r2544 w2545 rib2547 mod2548) r2544 (quote (())) s2546 rib2547 mod2548) (values type2551 (binding-value2097 b2550) e2543 w2545 s2546 mod2548))))))) (if (pair? e2543) (let ((first2552 (car e2543))) (if (id?2104 first2552) (let ((n2553 (id-var-name2126 first2552 w2545))) (let ((b2554 (lookup2101 n2553 r2544 (let ((t2555 (if (syntax-object?2088 first2552) (syntax-object-module2091 first2552) #f))) (if t2555 t2555 mod2548))))) (let ((type2556 (binding-type2096 b2554))) (if (memv type2556 (quote (lexical))) (values (quote lexical-call) (binding-value2097 b2554) e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (global))) (values (quote global-call) n2553 e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (macro))) (syntax-type2138 (chi-macro2143 (binding-value2097 b2554) e2543 r2544 w2545 rib2547 mod2548) r2544 (quote (())) s2546 rib2547 mod2548) (if (memv type2556 (quote (core external-macro module-ref))) (values type2556 (binding-value2097 b2554) e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value2097 b2554) e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (begin))) (values (quote begin-form) #f e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (eval-when))) (values (quote eval-when-form) #f e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (define))) ((lambda (tmp2557) ((lambda (tmp2558) (if (if tmp2558 (apply (lambda (_2559 name2560 val2561) (id?2104 name2560)) tmp2558) #f) (apply (lambda (_2562 name2563 val2564) (values (quote define-form) name2563 val2564 w2545 s2546 mod2548)) tmp2558) ((lambda (tmp2565) (if (if tmp2565 (apply (lambda (_2566 name2567 args2568 e12569 e22570) (if (id?2104 name2567) (valid-bound-ids?2129 (lambda-var-list2153 args2568)) #f)) tmp2565) #f) (apply (lambda (_2571 name2572 args2573 e12574 e22575) (values (quote define-form) (wrap2132 name2572 w2545 mod2548) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap2132 (cons args2573 (cons e12574 e22575)) w2545 mod2548)) (quote (())) s2546 mod2548)) tmp2565) ((lambda (tmp2577) (if (if tmp2577 (apply (lambda (_2578 name2579) (id?2104 name2579)) tmp2577) #f) (apply (lambda (_2580 name2581) (values (quote define-form) (wrap2132 name2581 w2545 mod2548) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s2546 mod2548)) tmp2577) (syntax-violation #f "source expression failed to match any pattern" tmp2557))) ($sc-dispatch tmp2557 (quote (any any)))))) ($sc-dispatch tmp2557 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp2557 (quote (any any any))))) e2543) (if (memv type2556 (quote (define-syntax))) ((lambda (tmp2582) ((lambda (tmp2583) (if (if tmp2583 (apply (lambda (_2584 name2585 val2586) (id?2104 name2585)) tmp2583) #f) (apply (lambda (_2587 name2588 val2589) (values (quote define-syntax-form) name2588 val2589 w2545 s2546 mod2548)) tmp2583) (syntax-violation #f "source expression failed to match any pattern" tmp2582))) ($sc-dispatch tmp2582 (quote (any any any))))) e2543) (values (quote call) #f e2543 w2545 s2546 mod2548))))))))))))) (values (quote call) #f e2543 w2545 s2546 mod2548))) (if (syntax-object?2088 e2543) (syntax-type2138 (syntax-object-expression2089 e2543) r2544 (join-wraps2123 w2545 (syntax-object-wrap2090 e2543)) #f rib2547 (let ((t2590 (syntax-object-module2091 e2543))) (if t2590 t2590 mod2548))) (if (annotation? e2543) (syntax-type2138 (annotation-expression e2543) r2544 w2545 (annotation-source e2543) rib2547 mod2548) (if (self-evaluating? e2543) (values (quote constant) #f e2543 w2545 s2546 mod2548) (values (quote other) #f e2543 w2545 s2546 mod2548)))))))) (chi-when-list2137 (lambda (e2591 when-list2592 w2593) (letrec ((f2594 (lambda (when-list2595 situations2596) (if (null? when-list2595) situations2596 (f2594 (cdr when-list2595) (cons (let ((x2597 (car when-list2595))) (if (free-id=?2127 x2597 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?2127 x2597 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?2127 x2597 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e2591 (wrap2132 x2597 w2593 #f)))))) situations2596)))))) (f2594 when-list2592 (quote ()))))) (chi-install-global2136 (lambda (name2598 e2599) (build-global-definition2079 #f name2598 (if (let ((v2600 (module-variable (current-module) name2598))) (if v2600 (if (variable-bound? v2600) (if (macro? (variable-ref v2600)) (not (eq? (macro-type (variable-ref v2600)) (quote syncase-macro))) #f) #f) #f)) (build-application2072 #f (build-primref2081 #f (quote make-extended-syncase-macro)) (list (build-application2072 #f (build-primref2081 #f (quote module-ref)) (list (build-application2072 #f (quote current-module) (quote ())) (build-data2082 #f name2598))) (build-data2082 #f (quote macro)) e2599)) (build-application2072 #f (build-primref2081 #f (quote make-syncase-macro)) (list (build-data2082 #f (quote macro)) e2599)))))) (chi-top-sequence2135 (lambda (body2601 r2602 w2603 s2604 m2605 esew2606 mod2607) (build-sequence2083 s2604 (letrec ((dobody2608 (lambda (body2609 r2610 w2611 m2612 esew2613 mod2614) (if (null? body2609) (quote ()) (let ((first2615 (chi-top2139 (car body2609) r2610 w2611 m2612 esew2613 mod2614))) (cons first2615 (dobody2608 (cdr body2609) r2610 w2611 m2612 esew2613 mod2614))))))) (dobody2608 body2601 r2602 w2603 m2605 esew2606 mod2607))))) (chi-sequence2134 (lambda (body2616 r2617 w2618 s2619 mod2620) (build-sequence2083 s2619 (letrec ((dobody2621 (lambda (body2622 r2623 w2624 mod2625) (if (null? body2622) (quote ()) (let ((first2626 (chi2140 (car body2622) r2623 w2624 mod2625))) (cons first2626 (dobody2621 (cdr body2622) r2623 w2624 mod2625))))))) (dobody2621 body2616 r2617 w2618 mod2620))))) (source-wrap2133 (lambda (x2627 w2628 s2629 defmod2630) (wrap2132 (if s2629 (make-annotation x2627 s2629 #f) x2627) w2628 defmod2630))) (wrap2132 (lambda (x2631 w2632 defmod2633) (if (if (null? (wrap-marks2107 w2632)) (null? (wrap-subst2108 w2632)) #f) x2631 (if (syntax-object?2088 x2631) (make-syntax-object2087 (syntax-object-expression2089 x2631) (join-wraps2123 w2632 (syntax-object-wrap2090 x2631)) (syntax-object-module2091 x2631)) (if (null? x2631) x2631 (make-syntax-object2087 x2631 w2632 defmod2633)))))) (bound-id-member?2131 (lambda (x2634 list2635) (if (not (null? list2635)) (let ((t2636 (bound-id=?2128 x2634 (car list2635)))) (if t2636 t2636 (bound-id-member?2131 x2634 (cdr list2635)))) #f))) (distinct-bound-ids?2130 (lambda (ids2637) (letrec ((distinct?2638 (lambda (ids2639) (let ((t2640 (null? ids2639))) (if t2640 t2640 (if (not (bound-id-member?2131 (car ids2639) (cdr ids2639))) (distinct?2638 (cdr ids2639)) #f)))))) (distinct?2638 ids2637)))) (valid-bound-ids?2129 (lambda (ids2641) (if (letrec ((all-ids?2642 (lambda (ids2643) (let ((t2644 (null? ids2643))) (if t2644 t2644 (if (id?2104 (car ids2643)) (all-ids?2642 (cdr ids2643)) #f)))))) (all-ids?2642 ids2641)) (distinct-bound-ids?2130 ids2641) #f))) (bound-id=?2128 (lambda (i2645 j2646) (if (if (syntax-object?2088 i2645) (syntax-object?2088 j2646) #f) (if (eq? (let ((e2647 (syntax-object-expression2089 i2645))) (if (annotation? e2647) (annotation-expression e2647) e2647)) (let ((e2648 (syntax-object-expression2089 j2646))) (if (annotation? e2648) (annotation-expression e2648) e2648))) (same-marks?2125 (wrap-marks2107 (syntax-object-wrap2090 i2645)) (wrap-marks2107 (syntax-object-wrap2090 j2646))) #f) (eq? (let ((e2649 i2645)) (if (annotation? e2649) (annotation-expression e2649) e2649)) (let ((e2650 j2646)) (if (annotation? e2650) (annotation-expression e2650) e2650)))))) (free-id=?2127 (lambda (i2651 j2652) (if (eq? (let ((x2653 i2651)) (let ((e2654 (if (syntax-object?2088 x2653) (syntax-object-expression2089 x2653) x2653))) (if (annotation? e2654) (annotation-expression e2654) e2654))) (let ((x2655 j2652)) (let ((e2656 (if (syntax-object?2088 x2655) (syntax-object-expression2089 x2655) x2655))) (if (annotation? e2656) (annotation-expression e2656) e2656)))) (eq? (id-var-name2126 i2651 (quote (()))) (id-var-name2126 j2652 (quote (())))) #f))) (id-var-name2126 (lambda (id2657 w2658) (letrec ((search-vector-rib2661 (lambda (sym2667 subst2668 marks2669 symnames2670 ribcage2671) (let ((n2672 (vector-length symnames2670))) (letrec ((f2673 (lambda (i2674) (if (fx=2065 i2674 n2672) (search2659 sym2667 (cdr subst2668) marks2669) (if (if (eq? (vector-ref symnames2670 i2674) sym2667) (same-marks?2125 marks2669 (vector-ref (ribcage-marks2114 ribcage2671) i2674)) #f) (values (vector-ref (ribcage-labels2115 ribcage2671) i2674) marks2669) (f2673 (fx+2063 i2674 1))))))) (f2673 0))))) (search-list-rib2660 (lambda (sym2675 subst2676 marks2677 symnames2678 ribcage2679) (letrec ((f2680 (lambda (symnames2681 i2682) (if (null? symnames2681) (search2659 sym2675 (cdr subst2676) marks2677) (if (if (eq? (car symnames2681) sym2675) (same-marks?2125 marks2677 (list-ref (ribcage-marks2114 ribcage2679) i2682)) #f) (values (list-ref (ribcage-labels2115 ribcage2679) i2682) marks2677) (f2680 (cdr symnames2681) (fx+2063 i2682 1))))))) (f2680 symnames2678 0)))) (search2659 (lambda (sym2683 subst2684 marks2685) (if (null? subst2684) (values #f marks2685) (let ((fst2686 (car subst2684))) (if (eq? fst2686 (quote shift)) (search2659 sym2683 (cdr subst2684) (cdr marks2685)) (let ((symnames2687 (ribcage-symnames2113 fst2686))) (if (vector? symnames2687) (search-vector-rib2661 sym2683 subst2684 marks2685 symnames2687 fst2686) (search-list-rib2660 sym2683 subst2684 marks2685 symnames2687 fst2686))))))))) (if (symbol? id2657) (let ((t2688 (call-with-values (lambda () (search2659 id2657 (wrap-subst2108 w2658) (wrap-marks2107 w2658))) (lambda (x2690 . ignore2689) x2690)))) (if t2688 t2688 id2657)) (if (syntax-object?2088 id2657) (let ((id2691 (let ((e2693 (syntax-object-expression2089 id2657))) (if (annotation? e2693) (annotation-expression e2693) e2693))) (w12692 (syntax-object-wrap2090 id2657))) (let ((marks2694 (join-marks2124 (wrap-marks2107 w2658) (wrap-marks2107 w12692)))) (call-with-values (lambda () (search2659 id2691 (wrap-subst2108 w2658) marks2694)) (lambda (new-id2695 marks2696) (let ((t2697 new-id2695)) (if t2697 t2697 (let ((t2698 (call-with-values (lambda () (search2659 id2691 (wrap-subst2108 w12692) marks2696)) (lambda (x2700 . ignore2699) x2700)))) (if t2698 t2698 id2691)))))))) (if (annotation? id2657) (let ((id2701 (let ((e2702 id2657)) (if (annotation? e2702) (annotation-expression e2702) e2702)))) (let ((t2703 (call-with-values (lambda () (search2659 id2701 (wrap-subst2108 w2658) (wrap-marks2107 w2658))) (lambda (x2705 . ignore2704) x2705)))) (if t2703 t2703 id2701))) (syntax-violation (quote id-var-name) "invalid id" id2657))))))) (same-marks?2125 (lambda (x2706 y2707) (let ((t2708 (eq? x2706 y2707))) (if t2708 t2708 (if (not (null? x2706)) (if (not (null? y2707)) (if (eq? (car x2706) (car y2707)) (same-marks?2125 (cdr x2706) (cdr y2707)) #f) #f) #f))))) (join-marks2124 (lambda (m12709 m22710) (smart-append2122 m12709 m22710))) (join-wraps2123 (lambda (w12711 w22712) (let ((m12713 (wrap-marks2107 w12711)) (s12714 (wrap-subst2108 w12711))) (if (null? m12713) (if (null? s12714) w22712 (make-wrap2106 (wrap-marks2107 w22712) (smart-append2122 s12714 (wrap-subst2108 w22712)))) (make-wrap2106 (smart-append2122 m12713 (wrap-marks2107 w22712)) (smart-append2122 s12714 (wrap-subst2108 w22712))))))) (smart-append2122 (lambda (m12715 m22716) (if (null? m22716) m12715 (append m12715 m22716)))) (make-binding-wrap2121 (lambda (ids2717 labels2718 w2719) (if (null? ids2717) w2719 (make-wrap2106 (wrap-marks2107 w2719) (cons (let ((labelvec2720 (list->vector labels2718))) (let ((n2721 (vector-length labelvec2720))) (let ((symnamevec2722 (make-vector n2721)) (marksvec2723 (make-vector n2721))) (begin (letrec ((f2724 (lambda (ids2725 i2726) (if (not (null? ids2725)) (call-with-values (lambda () (id-sym-name&marks2105 (car ids2725) w2719)) (lambda (symname2727 marks2728) (begin (vector-set! symnamevec2722 i2726 symname2727) (vector-set! marksvec2723 i2726 marks2728) (f2724 (cdr ids2725) (fx+2063 i2726 1))))) (if #f #f))))) (f2724 ids2717 0)) (make-ribcage2111 symnamevec2722 marksvec2723 labelvec2720))))) (wrap-subst2108 w2719)))))) (extend-ribcage!2120 (lambda (ribcage2729 id2730 label2731) (begin (set-ribcage-symnames!2116 ribcage2729 (cons (let ((e2732 (syntax-object-expression2089 id2730))) (if (annotation? e2732) (annotation-expression e2732) e2732)) (ribcage-symnames2113 ribcage2729))) (set-ribcage-marks!2117 ribcage2729 (cons (wrap-marks2107 (syntax-object-wrap2090 id2730)) (ribcage-marks2114 ribcage2729))) (set-ribcage-labels!2118 ribcage2729 (cons label2731 (ribcage-labels2115 ribcage2729)))))) (anti-mark2119 (lambda (w2733) (make-wrap2106 (cons #f (wrap-marks2107 w2733)) (cons (quote shift) (wrap-subst2108 w2733))))) (set-ribcage-labels!2118 (lambda (x2734 update2735) (vector-set! x2734 3 update2735))) (set-ribcage-marks!2117 (lambda (x2736 update2737) (vector-set! x2736 2 update2737))) (set-ribcage-symnames!2116 (lambda (x2738 update2739) (vector-set! x2738 1 update2739))) (ribcage-labels2115 (lambda (x2740) (vector-ref x2740 3))) (ribcage-marks2114 (lambda (x2741) (vector-ref x2741 2))) (ribcage-symnames2113 (lambda (x2742) (vector-ref x2742 1))) (ribcage?2112 (lambda (x2743) (if (vector? x2743) (if (= (vector-length x2743) 4) (eq? (vector-ref x2743 0) (quote ribcage)) #f) #f))) (make-ribcage2111 (lambda (symnames2744 marks2745 labels2746) (vector (quote ribcage) symnames2744 marks2745 labels2746))) (gen-labels2110 (lambda (ls2747) (if (null? ls2747) (quote ()) (cons (gen-label2109) (gen-labels2110 (cdr ls2747)))))) (gen-label2109 (lambda () (string #\i))) (wrap-subst2108 cdr) (wrap-marks2107 car) (make-wrap2106 cons) (id-sym-name&marks2105 (lambda (x2748 w2749) (if (syntax-object?2088 x2748) (values (let ((e2750 (syntax-object-expression2089 x2748))) (if (annotation? e2750) (annotation-expression e2750) e2750)) (join-marks2124 (wrap-marks2107 w2749) (wrap-marks2107 (syntax-object-wrap2090 x2748)))) (values (let ((e2751 x2748)) (if (annotation? e2751) (annotation-expression e2751) e2751)) (wrap-marks2107 w2749))))) (id?2104 (lambda (x2752) (if (symbol? x2752) #t (if (syntax-object?2088 x2752) (symbol? (let ((e2753 (syntax-object-expression2089 x2752))) (if (annotation? e2753) (annotation-expression e2753) e2753))) (if (annotation? x2752) (symbol? (annotation-expression x2752)) #f))))) (nonsymbol-id?2103 (lambda (x2754) (if (syntax-object?2088 x2754) (symbol? (let ((e2755 (syntax-object-expression2089 x2754))) (if (annotation? e2755) (annotation-expression e2755) e2755))) #f))) (global-extend2102 (lambda (type2756 sym2757 val2758) (put-global-definition-hook2069 sym2757 type2756 val2758))) (lookup2101 (lambda (x2759 r2760 mod2761) (let ((temp2762 (assq x2759 r2760))) (if temp2762 (cdr temp2762) (if (symbol? x2759) (let ((t2763 (get-global-definition-hook2070 x2759 mod2761))) (if t2763 t2763 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env2100 (lambda (r2764) (if (null? r2764) (quote ()) (let ((a2765 (car r2764))) (if (eq? (cadr a2765) (quote macro)) (cons a2765 (macros-only-env2100 (cdr r2764))) (macros-only-env2100 (cdr r2764))))))) (extend-var-env2099 (lambda (labels2766 vars2767 r2768) (if (null? labels2766) r2768 (extend-var-env2099 (cdr labels2766) (cdr vars2767) (cons (cons (car labels2766) (cons (quote lexical) (car vars2767))) r2768))))) (extend-env2098 (lambda (labels2769 bindings2770 r2771) (if (null? labels2769) r2771 (extend-env2098 (cdr labels2769) (cdr bindings2770) (cons (cons (car labels2769) (car bindings2770)) r2771))))) (binding-value2097 cdr) (binding-type2096 car) (source-annotation2095 (lambda (x2772) (if (annotation? x2772) (annotation-source x2772) (if (syntax-object?2088 x2772) (source-annotation2095 (syntax-object-expression2089 x2772)) #f)))) (set-syntax-object-module!2094 (lambda (x2773 update2774) (vector-set! x2773 3 update2774))) (set-syntax-object-wrap!2093 (lambda (x2775 update2776) (vector-set! x2775 2 update2776))) (set-syntax-object-expression!2092 (lambda (x2777 update2778) (vector-set! x2777 1 update2778))) (syntax-object-module2091 (lambda (x2779) (vector-ref x2779 3))) (syntax-object-wrap2090 (lambda (x2780) (vector-ref x2780 2))) (syntax-object-expression2089 (lambda (x2781) (vector-ref x2781 1))) (syntax-object?2088 (lambda (x2782) (if (vector? x2782) (if (= (vector-length x2782) 4) (eq? (vector-ref x2782 0) (quote syntax-object)) #f) #f))) (make-syntax-object2087 (lambda (expression2783 wrap2784 module2785) (vector (quote syntax-object) expression2783 wrap2784 module2785))) (build-letrec2086 (lambda (src2786 ids2787 vars2788 val-exps2789 body-exp2790) (if (null? vars2788) body-exp2790 (let ((atom-key2791 (fluid-ref *mode*2062))) (if (memv atom-key2791 (quote (c))) ((@ (language tree-il) make-letrec) src2786 ids2787 vars2788 val-exps2789 body-exp2790) (list (quote letrec) (map list vars2788 val-exps2789) body-exp2790)))))) (build-named-let2085 (lambda (src2792 ids2793 vars2794 val-exps2795 body-exp2796) (let ((f2797 (car vars2794)) (f-name2798 (car ids2793)) (vars2799 (cdr vars2794)) (ids2800 (cdr ids2793))) (let ((atom-key2801 (fluid-ref *mode*2062))) (if (memv atom-key2801 (quote (c))) ((@ (language tree-il) make-letrec) src2792 (list f-name2798) (list f2797) (list (build-lambda2080 src2792 ids2800 vars2799 #f body-exp2796)) (build-application2072 src2792 (build-lexical-reference2074 (quote fun) src2792 f-name2798 f2797) val-exps2795)) (list (quote let) f2797 (map list vars2799 val-exps2795) body-exp2796)))))) (build-let2084 (lambda (src2802 ids2803 vars2804 val-exps2805 body-exp2806) (if (null? vars2804) body-exp2806 (let ((atom-key2807 (fluid-ref *mode*2062))) (if (memv atom-key2807 (quote (c))) ((@ (language tree-il) make-let) src2802 ids2803 vars2804 val-exps2805 body-exp2806) (list (quote let) (map list vars2804 val-exps2805) body-exp2806)))))) (build-sequence2083 (lambda (src2808 exps2809) (if (null? (cdr exps2809)) (car exps2809) (let ((atom-key2810 (fluid-ref *mode*2062))) (if (memv atom-key2810 (quote (c))) ((@ (language tree-il) make-sequence) src2808 exps2809) (cons (quote begin) exps2809)))))) (build-data2082 (lambda (src2811 exp2812) (let ((atom-key2813 (fluid-ref *mode*2062))) (if (memv atom-key2813 (quote (c))) ((@ (language tree-il) make-const) src2811 exp2812) (if (if (self-evaluating? exp2812) (not (vector? exp2812)) #f) exp2812 (list (quote quote) exp2812)))))) (build-primref2081 (lambda (src2814 name2815) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key2816 (fluid-ref *mode*2062))) (if (memv atom-key2816 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src2814 name2815) name2815)) (let ((atom-key2817 (fluid-ref *mode*2062))) (if (memv atom-key2817 (quote (c))) ((@ (language tree-il) make-module-ref) src2814 (quote (guile)) name2815 #f) (list (quote @@) (quote (guile)) name2815)))))) (build-lambda2080 (lambda (src2818 ids2819 vars2820 docstring2821 exp2822) (let ((atom-key2823 (fluid-ref *mode*2062))) (if (memv atom-key2823 (quote (c))) ((@ (language tree-il) make-lambda) src2818 ids2819 vars2820 (if docstring2821 (list (cons (quote documentation) docstring2821)) (quote ())) exp2822) (cons (quote lambda) (cons vars2820 (append (if docstring2821 (list docstring2821) (quote ())) (list exp2822)))))))) (build-global-definition2079 (lambda (source2824 var2825 exp2826) (let ((atom-key2827 (fluid-ref *mode*2062))) (if (memv atom-key2827 (quote (c))) ((@ (language tree-il) make-toplevel-define) source2824 var2825 exp2826) (list (quote define) var2825 exp2826))))) (build-global-assignment2078 (lambda (source2828 var2829 exp2830 mod2831) (analyze-variable2076 mod2831 var2829 (lambda (mod2832 var2833 public?2834) (let ((atom-key2835 (fluid-ref *mode*2062))) (if (memv atom-key2835 (quote (c))) ((@ (language tree-il) make-module-set) source2828 mod2832 var2833 public?2834 exp2830) (list (quote set!) (list (if public?2834 (quote @) (quote @@)) mod2832 var2833) exp2830)))) (lambda (var2836) (let ((atom-key2837 (fluid-ref *mode*2062))) (if (memv atom-key2837 (quote (c))) ((@ (language tree-il) make-toplevel-set) source2828 var2836 exp2830) (list (quote set!) var2836 exp2830))))))) (build-global-reference2077 (lambda (source2838 var2839 mod2840) (analyze-variable2076 mod2840 var2839 (lambda (mod2841 var2842 public?2843) (let ((atom-key2844 (fluid-ref *mode*2062))) (if (memv atom-key2844 (quote (c))) ((@ (language tree-il) make-module-ref) source2838 mod2841 var2842 public?2843) (list (if public?2843 (quote @) (quote @@)) mod2841 var2842)))) (lambda (var2845) (let ((atom-key2846 (fluid-ref *mode*2062))) (if (memv atom-key2846 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source2838 var2845) var2845)))))) (analyze-variable2076 (lambda (mod2847 var2848 modref-cont2849 bare-cont2850) (if (not mod2847) (bare-cont2850 var2848) (let ((kind2851 (car mod2847)) (mod2852 (cdr mod2847))) (if (memv kind2851 (quote (public))) (modref-cont2849 mod2852 var2848 #t) (if (memv kind2851 (quote (private))) (if (not (equal? mod2852 (module-name (current-module)))) (modref-cont2849 mod2852 var2848 #f) (bare-cont2850 var2848)) (if (memv kind2851 (quote (bare))) (bare-cont2850 var2848) (if (memv kind2851 (quote (hygiene))) (if (if (not (equal? mod2852 (module-name (current-module)))) (module-variable (resolve-module mod2852) var2848) #f) (modref-cont2849 mod2852 var2848 #f) (bare-cont2850 var2848)) (syntax-violation #f "bad module kind" var2848 mod2852))))))))) (build-lexical-assignment2075 (lambda (source2853 name2854 var2855 exp2856) (let ((atom-key2857 (fluid-ref *mode*2062))) (if (memv atom-key2857 (quote (c))) ((@ (language tree-il) make-lexical-set) source2853 name2854 var2855 exp2856) (list (quote set!) var2855 exp2856))))) (build-lexical-reference2074 (lambda (type2858 source2859 name2860 var2861) (let ((atom-key2862 (fluid-ref *mode*2062))) (if (memv atom-key2862 (quote (c))) ((@ (language tree-il) make-lexical-ref) source2859 name2860 var2861) var2861)))) (build-conditional2073 (lambda (source2863 test-exp2864 then-exp2865 else-exp2866) (let ((atom-key2867 (fluid-ref *mode*2062))) (if (memv atom-key2867 (quote (c))) ((@ (language tree-il) make-conditional) source2863 test-exp2864 then-exp2865 else-exp2866) (list (quote if) test-exp2864 then-exp2865 else-exp2866))))) (build-application2072 (lambda (source2868 fun-exp2869 arg-exps2870) (let ((atom-key2871 (fluid-ref *mode*2062))) (if (memv atom-key2871 (quote (c))) ((@ (language tree-il) make-application) source2868 fun-exp2869 arg-exps2870) (cons fun-exp2869 arg-exps2870))))) (build-void2071 (lambda (source2872) (let ((atom-key2873 (fluid-ref *mode*2062))) (if (memv atom-key2873 (quote (c))) ((@ (language tree-il) make-void) source2872) (quote (if #f #f)))))) (get-global-definition-hook2070 (lambda (symbol2874 module2875) (begin (if (if (not module2875) (current-module) #f) (warn "module system is booted, we should have a module" symbol2874) (if #f #f)) (let ((v2876 (module-variable (if module2875 (resolve-module (cdr module2875)) (current-module)) symbol2874))) (if v2876 (if (variable-bound? v2876) (let ((val2877 (variable-ref v2876))) (if (macro? val2877) (if (syncase-macro-type val2877) (cons (syncase-macro-type val2877) (syncase-macro-binding val2877)) #f) #f)) #f) #f))))) (put-global-definition-hook2069 (lambda (symbol2878 type2879 val2880) (let ((existing2881 (let ((v2882 (module-variable (current-module) symbol2878))) (if v2882 (if (variable-bound? v2882) (let ((val2883 (variable-ref v2882))) (if (macro? val2883) (if (not (syncase-macro-type val2883)) val2883 #f) #f)) #f) #f)))) (module-define! (current-module) symbol2878 (if existing2881 (make-extended-syncase-macro existing2881 type2879 val2880) (make-syncase-macro type2879 val2880)))))) (local-eval-hook2068 (lambda (x2884 mod2885) (primitive-eval (list noexpand2061 (let ((atom-key2886 (fluid-ref *mode*2062))) (if (memv atom-key2886 (quote (c))) ((@ (language tree-il) tree-il->scheme) x2884) x2884)))))) (top-level-eval-hook2067 (lambda (x2887 mod2888) (primitive-eval (list noexpand2061 (let ((atom-key2889 (fluid-ref *mode*2062))) (if (memv atom-key2889 (quote (c))) ((@ (language tree-il) tree-il->scheme) x2887) x2887)))))) (fx<2066 <) (fx=2065 =) (fx-2064 -) (fx+2063 +) (*mode*2062 (make-fluid)) (noexpand2061 "noexpand")) (begin (global-extend2102 (quote local-syntax) (quote letrec-syntax) #t) (global-extend2102 (quote local-syntax) (quote let-syntax) #f) (global-extend2102 (quote core) (quote fluid-let-syntax) (lambda (e2890 r2891 w2892 s2893 mod2894) ((lambda (tmp2895) ((lambda (tmp2896) (if (if tmp2896 (apply (lambda (_2897 var2898 val2899 e12900 e22901) (valid-bound-ids?2129 var2898)) tmp2896) #f) (apply (lambda (_2903 var2904 val2905 e12906 e22907) (let ((names2908 (map (lambda (x2909) (id-var-name2126 x2909 w2892)) var2904))) (begin (for-each (lambda (id2911 n2912) (let ((atom-key2913 (binding-type2096 (lookup2101 n2912 r2891 mod2894)))) (if (memv atom-key2913 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e2890 (source-wrap2133 id2911 w2892 s2893 mod2894)) (if #f #f)))) var2904 names2908) (chi-body2144 (cons e12906 e22907) (source-wrap2133 e2890 w2892 s2893 mod2894) (extend-env2098 names2908 (let ((trans-r2916 (macros-only-env2100 r2891))) (map (lambda (x2917) (cons (quote macro) (eval-local-transformer2147 (chi2140 x2917 trans-r2916 w2892 mod2894) mod2894))) val2905)) r2891) w2892 mod2894)))) tmp2896) ((lambda (_2919) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap2133 e2890 w2892 s2893 mod2894))) tmp2895))) ($sc-dispatch tmp2895 (quote (any #(each (any any)) any . each-any))))) e2890))) (global-extend2102 (quote core) (quote quote) (lambda (e2920 r2921 w2922 s2923 mod2924) ((lambda (tmp2925) ((lambda (tmp2926) (if tmp2926 (apply (lambda (_2927 e2928) (build-data2082 s2923 (strip2151 e2928 w2922))) tmp2926) ((lambda (_2929) (syntax-violation (quote quote) "bad syntax" (source-wrap2133 e2920 w2922 s2923 mod2924))) tmp2925))) ($sc-dispatch tmp2925 (quote (any any))))) e2920))) (global-extend2102 (quote core) (quote syntax) (letrec ((regen2937 (lambda (x2938) (let ((atom-key2939 (car x2938))) (if (memv atom-key2939 (quote (ref))) (build-lexical-reference2074 (quote value) #f (cadr x2938) (cadr x2938)) (if (memv atom-key2939 (quote (primitive))) (build-primref2081 #f (cadr x2938)) (if (memv atom-key2939 (quote (quote))) (build-data2082 #f (cadr x2938)) (if (memv atom-key2939 (quote (lambda))) (build-lambda2080 #f (cadr x2938) (cadr x2938) #f (regen2937 (caddr x2938))) (if (memv atom-key2939 (quote (map))) (let ((ls2940 (map regen2937 (cdr x2938)))) (build-application2072 #f (build-primref2081 #f (quote map)) ls2940)) (build-application2072 #f (build-primref2081 #f (car x2938)) (map regen2937 (cdr x2938))))))))))) (gen-vector2936 (lambda (x2941) (if (eq? (car x2941) (quote list)) (cons (quote vector) (cdr x2941)) (if (eq? (car x2941) (quote quote)) (list (quote quote) (list->vector (cadr x2941))) (list (quote list->vector) x2941))))) (gen-append2935 (lambda (x2942 y2943) (if (equal? y2943 (quote (quote ()))) x2942 (list (quote append) x2942 y2943)))) (gen-cons2934 (lambda (x2944 y2945) (let ((atom-key2946 (car y2945))) (if (memv atom-key2946 (quote (quote))) (if (eq? (car x2944) (quote quote)) (list (quote quote) (cons (cadr x2944) (cadr y2945))) (if (eq? (cadr y2945) (quote ())) (list (quote list) x2944) (list (quote cons) x2944 y2945))) (if (memv atom-key2946 (quote (list))) (cons (quote list) (cons x2944 (cdr y2945))) (list (quote cons) x2944 y2945)))))) (gen-map2933 (lambda (e2947 map-env2948) (let ((formals2949 (map cdr map-env2948)) (actuals2950 (map (lambda (x2951) (list (quote ref) (car x2951))) map-env2948))) (if (eq? (car e2947) (quote ref)) (car actuals2950) (if (and-map (lambda (x2952) (if (eq? (car x2952) (quote ref)) (memq (cadr x2952) formals2949) #f)) (cdr e2947)) (cons (quote map) (cons (list (quote primitive) (car e2947)) (map (let ((r2953 (map cons formals2949 actuals2950))) (lambda (x2954) (cdr (assq (cadr x2954) r2953)))) (cdr e2947)))) (cons (quote map) (cons (list (quote lambda) formals2949 e2947) actuals2950))))))) (gen-mappend2932 (lambda (e2955 map-env2956) (list (quote apply) (quote (primitive append)) (gen-map2933 e2955 map-env2956)))) (gen-ref2931 (lambda (src2957 var2958 level2959 maps2960) (if (fx=2065 level2959 0) (values var2958 maps2960) (if (null? maps2960) (syntax-violation (quote syntax) "missing ellipsis" src2957) (call-with-values (lambda () (gen-ref2931 src2957 var2958 (fx-2064 level2959 1) (cdr maps2960))) (lambda (outer-var2961 outer-maps2962) (let ((b2963 (assq outer-var2961 (car maps2960)))) (if b2963 (values (cdr b2963) maps2960) (let ((inner-var2964 (gen-var2152 (quote tmp)))) (values inner-var2964 (cons (cons (cons outer-var2961 inner-var2964) (car maps2960)) outer-maps2962))))))))))) (gen-syntax2930 (lambda (src2965 e2966 r2967 maps2968 ellipsis?2969 mod2970) (if (id?2104 e2966) (let ((label2971 (id-var-name2126 e2966 (quote (()))))) (let ((b2972 (lookup2101 label2971 r2967 mod2970))) (if (eq? (binding-type2096 b2972) (quote syntax)) (call-with-values (lambda () (let ((var.lev2973 (binding-value2097 b2972))) (gen-ref2931 src2965 (car var.lev2973) (cdr var.lev2973) maps2968))) (lambda (var2974 maps2975) (values (list (quote ref) var2974) maps2975))) (if (ellipsis?2969 e2966) (syntax-violation (quote syntax) "misplaced ellipsis" src2965) (values (list (quote quote) e2966) maps2968))))) ((lambda (tmp2976) ((lambda (tmp2977) (if (if tmp2977 (apply (lambda (dots2978 e2979) (ellipsis?2969 dots2978)) tmp2977) #f) (apply (lambda (dots2980 e2981) (gen-syntax2930 src2965 e2981 r2967 maps2968 (lambda (x2982) #f) mod2970)) tmp2977) ((lambda (tmp2983) (if (if tmp2983 (apply (lambda (x2984 dots2985 y2986) (ellipsis?2969 dots2985)) tmp2983) #f) (apply (lambda (x2987 dots2988 y2989) (letrec ((f2990 (lambda (y2991 k2992) ((lambda (tmp2996) ((lambda (tmp2997) (if (if tmp2997 (apply (lambda (dots2998 y2999) (ellipsis?2969 dots2998)) tmp2997) #f) (apply (lambda (dots3000 y3001) (f2990 y3001 (lambda (maps3002) (call-with-values (lambda () (k2992 (cons (quote ()) maps3002))) (lambda (x3003 maps3004) (if (null? (car maps3004)) (syntax-violation (quote syntax) "extra ellipsis" src2965) (values (gen-mappend2932 x3003 (car maps3004)) (cdr maps3004)))))))) tmp2997) ((lambda (_3005) (call-with-values (lambda () (gen-syntax2930 src2965 y2991 r2967 maps2968 ellipsis?2969 mod2970)) (lambda (y3006 maps3007) (call-with-values (lambda () (k2992 maps3007)) (lambda (x3008 maps3009) (values (gen-append2935 x3008 y3006) maps3009)))))) tmp2996))) ($sc-dispatch tmp2996 (quote (any . any))))) y2991)))) (f2990 y2989 (lambda (maps2993) (call-with-values (lambda () (gen-syntax2930 src2965 x2987 r2967 (cons (quote ()) maps2993) ellipsis?2969 mod2970)) (lambda (x2994 maps2995) (if (null? (car maps2995)) (syntax-violation (quote syntax) "extra ellipsis" src2965) (values (gen-map2933 x2994 (car maps2995)) (cdr maps2995))))))))) tmp2983) ((lambda (tmp3010) (if tmp3010 (apply (lambda (x3011 y3012) (call-with-values (lambda () (gen-syntax2930 src2965 x3011 r2967 maps2968 ellipsis?2969 mod2970)) (lambda (x3013 maps3014) (call-with-values (lambda () (gen-syntax2930 src2965 y3012 r2967 maps3014 ellipsis?2969 mod2970)) (lambda (y3015 maps3016) (values (gen-cons2934 x3013 y3015) maps3016)))))) tmp3010) ((lambda (tmp3017) (if tmp3017 (apply (lambda (e13018 e23019) (call-with-values (lambda () (gen-syntax2930 src2965 (cons e13018 e23019) r2967 maps2968 ellipsis?2969 mod2970)) (lambda (e3021 maps3022) (values (gen-vector2936 e3021) maps3022)))) tmp3017) ((lambda (_3023) (values (list (quote quote) e2966) maps2968)) tmp2976))) ($sc-dispatch tmp2976 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2976 (quote (any . any)))))) ($sc-dispatch tmp2976 (quote (any any . any)))))) ($sc-dispatch tmp2976 (quote (any any))))) e2966))))) (lambda (e3024 r3025 w3026 s3027 mod3028) (let ((e3029 (source-wrap2133 e3024 w3026 s3027 mod3028))) ((lambda (tmp3030) ((lambda (tmp3031) (if tmp3031 (apply (lambda (_3032 x3033) (call-with-values (lambda () (gen-syntax2930 e3029 x3033 r3025 (quote ()) ellipsis?2149 mod3028)) (lambda (e3034 maps3035) (regen2937 e3034)))) tmp3031) ((lambda (_3036) (syntax-violation (quote syntax) "bad `syntax' form" e3029)) tmp3030))) ($sc-dispatch tmp3030 (quote (any any))))) e3029))))) (global-extend2102 (quote core) (quote lambda) (lambda (e3037 r3038 w3039 s3040 mod3041) ((lambda (tmp3042) ((lambda (tmp3043) (if tmp3043 (apply (lambda (_3044 c3045) (chi-lambda-clause2145 (source-wrap2133 e3037 w3039 s3040 mod3041) #f c3045 r3038 w3039 mod3041 (lambda (names3046 vars3047 docstring3048 body3049) (build-lambda2080 s3040 names3046 vars3047 docstring3048 body3049)))) tmp3043) (syntax-violation #f "source expression failed to match any pattern" tmp3042))) ($sc-dispatch tmp3042 (quote (any . any))))) e3037))) (global-extend2102 (quote core) (quote let) (letrec ((chi-let3050 (lambda (e3051 r3052 w3053 s3054 mod3055 constructor3056 ids3057 vals3058 exps3059) (if (not (valid-bound-ids?2129 ids3057)) (syntax-violation (quote let) "duplicate bound variable" e3051) (let ((labels3060 (gen-labels2110 ids3057)) (new-vars3061 (map gen-var2152 ids3057))) (let ((nw3062 (make-binding-wrap2121 ids3057 labels3060 w3053)) (nr3063 (extend-var-env2099 labels3060 new-vars3061 r3052))) (constructor3056 s3054 (map syntax->datum ids3057) new-vars3061 (map (lambda (x3064) (chi2140 x3064 r3052 w3053 mod3055)) vals3058) (chi-body2144 exps3059 (source-wrap2133 e3051 nw3062 s3054 mod3055) nr3063 nw3062 mod3055)))))))) (lambda (e3065 r3066 w3067 s3068 mod3069) ((lambda (tmp3070) ((lambda (tmp3071) (if tmp3071 (apply (lambda (_3072 id3073 val3074 e13075 e23076) (chi-let3050 e3065 r3066 w3067 s3068 mod3069 build-let2084 id3073 val3074 (cons e13075 e23076))) tmp3071) ((lambda (tmp3080) (if (if tmp3080 (apply (lambda (_3081 f3082 id3083 val3084 e13085 e23086) (id?2104 f3082)) tmp3080) #f) (apply (lambda (_3087 f3088 id3089 val3090 e13091 e23092) (chi-let3050 e3065 r3066 w3067 s3068 mod3069 build-named-let2085 (cons f3088 id3089) val3090 (cons e13091 e23092))) tmp3080) ((lambda (_3096) (syntax-violation (quote let) "bad let" (source-wrap2133 e3065 w3067 s3068 mod3069))) tmp3070))) ($sc-dispatch tmp3070 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp3070 (quote (any #(each (any any)) any . each-any))))) e3065)))) (global-extend2102 (quote core) (quote letrec) (lambda (e3097 r3098 w3099 s3100 mod3101) ((lambda (tmp3102) ((lambda (tmp3103) (if tmp3103 (apply (lambda (_3104 id3105 val3106 e13107 e23108) (let ((ids3109 id3105)) (if (not (valid-bound-ids?2129 ids3109)) (syntax-violation (quote letrec) "duplicate bound variable" e3097) (let ((labels3111 (gen-labels2110 ids3109)) (new-vars3112 (map gen-var2152 ids3109))) (let ((w3113 (make-binding-wrap2121 ids3109 labels3111 w3099)) (r3114 (extend-var-env2099 labels3111 new-vars3112 r3098))) (build-letrec2086 s3100 (map syntax->datum ids3109) new-vars3112 (map (lambda (x3115) (chi2140 x3115 r3114 w3113 mod3101)) val3106) (chi-body2144 (cons e13107 e23108) (source-wrap2133 e3097 w3113 s3100 mod3101) r3114 w3113 mod3101))))))) tmp3103) ((lambda (_3118) (syntax-violation (quote letrec) "bad letrec" (source-wrap2133 e3097 w3099 s3100 mod3101))) tmp3102))) ($sc-dispatch tmp3102 (quote (any #(each (any any)) any . each-any))))) e3097))) (global-extend2102 (quote core) (quote set!) (lambda (e3119 r3120 w3121 s3122 mod3123) ((lambda (tmp3124) ((lambda (tmp3125) (if (if tmp3125 (apply (lambda (_3126 id3127 val3128) (id?2104 id3127)) tmp3125) #f) (apply (lambda (_3129 id3130 val3131) (let ((val3132 (chi2140 val3131 r3120 w3121 mod3123)) (n3133 (id-var-name2126 id3130 w3121))) (let ((b3134 (lookup2101 n3133 r3120 mod3123))) (let ((atom-key3135 (binding-type2096 b3134))) (if (memv atom-key3135 (quote (lexical))) (build-lexical-assignment2075 s3122 (syntax->datum id3130) (binding-value2097 b3134) val3132) (if (memv atom-key3135 (quote (global))) (build-global-assignment2078 s3122 n3133 val3132 mod3123) (if (memv atom-key3135 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap2132 id3130 w3121 mod3123)) (syntax-violation (quote set!) "bad set!" (source-wrap2133 e3119 w3121 s3122 mod3123))))))))) tmp3125) ((lambda (tmp3136) (if tmp3136 (apply (lambda (_3137 head3138 tail3139 val3140) (call-with-values (lambda () (syntax-type2138 head3138 r3120 (quote (())) #f #f mod3123)) (lambda (type3141 value3142 ee3143 ww3144 ss3145 modmod3146) (if (memv type3141 (quote (module-ref))) (let ((val3147 (chi2140 val3140 r3120 w3121 mod3123))) (call-with-values (lambda () (value3142 (cons head3138 tail3139))) (lambda (id3149 mod3150) (build-global-assignment2078 s3122 id3149 val3147 mod3150)))) (build-application2072 s3122 (chi2140 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head3138) r3120 w3121 mod3123) (map (lambda (e3151) (chi2140 e3151 r3120 w3121 mod3123)) (append tail3139 (list val3140)))))))) tmp3136) ((lambda (_3153) (syntax-violation (quote set!) "bad set!" (source-wrap2133 e3119 w3121 s3122 mod3123))) tmp3124))) ($sc-dispatch tmp3124 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp3124 (quote (any any any))))) e3119))) (global-extend2102 (quote module-ref) (quote @) (lambda (e3154) ((lambda (tmp3155) ((lambda (tmp3156) (if (if tmp3156 (apply (lambda (_3157 mod3158 id3159) (if (and-map id?2104 mod3158) (id?2104 id3159) #f)) tmp3156) #f) (apply (lambda (_3161 mod3162 id3163) (values (syntax->datum id3163) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod3162)))) tmp3156) (syntax-violation #f "source expression failed to match any pattern" tmp3155))) ($sc-dispatch tmp3155 (quote (any each-any any))))) e3154))) (global-extend2102 (quote module-ref) (quote @@) (lambda (e3165) ((lambda (tmp3166) ((lambda (tmp3167) (if (if tmp3167 (apply (lambda (_3168 mod3169 id3170) (if (and-map id?2104 mod3169) (id?2104 id3170) #f)) tmp3167) #f) (apply (lambda (_3172 mod3173 id3174) (values (syntax->datum id3174) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod3173)))) tmp3167) (syntax-violation #f "source expression failed to match any pattern" tmp3166))) ($sc-dispatch tmp3166 (quote (any each-any any))))) e3165))) (global-extend2102 (quote core) (quote if) (lambda (e3176 r3177 w3178 s3179 mod3180) ((lambda (tmp3181) ((lambda (tmp3182) (if tmp3182 (apply (lambda (_3183 test3184 then3185) (build-conditional2073 s3179 (chi2140 test3184 r3177 w3178 mod3180) (chi2140 then3185 r3177 w3178 mod3180) (build-void2071 #f))) tmp3182) ((lambda (tmp3186) (if tmp3186 (apply (lambda (_3187 test3188 then3189 else3190) (build-conditional2073 s3179 (chi2140 test3188 r3177 w3178 mod3180) (chi2140 then3189 r3177 w3178 mod3180) (chi2140 else3190 r3177 w3178 mod3180))) tmp3186) (syntax-violation #f "source expression failed to match any pattern" tmp3181))) ($sc-dispatch tmp3181 (quote (any any any any)))))) ($sc-dispatch tmp3181 (quote (any any any))))) e3176))) (global-extend2102 (quote begin) (quote begin) (quote ())) (global-extend2102 (quote define) (quote define) (quote ())) (global-extend2102 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend2102 (quote eval-when) (quote eval-when) (quote ())) (global-extend2102 (quote core) (quote syntax-case) (letrec ((gen-syntax-case3194 (lambda (x3195 keys3196 clauses3197 r3198 mod3199) (if (null? clauses3197) (build-application2072 #f (build-primref2081 #f (quote syntax-violation)) (list #f "source expression failed to match any pattern" x3195)) ((lambda (tmp3200) ((lambda (tmp3201) (if tmp3201 (apply (lambda (pat3202 exp3203) (if (if (id?2104 pat3202) (and-map (lambda (x3204) (not (free-id=?2127 pat3202 x3204))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys3196)) #f) (let ((labels3205 (list (gen-label2109))) (var3206 (gen-var2152 pat3202))) (build-application2072 #f (build-lambda2080 #f (list (syntax->datum pat3202)) (list var3206) #f (chi2140 exp3203 (extend-env2098 labels3205 (list (cons (quote syntax) (cons var3206 0))) r3198) (make-binding-wrap2121 (list pat3202) labels3205 (quote (()))) mod3199)) (list x3195))) (gen-clause3193 x3195 keys3196 (cdr clauses3197) r3198 pat3202 #t exp3203 mod3199))) tmp3201) ((lambda (tmp3207) (if tmp3207 (apply (lambda (pat3208 fender3209 exp3210) (gen-clause3193 x3195 keys3196 (cdr clauses3197) r3198 pat3208 fender3209 exp3210 mod3199)) tmp3207) ((lambda (_3211) (syntax-violation (quote syntax-case) "invalid clause" (car clauses3197))) tmp3200))) ($sc-dispatch tmp3200 (quote (any any any)))))) ($sc-dispatch tmp3200 (quote (any any))))) (car clauses3197))))) (gen-clause3193 (lambda (x3212 keys3213 clauses3214 r3215 pat3216 fender3217 exp3218 mod3219) (call-with-values (lambda () (convert-pattern3191 pat3216 keys3213)) (lambda (p3220 pvars3221) (if (not (distinct-bound-ids?2130 (map car pvars3221))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat3216) (if (not (and-map (lambda (x3222) (not (ellipsis?2149 (car x3222)))) pvars3221)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat3216) (let ((y3223 (gen-var2152 (quote tmp)))) (build-application2072 #f (build-lambda2080 #f (list (quote tmp)) (list y3223) #f (let ((y3224 (build-lexical-reference2074 (quote value) #f (quote tmp) y3223))) (build-conditional2073 #f ((lambda (tmp3225) ((lambda (tmp3226) (if tmp3226 (apply (lambda () y3224) tmp3226) ((lambda (_3227) (build-conditional2073 #f y3224 (build-dispatch-call3192 pvars3221 fender3217 y3224 r3215 mod3219) (build-data2082 #f #f))) tmp3225))) ($sc-dispatch tmp3225 (quote #(atom #t))))) fender3217) (build-dispatch-call3192 pvars3221 exp3218 y3224 r3215 mod3219) (gen-syntax-case3194 x3212 keys3213 clauses3214 r3215 mod3219)))) (list (if (eq? p3220 (quote any)) (build-application2072 #f (build-primref2081 #f (quote list)) (list x3212)) (build-application2072 #f (build-primref2081 #f (quote $sc-dispatch)) (list x3212 (build-data2082 #f p3220))))))))))))) (build-dispatch-call3192 (lambda (pvars3228 exp3229 y3230 r3231 mod3232) (let ((ids3233 (map car pvars3228)) (levels3234 (map cdr pvars3228))) (let ((labels3235 (gen-labels2110 ids3233)) (new-vars3236 (map gen-var2152 ids3233))) (build-application2072 #f (build-primref2081 #f (quote apply)) (list (build-lambda2080 #f (map syntax->datum ids3233) new-vars3236 #f (chi2140 exp3229 (extend-env2098 labels3235 (map (lambda (var3237 level3238) (cons (quote syntax) (cons var3237 level3238))) new-vars3236 (map cdr pvars3228)) r3231) (make-binding-wrap2121 ids3233 labels3235 (quote (()))) mod3232)) y3230)))))) (convert-pattern3191 (lambda (pattern3239 keys3240) (letrec ((cvt3241 (lambda (p3242 n3243 ids3244) (if (id?2104 p3242) (if (bound-id-member?2131 p3242 keys3240) (values (vector (quote free-id) p3242) ids3244) (values (quote any) (cons (cons p3242 n3243) ids3244))) ((lambda (tmp3245) ((lambda (tmp3246) (if (if tmp3246 (apply (lambda (x3247 dots3248) (ellipsis?2149 dots3248)) tmp3246) #f) (apply (lambda (x3249 dots3250) (call-with-values (lambda () (cvt3241 x3249 (fx+2063 n3243 1) ids3244)) (lambda (p3251 ids3252) (values (if (eq? p3251 (quote any)) (quote each-any) (vector (quote each) p3251)) ids3252)))) tmp3246) ((lambda (tmp3253) (if tmp3253 (apply (lambda (x3254 y3255) (call-with-values (lambda () (cvt3241 y3255 n3243 ids3244)) (lambda (y3256 ids3257) (call-with-values (lambda () (cvt3241 x3254 n3243 ids3257)) (lambda (x3258 ids3259) (values (cons x3258 y3256) ids3259)))))) tmp3253) ((lambda (tmp3260) (if tmp3260 (apply (lambda () (values (quote ()) ids3244)) tmp3260) ((lambda (tmp3261) (if tmp3261 (apply (lambda (x3262) (call-with-values (lambda () (cvt3241 x3262 n3243 ids3244)) (lambda (p3264 ids3265) (values (vector (quote vector) p3264) ids3265)))) tmp3261) ((lambda (x3266) (values (vector (quote atom) (strip2151 p3242 (quote (())))) ids3244)) tmp3245))) ($sc-dispatch tmp3245 (quote #(vector each-any)))))) ($sc-dispatch tmp3245 (quote ()))))) ($sc-dispatch tmp3245 (quote (any . any)))))) ($sc-dispatch tmp3245 (quote (any any))))) p3242))))) (cvt3241 pattern3239 0 (quote ())))))) (lambda (e3267 r3268 w3269 s3270 mod3271) (let ((e3272 (source-wrap2133 e3267 w3269 s3270 mod3271))) ((lambda (tmp3273) ((lambda (tmp3274) (if tmp3274 (apply (lambda (_3275 val3276 key3277 m3278) (if (and-map (lambda (x3279) (if (id?2104 x3279) (not (ellipsis?2149 x3279)) #f)) key3277) (let ((x3281 (gen-var2152 (quote tmp)))) (build-application2072 s3270 (build-lambda2080 #f (list (quote tmp)) (list x3281) #f (gen-syntax-case3194 (build-lexical-reference2074 (quote value) #f (quote tmp) x3281) key3277 m3278 r3268 mod3271)) (list (chi2140 val3276 r3268 (quote (())) mod3271)))) (syntax-violation (quote syntax-case) "invalid literals list" e3272))) tmp3274) (syntax-violation #f "source expression failed to match any pattern" tmp3273))) ($sc-dispatch tmp3273 (quote (any any each-any . each-any))))) e3272))))) (set! sc-expand (lambda (x3285 . rest3284) (if (if (pair? x3285) (equal? (car x3285) noexpand2061) #f) (cadr x3285) (let ((m3286 (if (null? rest3284) (quote e) (car rest3284))) (esew3287 (if (let ((t3288 (null? rest3284))) (if t3288 t3288 (null? (cdr rest3284)))) (quote (eval)) (cadr rest3284)))) (with-fluid* *mode*2062 m3286 (lambda () (chi-top2139 x3285 (quote ()) (quote ((top))) m3286 esew3287 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x3289) (nonsymbol-id?2103 x3289))) (set! datum->syntax (lambda (id3290 datum3291) (make-syntax-object2087 datum3291 (syntax-object-wrap2090 id3290) #f))) (set! syntax->datum (lambda (x3292) (strip2151 x3292 (quote (()))))) (set! generate-temporaries (lambda (ls3293) (begin (let ((x3294 ls3293)) (if (not (list? x3294)) (syntax-violation (quote generate-temporaries) "invalid argument" x3294) (if #f #f))) (map (lambda (x3295) (wrap2132 (gensym) (quote ((top))) #f)) ls3293)))) (set! free-identifier=? (lambda (x3296 y3297) (begin (let ((x3298 x3296)) (if (not (nonsymbol-id?2103 x3298)) (syntax-violation (quote free-identifier=?) "invalid argument" x3298) (if #f #f))) (let ((x3299 y3297)) (if (not (nonsymbol-id?2103 x3299)) (syntax-violation (quote free-identifier=?) "invalid argument" x3299) (if #f #f))) (free-id=?2127 x3296 y3297)))) (set! bound-identifier=? (lambda (x3300 y3301) (begin (let ((x3302 x3300)) (if (not (nonsymbol-id?2103 x3302)) (syntax-violation (quote bound-identifier=?) "invalid argument" x3302) (if #f #f))) (let ((x3303 y3301)) (if (not (nonsymbol-id?2103 x3303)) (syntax-violation (quote bound-identifier=?) "invalid argument" x3303) (if #f #f))) (bound-id=?2128 x3300 y3301)))) (set! syntax-violation (lambda (who3307 message3306 form3305 . subform3304) (begin (let ((x3308 who3307)) (if (not ((lambda (x3309) (let ((t3310 (not x3309))) (if t3310 t3310 (let ((t3311 (string? x3309))) (if t3311 t3311 (symbol? x3309)))))) x3308)) (syntax-violation (quote syntax-violation) "invalid argument" x3308) (if #f #f))) (let ((x3312 message3306)) (if (not (string? x3312)) (syntax-violation (quote syntax-violation) "invalid argument" x3312) (if #f #f))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who3307 "~a: " "") "~a " (if (null? subform3304) "in ~a" "in subform `~s' of `~s'")) (let ((tail3313 (cons message3306 (map (lambda (x3314) (strip2151 x3314 (quote (())))) (append subform3304 (list form3305)))))) (if who3307 (cons who3307 tail3313) tail3313)) #f)))) (letrec ((match3319 (lambda (e3320 p3321 w3322 r3323 mod3324) (if (not r3323) #f (if (eq? p3321 (quote any)) (cons (wrap2132 e3320 w3322 mod3324) r3323) (if (syntax-object?2088 e3320) (match*3318 (let ((e3325 (syntax-object-expression2089 e3320))) (if (annotation? e3325) (annotation-expression e3325) e3325)) p3321 (join-wraps2123 w3322 (syntax-object-wrap2090 e3320)) r3323 (syntax-object-module2091 e3320)) (match*3318 (let ((e3326 e3320)) (if (annotation? e3326) (annotation-expression e3326) e3326)) p3321 w3322 r3323 mod3324)))))) (match*3318 (lambda (e3327 p3328 w3329 r3330 mod3331) (if (null? p3328) (if (null? e3327) r3330 #f) (if (pair? p3328) (if (pair? e3327) (match3319 (car e3327) (car p3328) w3329 (match3319 (cdr e3327) (cdr p3328) w3329 r3330 mod3331) mod3331) #f) (if (eq? p3328 (quote each-any)) (let ((l3332 (match-each-any3316 e3327 w3329 mod3331))) (if l3332 (cons l3332 r3330) #f)) (let ((atom-key3333 (vector-ref p3328 0))) (if (memv atom-key3333 (quote (each))) (if (null? e3327) (match-empty3317 (vector-ref p3328 1) r3330) (let ((l3334 (match-each3315 e3327 (vector-ref p3328 1) w3329 mod3331))) (if l3334 (letrec ((collect3335 (lambda (l3336) (if (null? (car l3336)) r3330 (cons (map car l3336) (collect3335 (map cdr l3336))))))) (collect3335 l3334)) #f))) (if (memv atom-key3333 (quote (free-id))) (if (id?2104 e3327) (if (free-id=?2127 (wrap2132 e3327 w3329 mod3331) (vector-ref p3328 1)) r3330 #f) #f) (if (memv atom-key3333 (quote (atom))) (if (equal? (vector-ref p3328 1) (strip2151 e3327 w3329)) r3330 #f) (if (memv atom-key3333 (quote (vector))) (if (vector? e3327) (match3319 (vector->list e3327) (vector-ref p3328 1) w3329 r3330 mod3331) #f) (if #f #f))))))))))) (match-empty3317 (lambda (p3337 r3338) (if (null? p3337) r3338 (if (eq? p3337 (quote any)) (cons (quote ()) r3338) (if (pair? p3337) (match-empty3317 (car p3337) (match-empty3317 (cdr p3337) r3338)) (if (eq? p3337 (quote each-any)) (cons (quote ()) r3338) (let ((atom-key3339 (vector-ref p3337 0))) (if (memv atom-key3339 (quote (each))) (match-empty3317 (vector-ref p3337 1) r3338) (if (memv atom-key3339 (quote (free-id atom))) r3338 (if (memv atom-key3339 (quote (vector))) (match-empty3317 (vector-ref p3337 1) r3338) (if #f #f))))))))))) (match-each-any3316 (lambda (e3340 w3341 mod3342) (if (annotation? e3340) (match-each-any3316 (annotation-expression e3340) w3341 mod3342) (if (pair? e3340) (let ((l3343 (match-each-any3316 (cdr e3340) w3341 mod3342))) (if l3343 (cons (wrap2132 (car e3340) w3341 mod3342) l3343) #f)) (if (null? e3340) (quote ()) (if (syntax-object?2088 e3340) (match-each-any3316 (syntax-object-expression2089 e3340) (join-wraps2123 w3341 (syntax-object-wrap2090 e3340)) mod3342) #f)))))) (match-each3315 (lambda (e3344 p3345 w3346 mod3347) (if (annotation? e3344) (match-each3315 (annotation-expression e3344) p3345 w3346 mod3347) (if (pair? e3344) (let ((first3348 (match3319 (car e3344) p3345 w3346 (quote ()) mod3347))) (if first3348 (let ((rest3349 (match-each3315 (cdr e3344) p3345 w3346 mod3347))) (if rest3349 (cons first3348 rest3349) #f)) #f)) (if (null? e3344) (quote ()) (if (syntax-object?2088 e3344) (match-each3315 (syntax-object-expression2089 e3344) p3345 (join-wraps2123 w3346 (syntax-object-wrap2090 e3344)) (syntax-object-module2091 e3344)) #f))))))) (set! $sc-dispatch (lambda (e3350 p3351) (if (eq? p3351 (quote any)) (list e3350) (if (syntax-object?2088 e3350) (match*3318 (let ((e3352 (syntax-object-expression2089 e3350))) (if (annotation? e3352) (annotation-expression e3352) e3352)) p3351 (syntax-object-wrap2090 e3350) (quote ()) (syntax-object-module2091 e3350)) (match*3318 (let ((e3353 e3350)) (if (annotation? e3353) (annotation-expression e3353) e3353)) p3351 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x3354) ((lambda (tmp3355) ((lambda (tmp3356) (if tmp3356 (apply (lambda (_3357 e13358 e23359) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13358 e23359))) tmp3356) ((lambda (tmp3361) (if tmp3361 (apply (lambda (_3362 out3363 in3364 e13365 e23366) (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))) in3364 (quote ()) (list out3363 (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 e13365 e23366))))) tmp3361) ((lambda (tmp3368) (if tmp3368 (apply (lambda (_3369 out3370 in3371 e13372 e23373) (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))) in3371) (quote ()) (list out3370 (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 e13372 e23373))))) tmp3368) (syntax-violation #f "source expression failed to match any pattern" tmp3355))) ($sc-dispatch tmp3355 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp3355 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp3355 (quote (any () any . each-any))))) x3354))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x3377) ((lambda (tmp3378) ((lambda (tmp3379) (if tmp3379 (apply (lambda (_3380 k3381 keyword3382 pattern3383 template3384) (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 k3381 (map (lambda (tmp3387 tmp3386) (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))) tmp3386) (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))) tmp3387))) template3384 pattern3383)))))) tmp3379) (syntax-violation #f "source expression failed to match any pattern" tmp3378))) ($sc-dispatch tmp3378 (quote (any each-any . #(each ((any . any) any))))))) x3377))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x3388) ((lambda (tmp3389) ((lambda (tmp3390) (if (if tmp3390 (apply (lambda (let*3391 x3392 v3393 e13394 e23395) (and-map identifier? x3392)) tmp3390) #f) (apply (lambda (let*3397 x3398 v3399 e13400 e23401) (letrec ((f3402 (lambda (bindings3403) (if (null? bindings3403) (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 e13400 e23401))) ((lambda (tmp3407) ((lambda (tmp3408) (if tmp3408 (apply (lambda (body3409 binding3410) (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 binding3410) body3409)) tmp3408) (syntax-violation #f "source expression failed to match any pattern" tmp3407))) ($sc-dispatch tmp3407 (quote (any any))))) (list (f3402 (cdr bindings3403)) (car bindings3403))))))) (f3402 (map list x3398 v3399)))) tmp3390) (syntax-violation #f "source expression failed to match any pattern" tmp3389))) ($sc-dispatch tmp3389 (quote (any #(each (any any)) any . each-any))))) x3388))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x3411) ((lambda (tmp3412) ((lambda (tmp3413) (if tmp3413 (apply (lambda (_3414 var3415 init3416 step3417 e03418 e13419 c3420) ((lambda (tmp3421) ((lambda (tmp3422) (if tmp3422 (apply (lambda (step3423) ((lambda (tmp3424) ((lambda (tmp3425) (if tmp3425 (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 var3415 init3416) (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))) e03418) (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 c3420 (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))) step3423))))))) tmp3425) ((lambda (tmp3430) (if tmp3430 (apply (lambda (e13431 e23432) (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 var3415 init3416) (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))) e03418 (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 e13431 e23432)) (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 c3420 (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))) step3423))))))) tmp3430) (syntax-violation #f "source expression failed to match any pattern" tmp3424))) ($sc-dispatch tmp3424 (quote (any . each-any)))))) ($sc-dispatch tmp3424 (quote ())))) e13419)) tmp3422) (syntax-violation #f "source expression failed to match any pattern" tmp3421))) ($sc-dispatch tmp3421 (quote each-any)))) (map (lambda (v3439 s3440) ((lambda (tmp3441) ((lambda (tmp3442) (if tmp3442 (apply (lambda () v3439) tmp3442) ((lambda (tmp3443) (if tmp3443 (apply (lambda (e3444) e3444) tmp3443) ((lambda (_3445) (syntax-violation (quote do) "bad step expression" orig-x3411 s3440)) tmp3441))) ($sc-dispatch tmp3441 (quote (any)))))) ($sc-dispatch tmp3441 (quote ())))) s3440)) var3415 step3417))) tmp3413) (syntax-violation #f "source expression failed to match any pattern" tmp3412))) ($sc-dispatch tmp3412 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x3411))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons3448 (lambda (x3452 y3453) ((lambda (tmp3454) ((lambda (tmp3455) (if tmp3455 (apply (lambda (x3456 y3457) ((lambda (tmp3458) ((lambda (tmp3459) (if tmp3459 (apply (lambda (dy3460) ((lambda (tmp3461) ((lambda (tmp3462) (if tmp3462 (apply (lambda (dx3463) (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 dx3463 dy3460))) tmp3462) ((lambda (_3464) (if (null? dy3460) (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))) x3456) (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))) x3456 y3457))) tmp3461))) ($sc-dispatch tmp3461 (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))))) x3456)) tmp3459) ((lambda (tmp3465) (if tmp3465 (apply (lambda (stuff3466) (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 x3456 stuff3466))) tmp3465) ((lambda (else3467) (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))) x3456 y3457)) tmp3458))) ($sc-dispatch tmp3458 (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 tmp3458 (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))))) y3457)) tmp3455) (syntax-violation #f "source expression failed to match any pattern" tmp3454))) ($sc-dispatch tmp3454 (quote (any any))))) (list x3452 y3453)))) (quasiappend3449 (lambda (x3468 y3469) ((lambda (tmp3470) ((lambda (tmp3471) (if tmp3471 (apply (lambda (x3472 y3473) ((lambda (tmp3474) ((lambda (tmp3475) (if tmp3475 (apply (lambda () x3472) tmp3475) ((lambda (_3476) (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))) x3472 y3473)) tmp3474))) ($sc-dispatch tmp3474 (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))) ()))))) y3473)) tmp3471) (syntax-violation #f "source expression failed to match any pattern" tmp3470))) ($sc-dispatch tmp3470 (quote (any any))))) (list x3468 y3469)))) (quasivector3450 (lambda (x3477) ((lambda (tmp3478) ((lambda (x3479) ((lambda (tmp3480) ((lambda (tmp3481) (if tmp3481 (apply (lambda (x3482) (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 x3482))) tmp3481) ((lambda (tmp3484) (if tmp3484 (apply (lambda (x3485) (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))) x3485)) tmp3484) ((lambda (_3487) (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))) x3479)) tmp3480))) ($sc-dispatch tmp3480 (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 tmp3480 (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))))) x3479)) tmp3478)) x3477))) (quasi3451 (lambda (p3488 lev3489) ((lambda (tmp3490) ((lambda (tmp3491) (if tmp3491 (apply (lambda (p3492) (if (= lev3489 0) p3492 (quasicons3448 (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)))) (quasi3451 (list p3492) (- lev3489 1))))) tmp3491) ((lambda (tmp3493) (if tmp3493 (apply (lambda (p3494 q3495) (if (= lev3489 0) (quasiappend3449 p3494 (quasi3451 q3495 lev3489)) (quasicons3448 (quasicons3448 (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)))) (quasi3451 (list p3494) (- lev3489 1))) (quasi3451 q3495 lev3489)))) tmp3493) ((lambda (tmp3496) (if tmp3496 (apply (lambda (p3497) (quasicons3448 (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)))) (quasi3451 (list p3497) (+ lev3489 1)))) tmp3496) ((lambda (tmp3498) (if tmp3498 (apply (lambda (p3499 q3500) (quasicons3448 (quasi3451 p3499 lev3489) (quasi3451 q3500 lev3489))) tmp3498) ((lambda (tmp3501) (if tmp3501 (apply (lambda (x3502) (quasivector3450 (quasi3451 x3502 lev3489))) tmp3501) ((lambda (p3504) (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))) p3504)) tmp3490))) ($sc-dispatch tmp3490 (quote #(vector each-any)))))) ($sc-dispatch tmp3490 (quote (any . any)))))) ($sc-dispatch tmp3490 (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 tmp3490 (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 tmp3490 (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))))) p3488)))) (lambda (x3505) ((lambda (tmp3506) ((lambda (tmp3507) (if tmp3507 (apply (lambda (_3508 e3509) (quasi3451 e3509 0)) tmp3507) (syntax-violation #f "source expression failed to match any pattern" tmp3506))) ($sc-dispatch tmp3506 (quote (any any))))) x3505)))))
+(define include (make-syncase-macro (quote macro) (lambda (x3510) (letrec ((read-file3511 (lambda (fn3512 k3513) (let ((p3514 (open-input-file fn3512))) (letrec ((f3515 (lambda (x3516) (if (eof-object? x3516) (begin (close-input-port p3514) (quote ())) (cons (datum->syntax k3513 x3516) (f3515 (read p3514))))))) (f3515 (read p3514))))))) ((lambda (tmp3517) ((lambda (tmp3518) (if tmp3518 (apply (lambda (k3519 filename3520) (let ((fn3521 (syntax->datum filename3520))) ((lambda (tmp3522) ((lambda (tmp3523) (if tmp3523 (apply (lambda (exp3524) (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))) exp3524)) tmp3523) (syntax-violation #f "source expression failed to match any pattern" tmp3522))) ($sc-dispatch tmp3522 (quote each-any)))) (read-file3511 fn3521 k3519)))) tmp3518) (syntax-violation #f "source expression failed to match any pattern" tmp3517))) ($sc-dispatch tmp3517 (quote (any any))))) x3510)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x3526) ((lambda (tmp3527) ((lambda (tmp3528) (if tmp3528 (apply (lambda (_3529 e3530) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x3526)) tmp3528) (syntax-violation #f "source expression failed to match any pattern" tmp3527))) ($sc-dispatch tmp3527 (quote (any any))))) x3526))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x3531) ((lambda (tmp3532) ((lambda (tmp3533) (if tmp3533 (apply (lambda (_3534 e3535) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x3531)) tmp3533) (syntax-violation #f "source expression failed to match any pattern" tmp3532))) ($sc-dispatch tmp3532 (quote (any any))))) x3531))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x3536) ((lambda (tmp3537) ((lambda (tmp3538) (if tmp3538 (apply (lambda (_3539 e3540 m13541 m23542) ((lambda (tmp3543) ((lambda (body3544) (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))) e3540)) body3544)) tmp3543)) (letrec ((f3545 (lambda (clause3546 clauses3547) (if (null? clauses3547) ((lambda (tmp3549) ((lambda (tmp3550) (if tmp3550 (apply (lambda (e13551 e23552) (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 e13551 e23552))) tmp3550) ((lambda (tmp3554) (if tmp3554 (apply (lambda (k3555 e13556 e23557) (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))) k3555)) (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 e13556 e23557)))) tmp3554) ((lambda (_3560) (syntax-violation (quote case) "bad clause" x3536 clause3546)) tmp3549))) ($sc-dispatch tmp3549 (quote (each-any any . each-any)))))) ($sc-dispatch tmp3549 (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))))) clause3546) ((lambda (tmp3561) ((lambda (rest3562) ((lambda (tmp3563) ((lambda (tmp3564) (if tmp3564 (apply (lambda (k3565 e13566 e23567) (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))) k3565)) (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 e13566 e23567)) rest3562)) tmp3564) ((lambda (_3570) (syntax-violation (quote case) "bad clause" x3536 clause3546)) tmp3563))) ($sc-dispatch tmp3563 (quote (each-any any . each-any))))) clause3546)) tmp3561)) (f3545 (car clauses3547) (cdr clauses3547))))))) (f3545 m13541 m23542)))) tmp3538) (syntax-violation #f "source expression failed to match any pattern" tmp3537))) ($sc-dispatch tmp3537 (quote (any any any . each-any))))) x3536))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x3571) ((lambda (tmp3572) ((lambda (tmp3573) (if tmp3573 (apply (lambda (_3574 e3575) (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))) e3575)) (list (cons _3574 (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 e3575 (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)))))))))) tmp3573) (syntax-violation #f "source expression failed to match any pattern" tmp3572))) ($sc-dispatch tmp3572 (quote (any any))))) x3571))))
HCoop / bpt / guile.git / blobdiff