go ahead and regenerate psyntax-pp.scm

[bpt/guile.git] / module / ice-9 / psyntax-pp.scm

(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 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) ls2374 (f372 (cdr ls1373) (cons (car ls1373) ls2374)))))) (f372 (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 (_376) (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 (body377 outer-form378 r379 w380 mod381) (let ((r382 (cons (quote ("placeholder" placeholder)) r379))) (let ((ribcage383 (make-ribcage118 (quote ()) (quote ()) (quote ())))) (let ((w384 (make-wrap113 (wrap-marks114 w380) (cons ribcage383 (wrap-subst115 w380))))) (letrec ((parse385 (lambda (body386 ids387 labels388 vars389 vals390 bindings391) (if (null? body386) (syntax-violation #f "no expressions in body" outer-form378) (let ((e393 (cdar body386)) (er394 (caar body386))) (call-with-values (lambda () (syntax-type145 e393 er394 (quote (())) #f ribcage383 mod381)) (lambda (type395 value396 e397 w398 s399 mod400) (let ((t401 type395)) (if (memv t401 (quote (define-form))) (let ((id402 (wrap139 value396 w398 mod400)) (label403 (gen-label116))) (let ((var404 (gen-var159 id402))) (begin (extend-ribcage!127 ribcage383 id402 label403) (parse385 (cdr body386) (cons id402 ids387) (cons label403 labels388) (cons var404 vars389) (cons (cons er394 (wrap139 e397 w398 mod400)) vals390) (cons (cons (quote lexical) var404) bindings391))))) (if (memv t401 (quote (define-syntax-form))) (let ((id405 (wrap139 value396 w398 mod400)) (label406 (gen-label116))) (begin (extend-ribcage!127 ribcage383 id405 label406) (parse385 (cdr body386) (cons id405 ids387) (cons label406 labels388) vars389 vals390 (cons (cons (quote macro) (cons er394 (wrap139 e397 w398 mod400))) bindings391)))) (if (memv t401 (quote (begin-form))) ((lambda (tmp407) ((lambda (tmp408) (if tmp408 (apply (lambda (_409 e1410) (parse385 (letrec ((f411 (lambda (forms412) (if (null? forms412) (cdr body386) (cons (cons er394 (wrap139 (car forms412) w398 mod400)) (f411 (cdr forms412))))))) (f411 e1410)) ids387 labels388 vars389 vals390 bindings391)) tmp408) (syntax-violation #f "source expression failed to match any pattern" tmp407))) ($sc-dispatch tmp407 (quote (any . each-any))))) e397) (if (memv t401 (quote (local-syntax-form))) (chi-local-syntax153 value396 e397 er394 w398 s399 mod400 (lambda (forms414 er415 w416 s417 mod418) (parse385 (letrec ((f419 (lambda (forms420) (if (null? forms420) (cdr body386) (cons (cons er415 (wrap139 (car forms420) w416 mod418)) (f419 (cdr forms420))))))) (f419 forms414)) ids387 labels388 vars389 vals390 bindings391))) (if (null? ids387) (build-sequence90 #f (map (lambda (x421) (chi147 (cdr x421) (car x421) (quote (())) mod400)) (cons (cons er394 (source-wrap140 e397 w398 s399 mod400)) (cdr body386)))) (begin (if (not (valid-bound-ids?136 ids387)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form378)) (letrec ((loop422 (lambda (bs423 er-cache424 r-cache425) (if (not (null? bs423)) (let ((b426 (car bs423))) (if (eq? (car b426) (quote macro)) (let ((er427 (cadr b426))) (let ((r-cache428 (if (eq? er427 er-cache424) r-cache425 (macros-only-env107 er427)))) (begin (set-cdr! b426 (eval-local-transformer154 (chi147 (cddr b426) r-cache428 (quote (())) mod400) mod400)) (loop422 (cdr bs423) er427 r-cache428)))) (loop422 (cdr bs423) er-cache424 r-cache425))))))) (loop422 bindings391 #f #f)) (set-cdr! r382 (extend-env105 labels388 bindings391 (cdr r382))) (build-letrec93 #f vars389 (map (lambda (x429) (chi147 (cdr x429) (car x429) (quote (())) mod400)) vals390) (build-sequence90 #f (map (lambda (x430) (chi147 (cdr x430) (car x430) (quote (())) mod400)) (cons (cons er394 (source-wrap140 e397 w398 s399 mod400)) (cdr body386))))))))))))))))))) (parse385 (map (lambda (x392) (cons r382 (wrap139 x392 w384 mod381))) body377) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro150 (lambda (p431 e432 r433 w434 rib435 mod436) (letrec ((rebuild-macro-output437 (lambda (x438 m439) (cond ((pair? x438) (cons (rebuild-macro-output437 (car x438) m439) (rebuild-macro-output437 (cdr x438) m439))) ((syntax-object?95 x438) (let ((w440 (syntax-object-wrap97 x438))) (let ((ms441 (wrap-marks114 w440)) (s442 (wrap-subst115 w440))) (if (and (pair? ms441) (eq? (car ms441) #f)) (make-syntax-object94 (syntax-object-expression96 x438) (make-wrap113 (cdr ms441) (if rib435 (cons rib435 (cdr s442)) (cdr s442))) (syntax-object-module98 x438)) (make-syntax-object94 (syntax-object-expression96 x438) (make-wrap113 (cons m439 ms441) (if rib435 (cons rib435 (cons (quote shift) s442)) (cons (quote shift) s442))) (let ((pmod443 (procedure-module p431))) (if pmod443 (cons (quote hygiene) (module-name pmod443)) (quote (hygiene guile))))))))) ((vector? x438) (let ((n444 (vector-length x438))) (let ((v445 (make-vector n444))) (letrec ((doloop446 (lambda (i447) (if (fx=73 i447 n444) v445 (begin (vector-set! v445 i447 (rebuild-macro-output437 (vector-ref x438 i447) m439)) (doloop446 (fx+71 i447 1))))))) (doloop446 0))))) ((symbol? x438) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap140 e432 w434 s mod436) x438)) (else x438))))) (rebuild-macro-output437 (p431 (wrap139 e432 (anti-mark126 w434) mod436)) (string #\m))))) (chi-application149 (lambda (x448 e449 r450 w451 s452 mod453) ((lambda (tmp454) ((lambda (tmp455) (if tmp455 (apply (lambda (e0456 e1457) (build-application79 s452 x448 (map (lambda (e458) (chi147 e458 r450 w451 mod453)) e1457))) tmp455) (syntax-violation #f "source expression failed to match any pattern" tmp454))) ($sc-dispatch tmp454 (quote (any . each-any))))) e449))) (chi-expr148 (lambda (type460 value461 e462 r463 w464 s465 mod466) (let ((t467 type460)) (if (memv t467 (quote (lexical))) (build-lexical-reference81 (quote value) s465 e462 value461) (if (memv t467 (quote (core external-macro))) (value461 e462 r463 w464 s465 mod466) (if (memv t467 (quote (module-ref))) (call-with-values (lambda () (value461 e462)) (lambda (id468 mod469) (build-global-reference84 s465 id468 mod469))) (if (memv t467 (quote (lexical-call))) (chi-application149 (build-lexical-reference81 (quote fun) (source-annotation102 (car e462)) (car e462) value461) e462 r463 w464 s465 mod466) (if (memv t467 (quote (global-call))) (chi-application149 (build-global-reference84 (source-annotation102 (car e462)) value461 (if (syntax-object?95 (car e462)) (syntax-object-module98 (car e462)) mod466)) e462 r463 w464 s465 mod466) (if (memv t467 (quote (constant))) (build-data89 s465 (strip158 (source-wrap140 e462 w464 s465 mod466) (quote (())))) (if (memv t467 (quote (global))) (build-global-reference84 s465 value461 mod466) (if (memv t467 (quote (call))) (chi-application149 (chi147 (car e462) r463 w464 mod466) e462 r463 w464 s465 mod466) (if (memv t467 (quote (begin-form))) ((lambda (tmp470) ((lambda (tmp471) (if tmp471 (apply (lambda (_472 e1473 e2474) (chi-sequence141 (cons e1473 e2474) r463 w464 s465 mod466)) tmp471) (syntax-violation #f "source expression failed to match any pattern" tmp470))) ($sc-dispatch tmp470 (quote (any any . each-any))))) e462) (if (memv t467 (quote (local-syntax-form))) (chi-local-syntax153 value461 e462 r463 w464 s465 mod466 chi-sequence141) (if (memv t467 (quote (eval-when-form))) ((lambda (tmp476) ((lambda (tmp477) (if tmp477 (apply (lambda (_478 x479 e1480 e2481) (let ((when-list482 (chi-when-list144 e462 x479 w464))) (if (memq (quote eval) when-list482) (chi-sequence141 (cons e1480 e2481) r463 w464 s465 mod466) (chi-void155)))) tmp477) (syntax-violation #f "source expression failed to match any pattern" tmp476))) ($sc-dispatch tmp476 (quote (any each-any any . each-any))))) e462) (if (memv t467 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e462 (wrap139 value461 w464 mod466)) (if (memv t467 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap140 e462 w464 s465 mod466)) (if (memv t467 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap140 e462 w464 s465 mod466)) (syntax-violation #f "unexpected syntax" (source-wrap140 e462 w464 s465 mod466))))))))))))))))))) (chi147 (lambda (e485 r486 w487 mod488) (call-with-values (lambda () (syntax-type145 e485 r486 w487 #f #f mod488)) (lambda (type489 value490 e491 w492 s493 mod494) (chi-expr148 type489 value490 e491 r486 w492 s493 mod494))))) (chi-top146 (lambda (e495 r496 w497 m498 esew499 mod500) (call-with-values (lambda () (syntax-type145 e495 r496 w497 #f #f mod500)) (lambda (type508 value509 e510 w511 s512 mod513) (let ((t514 type508)) (if (memv t514 (quote (begin-form))) ((lambda (tmp515) ((lambda (tmp516) (if tmp516 (apply (lambda (_517) (chi-void155)) tmp516) ((lambda (tmp518) (if tmp518 (apply (lambda (_519 e1520 e2521) (chi-top-sequence142 (cons e1520 e2521) r496 w511 s512 m498 esew499 mod513)) tmp518) (syntax-violation #f "source expression failed to match any pattern" tmp515))) ($sc-dispatch tmp515 (quote (any any . each-any)))))) ($sc-dispatch tmp515 (quote (any))))) e510) (if (memv t514 (quote (local-syntax-form))) (chi-local-syntax153 value509 e510 r496 w511 s512 mod513 (lambda (body523 r524 w525 s526 mod527) (chi-top-sequence142 body523 r524 w525 s526 m498 esew499 mod527))) (if (memv t514 (quote (eval-when-form))) ((lambda (tmp528) ((lambda (tmp529) (if tmp529 (apply (lambda (_530 x531 e1532 e2533) (let ((when-list534 (chi-when-list144 e510 x531 w511)) (body535 (cons e1532 e2533))) (cond ((eq? m498 (quote e)) (if (memq (quote eval) when-list534) (chi-top-sequence142 body535 r496 w511 s512 (quote e) (quote (eval)) mod513) (chi-void155))) ((memq (quote load) when-list534) (if (or (memq (quote compile) when-list534) (and (eq? m498 (quote c&e)) (memq (quote eval) when-list534))) (chi-top-sequence142 body535 r496 w511 s512 (quote c&e) (quote (compile load)) mod513) (if (memq m498 (quote (c c&e))) (chi-top-sequence142 body535 r496 w511 s512 (quote c) (quote (load)) mod513) (chi-void155)))) ((or (memq (quote compile) when-list534) (and (eq? m498 (quote c&e)) (memq (quote eval) when-list534))) (top-level-eval-hook75 (chi-top-sequence142 body535 r496 w511 s512 (quote e) (quote (eval)) mod513) mod513) (chi-void155)) (else (chi-void155))))) tmp529) (syntax-violation #f "source expression failed to match any pattern" tmp528))) ($sc-dispatch tmp528 (quote (any each-any any . each-any))))) e510) (if (memv t514 (quote (define-syntax-form))) (let ((n538 (id-var-name133 value509 w511)) (r539 (macros-only-env107 r496))) (let ((t540 m498)) (if (memv t540 (quote (c))) (if (memq (quote compile) esew499) (let ((e541 (chi-install-global143 n538 (chi147 e510 r539 w511 mod513)))) (begin (top-level-eval-hook75 e541 mod513) (if (memq (quote load) esew499) e541 (chi-void155)))) (if (memq (quote load) esew499) (chi-install-global143 n538 (chi147 e510 r539 w511 mod513)) (chi-void155))) (if (memv t540 (quote (c&e))) (let ((e542 (chi-install-global143 n538 (chi147 e510 r539 w511 mod513)))) (begin (top-level-eval-hook75 e542 mod513) e542)) (begin (if (memq (quote eval) esew499) (top-level-eval-hook75 (chi-install-global143 n538 (chi147 e510 r539 w511 mod513)) mod513)) (chi-void155)))))) (if (memv t514 (quote (define-form))) (let ((n543 (id-var-name133 value509 w511))) (let ((type544 (binding-type103 (lookup108 n543 r496 mod513)))) (let ((t545 type544)) (if (memv t545 (quote (global core macro module-ref))) (let ((x546 (build-global-definition86 s512 n543 (chi147 e510 r496 w511 mod513)))) (begin (if (eq? m498 (quote c&e)) (top-level-eval-hook75 x546 mod513)) x546)) (if (memv t545 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e510 (wrap139 value509 w511 mod513)) (syntax-violation #f "cannot define keyword at top level" e510 (wrap139 value509 w511 mod513))))))) (let ((x547 (chi-expr148 type508 value509 e510 r496 w511 s512 mod513))) (begin (if (eq? m498 (quote c&e)) (top-level-eval-hook75 x547 mod513)) x547)))))))))))) (syntax-type145 (lambda (e548 r549 w550 s551 rib552 mod553) (cond ((symbol? e548) (let ((n554 (id-var-name133 e548 w550))) (let ((b555 (lookup108 n554 r549 mod553))) (let ((type556 (binding-type103 b555))) (let ((t557 type556)) (if (memv t557 (quote (lexical))) (values type556 (binding-value104 b555) e548 w550 s551 mod553) (if (memv t557 (quote (global))) (values type556 n554 e548 w550 s551 mod553) (if (memv t557 (quote (macro))) (syntax-type145 (chi-macro150 (binding-value104 b555) e548 r549 w550 rib552 mod553) r549 (quote (())) s551 rib552 mod553) (values type556 (binding-value104 b555) e548 w550 s551 mod553))))))))) ((pair? e548) (let ((first558 (car e548))) (if (id?111 first558) (let ((n559 (id-var-name133 first558 w550))) (let ((b560 (lookup108 n559 r549 (or (and (syntax-object?95 first558) (syntax-object-module98 first558)) mod553)))) (let ((type561 (binding-type103 b560))) (let ((t562 type561)) (if (memv t562 (quote (lexical))) (values (quote lexical-call) (binding-value104 b560) e548 w550 s551 mod553) (if (memv t562 (quote (global))) (values (quote global-call) n559 e548 w550 s551 mod553) (if (memv t562 (quote (macro))) (syntax-type145 (chi-macro150 (binding-value104 b560) e548 r549 w550 rib552 mod553) r549 (quote (())) s551 rib552 mod553) (if (memv t562 (quote (core external-macro module-ref))) (values type561 (binding-value104 b560) e548 w550 s551 mod553) (if (memv t562 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value104 b560) e548 w550 s551 mod553) (if (memv t562 (quote (begin))) (values (quote begin-form) #f e548 w550 s551 mod553) (if (memv t562 (quote (eval-when))) (values (quote eval-when-form) #f e548 w550 s551 mod553) (if (memv t562 (quote (define))) ((lambda (tmp563) ((lambda (tmp564) (if (if tmp564 (apply (lambda (_565 name566 val567) (id?111 name566)) tmp564) #f) (apply (lambda (_568 name569 val570) (values (quote define-form) name569 val570 w550 s551 mod553)) tmp564) ((lambda (tmp571) (if (if tmp571 (apply (lambda (_572 name573 args574 e1575 e2576) (and (id?111 name573) (valid-bound-ids?136 (lambda-var-list160 args574)))) tmp571) #f) (apply (lambda (_577 name578 args579 e1580 e2581) (values (quote define-form) (wrap139 name578 w550 mod553) (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 args579 (cons e1580 e2581)) w550 mod553)) (quote (())) s551 mod553)) tmp571) ((lambda (tmp583) (if (if tmp583 (apply (lambda (_584 name585) (id?111 name585)) tmp583) #f) (apply (lambda (_586 name587) (values (quote define-form) (wrap139 name587 w550 mod553) (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 (())) s551 mod553)) tmp583) (syntax-violation #f "source expression failed to match any pattern" tmp563))) ($sc-dispatch tmp563 (quote (any any)))))) ($sc-dispatch tmp563 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp563 (quote (any any any))))) e548) (if (memv t562 (quote (define-syntax))) ((lambda (tmp588) ((lambda (tmp589) (if (if tmp589 (apply (lambda (_590 name591 val592) (id?111 name591)) tmp589) #f) (apply (lambda (_593 name594 val595) (values (quote define-syntax-form) name594 val595 w550 s551 mod553)) tmp589) (syntax-violation #f "source expression failed to match any pattern" tmp588))) ($sc-dispatch tmp588 (quote (any any any))))) e548) (values (quote call) #f e548 w550 s551 mod553)))))))))))))) (values (quote call) #f e548 w550 s551 mod553)))) ((syntax-object?95 e548) (syntax-type145 (syntax-object-expression96 e548) r549 (join-wraps130 w550 (syntax-object-wrap97 e548)) #f rib552 (or (syntax-object-module98 e548) mod553))) ((annotation? e548) (syntax-type145 (annotation-expression e548) r549 w550 (annotation-source e548) rib552 mod553)) ((self-evaluating? e548) (values (quote constant) #f e548 w550 s551 mod553)) (else (values (quote other) #f e548 w550 s551 mod553))))) (chi-when-list144 (lambda (e596 when-list597 w598) (letrec ((f599 (lambda (when-list600 situations601) (if (null? when-list600) situations601 (f599 (cdr when-list600) (cons (let ((x602 (car when-list600))) (cond ((free-id=?134 x602 (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 x602 (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 x602 (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" e596 (wrap139 x602 w598 #f))))) situations601)))))) (f599 when-list597 (quote ()))))) (chi-install-global143 (lambda (name603 e604) (build-global-definition86 #f name603 (if (let ((v605 (module-variable (current-module) name603))) (and v605 (variable-bound? v605) (macro? (variable-ref v605)) (not (eq? (macro-type (variable-ref v605)) (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 name603))) (build-data89 #f (quote macro)) e604)) (build-application79 #f (build-primref88 #f (quote make-syncase-macro)) (list (build-data89 #f (quote macro)) e604)))))) (chi-top-sequence142 (lambda (body606 r607 w608 s609 m610 esew611 mod612) (build-sequence90 s609 (letrec ((dobody613 (lambda (body614 r615 w616 m617 esew618 mod619) (if (null? body614) (quote ()) (let ((first620 (chi-top146 (car body614) r615 w616 m617 esew618 mod619))) (cons first620 (dobody613 (cdr body614) r615 w616 m617 esew618 mod619))))))) (dobody613 body606 r607 w608 m610 esew611 mod612))))) (chi-sequence141 (lambda (body621 r622 w623 s624 mod625) (build-sequence90 s624 (letrec ((dobody626 (lambda (body627 r628 w629 mod630) (if (null? body627) (quote ()) (let ((first631 (chi147 (car body627) r628 w629 mod630))) (cons first631 (dobody626 (cdr body627) r628 w629 mod630))))))) (dobody626 body621 r622 w623 mod625))))) (source-wrap140 (lambda (x632 w633 s634 defmod635) (wrap139 (if s634 (make-annotation x632 s634 #f) x632) w633 defmod635))) (wrap139 (lambda (x636 w637 defmod638) (cond ((and (null? (wrap-marks114 w637)) (null? (wrap-subst115 w637))) x636) ((syntax-object?95 x636) (make-syntax-object94 (syntax-object-expression96 x636) (join-wraps130 w637 (syntax-object-wrap97 x636)) (syntax-object-module98 x636))) ((null? x636) x636) (else (make-syntax-object94 x636 w637 defmod638))))) (bound-id-member?138 (lambda (x639 list640) (and (not (null? list640)) (or (bound-id=?135 x639 (car list640)) (bound-id-member?138 x639 (cdr list640)))))) (distinct-bound-ids?137 (lambda (ids641) (letrec ((distinct?642 (lambda (ids643) (or (null? ids643) (and (not (bound-id-member?138 (car ids643) (cdr ids643))) (distinct?642 (cdr ids643))))))) (distinct?642 ids641)))) (valid-bound-ids?136 (lambda (ids644) (and (letrec ((all-ids?645 (lambda (ids646) (or (null? ids646) (and (id?111 (car ids646)) (all-ids?645 (cdr ids646))))))) (all-ids?645 ids644)) (distinct-bound-ids?137 ids644)))) (bound-id=?135 (lambda (i647 j648) (if (and (syntax-object?95 i647) (syntax-object?95 j648)) (and (eq? (let ((e649 (syntax-object-expression96 i647))) (if (annotation? e649) (annotation-expression e649) e649)) (let ((e650 (syntax-object-expression96 j648))) (if (annotation? e650) (annotation-expression e650) e650))) (same-marks?132 (wrap-marks114 (syntax-object-wrap97 i647)) (wrap-marks114 (syntax-object-wrap97 j648)))) (eq? (let ((e651 i647)) (if (annotation? e651) (annotation-expression e651) e651)) (let ((e652 j648)) (if (annotation? e652) (annotation-expression e652) e652)))))) (free-id=?134 (lambda (i653 j654) (and (eq? (let ((x655 i653)) (let ((e656 (if (syntax-object?95 x655) (syntax-object-expression96 x655) x655))) (if (annotation? e656) (annotation-expression e656) e656))) (let ((x657 j654)) (let ((e658 (if (syntax-object?95 x657) (syntax-object-expression96 x657) x657))) (if (annotation? e658) (annotation-expression e658) e658)))) (eq? (id-var-name133 i653 (quote (()))) (id-var-name133 j654 (quote (()))))))) (id-var-name133 (lambda (id659 w660) (letrec ((search-vector-rib663 (lambda (sym669 subst670 marks671 symnames672 ribcage673) (let ((n674 (vector-length symnames672))) (letrec ((f675 (lambda (i676) (cond ((fx=73 i676 n674) (search661 sym669 (cdr subst670) marks671)) ((and (eq? (vector-ref symnames672 i676) sym669) (same-marks?132 marks671 (vector-ref (ribcage-marks121 ribcage673) i676))) (values (vector-ref (ribcage-labels122 ribcage673) i676) marks671)) (else (f675 (fx+71 i676 1))))))) (f675 0))))) (search-list-rib662 (lambda (sym677 subst678 marks679 symnames680 ribcage681) (letrec ((f682 (lambda (symnames683 i684) (cond ((null? symnames683) (search661 sym677 (cdr subst678) marks679)) ((and (eq? (car symnames683) sym677) (same-marks?132 marks679 (list-ref (ribcage-marks121 ribcage681) i684))) (values (list-ref (ribcage-labels122 ribcage681) i684) marks679)) (else (f682 (cdr symnames683) (fx+71 i684 1))))))) (f682 symnames680 0)))) (search661 (lambda (sym685 subst686 marks687) (if (null? subst686) (values #f marks687) (let ((fst688 (car subst686))) (if (eq? fst688 (quote shift)) (search661 sym685 (cdr subst686) (cdr marks687)) (let ((symnames689 (ribcage-symnames120 fst688))) (if (vector? symnames689) (search-vector-rib663 sym685 subst686 marks687 symnames689 fst688) (search-list-rib662 sym685 subst686 marks687 symnames689 fst688))))))))) (cond ((symbol? id659) (or (call-with-values (lambda () (search661 id659 (wrap-subst115 w660) (wrap-marks114 w660))) (lambda (x691 . ignore690) x691)) id659)) ((syntax-object?95 id659) (let ((id692 (let ((e694 (syntax-object-expression96 id659))) (if (annotation? e694) (annotation-expression e694) e694))) (w1693 (syntax-object-wrap97 id659))) (let ((marks695 (join-marks131 (wrap-marks114 w660) (wrap-marks114 w1693)))) (call-with-values (lambda () (search661 id692 (wrap-subst115 w660) marks695)) (lambda (new-id696 marks697) (or new-id696 (call-with-values (lambda () (search661 id692 (wrap-subst115 w1693) marks697)) (lambda (x699 . ignore698) x699)) id692)))))) ((annotation? id659) (let ((id700 (let ((e701 id659)) (if (annotation? e701) (annotation-expression e701) e701)))) (or (call-with-values (lambda () (search661 id700 (wrap-subst115 w660) (wrap-marks114 w660))) (lambda (x703 . ignore702) x703)) id700))) (else (syntax-violation (quote id-var-name) "invalid id" id659)))))) (same-marks?132 (lambda (x704 y705) (or (eq? x704 y705) (and (not (null? x704)) (not (null? y705)) (eq? (car x704) (car y705)) (same-marks?132 (cdr x704) (cdr y705)))))) (join-marks131 (lambda (m1706 m2707) (smart-append129 m1706 m2707))) (join-wraps130 (lambda (w1708 w2709) (let ((m1710 (wrap-marks114 w1708)) (s1711 (wrap-subst115 w1708))) (if (null? m1710) (if (null? s1711) w2709 (make-wrap113 (wrap-marks114 w2709) (smart-append129 s1711 (wrap-subst115 w2709)))) (make-wrap113 (smart-append129 m1710 (wrap-marks114 w2709)) (smart-append129 s1711 (wrap-subst115 w2709))))))) (smart-append129 (lambda (m1712 m2713) (if (null? m2713) m1712 (append m1712 m2713)))) (make-binding-wrap128 (lambda (ids714 labels715 w716) (if (null? ids714) w716 (make-wrap113 (wrap-marks114 w716) (cons (let ((labelvec717 (list->vector labels715))) (let ((n718 (vector-length labelvec717))) (let ((symnamevec719 (make-vector n718)) (marksvec720 (make-vector n718))) (begin (letrec ((f721 (lambda (ids722 i723) (if (not (null? ids722)) (call-with-values (lambda () (id-sym-name&marks112 (car ids722) w716)) (lambda (symname724 marks725) (begin (vector-set! symnamevec719 i723 symname724) (vector-set! marksvec720 i723 marks725) (f721 (cdr ids722) (fx+71 i723 1))))))))) (f721 ids714 0)) (make-ribcage118 symnamevec719 marksvec720 labelvec717))))) (wrap-subst115 w716)))))) (extend-ribcage!127 (lambda (ribcage726 id727 label728) (begin (set-ribcage-symnames!123 ribcage726 (cons (let ((e729 (syntax-object-expression96 id727))) (if (annotation? e729) (annotation-expression e729) e729)) (ribcage-symnames120 ribcage726))) (set-ribcage-marks!124 ribcage726 (cons (wrap-marks114 (syntax-object-wrap97 id727)) (ribcage-marks121 ribcage726))) (set-ribcage-labels!125 ribcage726 (cons label728 (ribcage-labels122 ribcage726)))))) (anti-mark126 (lambda (w730) (make-wrap113 (cons #f (wrap-marks114 w730)) (cons (quote shift) (wrap-subst115 w730))))) (set-ribcage-labels!125 (lambda (x731 update732) (vector-set! x731 3 update732))) (set-ribcage-marks!124 (lambda (x733 update734) (vector-set! x733 2 update734))) (set-ribcage-symnames!123 (lambda (x735 update736) (vector-set! x735 1 update736))) (ribcage-labels122 (lambda (x737) (vector-ref x737 3))) (ribcage-marks121 (lambda (x738) (vector-ref x738 2))) (ribcage-symnames120 (lambda (x739) (vector-ref x739 1))) (ribcage?119 (lambda (x740) (and (vector? x740) (= (vector-length x740) 4) (eq? (vector-ref x740 0) (quote ribcage))))) (make-ribcage118 (lambda (symnames741 marks742 labels743) (vector (quote ribcage) symnames741 marks742 labels743))) (gen-labels117 (lambda (ls744) (if (null? ls744) (quote ()) (cons (gen-label116) (gen-labels117 (cdr ls744)))))) (gen-label116 (lambda () (string #\i))) (wrap-subst115 cdr) (wrap-marks114 car) (make-wrap113 cons) (id-sym-name&marks112 (lambda (x745 w746) (if (syntax-object?95 x745) (values (let ((e747 (syntax-object-expression96 x745))) (if (annotation? e747) (annotation-expression e747) e747)) (join-marks131 (wrap-marks114 w746) (wrap-marks114 (syntax-object-wrap97 x745)))) (values (let ((e748 x745)) (if (annotation? e748) (annotation-expression e748) e748)) (wrap-marks114 w746))))) (id?111 (lambda (x749) (cond ((symbol? x749) #t) ((syntax-object?95 x749) (symbol? (let ((e750 (syntax-object-expression96 x749))) (if (annotation? e750) (annotation-expression e750) e750)))) ((annotation? x749) (symbol? (annotation-expression x749))) (else #f)))) (nonsymbol-id?110 (lambda (x751) (and (syntax-object?95 x751) (symbol? (let ((e752 (syntax-object-expression96 x751))) (if (annotation? e752) (annotation-expression e752) e752)))))) (global-extend109 (lambda (type753 sym754 val755) (put-global-definition-hook77 sym754 type753 val755))) (lookup108 (lambda (x756 r757 mod758) (cond ((assq x756 r757) => cdr) ((symbol? x756) (or (get-global-definition-hook78 x756 mod758) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env107 (lambda (r759) (if (null? r759) (quote ()) (let ((a760 (car r759))) (if (eq? (cadr a760) (quote macro)) (cons a760 (macros-only-env107 (cdr r759))) (macros-only-env107 (cdr r759))))))) (extend-var-env106 (lambda (labels761 vars762 r763) (if (null? labels761) r763 (extend-var-env106 (cdr labels761) (cdr vars762) (cons (cons (car labels761) (cons (quote lexical) (car vars762))) r763))))) (extend-env105 (lambda (labels764 bindings765 r766) (if (null? labels764) r766 (extend-env105 (cdr labels764) (cdr bindings765) (cons (cons (car labels764) (car bindings765)) r766))))) (binding-value104 cdr) (binding-type103 car) (source-annotation102 (lambda (x767) (cond ((annotation? x767) (annotation-source x767)) ((syntax-object?95 x767) (source-annotation102 (syntax-object-expression96 x767))) (else #f)))) (set-syntax-object-module!101 (lambda (x768 update769) (vector-set! x768 3 update769))) (set-syntax-object-wrap!100 (lambda (x770 update771) (vector-set! x770 2 update771))) (set-syntax-object-expression!99 (lambda (x772 update773) (vector-set! x772 1 update773))) (syntax-object-module98 (lambda (x774) (vector-ref x774 3))) (syntax-object-wrap97 (lambda (x775) (vector-ref x775 2))) (syntax-object-expression96 (lambda (x776) (vector-ref x776 1))) (syntax-object?95 (lambda (x777) (and (vector? x777) (= (vector-length x777) 4) (eq? (vector-ref x777 0) (quote syntax-object))))) (make-syntax-object94 (lambda (expression778 wrap779 module780) (vector (quote syntax-object) expression778 wrap779 module780))) (build-letrec93 (lambda (src781 vars782 val-exps783 body-exp784) (if (null? vars782) body-exp784 (let ((t785 (fluid-ref *mode*70))) (if (memv t785 (quote (c))) ((@ (language tree-il) make-letrec) src781 vars782 val-exps783 body-exp784) (list (quote letrec) (map list vars782 val-exps783) body-exp784)))))) (build-named-let92 (lambda (src786 vars787 val-exps788 body-exp789) (let ((f790 (car vars787)) (vars791 (cdr vars787))) (let ((t792 (fluid-ref *mode*70))) (if (memv t792 (quote (c))) ((@ (language tree-il) make-letrec) src786 (list f790) (list (build-lambda87 src786 vars791 #f body-exp789)) (build-application79 src786 (build-lexical-reference81 (quote fun) src786 f790 f790) val-exps788)) (list (quote let) f790 (map list vars791 val-exps788) body-exp789)))))) (build-let91 (lambda (src793 vars794 val-exps795 body-exp796) (if (null? vars794) body-exp796 (let ((t797 (fluid-ref *mode*70))) (if (memv t797 (quote (c))) ((@ (language tree-il) make-let) src793 vars794 val-exps795 body-exp796) (list (quote let) (map list vars794 val-exps795) body-exp796)))))) (build-sequence90 (lambda (src798 exps799) (if (null? (cdr exps799)) (car exps799) (let ((t800 (fluid-ref *mode*70))) (if (memv t800 (quote (c))) ((@ (language tree-il) make-sequence) src798 exps799) (cons (quote begin) exps799)))))) (build-data89 (lambda (src801 exp802) (let ((t803 (fluid-ref *mode*70))) (if (memv t803 (quote (c))) ((@ (language tree-il) make-const) src801 exp802) (if (and (self-evaluating? exp802) (not (vector? exp802))) exp802 (list (quote quote) exp802)))))) (build-primref88 (lambda (src804 name805) (let ((t806 (fluid-ref *mode*70))) (if (memv t806 (quote (c))) ((@ (language tree-il) make-primitive-ref) src804 name805) (build-global-reference84 src804 name805 (quote (hygiene guile))))))) (build-lambda87 (lambda (src807 vars808 docstring809 exp810) (let ((t811 (fluid-ref *mode*70))) (if (memv t811 (quote (c))) ((@ (language tree-il) make-lambda) src807 vars808 (if docstring809 (list (cons (quote documentation) docstring809)) (quote ())) exp810) (cons (quote lambda) (cons vars808 (append (if docstring809 (list docstring809) (quote ())) (list exp810)))))))) (build-global-definition86 (lambda (source812 var813 exp814) (let ((t815 (fluid-ref *mode*70))) (if (memv t815 (quote (c))) ((@ (language tree-il) make-toplevel-define) source812 var813 exp814) (list (quote define) var813 exp814))))) (build-global-assignment85 (lambda (source816 var817 exp818 mod819) (analyze-variable83 mod819 var817 (lambda (mod820 var821 public?822) (let ((t823 (fluid-ref *mode*70))) (if (memv t823 (quote (c))) ((@ (language tree-il) make-module-set) source816 mod820 var821 public?822 exp818) (list (quote set!) (list (if public?822 (quote @) (quote @@)) mod820 var821) exp818)))) (lambda (var824) (let ((t825 (fluid-ref *mode*70))) (if (memv t825 (quote (c))) ((@ (language tree-il) make-toplevel-set) source816 var824 exp818) (list (quote set!) var824 exp818))))))) (build-global-reference84 (lambda (source826 var827 mod828) (analyze-variable83 mod828 var827 (lambda (mod829 var830 public?831) (let ((t832 (fluid-ref *mode*70))) (if (memv t832 (quote (c))) ((@ (language tree-il) make-module-ref) source826 mod829 var830 public?831) (list (if public?831 (quote @) (quote @@)) mod829 var830)))) (lambda (var833) (let ((t834 (fluid-ref *mode*70))) (if (memv t834 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source826 var833) var833)))))) (analyze-variable83 (lambda (mod835 var836 modref-cont837 bare-cont838) (if (not mod835) (bare-cont838 var836) (let ((kind839 (car mod835)) (mod840 (cdr mod835))) (let ((t841 kind839)) (if (memv t841 (quote (public))) (modref-cont837 mod840 var836 #t) (if (memv t841 (quote (private))) (if (not (equal? mod840 (module-name (current-module)))) (modref-cont837 mod840 var836 #f) (bare-cont838 var836)) (if (memv t841 (quote (bare))) (bare-cont838 var836) (if (memv t841 (quote (hygiene))) (if (and (not (equal? mod840 (module-name (current-module)))) (module-variable (resolve-module mod840) var836)) (modref-cont837 mod840 var836 #f) (bare-cont838 var836)) (syntax-violation #f "bad module kind" var836 mod840)))))))))) (build-lexical-assignment82 (lambda (source842 name843 var844 exp845) (let ((t846 (fluid-ref *mode*70))) (if (memv t846 (quote (c))) ((@ (language tree-il) make-lexical-set) source842 name843 var844 exp845) (list (quote set!) var844 exp845))))) (build-lexical-reference81 (lambda (type847 source848 name849 var850) (let ((t851 (fluid-ref *mode*70))) (if (memv t851 (quote (c))) ((@ (language tree-il) make-lexical-ref) source848 name849 var850) var850)))) (build-conditional80 (lambda (source852 test-exp853 then-exp854 else-exp855) (let ((t856 (fluid-ref *mode*70))) (if (memv t856 (quote (c))) ((@ (language tree-il) make-conditional) source852 test-exp853 then-exp854 else-exp855) (list (quote if) test-exp853 then-exp854 else-exp855))))) (build-application79 (lambda (source857 fun-exp858 arg-exps859) (let ((t860 (fluid-ref *mode*70))) (if (memv t860 (quote (c))) ((@ (language tree-il) make-application) source857 fun-exp858 arg-exps859) (cons fun-exp858 arg-exps859))))) (get-global-definition-hook78 (lambda (symbol861 module862) (begin (if (and (not module862) (current-module)) (warn "module system is booted, we should have a module" symbol861)) (let ((v863 (module-variable (if module862 (resolve-module (cdr module862)) (current-module)) symbol861))) (and v863 (variable-bound? v863) (let ((val864 (variable-ref v863))) (and (macro? val864) (syncase-macro-type val864) (cons (syncase-macro-type val864) (syncase-macro-binding val864))))))))) (put-global-definition-hook77 (lambda (symbol865 type866 val867) (let ((existing868 (let ((v869 (module-variable (current-module) symbol865))) (and v869 (variable-bound? v869) (let ((val870 (variable-ref v869))) (and (macro? val870) (not (syncase-macro-type val870)) val870)))))) (module-define! (current-module) symbol865 (if existing868 (make-extended-syncase-macro existing868 type866 val867) (make-syncase-macro type866 val867)))))) (local-eval-hook76 (lambda (x871 mod872) (primitive-eval (list noexpand69 (let ((t873 (fluid-ref *mode*70))) (if (memv t873 (quote (c))) ((@ (language tree-il) tree-il->scheme) x871) x871)))))) (top-level-eval-hook75 (lambda (x874 mod875) (primitive-eval (list noexpand69 (let ((t876 (fluid-ref *mode*70))) (if (memv t876 (quote (c))) ((@ (language tree-il) tree-il->scheme) x874) x874)))))) (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 (e877 r878 w879 s880 mod881) ((lambda (tmp882) ((lambda (tmp883) (if (if tmp883 (apply (lambda (_884 var885 val886 e1887 e2888) (valid-bound-ids?136 var885)) tmp883) #f) (apply (lambda (_890 var891 val892 e1893 e2894) (let ((names895 (map (lambda (x896) (id-var-name133 x896 w879)) var891))) (begin (for-each (lambda (id898 n899) (let ((t900 (binding-type103 (lookup108 n899 r878 mod881)))) (if (memv t900 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e877 (source-wrap140 id898 w879 s880 mod881))))) var891 names895) (chi-body151 (cons e1893 e2894) (source-wrap140 e877 w879 s880 mod881) (extend-env105 names895 (let ((trans-r903 (macros-only-env107 r878))) (map (lambda (x904) (cons (quote macro) (eval-local-transformer154 (chi147 x904 trans-r903 w879 mod881) mod881))) val892)) r878) w879 mod881)))) tmp883) ((lambda (_906) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap140 e877 w879 s880 mod881))) tmp882))) ($sc-dispatch tmp882 (quote (any #(each (any any)) any . each-any))))) e877))) (global-extend109 (quote core) (quote quote) (lambda (e907 r908 w909 s910 mod911) ((lambda (tmp912) ((lambda (tmp913) (if tmp913 (apply (lambda (_914 e915) (build-data89 s910 (strip158 e915 w909))) tmp913) ((lambda (_916) (syntax-violation (quote quote) "bad syntax" (source-wrap140 e907 w909 s910 mod911))) tmp912))) ($sc-dispatch tmp912 (quote (any any))))) e907))) (global-extend109 (quote core) (quote syntax) (letrec ((regen924 (lambda (x925) (let ((t926 (car x925))) (if (memv t926 (quote (ref))) (build-lexical-reference81 (quote value) #f (cadr x925) (cadr x925)) (if (memv t926 (quote (primitive))) (build-primref88 #f (cadr x925)) (if (memv t926 (quote (quote))) (build-data89 #f (cadr x925)) (if (memv t926 (quote (lambda))) (build-lambda87 #f (cadr x925) #f (regen924 (caddr x925))) (if (memv t926 (quote (map))) (let ((ls927 (map regen924 (cdr x925)))) (build-application79 #f (build-primref88 #f (quote map)) ls927)) (build-application79 #f (build-primref88 #f (car x925)) (map regen924 (cdr x925))))))))))) (gen-vector923 (lambda (x928) (cond ((eq? (car x928) (quote list)) (cons (quote vector) (cdr x928))) ((eq? (car x928) (quote quote)) (list (quote quote) (list->vector (cadr x928)))) (else (list (quote list->vector) x928))))) (gen-append922 (lambda (x929 y930) (if (equal? y930 (quote (quote ()))) x929 (list (quote append) x929 y930)))) (gen-cons921 (lambda (x931 y932) (let ((t933 (car y932))) (if (memv t933 (quote (quote))) (if (eq? (car x931) (quote quote)) (list (quote quote) (cons (cadr x931) (cadr y932))) (if (eq? (cadr y932) (quote ())) (list (quote list) x931) (list (quote cons) x931 y932))) (if (memv t933 (quote (list))) (cons (quote list) (cons x931 (cdr y932))) (list (quote cons) x931 y932)))))) (gen-map920 (lambda (e934 map-env935) (let ((formals936 (map cdr map-env935)) (actuals937 (map (lambda (x938) (list (quote ref) (car x938))) map-env935))) (cond ((eq? (car e934) (quote ref)) (car actuals937)) ((and-map (lambda (x939) (and (eq? (car x939) (quote ref)) (memq (cadr x939) formals936))) (cdr e934)) (cons (quote map) (cons (list (quote primitive) (car e934)) (map (let ((r940 (map cons formals936 actuals937))) (lambda (x941) (cdr (assq (cadr x941) r940)))) (cdr e934))))) (else (cons (quote map) (cons (list (quote lambda) formals936 e934) actuals937))))))) (gen-mappend919 (lambda (e942 map-env943) (list (quote apply) (quote (primitive append)) (gen-map920 e942 map-env943)))) (gen-ref918 (lambda (src944 var945 level946 maps947) (if (fx=73 level946 0) (values var945 maps947) (if (null? maps947) (syntax-violation (quote syntax) "missing ellipsis" src944) (call-with-values (lambda () (gen-ref918 src944 var945 (fx-72 level946 1) (cdr maps947))) (lambda (outer-var948 outer-maps949) (let ((b950 (assq outer-var948 (car maps947)))) (if b950 (values (cdr b950) maps947) (let ((inner-var951 (gen-var159 (quote tmp)))) (values inner-var951 (cons (cons (cons outer-var948 inner-var951) (car maps947)) outer-maps949))))))))))) (gen-syntax917 (lambda (src952 e953 r954 maps955 ellipsis?956 mod957) (if (id?111 e953) (let ((label958 (id-var-name133 e953 (quote (()))))) (let ((b959 (lookup108 label958 r954 mod957))) (if (eq? (binding-type103 b959) (quote syntax)) (call-with-values (lambda () (let ((var.lev960 (binding-value104 b959))) (gen-ref918 src952 (car var.lev960) (cdr var.lev960) maps955))) (lambda (var961 maps962) (values (list (quote ref) var961) maps962))) (if (ellipsis?956 e953) (syntax-violation (quote syntax) "misplaced ellipsis" src952) (values (list (quote quote) e953) maps955))))) ((lambda (tmp963) ((lambda (tmp964) (if (if tmp964 (apply (lambda (dots965 e966) (ellipsis?956 dots965)) tmp964) #f) (apply (lambda (dots967 e968) (gen-syntax917 src952 e968 r954 maps955 (lambda (x969) #f) mod957)) tmp964) ((lambda (tmp970) (if (if tmp970 (apply (lambda (x971 dots972 y973) (ellipsis?956 dots972)) tmp970) #f) (apply (lambda (x974 dots975 y976) (letrec ((f977 (lambda (y978 k979) ((lambda (tmp983) ((lambda (tmp984) (if (if tmp984 (apply (lambda (dots985 y986) (ellipsis?956 dots985)) tmp984) #f) (apply (lambda (dots987 y988) (f977 y988 (lambda (maps989) (call-with-values (lambda () (k979 (cons (quote ()) maps989))) (lambda (x990 maps991) (if (null? (car maps991)) (syntax-violation (quote syntax) "extra ellipsis" src952) (values (gen-mappend919 x990 (car maps991)) (cdr maps991)))))))) tmp984) ((lambda (_992) (call-with-values (lambda () (gen-syntax917 src952 y978 r954 maps955 ellipsis?956 mod957)) (lambda (y993 maps994) (call-with-values (lambda () (k979 maps994)) (lambda (x995 maps996) (values (gen-append922 x995 y993) maps996)))))) tmp983))) ($sc-dispatch tmp983 (quote (any . any))))) y978)))) (f977 y976 (lambda (maps980) (call-with-values (lambda () (gen-syntax917 src952 x974 r954 (cons (quote ()) maps980) ellipsis?956 mod957)) (lambda (x981 maps982) (if (null? (car maps982)) (syntax-violation (quote syntax) "extra ellipsis" src952) (values (gen-map920 x981 (car maps982)) (cdr maps982))))))))) tmp970) ((lambda (tmp997) (if tmp997 (apply (lambda (x998 y999) (call-with-values (lambda () (gen-syntax917 src952 x998 r954 maps955 ellipsis?956 mod957)) (lambda (x1000 maps1001) (call-with-values (lambda () (gen-syntax917 src952 y999 r954 maps1001 ellipsis?956 mod957)) (lambda (y1002 maps1003) (values (gen-cons921 x1000 y1002) maps1003)))))) tmp997) ((lambda (tmp1004) (if tmp1004 (apply (lambda (e11005 e21006) (call-with-values (lambda () (gen-syntax917 src952 (cons e11005 e21006) r954 maps955 ellipsis?956 mod957)) (lambda (e1008 maps1009) (values (gen-vector923 e1008) maps1009)))) tmp1004) ((lambda (_1010) (values (list (quote quote) e953) maps955)) tmp963))) ($sc-dispatch tmp963 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp963 (quote (any . any)))))) ($sc-dispatch tmp963 (quote (any any . any)))))) ($sc-dispatch tmp963 (quote (any any))))) e953))))) (lambda (e1011 r1012 w1013 s1014 mod1015) (let ((e1016 (source-wrap140 e1011 w1013 s1014 mod1015))) ((lambda (tmp1017) ((lambda (tmp1018) (if tmp1018 (apply (lambda (_1019 x1020) (call-with-values (lambda () (gen-syntax917 e1016 x1020 r1012 (quote ()) ellipsis?156 mod1015)) (lambda (e1021 maps1022) (regen924 e1021)))) tmp1018) ((lambda (_1023) (syntax-violation (quote syntax) "bad `syntax' form" e1016)) tmp1017))) ($sc-dispatch tmp1017 (quote (any any))))) e1016))))) (global-extend109 (quote core) (quote lambda) (lambda (e1024 r1025 w1026 s1027 mod1028) ((lambda (tmp1029) ((lambda (tmp1030) (if tmp1030 (apply (lambda (_1031 c1032) (chi-lambda-clause152 (source-wrap140 e1024 w1026 s1027 mod1028) #f c1032 r1025 w1026 mod1028 (lambda (vars1033 docstring1034 body1035) (build-lambda87 s1027 vars1033 docstring1034 body1035)))) tmp1030) (syntax-violation #f "source expression failed to match any pattern" tmp1029))) ($sc-dispatch tmp1029 (quote (any . any))))) e1024))) (global-extend109 (quote core) (quote let) (letrec ((chi-let1036 (lambda (e1037 r1038 w1039 s1040 mod1041 constructor1042 ids1043 vals1044 exps1045) (if (not (valid-bound-ids?136 ids1043)) (syntax-violation (quote let) "duplicate bound variable" e1037) (let ((labels1046 (gen-labels117 ids1043)) (new-vars1047 (map gen-var159 ids1043))) (let ((nw1048 (make-binding-wrap128 ids1043 labels1046 w1039)) (nr1049 (extend-var-env106 labels1046 new-vars1047 r1038))) (constructor1042 s1040 new-vars1047 (map (lambda (x1050) (chi147 x1050 r1038 w1039 mod1041)) vals1044) (chi-body151 exps1045 (source-wrap140 e1037 nw1048 s1040 mod1041) nr1049 nw1048 mod1041)))))))) (lambda (e1051 r1052 w1053 s1054 mod1055) ((lambda (tmp1056) ((lambda (tmp1057) (if tmp1057 (apply (lambda (_1058 id1059 val1060 e11061 e21062) (chi-let1036 e1051 r1052 w1053 s1054 mod1055 build-let91 id1059 val1060 (cons e11061 e21062))) tmp1057) ((lambda (tmp1066) (if (if tmp1066 (apply (lambda (_1067 f1068 id1069 val1070 e11071 e21072) (id?111 f1068)) tmp1066) #f) (apply (lambda (_1073 f1074 id1075 val1076 e11077 e21078) (chi-let1036 e1051 r1052 w1053 s1054 mod1055 build-named-let92 (cons f1074 id1075) val1076 (cons e11077 e21078))) tmp1066) ((lambda (_1082) (syntax-violation (quote let) "bad let" (source-wrap140 e1051 w1053 s1054 mod1055))) tmp1056))) ($sc-dispatch tmp1056 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1056 (quote (any #(each (any any)) any . each-any))))) e1051)))) (global-extend109 (quote core) (quote letrec) (lambda (e1083 r1084 w1085 s1086 mod1087) ((lambda (tmp1088) ((lambda (tmp1089) (if tmp1089 (apply (lambda (_1090 id1091 val1092 e11093 e21094) (let ((ids1095 id1091)) (if (not (valid-bound-ids?136 ids1095)) (syntax-violation (quote letrec) "duplicate bound variable" e1083) (let ((labels1097 (gen-labels117 ids1095)) (new-vars1098 (map gen-var159 ids1095))) (let ((w1099 (make-binding-wrap128 ids1095 labels1097 w1085)) (r1100 (extend-var-env106 labels1097 new-vars1098 r1084))) (build-letrec93 s1086 new-vars1098 (map (lambda (x1101) (chi147 x1101 r1100 w1099 mod1087)) val1092) (chi-body151 (cons e11093 e21094) (source-wrap140 e1083 w1099 s1086 mod1087) r1100 w1099 mod1087))))))) tmp1089) ((lambda (_1104) (syntax-violation (quote letrec) "bad letrec" (source-wrap140 e1083 w1085 s1086 mod1087))) tmp1088))) ($sc-dispatch tmp1088 (quote (any #(each (any any)) any . each-any))))) e1083))) (global-extend109 (quote core) (quote set!) (lambda (e1105 r1106 w1107 s1108 mod1109) ((lambda (tmp1110) ((lambda (tmp1111) (if (if tmp1111 (apply (lambda (_1112 id1113 val1114) (id?111 id1113)) tmp1111) #f) (apply (lambda (_1115 id1116 val1117) (let ((val1118 (chi147 val1117 r1106 w1107 mod1109)) (n1119 (id-var-name133 id1116 w1107))) (let ((b1120 (lookup108 n1119 r1106 mod1109))) (let ((t1121 (binding-type103 b1120))) (if (memv t1121 (quote (lexical))) (build-lexical-assignment82 s1108 (syntax->datum id1116) (binding-value104 b1120) val1118) (if (memv t1121 (quote (global))) (build-global-assignment85 s1108 n1119 val1118 mod1109) (if (memv t1121 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap139 id1116 w1107 mod1109)) (syntax-violation (quote set!) "bad set!" (source-wrap140 e1105 w1107 s1108 mod1109))))))))) tmp1111) ((lambda (tmp1122) (if tmp1122 (apply (lambda (_1123 head1124 tail1125 val1126) (call-with-values (lambda () (syntax-type145 head1124 r1106 (quote (())) #f #f mod1109)) (lambda (type1127 value1128 ee1129 ww1130 ss1131 modmod1132) (let ((t1133 type1127)) (if (memv t1133 (quote (module-ref))) (let ((val1134 (chi147 val1126 r1106 w1107 mod1109))) (call-with-values (lambda () (value1128 (cons head1124 tail1125))) (lambda (id1136 mod1137) (build-global-assignment85 s1108 id1136 val1134 mod1137)))) (build-application79 s1108 (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))) head1124) r1106 w1107 mod1109) (map (lambda (e1138) (chi147 e1138 r1106 w1107 mod1109)) (append tail1125 (list val1126))))))))) tmp1122) ((lambda (_1140) (syntax-violation (quote set!) "bad set!" (source-wrap140 e1105 w1107 s1108 mod1109))) tmp1110))) ($sc-dispatch tmp1110 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1110 (quote (any any any))))) e1105))) (global-extend109 (quote module-ref) (quote @) (lambda (e1141) ((lambda (tmp1142) ((lambda (tmp1143) (if (if tmp1143 (apply (lambda (_1144 mod1145 id1146) (and (and-map id?111 mod1145) (id?111 id1146))) tmp1143) #f) (apply (lambda (_1148 mod1149 id1150) (values (syntax->datum id1150) (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))) mod1149)))) tmp1143) (syntax-violation #f "source expression failed to match any pattern" tmp1142))) ($sc-dispatch tmp1142 (quote (any each-any any))))) e1141))) (global-extend109 (quote module-ref) (quote @@) (lambda (e1152) ((lambda (tmp1153) ((lambda (tmp1154) (if (if tmp1154 (apply (lambda (_1155 mod1156 id1157) (and (and-map id?111 mod1156) (id?111 id1157))) tmp1154) #f) (apply (lambda (_1159 mod1160 id1161) (values (syntax->datum id1161) (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))) mod1160)))) tmp1154) (syntax-violation #f "source expression failed to match any pattern" tmp1153))) ($sc-dispatch tmp1153 (quote (any each-any any))))) e1152))) (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-case1166 (lambda (x1167 keys1168 clauses1169 r1170 mod1171) (if (null? clauses1169) (build-application79 #f (build-primref88 #f (quote syntax-violation)) (list #f "source expression failed to match any pattern" x1167)) ((lambda (tmp1172) ((lambda (tmp1173) (if tmp1173 (apply (lambda (pat1174 exp1175) (if (and (id?111 pat1174) (and-map (lambda (x1176) (not (free-id=?134 pat1174 x1176))) (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))) keys1168))) (let ((labels1177 (list (gen-label116))) (var1178 (gen-var159 pat1174))) (build-application79 #f (build-lambda87 #f (list var1178) #f (chi147 exp1175 (extend-env105 labels1177 (list (cons (quote syntax) (cons var1178 0))) r1170) (make-binding-wrap128 (list pat1174) labels1177 (quote (()))) mod1171)) (list x1167))) (gen-clause1165 x1167 keys1168 (cdr clauses1169) r1170 pat1174 #t exp1175 mod1171))) tmp1173) ((lambda (tmp1179) (if tmp1179 (apply (lambda (pat1180 fender1181 exp1182) (gen-clause1165 x1167 keys1168 (cdr clauses1169) r1170 pat1180 fender1181 exp1182 mod1171)) tmp1179) ((lambda (_1183) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1169))) tmp1172))) ($sc-dispatch tmp1172 (quote (any any any)))))) ($sc-dispatch tmp1172 (quote (any any))))) (car clauses1169))))) (gen-clause1165 (lambda (x1184 keys1185 clauses1186 r1187 pat1188 fender1189 exp1190 mod1191) (call-with-values (lambda () (convert-pattern1163 pat1188 keys1185)) (lambda (p1192 pvars1193) (cond ((not (distinct-bound-ids?137 (map car pvars1193))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1188)) ((not (and-map (lambda (x1194) (not (ellipsis?156 (car x1194)))) pvars1193)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1188)) (else (let ((y1195 (gen-var159 (quote tmp)))) (build-application79 #f (build-lambda87 #f (list y1195) #f (let ((y1196 (build-lexical-reference81 (quote value) #f (quote tmp) y1195))) (build-conditional80 #f ((lambda (tmp1197) ((lambda (tmp1198) (if tmp1198 (apply (lambda () y1196) tmp1198) ((lambda (_1199) (build-conditional80 #f y1196 (build-dispatch-call1164 pvars1193 fender1189 y1196 r1187 mod1191) (build-data89 #f #f))) tmp1197))) ($sc-dispatch tmp1197 (quote #(atom #t))))) fender1189) (build-dispatch-call1164 pvars1193 exp1190 y1196 r1187 mod1191) (gen-syntax-case1166 x1184 keys1185 clauses1186 r1187 mod1191)))) (list (if (eq? p1192 (quote any)) (build-application79 #f (build-primref88 #f (quote list)) (list x1184)) (build-application79 #f (build-primref88 #f (quote $sc-dispatch)) (list x1184 (build-data89 #f p1192))))))))))))) (build-dispatch-call1164 (lambda (pvars1200 exp1201 y1202 r1203 mod1204) (let ((ids1205 (map car pvars1200)) (levels1206 (map cdr pvars1200))) (let ((labels1207 (gen-labels117 ids1205)) (new-vars1208 (map gen-var159 ids1205))) (build-application79 #f (build-primref88 #f (quote apply)) (list (build-lambda87 #f new-vars1208 #f (chi147 exp1201 (extend-env105 labels1207 (map (lambda (var1209 level1210) (cons (quote syntax) (cons var1209 level1210))) new-vars1208 (map cdr pvars1200)) r1203) (make-binding-wrap128 ids1205 labels1207 (quote (()))) mod1204)) y1202)))))) (convert-pattern1163 (lambda (pattern1211 keys1212) (letrec ((cvt1213 (lambda (p1214 n1215 ids1216) (if (id?111 p1214) (if (bound-id-member?138 p1214 keys1212) (values (vector (quote free-id) p1214) ids1216) (values (quote any) (cons (cons p1214 n1215) ids1216))) ((lambda (tmp1217) ((lambda (tmp1218) (if (if tmp1218 (apply (lambda (x1219 dots1220) (ellipsis?156 dots1220)) tmp1218) #f) (apply (lambda (x1221 dots1222) (call-with-values (lambda () (cvt1213 x1221 (fx+71 n1215 1) ids1216)) (lambda (p1223 ids1224) (values (if (eq? p1223 (quote any)) (quote each-any) (vector (quote each) p1223)) ids1224)))) tmp1218) ((lambda (tmp1225) (if tmp1225 (apply (lambda (x1226 y1227) (call-with-values (lambda () (cvt1213 y1227 n1215 ids1216)) (lambda (y1228 ids1229) (call-with-values (lambda () (cvt1213 x1226 n1215 ids1229)) (lambda (x1230 ids1231) (values (cons x1230 y1228) ids1231)))))) tmp1225) ((lambda (tmp1232) (if tmp1232 (apply (lambda () (values (quote ()) ids1216)) tmp1232) ((lambda (tmp1233) (if tmp1233 (apply (lambda (x1234) (call-with-values (lambda () (cvt1213 x1234 n1215 ids1216)) (lambda (p1236 ids1237) (values (vector (quote vector) p1236) ids1237)))) tmp1233) ((lambda (x1238) (values (vector (quote atom) (strip158 p1214 (quote (())))) ids1216)) tmp1217))) ($sc-dispatch tmp1217 (quote #(vector each-any)))))) ($sc-dispatch tmp1217 (quote ()))))) ($sc-dispatch tmp1217 (quote (any . any)))))) ($sc-dispatch tmp1217 (quote (any any))))) p1214))))) (cvt1213 pattern1211 0 (quote ())))))) (lambda (e1239 r1240 w1241 s1242 mod1243) (let ((e1244 (source-wrap140 e1239 w1241 s1242 mod1243))) ((lambda (tmp1245) ((lambda (tmp1246) (if tmp1246 (apply (lambda (_1247 val1248 key1249 m1250) (if (and-map (lambda (x1251) (and (id?111 x1251) (not (ellipsis?156 x1251)))) key1249) (let ((x1253 (gen-var159 (quote tmp)))) (build-application79 s1242 (build-lambda87 #f (list x1253) #f (gen-syntax-case1166 (build-lexical-reference81 (quote value) #f (quote tmp) x1253) key1249 m1250 r1240 mod1243)) (list (chi147 val1248 r1240 (quote (())) mod1243)))) (syntax-violation (quote syntax-case) "invalid literals list" e1244))) tmp1246) (syntax-violation #f "source expression failed to match any pattern" tmp1245))) ($sc-dispatch tmp1245 (quote (any any each-any . each-any))))) e1244))))) (set! sc-expand (lambda (x1257 . rest1256) (if (and (pair? x1257) (equal? (car x1257) noexpand69)) (cadr x1257) (let ((m1258 (if (null? rest1256) (quote e) (car rest1256))) (esew1259 (if (or (null? rest1256) (null? (cdr rest1256))) (quote (eval)) (cadr rest1256)))) (with-fluid* *mode*70 m1258 (lambda () (chi-top146 x1257 (quote ()) (quote ((top))) m1258 esew1259 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1260) (nonsymbol-id?110 x1260))) (set! datum->syntax (lambda (id1261 datum1262) (make-syntax-object94 datum1262 (syntax-object-wrap97 id1261) #f))) (set! syntax->datum (lambda (x1263) (strip158 x1263 (quote (()))))) (set! generate-temporaries (lambda (ls1264) (begin (let ((x1265 ls1264)) (if (not (list? x1265)) (syntax-violation (quote generate-temporaries) "invalid argument" x1265))) (map (lambda (x1266) (wrap139 (gensym) (quote ((top))) #f)) ls1264)))) (set! free-identifier=? (lambda (x1267 y1268) (begin (let ((x1269 x1267)) (if (not (nonsymbol-id?110 x1269)) (syntax-violation (quote free-identifier=?) "invalid argument" x1269))) (let ((x1270 y1268)) (if (not (nonsymbol-id?110 x1270)) (syntax-violation (quote free-identifier=?) "invalid argument" x1270))) (free-id=?134 x1267 y1268)))) (set! bound-identifier=? (lambda (x1271 y1272) (begin (let ((x1273 x1271)) (if (not (nonsymbol-id?110 x1273)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1273))) (let ((x1274 y1272)) (if (not (nonsymbol-id?110 x1274)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1274))) (bound-id=?135 x1271 y1272)))) (set! syntax-violation (lambda (who1278 message1277 form1276 . subform1275) (begin (let ((x1279 who1278)) (if (not ((lambda (x1280) (or (not x1280) (string? x1280) (symbol? x1280))) x1279)) (syntax-violation (quote syntax-violation) "invalid argument" x1279))) (let ((x1281 message1277)) (if (not (string? x1281)) (syntax-violation (quote syntax-violation) "invalid argument" x1281))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1278 "~a: " "") "~a " (if (null? subform1275) "in ~a" "in subform `~s' of `~s'")) (let ((tail1282 (cons message1277 (map (lambda (x1283) (strip158 x1283 (quote (())))) (append subform1275 (list form1276)))))) (if who1278 (cons who1278 tail1282) tail1282)) #f)))) (letrec ((match1288 (lambda (e1289 p1290 w1291 r1292 mod1293) (cond ((not r1292) #f) ((eq? p1290 (quote any)) (cons (wrap139 e1289 w1291 mod1293) r1292)) ((syntax-object?95 e1289) (match*1287 (let ((e1294 (syntax-object-expression96 e1289))) (if (annotation? e1294) (annotation-expression e1294) e1294)) p1290 (join-wraps130 w1291 (syntax-object-wrap97 e1289)) r1292 (syntax-object-module98 e1289))) (else (match*1287 (let ((e1295 e1289)) (if (annotation? e1295) (annotation-expression e1295) e1295)) p1290 w1291 r1292 mod1293))))) (match*1287 (lambda (e1296 p1297 w1298 r1299 mod1300) (cond ((null? p1297) (and (null? e1296) r1299)) ((pair? p1297) (and (pair? e1296) (match1288 (car e1296) (car p1297) w1298 (match1288 (cdr e1296) (cdr p1297) w1298 r1299 mod1300) mod1300))) ((eq? p1297 (quote each-any)) (let ((l1301 (match-each-any1285 e1296 w1298 mod1300))) (and l1301 (cons l1301 r1299)))) (else (let ((t1302 (vector-ref p1297 0))) (if (memv t1302 (quote (each))) (if (null? e1296) (match-empty1286 (vector-ref p1297 1) r1299) (let ((l1303 (match-each1284 e1296 (vector-ref p1297 1) w1298 mod1300))) (and l1303 (letrec ((collect1304 (lambda (l1305) (if (null? (car l1305)) r1299 (cons (map car l1305) (collect1304 (map cdr l1305))))))) (collect1304 l1303))))) (if (memv t1302 (quote (free-id))) (and (id?111 e1296) (free-id=?134 (wrap139 e1296 w1298 mod1300) (vector-ref p1297 1)) r1299) (if (memv t1302 (quote (atom))) (and (equal? (vector-ref p1297 1) (strip158 e1296 w1298)) r1299) (if (memv t1302 (quote (vector))) (and (vector? e1296) (match1288 (vector->list e1296) (vector-ref p1297 1) w1298 r1299 mod1300))))))))))) (match-empty1286 (lambda (p1306 r1307) (cond ((null? p1306) r1307) ((eq? p1306 (quote any)) (cons (quote ()) r1307)) ((pair? p1306) (match-empty1286 (car p1306) (match-empty1286 (cdr p1306) r1307))) ((eq? p1306 (quote each-any)) (cons (quote ()) r1307)) (else (let ((t1308 (vector-ref p1306 0))) (if (memv t1308 (quote (each))) (match-empty1286 (vector-ref p1306 1) r1307) (if (memv t1308 (quote (free-id atom))) r1307 (if (memv t1308 (quote (vector))) (match-empty1286 (vector-ref p1306 1) r1307))))))))) (match-each-any1285 (lambda (e1309 w1310 mod1311) (cond ((annotation? e1309) (match-each-any1285 (annotation-expression e1309) w1310 mod1311)) ((pair? e1309) (let ((l1312 (match-each-any1285 (cdr e1309) w1310 mod1311))) (and l1312 (cons (wrap139 (car e1309) w1310 mod1311) l1312)))) ((null? e1309) (quote ())) ((syntax-object?95 e1309) (match-each-any1285 (syntax-object-expression96 e1309) (join-wraps130 w1310 (syntax-object-wrap97 e1309)) mod1311)) (else #f)))) (match-each1284 (lambda (e1313 p1314 w1315 mod1316) (cond ((annotation? e1313) (match-each1284 (annotation-expression e1313) p1314 w1315 mod1316)) ((pair? e1313) (let ((first1317 (match1288 (car e1313) p1314 w1315 (quote ()) mod1316))) (and first1317 (let ((rest1318 (match-each1284 (cdr e1313) p1314 w1315 mod1316))) (and rest1318 (cons first1317 rest1318)))))) ((null? e1313) (quote ())) ((syntax-object?95 e1313) (match-each1284 (syntax-object-expression96 e1313) p1314 (join-wraps130 w1315 (syntax-object-wrap97 e1313)) (syntax-object-module98 e1313))) (else #f))))) (set! $sc-dispatch (lambda (e1319 p1320) (cond ((eq? p1320 (quote any)) (list e1319)) ((syntax-object?95 e1319) (match*1287 (let ((e1321 (syntax-object-expression96 e1319))) (if (annotation? e1321) (annotation-expression e1321) e1321)) p1320 (syntax-object-wrap97 e1319) (quote ()) (syntax-object-module98 e1319))) (else (match*1287 (let ((e1322 e1319)) (if (annotation? e1322) (annotation-expression e1322) e1322)) p1320 (quote (())) (quote ()) #f)))))))))
(define with-syntax (make-syncase-macro (quote macro) (lambda (x1323) ((lambda (tmp1324) ((lambda (tmp1325) (if tmp1325 (apply (lambda (_1326 e11327 e21328) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11327 e21328))) tmp1325) ((lambda (tmp1330) (if tmp1330 (apply (lambda (_1331 out1332 in1333 e11334 e21335) (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))) in1333 (quote ()) (list out1332 (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 e11334 e21335))))) tmp1330) ((lambda (tmp1337) (if tmp1337 (apply (lambda (_1338 out1339 in1340 e11341 e21342) (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))) in1340) (quote ()) (list out1339 (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 e11341 e21342))))) tmp1337) (syntax-violation #f "source expression failed to match any pattern" tmp1324))) ($sc-dispatch tmp1324 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1324 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1324 (quote (any () any . each-any))))) x1323))))
(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1346) ((lambda (tmp1347) ((lambda (tmp1348) (if tmp1348 (apply (lambda (_1349 k1350 keyword1351 pattern1352 template1353) (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 k1350 (map (lambda (tmp1356 tmp1355) (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))) tmp1355) (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))) tmp1356))) template1353 pattern1352)))))) tmp1348) (syntax-violation #f "source expression failed to match any pattern" tmp1347))) ($sc-dispatch tmp1347 (quote (any each-any . #(each ((any . any) any))))))) x1346))))
(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1357) ((lambda (tmp1358) ((lambda (tmp1359) (if (if tmp1359 (apply (lambda (let*1360 x1361 v1362 e11363 e21364) (and-map identifier? x1361)) tmp1359) #f) (apply (lambda (let*1366 x1367 v1368 e11369 e21370) (letrec ((f1371 (lambda (bindings1372) (if (null? bindings1372) (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 e11369 e21370))) ((lambda (tmp1376) ((lambda (tmp1377) (if tmp1377 (apply (lambda (body1378 binding1379) (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 binding1379) body1378)) tmp1377) (syntax-violation #f "source expression failed to match any pattern" tmp1376))) ($sc-dispatch tmp1376 (quote (any any))))) (list (f1371 (cdr bindings1372)) (car bindings1372))))))) (f1371 (map list x1367 v1368)))) tmp1359) (syntax-violation #f "source expression failed to match any pattern" tmp1358))) ($sc-dispatch tmp1358 (quote (any #(each (any any)) any . each-any))))) x1357))))
(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1380) ((lambda (tmp1381) ((lambda (tmp1382) (if tmp1382 (apply (lambda (_1383 var1384 init1385 step1386 e01387 e11388 c1389) ((lambda (tmp1390) ((lambda (tmp1391) (if tmp1391 (apply (lambda (step1392) ((lambda (tmp1393) ((lambda (tmp1394) (if tmp1394 (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 var1384 init1385) (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))) e01387) (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 c1389 (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))) step1392))))))) tmp1394) ((lambda (tmp1399) (if tmp1399 (apply (lambda (e11400 e21401) (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 var1384 init1385) (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))) e01387 (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 e11400 e21401)) (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 c1389 (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))) step1392))))))) tmp1399) (syntax-violation #f "source expression failed to match any pattern" tmp1393))) ($sc-dispatch tmp1393 (quote (any . each-any)))))) ($sc-dispatch tmp1393 (quote ())))) e11388)) tmp1391) (syntax-violation #f "source expression failed to match any pattern" tmp1390))) ($sc-dispatch tmp1390 (quote each-any)))) (map (lambda (v1408 s1409) ((lambda (tmp1410) ((lambda (tmp1411) (if tmp1411 (apply (lambda () v1408) tmp1411) ((lambda (tmp1412) (if tmp1412 (apply (lambda (e1413) e1413) tmp1412) ((lambda (_1414) (syntax-violation (quote do) "bad step expression" orig-x1380 s1409)) tmp1410))) ($sc-dispatch tmp1410 (quote (any)))))) ($sc-dispatch tmp1410 (quote ())))) s1409)) var1384 step1386))) tmp1382) (syntax-violation #f "source expression failed to match any pattern" tmp1381))) ($sc-dispatch tmp1381 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1380))))
(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1417 (lambda (x1421 y1422) ((lambda (tmp1423) ((lambda (tmp1424) (if tmp1424 (apply (lambda (x1425 y1426) ((lambda (tmp1427) ((lambda (tmp1428) (if tmp1428 (apply (lambda (dy1429) ((lambda (tmp1430) ((lambda (tmp1431) (if tmp1431 (apply (lambda (dx1432) (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 dx1432 dy1429))) tmp1431) ((lambda (_1433) (if (null? dy1429) (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))) x1425) (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))) x1425 y1426))) tmp1430))) ($sc-dispatch tmp1430 (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))))) x1425)) tmp1428) ((lambda (tmp1434) (if tmp1434 (apply (lambda (stuff1435) (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 x1425 stuff1435))) tmp1434) ((lambda (else1436) (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))) x1425 y1426)) tmp1427))) ($sc-dispatch tmp1427 (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 tmp1427 (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))))) y1426)) tmp1424) (syntax-violation #f "source expression failed to match any pattern" tmp1423))) ($sc-dispatch tmp1423 (quote (any any))))) (list x1421 y1422)))) (quasiappend1418 (lambda (x1437 y1438) ((lambda (tmp1439) ((lambda (tmp1440) (if tmp1440 (apply (lambda (x1441 y1442) ((lambda (tmp1443) ((lambda (tmp1444) (if tmp1444 (apply (lambda () x1441) tmp1444) ((lambda (_1445) (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))) x1441 y1442)) tmp1443))) ($sc-dispatch tmp1443 (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))) ()))))) y1442)) tmp1440) (syntax-violation #f "source expression failed to match any pattern" tmp1439))) ($sc-dispatch tmp1439 (quote (any any))))) (list x1437 y1438)))) (quasivector1419 (lambda (x1446) ((lambda (tmp1447) ((lambda (x1448) ((lambda (tmp1449) ((lambda (tmp1450) (if tmp1450 (apply (lambda (x1451) (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 x1451))) tmp1450) ((lambda (tmp1453) (if tmp1453 (apply (lambda (x1454) (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))) x1454)) tmp1453) ((lambda (_1456) (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))) x1448)) tmp1449))) ($sc-dispatch tmp1449 (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 tmp1449 (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))))) x1448)) tmp1447)) x1446))) (quasi1420 (lambda (p1457 lev1458) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (p1461) (if (= lev1458 0) p1461 (quasicons1417 (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)))) (quasi1420 (list p1461) (- lev1458 1))))) tmp1460) ((lambda (tmp1462) (if tmp1462 (apply (lambda (p1463 q1464) (if (= lev1458 0) (quasiappend1418 p1463 (quasi1420 q1464 lev1458)) (quasicons1417 (quasicons1417 (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)))) (quasi1420 (list p1463) (- lev1458 1))) (quasi1420 q1464 lev1458)))) tmp1462) ((lambda (tmp1465) (if tmp1465 (apply (lambda (p1466) (quasicons1417 (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)))) (quasi1420 (list p1466) (+ lev1458 1)))) tmp1465) ((lambda (tmp1467) (if tmp1467 (apply (lambda (p1468 q1469) (quasicons1417 (quasi1420 p1468 lev1458) (quasi1420 q1469 lev1458))) tmp1467) ((lambda (tmp1470) (if tmp1470 (apply (lambda (x1471) (quasivector1419 (quasi1420 x1471 lev1458))) tmp1470) ((lambda (p1473) (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))) p1473)) tmp1459))) ($sc-dispatch tmp1459 (quote #(vector each-any)))))) ($sc-dispatch tmp1459 (quote (any . any)))))) ($sc-dispatch tmp1459 (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 tmp1459 (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 tmp1459 (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))))) p1457)))) (lambda (x1474) ((lambda (tmp1475) ((lambda (tmp1476) (if tmp1476 (apply (lambda (_1477 e1478) (quasi1420 e1478 0)) tmp1476) (syntax-violation #f "source expression failed to match any pattern" tmp1475))) ($sc-dispatch tmp1475 (quote (any any))))) x1474)))))
(define include (make-syncase-macro (quote macro) (lambda (x1479) (letrec ((read-file1480 (lambda (fn1481 k1482) (let ((p1483 (open-input-file fn1481))) (letrec ((f1484 (lambda (x1485) (if (eof-object? x1485) (begin (close-input-port p1483) (quote ())) (cons (datum->syntax k1482 x1485) (f1484 (read p1483))))))) (f1484 (read p1483))))))) ((lambda (tmp1486) ((lambda (tmp1487) (if tmp1487 (apply (lambda (k1488 filename1489) (let ((fn1490 (syntax->datum filename1489))) ((lambda (tmp1491) ((lambda (tmp1492) (if tmp1492 (apply (lambda (exp1493) (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))) exp1493)) tmp1492) (syntax-violation #f "source expression failed to match any pattern" tmp1491))) ($sc-dispatch tmp1491 (quote each-any)))) (read-file1480 fn1490 k1488)))) tmp1487) (syntax-violation #f "source expression failed to match any pattern" tmp1486))) ($sc-dispatch tmp1486 (quote (any any))))) x1479)))))
(define unquote (make-syncase-macro (quote macro) (lambda (x1495) ((lambda (tmp1496) ((lambda (tmp1497) (if tmp1497 (apply (lambda (_1498 e1499) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1495)) tmp1497) (syntax-violation #f "source expression failed to match any pattern" tmp1496))) ($sc-dispatch tmp1496 (quote (any any))))) x1495))))
(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1500) ((lambda (tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda (_1503 e1504) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1500)) tmp1502) (syntax-violation #f "source expression failed to match any pattern" tmp1501))) ($sc-dispatch tmp1501 (quote (any any))))) x1500))))
(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1505) ((lambda (tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (_1508 e1509 m11510 m21511) ((lambda (tmp1512) ((lambda (body1513) (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))) e1509)) body1513)) tmp1512)) (letrec ((f1514 (lambda (clause1515 clauses1516) (if (null? clauses1516) ((lambda (tmp1518) ((lambda (tmp1519) (if tmp1519 (apply (lambda (e11520 e21521) (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 e11520 e21521))) tmp1519) ((lambda (tmp1523) (if tmp1523 (apply (lambda (k1524 e11525 e21526) (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))) k1524)) (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 e11525 e21526)))) tmp1523) ((lambda (_1529) (syntax-violation (quote case) "bad clause" x1505 clause1515)) tmp1518))) ($sc-dispatch tmp1518 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1518 (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))))) clause1515) ((lambda (tmp1530) ((lambda (rest1531) ((lambda (tmp1532) ((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 #(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))) k1534)) (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 e11535 e21536)) rest1531)) tmp1533) ((lambda (_1539) (syntax-violation (quote case) "bad clause" x1505 clause1515)) tmp1532))) ($sc-dispatch tmp1532 (quote (each-any any . each-any))))) clause1515)) tmp1530)) (f1514 (car clauses1516) (cdr clauses1516))))))) (f1514 m11510 m21511)))) tmp1507) (syntax-violation #f "source expression failed to match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any any any . each-any))))) x1505))))
(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1540) ((lambda (tmp1541) ((lambda (tmp1542) (if tmp1542 (apply (lambda (_1543 e1544) (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))) e1544)) (list (cons _1543 (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 e1544 (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)))))))))) tmp1542) (syntax-violation #f "source expression failed to match any pattern" tmp1541))) ($sc-dispatch tmp1541 (quote (any any))))) x1540))))