residualize names into procedures. re-implement srfi-61. module naming foo.

[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) (let ((t58 (null? first56))) (if t58 t58 (if (null? rest55) (letrec ((andmap59 (lambda (first60) (let ((x61 (car first60)) (first62 (cdr first60))) (if (null? first62) (f57 x61) (if (f57 x61) (andmap59 first62) #f)))))) (andmap59 first56)) (letrec ((andmap63 (lambda (first64 rest65) (let ((x66 (car first64)) (xr67 (map car rest65)) (first68 (cdr first64)) (rest69 (map cdr rest65))) (if (null? first68) (apply f57 (cons x66 xr67)) (if (apply f57 (cons x66 xr67)) (andmap63 first68 rest69) #f)))))) (andmap63 first56 rest55)))))))) (letrec ((lambda-var-list163 (lambda (vars292) (letrec ((lvl293 (lambda (vars294 ls295 w296) (if (pair? vars294) (lvl293 (cdr vars294) (cons (wrap142 (car vars294) w296 #f) ls295) w296) (if (id?114 vars294) (cons (wrap142 vars294 w296 #f) ls295) (if (null? vars294) ls295 (if (syntax-object?98 vars294) (lvl293 (syntax-object-expression99 vars294) ls295 (join-wraps133 w296 (syntax-object-wrap100 vars294))) (if (annotation? vars294) (lvl293 (annotation-expression vars294) ls295 w296) (cons vars294 ls295))))))))) (lvl293 vars292 (quote ()) (quote (())))))) (gen-var162 (lambda (id297) (let ((id298 (if (syntax-object?98 id297) (syntax-object-expression99 id297) id297))) (if (annotation? id298) (gensym (symbol->string (annotation-expression id298))) (gensym (symbol->string id298)))))) (strip161 (lambda (x299 w300) (if (memq (quote top) (wrap-marks117 w300)) (if (let ((t301 (annotation? x299))) (if t301 t301 (if (pair? x299) (annotation? (car x299)) #f))) (strip-annotation160 x299 #f) x299) (letrec ((f302 (lambda (x303) (if (syntax-object?98 x303) (strip161 (syntax-object-expression99 x303) (syntax-object-wrap100 x303)) (if (pair? x303) (let ((a304 (f302 (car x303))) (d305 (f302 (cdr x303)))) (if (if (eq? a304 (car x303)) (eq? d305 (cdr x303)) #f) x303 (cons a304 d305))) (if (vector? x303) (let ((old306 (vector->list x303))) (let ((new307 (map f302 old306))) (if (and-map*17 eq? old306 new307) x303 (list->vector new307)))) x303)))))) (f302 x299))))) (strip-annotation160 (lambda (x308 parent309) (if (pair? x308) (let ((new310 (cons #f #f))) (begin (if parent309 (set-annotation-stripped! parent309 new310)) (set-car! new310 (strip-annotation160 (car x308) #f)) (set-cdr! new310 (strip-annotation160 (cdr x308) #f)) new310)) (if (annotation? x308) (let ((t311 (annotation-stripped x308))) (if t311 t311 (strip-annotation160 (annotation-expression x308) x308))) (if (vector? x308) (let ((new312 (make-vector (vector-length x308)))) (begin (if parent309 (set-annotation-stripped! parent309 new312)) (letrec ((loop313 (lambda (i314) (unless (fx<75 i314 0) (vector-set! new312 i314 (strip-annotation160 (vector-ref x308 i314) #f)) (loop313 (fx-73 i314 1)))))) (loop313 (- (vector-length x308) 1))) new312)) x308))))) (ellipsis?159 (lambda (x315) (if (nonsymbol-id?113 x315) (free-id=?137 x315 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f))) (chi-void158 (lambda () (build-void80 #f))) (eval-local-transformer157 (lambda (expanded316 mod317) (let ((p318 (local-eval-hook77 expanded316 mod317))) (if (procedure? p318) p318 (syntax-violation #f "nonprocedure transformer" p318))))) (chi-local-syntax156 (lambda (rec?319 e320 r321 w322 s323 mod324 k325) ((lambda (tmp326) ((lambda (tmp327) (if tmp327 (apply (lambda (_328 id329 val330 e1331 e2332) (let ((ids333 id329)) (if (not (valid-bound-ids?139 ids333)) (syntax-violation #f "duplicate bound keyword" e320) (let ((labels335 (gen-labels120 ids333))) (let ((new-w336 (make-binding-wrap131 ids333 labels335 w322))) (k325 (cons e1331 e2332) (extend-env108 labels335 (let ((w338 (if rec?319 new-w336 w322)) (trans-r339 (macros-only-env110 r321))) (map (lambda (x340) (cons (quote macro) (eval-local-transformer157 (chi150 x340 trans-r339 w338 mod324) mod324))) val330)) r321) new-w336 s323 mod324)))))) tmp327) ((lambda (_342) (syntax-violation #f "bad local syntax definition" (source-wrap143 e320 w322 s323 mod324))) tmp326))) ($sc-dispatch tmp326 (quote (any #(each (any any)) any . each-any))))) e320))) (chi-lambda-clause155 (lambda (e343 docstring344 c345 r346 w347 mod348 k349) ((lambda (tmp350) ((lambda (tmp351) (if (if tmp351 (apply (lambda (args352 doc353 e1354 e2355) (if (string? (syntax->datum doc353)) (not docstring344) #f)) tmp351) #f) (apply (lambda (args356 doc357 e1358 e2359) (chi-lambda-clause155 e343 doc357 (cons args356 (cons e1358 e2359)) r346 w347 mod348 k349)) tmp351) ((lambda (tmp361) (if tmp361 (apply (lambda (id362 e1363 e2364) (let ((ids365 id362)) (if (not (valid-bound-ids?139 ids365)) (syntax-violation (quote lambda) "invalid parameter list" e343) (let ((labels367 (gen-labels120 ids365)) (new-vars368 (map gen-var162 ids365))) (k349 (map syntax->datum ids365) new-vars368 (if docstring344 (syntax->datum docstring344) #f) (chi-body154 (cons e1363 e2364) e343 (extend-var-env109 labels367 new-vars368 r346) (make-binding-wrap131 ids365 labels367 w347) mod348)))))) tmp361) ((lambda (tmp370) (if tmp370 (apply (lambda (ids371 e1372 e2373) (let ((old-ids374 (lambda-var-list163 ids371))) (if (not (valid-bound-ids?139 old-ids374)) (syntax-violation (quote lambda) "invalid parameter list" e343) (let ((labels375 (gen-labels120 old-ids374)) (new-vars376 (map gen-var162 old-ids374))) (k349 (letrec ((f377 (lambda (ls1378 ls2379) (if (null? ls1378) (syntax->datum ls2379) (f377 (cdr ls1378) (cons (syntax->datum (car ls1378)) ls2379)))))) (f377 (cdr old-ids374) (car old-ids374))) (letrec ((f380 (lambda (ls1381 ls2382) (if (null? ls1381) ls2382 (f380 (cdr ls1381) (cons (car ls1381) ls2382)))))) (f380 (cdr new-vars376) (car new-vars376))) (if docstring344 (syntax->datum docstring344) #f) (chi-body154 (cons e1372 e2373) e343 (extend-var-env109 labels375 new-vars376 r346) (make-binding-wrap131 old-ids374 labels375 w347) mod348)))))) tmp370) ((lambda (_384) (syntax-violation (quote lambda) "bad lambda" e343)) tmp350))) ($sc-dispatch tmp350 (quote (any any . each-any)))))) ($sc-dispatch tmp350 (quote (each-any any . each-any)))))) ($sc-dispatch tmp350 (quote (any any any . each-any))))) c345))) (chi-body154 (lambda (body385 outer-form386 r387 w388 mod389) (let ((r390 (cons (quote ("placeholder" placeholder)) r387))) (let ((ribcage391 (make-ribcage121 (quote ()) (quote ()) (quote ())))) (let ((w392 (make-wrap116 (wrap-marks117 w388) (cons ribcage391 (wrap-subst118 w388))))) (letrec ((parse393 (lambda (body394 ids395 labels396 vars397 vals398 bindings399) (if (null? body394) (syntax-violation #f "no expressions in body" outer-form386) (let ((e401 (cdar body394)) (er402 (caar body394))) (call-with-values (lambda () (syntax-type148 e401 er402 (quote (())) #f ribcage391 mod389)) (lambda (type403 value404 e405 w406 s407 mod408) (if (memv type403 (quote (define-form))) (let ((id409 (wrap142 value404 w406 mod408)) (label410 (gen-label119))) (let ((var411 (gen-var162 id409))) (begin (extend-ribcage!130 ribcage391 id409 label410) (parse393 (cdr body394) (cons id409 ids395) (cons label410 labels396) (cons var411 vars397) (cons (cons er402 (wrap142 e405 w406 mod408)) vals398) (cons (cons (quote lexical) var411) bindings399))))) (if (memv type403 (quote (define-syntax-form))) (let ((id412 (wrap142 value404 w406 mod408)) (label413 (gen-label119))) (begin (extend-ribcage!130 ribcage391 id412 label413) (parse393 (cdr body394) (cons id412 ids395) (cons label413 labels396) vars397 vals398 (cons (cons (quote macro) (cons er402 (wrap142 e405 w406 mod408))) bindings399)))) (if (memv type403 (quote (begin-form))) ((lambda (tmp414) ((lambda (tmp415) (if tmp415 (apply (lambda (_416 e1417) (parse393 (letrec ((f418 (lambda (forms419) (if (null? forms419) (cdr body394) (cons (cons er402 (wrap142 (car forms419) w406 mod408)) (f418 (cdr forms419))))))) (f418 e1417)) ids395 labels396 vars397 vals398 bindings399)) tmp415) (syntax-violation #f "source expression failed to match any pattern" tmp414))) ($sc-dispatch tmp414 (quote (any . each-any))))) e405) (if (memv type403 (quote (local-syntax-form))) (chi-local-syntax156 value404 e405 er402 w406 s407 mod408 (lambda (forms421 er422 w423 s424 mod425) (parse393 (letrec ((f426 (lambda (forms427) (if (null? forms427) (cdr body394) (cons (cons er422 (wrap142 (car forms427) w423 mod425)) (f426 (cdr forms427))))))) (f426 forms421)) ids395 labels396 vars397 vals398 bindings399))) (if (null? ids395) (build-sequence93 #f (map (lambda (x428) (chi150 (cdr x428) (car x428) (quote (())) mod408)) (cons (cons er402 (source-wrap143 e405 w406 s407 mod408)) (cdr body394)))) (begin (if (not (valid-bound-ids?139 ids395)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form386)) (letrec ((loop429 (lambda (bs430 er-cache431 r-cache432) (if (not (null? bs430)) (let ((b433 (car bs430))) (if (eq? (car b433) (quote macro)) (let ((er434 (cadr b433))) (let ((r-cache435 (if (eq? er434 er-cache431) r-cache432 (macros-only-env110 er434)))) (begin (set-cdr! b433 (eval-local-transformer157 (chi150 (cddr b433) r-cache435 (quote (())) mod408) mod408)) (loop429 (cdr bs430) er434 r-cache435)))) (loop429 (cdr bs430) er-cache431 r-cache432))))))) (loop429 bindings399 #f #f)) (set-cdr! r390 (extend-env108 labels396 bindings399 (cdr r390))) (build-letrec96 #f (map syntax->datum ids395) vars397 (map (lambda (x436) (chi150 (cdr x436) (car x436) (quote (())) mod408)) vals398) (build-sequence93 #f (map (lambda (x437) (chi150 (cdr x437) (car x437) (quote (())) mod408)) (cons (cons er402 (source-wrap143 e405 w406 s407 mod408)) (cdr body394)))))))))))))))))) (parse393 (map (lambda (x400) (cons r390 (wrap142 x400 w392 mod389))) body385) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro153 (lambda (p438 e439 r440 w441 rib442 mod443) (letrec ((rebuild-macro-output444 (lambda (x445 m446) (if (pair? x445) (cons (rebuild-macro-output444 (car x445) m446) (rebuild-macro-output444 (cdr x445) m446)) (if (syntax-object?98 x445) (let ((w447 (syntax-object-wrap100 x445))) (let ((ms448 (wrap-marks117 w447)) (s449 (wrap-subst118 w447))) (if (if (pair? ms448) (eq? (car ms448) #f) #f) (make-syntax-object97 (syntax-object-expression99 x445) (make-wrap116 (cdr ms448) (if rib442 (cons rib442 (cdr s449)) (cdr s449))) (syntax-object-module101 x445)) (make-syntax-object97 (syntax-object-expression99 x445) (make-wrap116 (cons m446 ms448) (if rib442 (cons rib442 (cons (quote shift) s449)) (cons (quote shift) s449))) (let ((pmod450 (procedure-module p438))) (if pmod450 (cons (quote hygiene) (module-name pmod450)) (quote (hygiene guile)))))))) (if (vector? x445) (let ((n451 (vector-length x445))) (let ((v452 (make-vector n451))) (letrec ((loop453 (lambda (i454) (if (fx=74 i454 n451) (begin (if #f #f) v452) (begin (vector-set! v452 i454 (rebuild-macro-output444 (vector-ref x445 i454) m446)) (loop453 (fx+72 i454 1))))))) (loop453 0)))) (if (symbol? x445) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap143 e439 w441 s mod443) x445) x445))))))) (rebuild-macro-output444 (p438 (wrap142 e439 (anti-mark129 w441) mod443)) (string #\m))))) (chi-application152 (lambda (x455 e456 r457 w458 s459 mod460) ((lambda (tmp461) ((lambda (tmp462) (if tmp462 (apply (lambda (e0463 e1464) (build-application81 s459 x455 (map (lambda (e465) (chi150 e465 r457 w458 mod460)) e1464))) tmp462) (syntax-violation #f "source expression failed to match any pattern" tmp461))) ($sc-dispatch tmp461 (quote (any . each-any))))) e456))) (chi-expr151 (lambda (type467 value468 e469 r470 w471 s472 mod473) (if (memv type467 (quote (lexical))) (build-lexical-reference83 (quote value) s472 e469 value468) (if (memv type467 (quote (core external-macro))) (value468 e469 r470 w471 s472 mod473) (if (memv type467 (quote (module-ref))) (call-with-values (lambda () (value468 e469)) (lambda (id474 mod475) (build-global-reference86 s472 id474 mod475))) (if (memv type467 (quote (lexical-call))) (chi-application152 (build-lexical-reference83 (quote fun) (source-annotation105 (car e469)) (car e469) value468) e469 r470 w471 s472 mod473) (if (memv type467 (quote (global-call))) (chi-application152 (build-global-reference86 (source-annotation105 (car e469)) value468 (if (syntax-object?98 (car e469)) (syntax-object-module101 (car e469)) mod473)) e469 r470 w471 s472 mod473) (if (memv type467 (quote (constant))) (build-data92 s472 (strip161 (source-wrap143 e469 w471 s472 mod473) (quote (())))) (if (memv type467 (quote (global))) (build-global-reference86 s472 value468 mod473) (if (memv type467 (quote (call))) (chi-application152 (chi150 (car e469) r470 w471 mod473) e469 r470 w471 s472 mod473) (if (memv type467 (quote (begin-form))) ((lambda (tmp476) ((lambda (tmp477) (if tmp477 (apply (lambda (_478 e1479 e2480) (chi-sequence144 (cons e1479 e2480) r470 w471 s472 mod473)) tmp477) (syntax-violation #f "source expression failed to match any pattern" tmp476))) ($sc-dispatch tmp476 (quote (any any . each-any))))) e469) (if (memv type467 (quote (local-syntax-form))) (chi-local-syntax156 value468 e469 r470 w471 s472 mod473 chi-sequence144) (if (memv type467 (quote (eval-when-form))) ((lambda (tmp482) ((lambda (tmp483) (if tmp483 (apply (lambda (_484 x485 e1486 e2487) (let ((when-list488 (chi-when-list147 e469 x485 w471))) (if (memq (quote eval) when-list488) (chi-sequence144 (cons e1486 e2487) r470 w471 s472 mod473) (chi-void158)))) tmp483) (syntax-violation #f "source expression failed to match any pattern" tmp482))) ($sc-dispatch tmp482 (quote (any each-any any . each-any))))) e469) (if (memv type467 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e469 (wrap142 value468 w471 mod473)) (if (memv type467 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap143 e469 w471 s472 mod473)) (if (memv type467 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap143 e469 w471 s472 mod473)) (syntax-violation #f "unexpected syntax" (source-wrap143 e469 w471 s472 mod473)))))))))))))))))) (chi150 (lambda (e491 r492 w493 mod494) (call-with-values (lambda () (syntax-type148 e491 r492 w493 #f #f mod494)) (lambda (type495 value496 e497 w498 s499 mod500) (chi-expr151 type495 value496 e497 r492 w498 s499 mod500))))) (chi-top149 (lambda (e501 r502 w503 m504 esew505 mod506) (call-with-values (lambda () (syntax-type148 e501 r502 w503 #f #f mod506)) (lambda (type514 value515 e516 w517 s518 mod519) (if (memv type514 (quote (begin-form))) ((lambda (tmp520) ((lambda (tmp521) (if tmp521 (apply (lambda (_522) (chi-void158)) tmp521) ((lambda (tmp523) (if tmp523 (apply (lambda (_524 e1525 e2526) (chi-top-sequence145 (cons e1525 e2526) r502 w517 s518 m504 esew505 mod519)) tmp523) (syntax-violation #f "source expression failed to match any pattern" tmp520))) ($sc-dispatch tmp520 (quote (any any . each-any)))))) ($sc-dispatch tmp520 (quote (any))))) e516) (if (memv type514 (quote (local-syntax-form))) (chi-local-syntax156 value515 e516 r502 w517 s518 mod519 (lambda (body528 r529 w530 s531 mod532) (chi-top-sequence145 body528 r529 w530 s531 m504 esew505 mod532))) (if (memv type514 (quote (eval-when-form))) ((lambda (tmp533) ((lambda (tmp534) (if tmp534 (apply (lambda (_535 x536 e1537 e2538) (let ((when-list539 (chi-when-list147 e516 x536 w517)) (body540 (cons e1537 e2538))) (if (eq? m504 (quote e)) (if (memq (quote eval) when-list539) (chi-top-sequence145 body540 r502 w517 s518 (quote e) (quote (eval)) mod519) (chi-void158)) (if (memq (quote load) when-list539) (if (let ((t543 (memq (quote compile) when-list539))) (if t543 t543 (if (eq? m504 (quote c&e)) (memq (quote eval) when-list539) #f))) (chi-top-sequence145 body540 r502 w517 s518 (quote c&e) (quote (compile load)) mod519) (if (memq m504 (quote (c c&e))) (chi-top-sequence145 body540 r502 w517 s518 (quote c) (quote (load)) mod519) (chi-void158))) (if (let ((t544 (memq (quote compile) when-list539))) (if t544 t544 (if (eq? m504 (quote c&e)) (memq (quote eval) when-list539) #f))) (begin (top-level-eval-hook76 (chi-top-sequence145 body540 r502 w517 s518 (quote e) (quote (eval)) mod519) mod519) (chi-void158)) (chi-void158)))))) tmp534) (syntax-violation #f "source expression failed to match any pattern" tmp533))) ($sc-dispatch tmp533 (quote (any each-any any . each-any))))) e516) (if (memv type514 (quote (define-syntax-form))) (let ((n545 (id-var-name136 value515 w517)) (r546 (macros-only-env110 r502))) (if (memv m504 (quote (c))) (if (memq (quote compile) esew505) (let ((e547 (chi-install-global146 n545 (chi150 e516 r546 w517 mod519)))) (begin (top-level-eval-hook76 e547 mod519) (if (memq (quote load) esew505) e547 (chi-void158)))) (if (memq (quote load) esew505) (chi-install-global146 n545 (chi150 e516 r546 w517 mod519)) (chi-void158))) (if (memv m504 (quote (c&e))) (let ((e548 (chi-install-global146 n545 (chi150 e516 r546 w517 mod519)))) (begin (top-level-eval-hook76 e548 mod519) e548)) (begin (if (memq (quote eval) esew505) (top-level-eval-hook76 (chi-install-global146 n545 (chi150 e516 r546 w517 mod519)) mod519)) (chi-void158))))) (if (memv type514 (quote (define-form))) (let ((n549 (id-var-name136 value515 w517))) (let ((type550 (binding-type106 (lookup111 n549 r502 mod519)))) (if (memv type550 (quote (global core macro module-ref))) (let ((x551 (build-global-definition89 s518 n549 (chi150 e516 r502 w517 mod519)))) (begin (if (eq? m504 (quote c&e)) (top-level-eval-hook76 x551 mod519)) x551)) (if (memv type550 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e516 (wrap142 value515 w517 mod519)) (syntax-violation #f "cannot define keyword at top level" e516 (wrap142 value515 w517 mod519)))))) (let ((x552 (chi-expr151 type514 value515 e516 r502 w517 s518 mod519))) (begin (if (eq? m504 (quote c&e)) (top-level-eval-hook76 x552 mod519)) x552))))))))))) (syntax-type148 (lambda (e553 r554 w555 s556 rib557 mod558) (if (symbol? e553) (let ((n559 (id-var-name136 e553 w555))) (let ((b560 (lookup111 n559 r554 mod558))) (let ((type561 (binding-type106 b560))) (if (memv type561 (quote (lexical))) (values type561 (binding-value107 b560) e553 w555 s556 mod558) (if (memv type561 (quote (global))) (values type561 n559 e553 w555 s556 mod558) (if (memv type561 (quote (macro))) (syntax-type148 (chi-macro153 (binding-value107 b560) e553 r554 w555 rib557 mod558) r554 (quote (())) s556 rib557 mod558) (values type561 (binding-value107 b560) e553 w555 s556 mod558))))))) (if (pair? e553) (let ((first562 (car e553))) (if (id?114 first562) (let ((n563 (id-var-name136 first562 w555))) (let ((b564 (lookup111 n563 r554 (let ((t565 (if (syntax-object?98 first562) (syntax-object-module101 first562) #f))) (if t565 t565 mod558))))) (let ((type566 (binding-type106 b564))) (if (memv type566 (quote (lexical))) (values (quote lexical-call) (binding-value107 b564) e553 w555 s556 mod558) (if (memv type566 (quote (global))) (values (quote global-call) n563 e553 w555 s556 mod558) (if (memv type566 (quote (macro))) (syntax-type148 (chi-macro153 (binding-value107 b564) e553 r554 w555 rib557 mod558) r554 (quote (())) s556 rib557 mod558) (if (memv type566 (quote (core external-macro module-ref))) (values type566 (binding-value107 b564) e553 w555 s556 mod558) (if (memv type566 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value107 b564) e553 w555 s556 mod558) (if (memv type566 (quote (begin))) (values (quote begin-form) #f e553 w555 s556 mod558) (if (memv type566 (quote (eval-when))) (values (quote eval-when-form) #f e553 w555 s556 mod558) (if (memv type566 (quote (define))) ((lambda (tmp567) ((lambda (tmp568) (if (if tmp568 (apply (lambda (_569 name570 val571) (id?114 name570)) tmp568) #f) (apply (lambda (_572 name573 val574) (values (quote define-form) name573 val574 w555 s556 mod558)) tmp568) ((lambda (tmp575) (if (if tmp575 (apply (lambda (_576 name577 args578 e1579 e2580) (if (id?114 name577) (valid-bound-ids?139 (lambda-var-list163 args578)) #f)) tmp575) #f) (apply (lambda (_581 name582 args583 e1584 e2585) (values (quote define-form) (wrap142 name582 w555 mod558) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap142 (cons args583 (cons e1584 e2585)) w555 mod558)) (quote (())) s556 mod558)) tmp575) ((lambda (tmp587) (if (if tmp587 (apply (lambda (_588 name589) (id?114 name589)) tmp587) #f) (apply (lambda (_590 name591) (values (quote define-form) (wrap142 name591 w555 mod558) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s556 mod558)) tmp587) (syntax-violation #f "source expression failed to match any pattern" tmp567))) ($sc-dispatch tmp567 (quote (any any)))))) ($sc-dispatch tmp567 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp567 (quote (any any any))))) e553) (if (memv type566 (quote (define-syntax))) ((lambda (tmp592) ((lambda (tmp593) (if (if tmp593 (apply (lambda (_594 name595 val596) (id?114 name595)) tmp593) #f) (apply (lambda (_597 name598 val599) (values (quote define-syntax-form) name598 val599 w555 s556 mod558)) tmp593) (syntax-violation #f "source expression failed to match any pattern" tmp592))) ($sc-dispatch tmp592 (quote (any any any))))) e553) (values (quote call) #f e553 w555 s556 mod558))))))))))))) (values (quote call) #f e553 w555 s556 mod558))) (if (syntax-object?98 e553) (syntax-type148 (syntax-object-expression99 e553) r554 (join-wraps133 w555 (syntax-object-wrap100 e553)) #f rib557 (let ((t600 (syntax-object-module101 e553))) (if t600 t600 mod558))) (if (annotation? e553) (syntax-type148 (annotation-expression e553) r554 w555 (annotation-source e553) rib557 mod558) (if (self-evaluating? e553) (values (quote constant) #f e553 w555 s556 mod558) (values (quote other) #f e553 w555 s556 mod558)))))))) (chi-when-list147 (lambda (e601 when-list602 w603) (letrec ((f604 (lambda (when-list605 situations606) (if (null? when-list605) situations606 (f604 (cdr when-list605) (cons (let ((x607 (car when-list605))) (if (free-id=?137 x607 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile) (if (free-id=?137 x607 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load) (if (free-id=?137 x607 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval) (syntax-violation (quote eval-when) "invalid situation" e601 (wrap142 x607 w603 #f)))))) situations606)))))) (f604 when-list602 (quote ()))))) (chi-install-global146 (lambda (name608 e609) (build-global-definition89 #f name608 (if (let ((v610 (module-variable (current-module) name608))) (if v610 (if (variable-bound? v610) (if (macro? (variable-ref v610)) (not (eq? (macro-type (variable-ref v610)) (quote syncase-macro))) #f) #f) #f)) (build-application81 #f (build-primref91 #f (quote make-extended-syncase-macro)) (list (build-application81 #f (build-primref91 #f (quote module-ref)) (list (build-application81 #f (build-primref91 #f (quote current-module)) (quote ())) (build-data92 #f name608))) (build-data92 #f (quote macro)) e609)) (build-application81 #f (build-primref91 #f (quote make-syncase-macro)) (list (build-data92 #f (quote macro)) e609)))))) (chi-top-sequence145 (lambda (body611 r612 w613 s614 m615 esew616 mod617) (build-sequence93 s614 (letrec ((dobody618 (lambda (body619 r620 w621 m622 esew623 mod624) (if (null? body619) (quote ()) (let ((first625 (chi-top149 (car body619) r620 w621 m622 esew623 mod624))) (cons first625 (dobody618 (cdr body619) r620 w621 m622 esew623 mod624))))))) (dobody618 body611 r612 w613 m615 esew616 mod617))))) (chi-sequence144 (lambda (body626 r627 w628 s629 mod630) (build-sequence93 s629 (letrec ((dobody631 (lambda (body632 r633 w634 mod635) (if (null? body632) (quote ()) (let ((first636 (chi150 (car body632) r633 w634 mod635))) (cons first636 (dobody631 (cdr body632) r633 w634 mod635))))))) (dobody631 body626 r627 w628 mod630))))) (source-wrap143 (lambda (x637 w638 s639 defmod640) (wrap142 (if s639 (make-annotation x637 s639 #f) x637) w638 defmod640))) (wrap142 (lambda (x641 w642 defmod643) (if (if (null? (wrap-marks117 w642)) (null? (wrap-subst118 w642)) #f) x641 (if (syntax-object?98 x641) (make-syntax-object97 (syntax-object-expression99 x641) (join-wraps133 w642 (syntax-object-wrap100 x641)) (syntax-object-module101 x641)) (if (null? x641) x641 (make-syntax-object97 x641 w642 defmod643)))))) (bound-id-member?141 (lambda (x644 list645) (if (not (null? list645)) (let ((t646 (bound-id=?138 x644 (car list645)))) (if t646 t646 (bound-id-member?141 x644 (cdr list645)))) #f))) (distinct-bound-ids?140 (lambda (ids647) (letrec ((distinct?648 (lambda (ids649) (let ((t650 (null? ids649))) (if t650 t650 (if (not (bound-id-member?141 (car ids649) (cdr ids649))) (distinct?648 (cdr ids649)) #f)))))) (distinct?648 ids647)))) (valid-bound-ids?139 (lambda (ids651) (if (letrec ((all-ids?652 (lambda (ids653) (let ((t654 (null? ids653))) (if t654 t654 (if (id?114 (car ids653)) (all-ids?652 (cdr ids653)) #f)))))) (all-ids?652 ids651)) (distinct-bound-ids?140 ids651) #f))) (bound-id=?138 (lambda (i655 j656) (if (if (syntax-object?98 i655) (syntax-object?98 j656) #f) (if (eq? (let ((e657 (syntax-object-expression99 i655))) (if (annotation? e657) (annotation-expression e657) e657)) (let ((e658 (syntax-object-expression99 j656))) (if (annotation? e658) (annotation-expression e658) e658))) (same-marks?135 (wrap-marks117 (syntax-object-wrap100 i655)) (wrap-marks117 (syntax-object-wrap100 j656))) #f) (eq? (let ((e659 i655)) (if (annotation? e659) (annotation-expression e659) e659)) (let ((e660 j656)) (if (annotation? e660) (annotation-expression e660) e660)))))) (free-id=?137 (lambda (i661 j662) (if (eq? (let ((x663 i661)) (let ((e664 (if (syntax-object?98 x663) (syntax-object-expression99 x663) x663))) (if (annotation? e664) (annotation-expression e664) e664))) (let ((x665 j662)) (let ((e666 (if (syntax-object?98 x665) (syntax-object-expression99 x665) x665))) (if (annotation? e666) (annotation-expression e666) e666)))) (eq? (id-var-name136 i661 (quote (()))) (id-var-name136 j662 (quote (())))) #f))) (id-var-name136 (lambda (id667 w668) (letrec ((search-vector-rib671 (lambda (sym677 subst678 marks679 symnames680 ribcage681) (let ((n682 (vector-length symnames680))) (letrec ((f683 (lambda (i684) (if (fx=74 i684 n682) (search669 sym677 (cdr subst678) marks679) (if (if (eq? (vector-ref symnames680 i684) sym677) (same-marks?135 marks679 (vector-ref (ribcage-marks124 ribcage681) i684)) #f) (values (vector-ref (ribcage-labels125 ribcage681) i684) marks679) (f683 (fx+72 i684 1))))))) (f683 0))))) (search-list-rib670 (lambda (sym685 subst686 marks687 symnames688 ribcage689) (letrec ((f690 (lambda (symnames691 i692) (if (null? symnames691) (search669 sym685 (cdr subst686) marks687) (if (if (eq? (car symnames691) sym685) (same-marks?135 marks687 (list-ref (ribcage-marks124 ribcage689) i692)) #f) (values (list-ref (ribcage-labels125 ribcage689) i692) marks687) (f690 (cdr symnames691) (fx+72 i692 1))))))) (f690 symnames688 0)))) (search669 (lambda (sym693 subst694 marks695) (if (null? subst694) (values #f marks695) (let ((fst696 (car subst694))) (if (eq? fst696 (quote shift)) (search669 sym693 (cdr subst694) (cdr marks695)) (let ((symnames697 (ribcage-symnames123 fst696))) (if (vector? symnames697) (search-vector-rib671 sym693 subst694 marks695 symnames697 fst696) (search-list-rib670 sym693 subst694 marks695 symnames697 fst696))))))))) (if (symbol? id667) (let ((t698 (call-with-values (lambda () (search669 id667 (wrap-subst118 w668) (wrap-marks117 w668))) (lambda (x700 . ignore699) x700)))) (if t698 t698 id667)) (if (syntax-object?98 id667) (let ((id701 (let ((e703 (syntax-object-expression99 id667))) (if (annotation? e703) (annotation-expression e703) e703))) (w1702 (syntax-object-wrap100 id667))) (let ((marks704 (join-marks134 (wrap-marks117 w668) (wrap-marks117 w1702)))) (call-with-values (lambda () (search669 id701 (wrap-subst118 w668) marks704)) (lambda (new-id705 marks706) (let ((t707 new-id705)) (if t707 t707 (let ((t708 (call-with-values (lambda () (search669 id701 (wrap-subst118 w1702) marks706)) (lambda (x710 . ignore709) x710)))) (if t708 t708 id701)))))))) (if (annotation? id667) (let ((id711 (let ((e712 id667)) (if (annotation? e712) (annotation-expression e712) e712)))) (let ((t713 (call-with-values (lambda () (search669 id711 (wrap-subst118 w668) (wrap-marks117 w668))) (lambda (x715 . ignore714) x715)))) (if t713 t713 id711))) (syntax-violation (quote id-var-name) "invalid id" id667))))))) (same-marks?135 (lambda (x716 y717) (let ((t718 (eq? x716 y717))) (if t718 t718 (if (not (null? x716)) (if (not (null? y717)) (if (eq? (car x716) (car y717)) (same-marks?135 (cdr x716) (cdr y717)) #f) #f) #f))))) (join-marks134 (lambda (m1719 m2720) (smart-append132 m1719 m2720))) (join-wraps133 (lambda (w1721 w2722) (let ((m1723 (wrap-marks117 w1721)) (s1724 (wrap-subst118 w1721))) (if (null? m1723) (if (null? s1724) w2722 (make-wrap116 (wrap-marks117 w2722) (smart-append132 s1724 (wrap-subst118 w2722)))) (make-wrap116 (smart-append132 m1723 (wrap-marks117 w2722)) (smart-append132 s1724 (wrap-subst118 w2722))))))) (smart-append132 (lambda (m1725 m2726) (if (null? m2726) m1725 (append m1725 m2726)))) (make-binding-wrap131 (lambda (ids727 labels728 w729) (if (null? ids727) w729 (make-wrap116 (wrap-marks117 w729) (cons (let ((labelvec730 (list->vector labels728))) (let ((n731 (vector-length labelvec730))) (let ((symnamevec732 (make-vector n731)) (marksvec733 (make-vector n731))) (begin (letrec ((f734 (lambda (ids735 i736) (if (not (null? ids735)) (call-with-values (lambda () (id-sym-name&marks115 (car ids735) w729)) (lambda (symname737 marks738) (begin (vector-set! symnamevec732 i736 symname737) (vector-set! marksvec733 i736 marks738) (f734 (cdr ids735) (fx+72 i736 1))))))))) (f734 ids727 0)) (make-ribcage121 symnamevec732 marksvec733 labelvec730))))) (wrap-subst118 w729)))))) (extend-ribcage!130 (lambda (ribcage739 id740 label741) (begin (set-ribcage-symnames!126 ribcage739 (cons (let ((e742 (syntax-object-expression99 id740))) (if (annotation? e742) (annotation-expression e742) e742)) (ribcage-symnames123 ribcage739))) (set-ribcage-marks!127 ribcage739 (cons (wrap-marks117 (syntax-object-wrap100 id740)) (ribcage-marks124 ribcage739))) (set-ribcage-labels!128 ribcage739 (cons label741 (ribcage-labels125 ribcage739)))))) (anti-mark129 (lambda (w743) (make-wrap116 (cons #f (wrap-marks117 w743)) (cons (quote shift) (wrap-subst118 w743))))) (set-ribcage-labels!128 (lambda (x744 update745) (vector-set! x744 3 update745))) (set-ribcage-marks!127 (lambda (x746 update747) (vector-set! x746 2 update747))) (set-ribcage-symnames!126 (lambda (x748 update749) (vector-set! x748 1 update749))) (ribcage-labels125 (lambda (x750) (vector-ref x750 3))) (ribcage-marks124 (lambda (x751) (vector-ref x751 2))) (ribcage-symnames123 (lambda (x752) (vector-ref x752 1))) (ribcage?122 (lambda (x753) (if (vector? x753) (if (= (vector-length x753) 4) (eq? (vector-ref x753 0) (quote ribcage)) #f) #f))) (make-ribcage121 (lambda (symnames754 marks755 labels756) (vector (quote ribcage) symnames754 marks755 labels756))) (gen-labels120 (lambda (ls757) (if (null? ls757) (quote ()) (cons (gen-label119) (gen-labels120 (cdr ls757)))))) (gen-label119 (lambda () (string #\i))) (wrap-subst118 cdr) (wrap-marks117 car) (make-wrap116 cons) (id-sym-name&marks115 (lambda (x758 w759) (if (syntax-object?98 x758) (values (let ((e760 (syntax-object-expression99 x758))) (if (annotation? e760) (annotation-expression e760) e760)) (join-marks134 (wrap-marks117 w759) (wrap-marks117 (syntax-object-wrap100 x758)))) (values (let ((e761 x758)) (if (annotation? e761) (annotation-expression e761) e761)) (wrap-marks117 w759))))) (id?114 (lambda (x762) (if (symbol? x762) #t (if (syntax-object?98 x762) (symbol? (let ((e763 (syntax-object-expression99 x762))) (if (annotation? e763) (annotation-expression e763) e763))) (if (annotation? x762) (symbol? (annotation-expression x762)) #f))))) (nonsymbol-id?113 (lambda (x764) (if (syntax-object?98 x764) (symbol? (let ((e765 (syntax-object-expression99 x764))) (if (annotation? e765) (annotation-expression e765) e765))) #f))) (global-extend112 (lambda (type766 sym767 val768) (put-global-definition-hook78 sym767 type766 val768))) (lookup111 (lambda (x769 r770 mod771) (let ((t772 (assq x769 r770))) (if t772 (cdr t772) (if (symbol? x769) (let ((t773 (get-global-definition-hook79 x769 mod771))) (if t773 t773 (quote (global)))) (quote (displaced-lexical))))))) (macros-only-env110 (lambda (r774) (if (null? r774) (quote ()) (let ((a775 (car r774))) (if (eq? (cadr a775) (quote macro)) (cons a775 (macros-only-env110 (cdr r774))) (macros-only-env110 (cdr r774))))))) (extend-var-env109 (lambda (labels776 vars777 r778) (if (null? labels776) r778 (extend-var-env109 (cdr labels776) (cdr vars777) (cons (cons (car labels776) (cons (quote lexical) (car vars777))) r778))))) (extend-env108 (lambda (labels779 bindings780 r781) (if (null? labels779) r781 (extend-env108 (cdr labels779) (cdr bindings780) (cons (cons (car labels779) (car bindings780)) r781))))) (binding-value107 cdr) (binding-type106 car) (source-annotation105 (lambda (x782) (if (annotation? x782) (annotation-source x782) (if (syntax-object?98 x782) (source-annotation105 (syntax-object-expression99 x782)) #f)))) (set-syntax-object-module!104 (lambda (x783 update784) (vector-set! x783 3 update784))) (set-syntax-object-wrap!103 (lambda (x785 update786) (vector-set! x785 2 update786))) (set-syntax-object-expression!102 (lambda (x787 update788) (vector-set! x787 1 update788))) (syntax-object-module101 (lambda (x789) (vector-ref x789 3))) (syntax-object-wrap100 (lambda (x790) (vector-ref x790 2))) (syntax-object-expression99 (lambda (x791) (vector-ref x791 1))) (syntax-object?98 (lambda (x792) (if (vector? x792) (if (= (vector-length x792) 4) (eq? (vector-ref x792 0) (quote syntax-object)) #f) #f))) (make-syntax-object97 (lambda (expression793 wrap794 module795) (vector (quote syntax-object) expression793 wrap794 module795))) (build-letrec96 (lambda (src796 ids797 vars798 val-exps799 body-exp800) (if (null? vars798) body-exp800 (let ((atom-key801 (fluid-ref *mode*71))) (if (memv atom-key801 (quote (c))) (begin (for-each maybe-name-value!88 ids797 val-exps799) ((@ (language tree-il) make-letrec) src796 ids797 vars798 val-exps799 body-exp800)) (list (quote letrec) (map list vars798 val-exps799) body-exp800)))))) (build-named-let95 (lambda (src802 ids803 vars804 val-exps805 body-exp806) (let ((f807 (car vars804)) (f-name808 (car ids803)) (vars809 (cdr vars804)) (ids810 (cdr ids803))) (let ((atom-key811 (fluid-ref *mode*71))) (if (memv atom-key811 (quote (c))) (let ((proc812 (build-lambda90 src802 ids810 vars809 #f body-exp806))) (begin (maybe-name-value!88 f-name808 proc812) (for-each maybe-name-value!88 ids810 val-exps805) ((@ (language tree-il) make-letrec) src802 (list f-name808) (list f807) (list proc812) (build-application81 src802 (build-lexical-reference83 (quote fun) src802 f-name808 f807) val-exps805)))) (list (quote let) f807 (map list vars809 val-exps805) body-exp806)))))) (build-let94 (lambda (src813 ids814 vars815 val-exps816 body-exp817) (if (null? vars815) body-exp817 (let ((atom-key818 (fluid-ref *mode*71))) (if (memv atom-key818 (quote (c))) (begin (for-each maybe-name-value!88 ids814 val-exps816) ((@ (language tree-il) make-let) src813 ids814 vars815 val-exps816 body-exp817)) (list (quote let) (map list vars815 val-exps816) body-exp817)))))) (build-sequence93 (lambda (src819 exps820) (if (null? (cdr exps820)) (car exps820) (let ((atom-key821 (fluid-ref *mode*71))) (if (memv atom-key821 (quote (c))) ((@ (language tree-il) make-sequence) src819 exps820) (cons (quote begin) exps820)))))) (build-data92 (lambda (src822 exp823) (let ((atom-key824 (fluid-ref *mode*71))) (if (memv atom-key824 (quote (c))) ((@ (language tree-il) make-const) src822 exp823) (if (if (self-evaluating? exp823) (not (vector? exp823)) #f) exp823 (list (quote quote) exp823)))))) (build-primref91 (lambda (src825 name826) (if (equal? (module-name (current-module)) (quote (guile))) (let ((atom-key827 (fluid-ref *mode*71))) (if (memv atom-key827 (quote (c))) ((@ (language tree-il) make-toplevel-ref) src825 name826) name826)) (let ((atom-key828 (fluid-ref *mode*71))) (if (memv atom-key828 (quote (c))) ((@ (language tree-il) make-module-ref) src825 (quote (guile)) name826 #f) (list (quote @@) (quote (guile)) name826)))))) (build-lambda90 (lambda (src829 ids830 vars831 docstring832 exp833) (let ((atom-key834 (fluid-ref *mode*71))) (if (memv atom-key834 (quote (c))) ((@ (language tree-il) make-lambda) src829 ids830 vars831 (if docstring832 (list (cons (quote documentation) docstring832)) (quote ())) exp833) (cons (quote lambda) (cons vars831 (append (if docstring832 (list docstring832) (quote ())) (list exp833)))))))) (build-global-definition89 (lambda (source835 var836 exp837) (let ((atom-key838 (fluid-ref *mode*71))) (if (memv atom-key838 (quote (c))) (begin (maybe-name-value!88 var836 exp837) ((@ (language tree-il) make-toplevel-define) source835 var836 exp837)) (list (quote define) var836 exp837))))) (maybe-name-value!88 (lambda (name839 val840) (if ((@ (language tree-il) lambda?) val840) (let ((meta841 ((@ (language tree-il) lambda-meta) val840))) (if (not (assq (quote name) meta841)) ((setter (@ (language tree-il) lambda-meta)) val840 (acons (quote name) name839 meta841))))))) (build-global-assignment87 (lambda (source842 var843 exp844 mod845) (analyze-variable85 mod845 var843 (lambda (mod846 var847 public?848) (let ((atom-key849 (fluid-ref *mode*71))) (if (memv atom-key849 (quote (c))) ((@ (language tree-il) make-module-set) source842 mod846 var847 public?848 exp844) (list (quote set!) (list (if public?848 (quote @) (quote @@)) mod846 var847) exp844)))) (lambda (var850) (let ((atom-key851 (fluid-ref *mode*71))) (if (memv atom-key851 (quote (c))) ((@ (language tree-il) make-toplevel-set) source842 var850 exp844) (list (quote set!) var850 exp844))))))) (build-global-reference86 (lambda (source852 var853 mod854) (analyze-variable85 mod854 var853 (lambda (mod855 var856 public?857) (let ((atom-key858 (fluid-ref *mode*71))) (if (memv atom-key858 (quote (c))) ((@ (language tree-il) make-module-ref) source852 mod855 var856 public?857) (list (if public?857 (quote @) (quote @@)) mod855 var856)))) (lambda (var859) (let ((atom-key860 (fluid-ref *mode*71))) (if (memv atom-key860 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source852 var859) var859)))))) (analyze-variable85 (lambda (mod861 var862 modref-cont863 bare-cont864) (if (not mod861) (bare-cont864 var862) (let ((kind865 (car mod861)) (mod866 (cdr mod861))) (if (memv kind865 (quote (public))) (modref-cont863 mod866 var862 #t) (if (memv kind865 (quote (private))) (if (not (equal? mod866 (module-name (current-module)))) (modref-cont863 mod866 var862 #f) (bare-cont864 var862)) (if (memv kind865 (quote (bare))) (bare-cont864 var862) (if (memv kind865 (quote (hygiene))) (if (if (not (equal? mod866 (module-name (current-module)))) (module-variable (resolve-module mod866) var862) #f) (modref-cont863 mod866 var862 #f) (bare-cont864 var862)) (syntax-violation #f "bad module kind" var862 mod866))))))))) (build-lexical-assignment84 (lambda (source867 name868 var869 exp870) (let ((atom-key871 (fluid-ref *mode*71))) (if (memv atom-key871 (quote (c))) ((@ (language tree-il) make-lexical-set) source867 name868 var869 exp870) (list (quote set!) var869 exp870))))) (build-lexical-reference83 (lambda (type872 source873 name874 var875) (let ((atom-key876 (fluid-ref *mode*71))) (if (memv atom-key876 (quote (c))) ((@ (language tree-il) make-lexical-ref) source873 name874 var875) var875)))) (build-conditional82 (lambda (source877 test-exp878 then-exp879 else-exp880) (let ((atom-key881 (fluid-ref *mode*71))) (if (memv atom-key881 (quote (c))) ((@ (language tree-il) make-conditional) source877 test-exp878 then-exp879 else-exp880) (if (equal? else-exp880 (quote (if #f #f))) (list (quote if) test-exp878 then-exp879) (list (quote if) test-exp878 then-exp879 else-exp880)))))) (build-application81 (lambda (source882 fun-exp883 arg-exps884) (let ((atom-key885 (fluid-ref *mode*71))) (if (memv atom-key885 (quote (c))) ((@ (language tree-il) make-application) source882 fun-exp883 arg-exps884) (cons fun-exp883 arg-exps884))))) (build-void80 (lambda (source886) (let ((atom-key887 (fluid-ref *mode*71))) (if (memv atom-key887 (quote (c))) ((@ (language tree-il) make-void) source886) (quote (if #f #f)))))) (get-global-definition-hook79 (lambda (symbol888 module889) (begin (if (if (not module889) (current-module) #f) (warn "module system is booted, we should have a module" symbol888)) (let ((v890 (module-variable (if module889 (resolve-module (cdr module889)) (current-module)) symbol888))) (if v890 (if (variable-bound? v890) (let ((val891 (variable-ref v890))) (if (macro? val891) (if (syncase-macro-type val891) (cons (syncase-macro-type val891) (syncase-macro-binding val891)) #f) #f)) #f) #f))))) (put-global-definition-hook78 (lambda (symbol892 type893 val894) (let ((existing895 (let ((v896 (module-variable (current-module) symbol892))) (if v896 (if (variable-bound? v896) (let ((val897 (variable-ref v896))) (if (macro? val897) (if (not (syncase-macro-type val897)) val897 #f) #f)) #f) #f)))) (module-define! (current-module) symbol892 (if existing895 (make-extended-syncase-macro existing895 type893 val894) (make-syncase-macro type893 val894)))))) (local-eval-hook77 (lambda (x898 mod899) (primitive-eval (list noexpand70 (let ((atom-key900 (fluid-ref *mode*71))) (if (memv atom-key900 (quote (c))) ((@ (language tree-il) tree-il->scheme) x898) x898)))))) (top-level-eval-hook76 (lambda (x901 mod902) (primitive-eval (list noexpand70 (let ((atom-key903 (fluid-ref *mode*71))) (if (memv atom-key903 (quote (c))) ((@ (language tree-il) tree-il->scheme) x901) x901)))))) (fx<75 <) (fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand")) (begin (global-extend112 (quote local-syntax) (quote letrec-syntax) #t) (global-extend112 (quote local-syntax) (quote let-syntax) #f) (global-extend112 (quote core) (quote fluid-let-syntax) (lambda (e904 r905 w906 s907 mod908) ((lambda (tmp909) ((lambda (tmp910) (if (if tmp910 (apply (lambda (_911 var912 val913 e1914 e2915) (valid-bound-ids?139 var912)) tmp910) #f) (apply (lambda (_917 var918 val919 e1920 e2921) (let ((names922 (map (lambda (x923) (id-var-name136 x923 w906)) var918))) (begin (for-each (lambda (id925 n926) (let ((atom-key927 (binding-type106 (lookup111 n926 r905 mod908)))) (if (memv atom-key927 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e904 (source-wrap143 id925 w906 s907 mod908))))) var918 names922) (chi-body154 (cons e1920 e2921) (source-wrap143 e904 w906 s907 mod908) (extend-env108 names922 (let ((trans-r930 (macros-only-env110 r905))) (map (lambda (x931) (cons (quote macro) (eval-local-transformer157 (chi150 x931 trans-r930 w906 mod908) mod908))) val919)) r905) w906 mod908)))) tmp910) ((lambda (_933) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap143 e904 w906 s907 mod908))) tmp909))) ($sc-dispatch tmp909 (quote (any #(each (any any)) any . each-any))))) e904))) (global-extend112 (quote core) (quote quote) (lambda (e934 r935 w936 s937 mod938) ((lambda (tmp939) ((lambda (tmp940) (if tmp940 (apply (lambda (_941 e942) (build-data92 s937 (strip161 e942 w936))) tmp940) ((lambda (_943) (syntax-violation (quote quote) "bad syntax" (source-wrap143 e934 w936 s937 mod938))) tmp939))) ($sc-dispatch tmp939 (quote (any any))))) e934))) (global-extend112 (quote core) (quote syntax) (letrec ((regen951 (lambda (x952) (let ((atom-key953 (car x952))) (if (memv atom-key953 (quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x952) (cadr x952)) (if (memv atom-key953 (quote (primitive))) (build-primref91 #f (cadr x952)) (if (memv atom-key953 (quote (quote))) (build-data92 #f (cadr x952)) (if (memv atom-key953 (quote (lambda))) (build-lambda90 #f (cadr x952) (cadr x952) #f (regen951 (caddr x952))) (if (memv atom-key953 (quote (map))) (let ((ls954 (map regen951 (cdr x952)))) (build-application81 #f (build-primref91 #f (quote map)) ls954)) (build-application81 #f (build-primref91 #f (car x952)) (map regen951 (cdr x952))))))))))) (gen-vector950 (lambda (x955) (if (eq? (car x955) (quote list)) (cons (quote vector) (cdr x955)) (if (eq? (car x955) (quote quote)) (list (quote quote) (list->vector (cadr x955))) (list (quote list->vector) x955))))) (gen-append949 (lambda (x956 y957) (if (equal? y957 (quote (quote ()))) x956 (list (quote append) x956 y957)))) (gen-cons948 (lambda (x958 y959) (let ((atom-key960 (car y959))) (if (memv atom-key960 (quote (quote))) (if (eq? (car x958) (quote quote)) (list (quote quote) (cons (cadr x958) (cadr y959))) (if (eq? (cadr y959) (quote ())) (list (quote list) x958) (list (quote cons) x958 y959))) (if (memv atom-key960 (quote (list))) (cons (quote list) (cons x958 (cdr y959))) (list (quote cons) x958 y959)))))) (gen-map947 (lambda (e961 map-env962) (let ((formals963 (map cdr map-env962)) (actuals964 (map (lambda (x965) (list (quote ref) (car x965))) map-env962))) (if (eq? (car e961) (quote ref)) (car actuals964) (if (and-map (lambda (x966) (if (eq? (car x966) (quote ref)) (memq (cadr x966) formals963) #f)) (cdr e961)) (cons (quote map) (cons (list (quote primitive) (car e961)) (map (let ((r967 (map cons formals963 actuals964))) (lambda (x968) (cdr (assq (cadr x968) r967)))) (cdr e961)))) (cons (quote map) (cons (list (quote lambda) formals963 e961) actuals964))))))) (gen-mappend946 (lambda (e969 map-env970) (list (quote apply) (quote (primitive append)) (gen-map947 e969 map-env970)))) (gen-ref945 (lambda (src971 var972 level973 maps974) (if (fx=74 level973 0) (values var972 maps974) (if (null? maps974) (syntax-violation (quote syntax) "missing ellipsis" src971) (call-with-values (lambda () (gen-ref945 src971 var972 (fx-73 level973 1) (cdr maps974))) (lambda (outer-var975 outer-maps976) (let ((b977 (assq outer-var975 (car maps974)))) (if b977 (values (cdr b977) maps974) (let ((inner-var978 (gen-var162 (quote tmp)))) (values inner-var978 (cons (cons (cons outer-var975 inner-var978) (car maps974)) outer-maps976))))))))))) (gen-syntax944 (lambda (src979 e980 r981 maps982 ellipsis?983 mod984) (if (id?114 e980) (let ((label985 (id-var-name136 e980 (quote (()))))) (let ((b986 (lookup111 label985 r981 mod984))) (if (eq? (binding-type106 b986) (quote syntax)) (call-with-values (lambda () (let ((var.lev987 (binding-value107 b986))) (gen-ref945 src979 (car var.lev987) (cdr var.lev987) maps982))) (lambda (var988 maps989) (values (list (quote ref) var988) maps989))) (if (ellipsis?983 e980) (syntax-violation (quote syntax) "misplaced ellipsis" src979) (values (list (quote quote) e980) maps982))))) ((lambda (tmp990) ((lambda (tmp991) (if (if tmp991 (apply (lambda (dots992 e993) (ellipsis?983 dots992)) tmp991) #f) (apply (lambda (dots994 e995) (gen-syntax944 src979 e995 r981 maps982 (lambda (x996) #f) mod984)) tmp991) ((lambda (tmp997) (if (if tmp997 (apply (lambda (x998 dots999 y1000) (ellipsis?983 dots999)) tmp997) #f) (apply (lambda (x1001 dots1002 y1003) (letrec ((f1004 (lambda (y1005 k1006) ((lambda (tmp1010) ((lambda (tmp1011) (if (if tmp1011 (apply (lambda (dots1012 y1013) (ellipsis?983 dots1012)) tmp1011) #f) (apply (lambda (dots1014 y1015) (f1004 y1015 (lambda (maps1016) (call-with-values (lambda () (k1006 (cons (quote ()) maps1016))) (lambda (x1017 maps1018) (if (null? (car maps1018)) (syntax-violation (quote syntax) "extra ellipsis" src979) (values (gen-mappend946 x1017 (car maps1018)) (cdr maps1018)))))))) tmp1011) ((lambda (_1019) (call-with-values (lambda () (gen-syntax944 src979 y1005 r981 maps982 ellipsis?983 mod984)) (lambda (y1020 maps1021) (call-with-values (lambda () (k1006 maps1021)) (lambda (x1022 maps1023) (values (gen-append949 x1022 y1020) maps1023)))))) tmp1010))) ($sc-dispatch tmp1010 (quote (any . any))))) y1005)))) (f1004 y1003 (lambda (maps1007) (call-with-values (lambda () (gen-syntax944 src979 x1001 r981 (cons (quote ()) maps1007) ellipsis?983 mod984)) (lambda (x1008 maps1009) (if (null? (car maps1009)) (syntax-violation (quote syntax) "extra ellipsis" src979) (values (gen-map947 x1008 (car maps1009)) (cdr maps1009))))))))) tmp997) ((lambda (tmp1024) (if tmp1024 (apply (lambda (x1025 y1026) (call-with-values (lambda () (gen-syntax944 src979 x1025 r981 maps982 ellipsis?983 mod984)) (lambda (x1027 maps1028) (call-with-values (lambda () (gen-syntax944 src979 y1026 r981 maps1028 ellipsis?983 mod984)) (lambda (y1029 maps1030) (values (gen-cons948 x1027 y1029) maps1030)))))) tmp1024) ((lambda (tmp1031) (if tmp1031 (apply (lambda (e11032 e21033) (call-with-values (lambda () (gen-syntax944 src979 (cons e11032 e21033) r981 maps982 ellipsis?983 mod984)) (lambda (e1035 maps1036) (values (gen-vector950 e1035) maps1036)))) tmp1031) ((lambda (_1037) (values (list (quote quote) e980) maps982)) tmp990))) ($sc-dispatch tmp990 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp990 (quote (any . any)))))) ($sc-dispatch tmp990 (quote (any any . any)))))) ($sc-dispatch tmp990 (quote (any any))))) e980))))) (lambda (e1038 r1039 w1040 s1041 mod1042) (let ((e1043 (source-wrap143 e1038 w1040 s1041 mod1042))) ((lambda (tmp1044) ((lambda (tmp1045) (if tmp1045 (apply (lambda (_1046 x1047) (call-with-values (lambda () (gen-syntax944 e1043 x1047 r1039 (quote ()) ellipsis?159 mod1042)) (lambda (e1048 maps1049) (regen951 e1048)))) tmp1045) ((lambda (_1050) (syntax-violation (quote syntax) "bad `syntax' form" e1043)) tmp1044))) ($sc-dispatch tmp1044 (quote (any any))))) e1043))))) (global-extend112 (quote core) (quote lambda) (lambda (e1051 r1052 w1053 s1054 mod1055) ((lambda (tmp1056) ((lambda (tmp1057) (if tmp1057 (apply (lambda (_1058 c1059) (chi-lambda-clause155 (source-wrap143 e1051 w1053 s1054 mod1055) #f c1059 r1052 w1053 mod1055 (lambda (names1060 vars1061 docstring1062 body1063) (build-lambda90 s1054 names1060 vars1061 docstring1062 body1063)))) tmp1057) (syntax-violation #f "source expression failed to match any pattern" tmp1056))) ($sc-dispatch tmp1056 (quote (any . any))))) e1051))) (global-extend112 (quote core) (quote let) (letrec ((chi-let1064 (lambda (e1065 r1066 w1067 s1068 mod1069 constructor1070 ids1071 vals1072 exps1073) (if (not (valid-bound-ids?139 ids1071)) (syntax-violation (quote let) "duplicate bound variable" e1065) (let ((labels1074 (gen-labels120 ids1071)) (new-vars1075 (map gen-var162 ids1071))) (let ((nw1076 (make-binding-wrap131 ids1071 labels1074 w1067)) (nr1077 (extend-var-env109 labels1074 new-vars1075 r1066))) (constructor1070 s1068 (map syntax->datum ids1071) new-vars1075 (map (lambda (x1078) (chi150 x1078 r1066 w1067 mod1069)) vals1072) (chi-body154 exps1073 (source-wrap143 e1065 nw1076 s1068 mod1069) nr1077 nw1076 mod1069)))))))) (lambda (e1079 r1080 w1081 s1082 mod1083) ((lambda (tmp1084) ((lambda (tmp1085) (if (if tmp1085 (apply (lambda (_1086 id1087 val1088 e11089 e21090) (and-map id?114 id1087)) tmp1085) #f) (apply (lambda (_1092 id1093 val1094 e11095 e21096) (chi-let1064 e1079 r1080 w1081 s1082 mod1083 build-let94 id1093 val1094 (cons e11095 e21096))) tmp1085) ((lambda (tmp1100) (if (if tmp1100 (apply (lambda (_1101 f1102 id1103 val1104 e11105 e21106) (if (id?114 f1102) (and-map id?114 id1103) #f)) tmp1100) #f) (apply (lambda (_1108 f1109 id1110 val1111 e11112 e21113) (chi-let1064 e1079 r1080 w1081 s1082 mod1083 build-named-let95 (cons f1109 id1110) val1111 (cons e11112 e21113))) tmp1100) ((lambda (_1117) (syntax-violation (quote let) "bad let" (source-wrap143 e1079 w1081 s1082 mod1083))) tmp1084))) ($sc-dispatch tmp1084 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1084 (quote (any #(each (any any)) any . each-any))))) e1079)))) (global-extend112 (quote core) (quote letrec) (lambda (e1118 r1119 w1120 s1121 mod1122) ((lambda (tmp1123) ((lambda (tmp1124) (if (if tmp1124 (apply (lambda (_1125 id1126 val1127 e11128 e21129) (and-map id?114 id1126)) tmp1124) #f) (apply (lambda (_1131 id1132 val1133 e11134 e21135) (let ((ids1136 id1132)) (if (not (valid-bound-ids?139 ids1136)) (syntax-violation (quote letrec) "duplicate bound variable" e1118) (let ((labels1138 (gen-labels120 ids1136)) (new-vars1139 (map gen-var162 ids1136))) (let ((w1140 (make-binding-wrap131 ids1136 labels1138 w1120)) (r1141 (extend-var-env109 labels1138 new-vars1139 r1119))) (build-letrec96 s1121 (map syntax->datum ids1136) new-vars1139 (map (lambda (x1142) (chi150 x1142 r1141 w1140 mod1122)) val1133) (chi-body154 (cons e11134 e21135) (source-wrap143 e1118 w1140 s1121 mod1122) r1141 w1140 mod1122))))))) tmp1124) ((lambda (_1145) (syntax-violation (quote letrec) "bad letrec" (source-wrap143 e1118 w1120 s1121 mod1122))) tmp1123))) ($sc-dispatch tmp1123 (quote (any #(each (any any)) any . each-any))))) e1118))) (global-extend112 (quote core) (quote set!) (lambda (e1146 r1147 w1148 s1149 mod1150) ((lambda (tmp1151) ((lambda (tmp1152) (if (if tmp1152 (apply (lambda (_1153 id1154 val1155) (id?114 id1154)) tmp1152) #f) (apply (lambda (_1156 id1157 val1158) (let ((val1159 (chi150 val1158 r1147 w1148 mod1150)) (n1160 (id-var-name136 id1157 w1148))) (let ((b1161 (lookup111 n1160 r1147 mod1150))) (let ((atom-key1162 (binding-type106 b1161))) (if (memv atom-key1162 (quote (lexical))) (build-lexical-assignment84 s1149 (syntax->datum id1157) (binding-value107 b1161) val1159) (if (memv atom-key1162 (quote (global))) (build-global-assignment87 s1149 n1160 val1159 mod1150) (if (memv atom-key1162 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap142 id1157 w1148 mod1150)) (syntax-violation (quote set!) "bad set!" (source-wrap143 e1146 w1148 s1149 mod1150))))))))) tmp1152) ((lambda (tmp1163) (if tmp1163 (apply (lambda (_1164 head1165 tail1166 val1167) (call-with-values (lambda () (syntax-type148 head1165 r1147 (quote (())) #f #f mod1150)) (lambda (type1168 value1169 ee1170 ww1171 ss1172 modmod1173) (if (memv type1168 (quote (module-ref))) (let ((val1174 (chi150 val1167 r1147 w1148 mod1150))) (call-with-values (lambda () (value1169 (cons head1165 tail1166))) (lambda (id1176 mod1177) (build-global-assignment87 s1149 id1176 val1174 mod1177)))) (build-application81 s1149 (chi150 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head1165) r1147 w1148 mod1150) (map (lambda (e1178) (chi150 e1178 r1147 w1148 mod1150)) (append tail1166 (list val1167)))))))) tmp1163) ((lambda (_1180) (syntax-violation (quote set!) "bad set!" (source-wrap143 e1146 w1148 s1149 mod1150))) tmp1151))) ($sc-dispatch tmp1151 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1151 (quote (any any any))))) e1146))) (global-extend112 (quote module-ref) (quote @) (lambda (e1181) ((lambda (tmp1182) ((lambda (tmp1183) (if (if tmp1183 (apply (lambda (_1184 mod1185 id1186) (if (and-map id?114 mod1185) (id?114 id1186) #f)) tmp1183) #f) (apply (lambda (_1188 mod1189 id1190) (values (syntax->datum id1190) (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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1189)))) tmp1183) (syntax-violation #f "source expression failed to match any pattern" tmp1182))) ($sc-dispatch tmp1182 (quote (any each-any any))))) e1181))) (global-extend112 (quote module-ref) (quote @@) (lambda (e1192) ((lambda (tmp1193) ((lambda (tmp1194) (if (if tmp1194 (apply (lambda (_1195 mod1196 id1197) (if (and-map id?114 mod1196) (id?114 id1197) #f)) tmp1194) #f) (apply (lambda (_1199 mod1200 id1201) (values (syntax->datum id1201) (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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod1200)))) tmp1194) (syntax-violation #f "source expression failed to match any pattern" tmp1193))) ($sc-dispatch tmp1193 (quote (any each-any any))))) e1192))) (global-extend112 (quote core) (quote if) (lambda (e1203 r1204 w1205 s1206 mod1207) ((lambda (tmp1208) ((lambda (tmp1209) (if tmp1209 (apply (lambda (_1210 test1211 then1212) (build-conditional82 s1206 (chi150 test1211 r1204 w1205 mod1207) (chi150 then1212 r1204 w1205 mod1207) (build-void80 #f))) tmp1209) ((lambda (tmp1213) (if tmp1213 (apply (lambda (_1214 test1215 then1216 else1217) (build-conditional82 s1206 (chi150 test1215 r1204 w1205 mod1207) (chi150 then1216 r1204 w1205 mod1207) (chi150 else1217 r1204 w1205 mod1207))) tmp1213) (syntax-violation #f "source expression failed to match any pattern" tmp1208))) ($sc-dispatch tmp1208 (quote (any any any any)))))) ($sc-dispatch tmp1208 (quote (any any any))))) e1203))) (global-extend112 (quote begin) (quote begin) (quote ())) (global-extend112 (quote define) (quote define) (quote ())) (global-extend112 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend112 (quote eval-when) (quote eval-when) (quote ())) (global-extend112 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1221 (lambda (x1222 keys1223 clauses1224 r1225 mod1226) (if (null? clauses1224) (build-application81 #f (build-primref91 #f (quote syntax-violation)) (list (build-data92 #f #f) (build-data92 #f "source expression failed to match any pattern") x1222)) ((lambda (tmp1227) ((lambda (tmp1228) (if tmp1228 (apply (lambda (pat1229 exp1230) (if (if (id?114 pat1229) (and-map (lambda (x1231) (not (free-id=?137 pat1229 x1231))) (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 maybe-name-value! build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application build-void get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys1223)) #f) (let ((labels1232 (list (gen-label119))) (var1233 (gen-var162 pat1229))) (build-application81 #f (build-lambda90 #f (list (syntax->datum pat1229)) (list var1233) #f (chi150 exp1230 (extend-env108 labels1232 (list (cons (quote syntax) (cons var1233 0))) r1225) (make-binding-wrap131 (list pat1229) labels1232 (quote (()))) mod1226)) (list x1222))) (gen-clause1220 x1222 keys1223 (cdr clauses1224) r1225 pat1229 #t exp1230 mod1226))) tmp1228) ((lambda (tmp1234) (if tmp1234 (apply (lambda (pat1235 fender1236 exp1237) (gen-clause1220 x1222 keys1223 (cdr clauses1224) r1225 pat1235 fender1236 exp1237 mod1226)) tmp1234) ((lambda (_1238) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1224))) tmp1227))) ($sc-dispatch tmp1227 (quote (any any any)))))) ($sc-dispatch tmp1227 (quote (any any))))) (car clauses1224))))) (gen-clause1220 (lambda (x1239 keys1240 clauses1241 r1242 pat1243 fender1244 exp1245 mod1246) (call-with-values (lambda () (convert-pattern1218 pat1243 keys1240)) (lambda (p1247 pvars1248) (if (not (distinct-bound-ids?140 (map car pvars1248))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1243) (if (not (and-map (lambda (x1249) (not (ellipsis?159 (car x1249)))) pvars1248)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1243) (let ((y1250 (gen-var162 (quote tmp)))) (build-application81 #f (build-lambda90 #f (list (quote tmp)) (list y1250) #f (let ((y1251 (build-lexical-reference83 (quote value) #f (quote tmp) y1250))) (build-conditional82 #f ((lambda (tmp1252) ((lambda (tmp1253) (if tmp1253 (apply (lambda () y1251) tmp1253) ((lambda (_1254) (build-conditional82 #f y1251 (build-dispatch-call1219 pvars1248 fender1244 y1251 r1242 mod1246) (build-data92 #f #f))) tmp1252))) ($sc-dispatch tmp1252 (quote #(atom #t))))) fender1244) (build-dispatch-call1219 pvars1248 exp1245 y1251 r1242 mod1246) (gen-syntax-case1221 x1239 keys1240 clauses1241 r1242 mod1246)))) (list (if (eq? p1247 (quote any)) (build-application81 #f (build-primref91 #f (quote list)) (list x1239)) (build-application81 #f (build-primref91 #f (quote $sc-dispatch)) (list x1239 (build-data92 #f p1247))))))))))))) (build-dispatch-call1219 (lambda (pvars1255 exp1256 y1257 r1258 mod1259) (let ((ids1260 (map car pvars1255)) (levels1261 (map cdr pvars1255))) (let ((labels1262 (gen-labels120 ids1260)) (new-vars1263 (map gen-var162 ids1260))) (build-application81 #f (build-primref91 #f (quote apply)) (list (build-lambda90 #f (map syntax->datum ids1260) new-vars1263 #f (chi150 exp1256 (extend-env108 labels1262 (map (lambda (var1264 level1265) (cons (quote syntax) (cons var1264 level1265))) new-vars1263 (map cdr pvars1255)) r1258) (make-binding-wrap131 ids1260 labels1262 (quote (()))) mod1259)) y1257)))))) (convert-pattern1218 (lambda (pattern1266 keys1267) (letrec ((cvt1268 (lambda (p1269 n1270 ids1271) (if (id?114 p1269) (if (bound-id-member?141 p1269 keys1267) (values (vector (quote free-id) p1269) ids1271) (values (quote any) (cons (cons p1269 n1270) ids1271))) ((lambda (tmp1272) ((lambda (tmp1273) (if (if tmp1273 (apply (lambda (x1274 dots1275) (ellipsis?159 dots1275)) tmp1273) #f) (apply (lambda (x1276 dots1277) (call-with-values (lambda () (cvt1268 x1276 (fx+72 n1270 1) ids1271)) (lambda (p1278 ids1279) (values (if (eq? p1278 (quote any)) (quote each-any) (vector (quote each) p1278)) ids1279)))) tmp1273) ((lambda (tmp1280) (if tmp1280 (apply (lambda (x1281 y1282) (call-with-values (lambda () (cvt1268 y1282 n1270 ids1271)) (lambda (y1283 ids1284) (call-with-values (lambda () (cvt1268 x1281 n1270 ids1284)) (lambda (x1285 ids1286) (values (cons x1285 y1283) ids1286)))))) tmp1280) ((lambda (tmp1287) (if tmp1287 (apply (lambda () (values (quote ()) ids1271)) tmp1287) ((lambda (tmp1288) (if tmp1288 (apply (lambda (x1289) (call-with-values (lambda () (cvt1268 x1289 n1270 ids1271)) (lambda (p1291 ids1292) (values (vector (quote vector) p1291) ids1292)))) tmp1288) ((lambda (x1293) (values (vector (quote atom) (strip161 p1269 (quote (())))) ids1271)) tmp1272))) ($sc-dispatch tmp1272 (quote #(vector each-any)))))) ($sc-dispatch tmp1272 (quote ()))))) ($sc-dispatch tmp1272 (quote (any . any)))))) ($sc-dispatch tmp1272 (quote (any any))))) p1269))))) (cvt1268 pattern1266 0 (quote ())))))) (lambda (e1294 r1295 w1296 s1297 mod1298) (let ((e1299 (source-wrap143 e1294 w1296 s1297 mod1298))) ((lambda (tmp1300) ((lambda (tmp1301) (if tmp1301 (apply (lambda (_1302 val1303 key1304 m1305) (if (and-map (lambda (x1306) (if (id?114 x1306) (not (ellipsis?159 x1306)) #f)) key1304) (let ((x1308 (gen-var162 (quote tmp)))) (build-application81 s1297 (build-lambda90 #f (list (quote tmp)) (list x1308) #f (gen-syntax-case1221 (build-lexical-reference83 (quote value) #f (quote tmp) x1308) key1304 m1305 r1295 mod1298)) (list (chi150 val1303 r1295 (quote (())) mod1298)))) (syntax-violation (quote syntax-case) "invalid literals list" e1299))) tmp1301) (syntax-violation #f "source expression failed to match any pattern" tmp1300))) ($sc-dispatch tmp1300 (quote (any any each-any . each-any))))) e1299))))) (set! sc-expand (lambda (x1312 . rest1311) (if (if (pair? x1312) (equal? (car x1312) noexpand70) #f) (cadr x1312) (let ((m1313 (if (null? rest1311) (quote e) (car rest1311))) (esew1314 (if (let ((t1315 (null? rest1311))) (if t1315 t1315 (null? (cdr rest1311)))) (quote (eval)) (cadr rest1311)))) (with-fluid* *mode*71 m1313 (lambda () (chi-top149 x1312 (quote ()) (quote ((top))) m1313 esew1314 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1316) (nonsymbol-id?113 x1316))) (set! datum->syntax (lambda (id1317 datum1318) (make-syntax-object97 datum1318 (syntax-object-wrap100 id1317) #f))) (set! syntax->datum (lambda (x1319) (strip161 x1319 (quote (()))))) (set! generate-temporaries (lambda (ls1320) (begin (let ((x1321 ls1320)) (if (not (list? x1321)) (syntax-violation (quote generate-temporaries) "invalid argument" x1321))) (map (lambda (x1322) (wrap142 (gensym) (quote ((top))) #f)) ls1320)))) (set! free-identifier=? (lambda (x1323 y1324) (begin (let ((x1325 x1323)) (if (not (nonsymbol-id?113 x1325)) (syntax-violation (quote free-identifier=?) "invalid argument" x1325))) (let ((x1326 y1324)) (if (not (nonsymbol-id?113 x1326)) (syntax-violation (quote free-identifier=?) "invalid argument" x1326))) (free-id=?137 x1323 y1324)))) (set! bound-identifier=? (lambda (x1327 y1328) (begin (let ((x1329 x1327)) (if (not (nonsymbol-id?113 x1329)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1329))) (let ((x1330 y1328)) (if (not (nonsymbol-id?113 x1330)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1330))) (bound-id=?138 x1327 y1328)))) (set! syntax-violation (lambda (who1334 message1333 form1332 . subform1331) (begin (let ((x1335 who1334)) (if (not ((lambda (x1336) (let ((t1337 (not x1336))) (if t1337 t1337 (let ((t1338 (string? x1336))) (if t1338 t1338 (symbol? x1336)))))) x1335)) (syntax-violation (quote syntax-violation) "invalid argument" x1335))) (let ((x1339 message1333)) (if (not (string? x1339)) (syntax-violation (quote syntax-violation) "invalid argument" x1339))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1334 "~a: " "") "~a " (if (null? subform1331) "in ~a" "in subform `~s' of `~s'")) (let ((tail1340 (cons message1333 (map (lambda (x1341) (strip161 x1341 (quote (())))) (append subform1331 (list form1332)))))) (if who1334 (cons who1334 tail1340) tail1340)) #f)))) (letrec ((match1346 (lambda (e1347 p1348 w1349 r1350 mod1351) (if (not r1350) #f (if (eq? p1348 (quote any)) (cons (wrap142 e1347 w1349 mod1351) r1350) (if (syntax-object?98 e1347) (match*1345 (let ((e1352 (syntax-object-expression99 e1347))) (if (annotation? e1352) (annotation-expression e1352) e1352)) p1348 (join-wraps133 w1349 (syntax-object-wrap100 e1347)) r1350 (syntax-object-module101 e1347)) (match*1345 (let ((e1353 e1347)) (if (annotation? e1353) (annotation-expression e1353) e1353)) p1348 w1349 r1350 mod1351)))))) (match*1345 (lambda (e1354 p1355 w1356 r1357 mod1358) (if (null? p1355) (if (null? e1354) r1357 #f) (if (pair? p1355) (if (pair? e1354) (match1346 (car e1354) (car p1355) w1356 (match1346 (cdr e1354) (cdr p1355) w1356 r1357 mod1358) mod1358) #f) (if (eq? p1355 (quote each-any)) (let ((l1359 (match-each-any1343 e1354 w1356 mod1358))) (if l1359 (cons l1359 r1357) #f)) (let ((atom-key1360 (vector-ref p1355 0))) (if (memv atom-key1360 (quote (each))) (if (null? e1354) (match-empty1344 (vector-ref p1355 1) r1357) (let ((l1361 (match-each1342 e1354 (vector-ref p1355 1) w1356 mod1358))) (if l1361 (letrec ((collect1362 (lambda (l1363) (if (null? (car l1363)) r1357 (cons (map car l1363) (collect1362 (map cdr l1363))))))) (collect1362 l1361)) #f))) (if (memv atom-key1360 (quote (free-id))) (if (id?114 e1354) (if (free-id=?137 (wrap142 e1354 w1356 mod1358) (vector-ref p1355 1)) r1357 #f) #f) (if (memv atom-key1360 (quote (atom))) (if (equal? (vector-ref p1355 1) (strip161 e1354 w1356)) r1357 #f) (if (memv atom-key1360 (quote (vector))) (if (vector? e1354) (match1346 (vector->list e1354) (vector-ref p1355 1) w1356 r1357 mod1358) #f))))))))))) (match-empty1344 (lambda (p1364 r1365) (if (null? p1364) r1365 (if (eq? p1364 (quote any)) (cons (quote ()) r1365) (if (pair? p1364) (match-empty1344 (car p1364) (match-empty1344 (cdr p1364) r1365)) (if (eq? p1364 (quote each-any)) (cons (quote ()) r1365) (let ((atom-key1366 (vector-ref p1364 0))) (if (memv atom-key1366 (quote (each))) (match-empty1344 (vector-ref p1364 1) r1365) (if (memv atom-key1366 (quote (free-id atom))) r1365 (if (memv atom-key1366 (quote (vector))) (match-empty1344 (vector-ref p1364 1) r1365))))))))))) (match-each-any1343 (lambda (e1367 w1368 mod1369) (if (annotation? e1367) (match-each-any1343 (annotation-expression e1367) w1368 mod1369) (if (pair? e1367) (let ((l1370 (match-each-any1343 (cdr e1367) w1368 mod1369))) (if l1370 (cons (wrap142 (car e1367) w1368 mod1369) l1370) #f)) (if (null? e1367) (quote ()) (if (syntax-object?98 e1367) (match-each-any1343 (syntax-object-expression99 e1367) (join-wraps133 w1368 (syntax-object-wrap100 e1367)) mod1369) #f)))))) (match-each1342 (lambda (e1371 p1372 w1373 mod1374) (if (annotation? e1371) (match-each1342 (annotation-expression e1371) p1372 w1373 mod1374) (if (pair? e1371) (let ((first1375 (match1346 (car e1371) p1372 w1373 (quote ()) mod1374))) (if first1375 (let ((rest1376 (match-each1342 (cdr e1371) p1372 w1373 mod1374))) (if rest1376 (cons first1375 rest1376) #f)) #f)) (if (null? e1371) (quote ()) (if (syntax-object?98 e1371) (match-each1342 (syntax-object-expression99 e1371) p1372 (join-wraps133 w1373 (syntax-object-wrap100 e1371)) (syntax-object-module101 e1371)) #f))))))) (set! $sc-dispatch (lambda (e1377 p1378) (if (eq? p1378 (quote any)) (list e1377) (if (syntax-object?98 e1377) (match*1345 (let ((e1379 (syntax-object-expression99 e1377))) (if (annotation? e1379) (annotation-expression e1379) e1379)) p1378 (syntax-object-wrap100 e1377) (quote ()) (syntax-object-module101 e1377)) (match*1345 (let ((e1380 e1377)) (if (annotation? e1380) (annotation-expression e1380) e1380)) p1378 (quote (())) (quote ()) #f)))))))))
(define with-syntax (make-syncase-macro (quote macro) (lambda (x1381) ((lambda (tmp1382) ((lambda (tmp1383) (if tmp1383 (apply (lambda (_1384 e11385 e21386) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11385 e21386))) tmp1383) ((lambda (tmp1388) (if tmp1388 (apply (lambda (_1389 out1390 in1391 e11392 e21393) (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))) in1391 (quote ()) (list out1390 (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 e11392 e21393))))) tmp1388) ((lambda (tmp1395) (if tmp1395 (apply (lambda (_1396 out1397 in1398 e11399 e21400) (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))) in1398) (quote ()) (list out1397 (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 e11399 e21400))))) tmp1395) (syntax-violation #f "source expression failed to match any pattern" tmp1382))) ($sc-dispatch tmp1382 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1382 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1382 (quote (any () any . each-any))))) x1381))))
(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1404) ((lambda (tmp1405) ((lambda (tmp1406) (if tmp1406 (apply (lambda (_1407 k1408 keyword1409 pattern1410 template1411) (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 k1408 (map (lambda (tmp1414 tmp1413) (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))) tmp1413) (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))) tmp1414))) template1411 pattern1410)))))) tmp1406) (syntax-violation #f "source expression failed to match any pattern" tmp1405))) ($sc-dispatch tmp1405 (quote (any each-any . #(each ((any . any) any))))))) x1404))))
(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1415) ((lambda (tmp1416) ((lambda (tmp1417) (if (if tmp1417 (apply (lambda (let*1418 x1419 v1420 e11421 e21422) (and-map identifier? x1419)) tmp1417) #f) (apply (lambda (let*1424 x1425 v1426 e11427 e21428) (letrec ((f1429 (lambda (bindings1430) (if (null? bindings1430) (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 e11427 e21428))) ((lambda (tmp1434) ((lambda (tmp1435) (if tmp1435 (apply (lambda (body1436 binding1437) (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 binding1437) body1436)) tmp1435) (syntax-violation #f "source expression failed to match any pattern" tmp1434))) ($sc-dispatch tmp1434 (quote (any any))))) (list (f1429 (cdr bindings1430)) (car bindings1430))))))) (f1429 (map list x1425 v1426)))) tmp1417) (syntax-violation #f "source expression failed to match any pattern" tmp1416))) ($sc-dispatch tmp1416 (quote (any #(each (any any)) any . each-any))))) x1415))))
(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1438) ((lambda (tmp1439) ((lambda (tmp1440) (if tmp1440 (apply (lambda (_1441 var1442 init1443 step1444 e01445 e11446 c1447) ((lambda (tmp1448) ((lambda (tmp1449) (if tmp1449 (apply (lambda (step1450) ((lambda (tmp1451) ((lambda (tmp1452) (if tmp1452 (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 var1442 init1443) (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))) e01445) (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 c1447 (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))) step1450))))))) tmp1452) ((lambda (tmp1457) (if tmp1457 (apply (lambda (e11458 e21459) (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 var1442 init1443) (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))) e01445 (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 e11458 e21459)) (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 c1447 (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))) step1450))))))) tmp1457) (syntax-violation #f "source expression failed to match any pattern" tmp1451))) ($sc-dispatch tmp1451 (quote (any . each-any)))))) ($sc-dispatch tmp1451 (quote ())))) e11446)) tmp1449) (syntax-violation #f "source expression failed to match any pattern" tmp1448))) ($sc-dispatch tmp1448 (quote each-any)))) (map (lambda (v1466 s1467) ((lambda (tmp1468) ((lambda (tmp1469) (if tmp1469 (apply (lambda () v1466) tmp1469) ((lambda (tmp1470) (if tmp1470 (apply (lambda (e1471) e1471) tmp1470) ((lambda (_1472) (syntax-violation (quote do) "bad step expression" orig-x1438 s1467)) tmp1468))) ($sc-dispatch tmp1468 (quote (any)))))) ($sc-dispatch tmp1468 (quote ())))) s1467)) var1442 step1444))) tmp1440) (syntax-violation #f "source expression failed to match any pattern" tmp1439))) ($sc-dispatch tmp1439 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1438))))
(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1475 (lambda (x1479 y1480) ((lambda (tmp1481) ((lambda (tmp1482) (if tmp1482 (apply (lambda (x1483 y1484) ((lambda (tmp1485) ((lambda (tmp1486) (if tmp1486 (apply (lambda (dy1487) ((lambda (tmp1488) ((lambda (tmp1489) (if tmp1489 (apply (lambda (dx1490) (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 dx1490 dy1487))) tmp1489) ((lambda (_1491) (if (null? dy1487) (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))) x1483) (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))) x1483 y1484))) tmp1488))) ($sc-dispatch tmp1488 (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))))) x1483)) tmp1486) ((lambda (tmp1492) (if tmp1492 (apply (lambda (stuff1493) (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 x1483 stuff1493))) tmp1492) ((lambda (else1494) (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))) x1483 y1484)) tmp1485))) ($sc-dispatch tmp1485 (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 tmp1485 (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))))) y1484)) tmp1482) (syntax-violation #f "source expression failed to match any pattern" tmp1481))) ($sc-dispatch tmp1481 (quote (any any))))) (list x1479 y1480)))) (quasiappend1476 (lambda (x1495 y1496) ((lambda (tmp1497) ((lambda (tmp1498) (if tmp1498 (apply (lambda (x1499 y1500) ((lambda (tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda () x1499) tmp1502) ((lambda (_1503) (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))) x1499 y1500)) tmp1501))) ($sc-dispatch tmp1501 (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))) ()))))) y1500)) tmp1498) (syntax-violation #f "source expression failed to match any pattern" tmp1497))) ($sc-dispatch tmp1497 (quote (any any))))) (list x1495 y1496)))) (quasivector1477 (lambda (x1504) ((lambda (tmp1505) ((lambda (x1506) ((lambda (tmp1507) ((lambda (tmp1508) (if tmp1508 (apply (lambda (x1509) (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 x1509))) tmp1508) ((lambda (tmp1511) (if tmp1511 (apply (lambda (x1512) (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))) x1512)) tmp1511) ((lambda (_1514) (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))) x1506)) tmp1507))) ($sc-dispatch tmp1507 (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 tmp1507 (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))))) x1506)) tmp1505)) x1504))) (quasi1478 (lambda (p1515 lev1516) ((lambda (tmp1517) ((lambda (tmp1518) (if tmp1518 (apply (lambda (p1519) (if (= lev1516 0) p1519 (quasicons1475 (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)))) (quasi1478 (list p1519) (- lev1516 1))))) tmp1518) ((lambda (tmp1520) (if (if tmp1520 (apply (lambda (args1521) (= lev1516 0)) tmp1520) #f) (apply (lambda (args1522) (syntax-violation (quote unquote) "unquote takes exactly one argument" p1515 (cons (quote #(syntax-object unquote ((top) #(ribcage #(args) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1522))) tmp1520) ((lambda (tmp1523) (if tmp1523 (apply (lambda (p1524 q1525) (if (= lev1516 0) (quasiappend1476 p1524 (quasi1478 q1525 lev1516)) (quasicons1475 (quasicons1475 (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)))) (quasi1478 (list p1524) (- lev1516 1))) (quasi1478 q1525 lev1516)))) tmp1523) ((lambda (tmp1526) (if (if tmp1526 (apply (lambda (args1527 q1528) (= lev1516 0)) tmp1526) #f) (apply (lambda (args1529 q1530) (syntax-violation (quote unquote-splicing) "unquote-splicing takes exactly one argument" p1515 (cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1529))) tmp1526) ((lambda (tmp1531) (if tmp1531 (apply (lambda (p1532) (quasicons1475 (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)))) (quasi1478 (list p1532) (+ lev1516 1)))) tmp1531) ((lambda (tmp1533) (if tmp1533 (apply (lambda (p1534 q1535) (quasicons1475 (quasi1478 p1534 lev1516) (quasi1478 q1535 lev1516))) tmp1533) ((lambda (tmp1536) (if tmp1536 (apply (lambda (x1537) (quasivector1477 (quasi1478 x1537 lev1516))) tmp1536) ((lambda (p1539) (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))) p1539)) tmp1517))) ($sc-dispatch tmp1517 (quote #(vector each-any)))))) ($sc-dispatch tmp1517 (quote (any . any)))))) ($sc-dispatch tmp1517 (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 tmp1517 (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 tmp1517 (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 tmp1517 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp1517 (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))))) p1515)))) (lambda (x1540) ((lambda (tmp1541) ((lambda (tmp1542) (if tmp1542 (apply (lambda (_1543 e1544) (quasi1478 e1544 0)) tmp1542) (syntax-violation #f "source expression failed to match any pattern" tmp1541))) ($sc-dispatch tmp1541 (quote (any any))))) x1540)))))
(define include (make-syncase-macro (quote macro) (lambda (x1545) (letrec ((read-file1546 (lambda (fn1547 k1548) (let ((p1549 (open-input-file fn1547))) (letrec ((f1550 (lambda (x1551) (if (eof-object? x1551) (begin (close-input-port p1549) (quote ())) (cons (datum->syntax k1548 x1551) (f1550 (read p1549))))))) (f1550 (read p1549))))))) ((lambda (tmp1552) ((lambda (tmp1553) (if tmp1553 (apply (lambda (k1554 filename1555) (let ((fn1556 (syntax->datum filename1555))) ((lambda (tmp1557) ((lambda (tmp1558) (if tmp1558 (apply (lambda (exp1559) (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))) exp1559)) tmp1558) (syntax-violation #f "source expression failed to match any pattern" tmp1557))) ($sc-dispatch tmp1557 (quote each-any)))) (read-file1546 fn1556 k1554)))) tmp1553) (syntax-violation #f "source expression failed to match any pattern" tmp1552))) ($sc-dispatch tmp1552 (quote (any any))))) x1545)))))
(define unquote (make-syncase-macro (quote macro) (lambda (x1561) ((lambda (tmp1562) ((lambda (tmp1563) (if tmp1563 (apply (lambda (_1564 e1565) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1561)) tmp1563) (syntax-violation #f "source expression failed to match any pattern" tmp1562))) ($sc-dispatch tmp1562 (quote (any any))))) x1561))))
(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1566) ((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569 e1570) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1566)) tmp1568) (syntax-violation #f "source expression failed to match any pattern" tmp1567))) ($sc-dispatch tmp1567 (quote (any any))))) x1566))))
(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1571) ((lambda (tmp1572) ((lambda (tmp1573) (if tmp1573 (apply (lambda (_1574 e1575 m11576 m21577) ((lambda (tmp1578) ((lambda (body1579) (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))) e1575)) body1579)) tmp1578)) (letrec ((f1580 (lambda (clause1581 clauses1582) (if (null? clauses1582) ((lambda (tmp1584) ((lambda (tmp1585) (if tmp1585 (apply (lambda (e11586 e21587) (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 e11586 e21587))) tmp1585) ((lambda (tmp1589) (if tmp1589 (apply (lambda (k1590 e11591 e21592) (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))) k1590)) (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 e11591 e21592)))) tmp1589) ((lambda (_1595) (syntax-violation (quote case) "bad clause" x1571 clause1581)) tmp1584))) ($sc-dispatch tmp1584 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1584 (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))))) clause1581) ((lambda (tmp1596) ((lambda (rest1597) ((lambda (tmp1598) ((lambda (tmp1599) (if tmp1599 (apply (lambda (k1600 e11601 e21602) (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))) k1600)) (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 e11601 e21602)) rest1597)) tmp1599) ((lambda (_1605) (syntax-violation (quote case) "bad clause" x1571 clause1581)) tmp1598))) ($sc-dispatch tmp1598 (quote (each-any any . each-any))))) clause1581)) tmp1596)) (f1580 (car clauses1582) (cdr clauses1582))))))) (f1580 m11576 m21577)))) tmp1573) (syntax-violation #f "source expression failed to match any pattern" tmp1572))) ($sc-dispatch tmp1572 (quote (any any any . each-any))))) x1571))))
(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1606) ((lambda (tmp1607) ((lambda (tmp1608) (if tmp1608 (apply (lambda (_1609 e1610) (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))) e1610)) (list (cons _1609 (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 e1610 (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)))))))))) tmp1608) (syntax-violation #f "source expression failed to match any pattern" tmp1607))) ($sc-dispatch tmp1607 (quote (any any))))) x1606))))