diff options
-rw-r--r-- | module/ice-9/psyntax-pp.scm | 7787 | ||||
-rw-r--r-- | module/ice-9/psyntax.scm | 63 |
2 files changed, 4050 insertions, 3800 deletions
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index a6e35b098..e2a3d60e3 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -1,90 +1,97 @@ (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) +(letrec ((and-map*2378 + (lambda (f2418 first2417 . rest2416) + (let ((t2419 (null? first2417))) + (if t2419 + t2419 + (if (null? rest2416) + (letrec ((andmap2420 + (lambda (first2421) + (let ((x2422 (car first2421)) + (first2423 (cdr first2421))) + (if (null? first2423) + (f2418 x2422) + (if (f2418 x2422) + (andmap2420 first2423) #f)))))) - (andmap63 first56 rest55)))))))) - (letrec ((lambda-var-list162 - (lambda (vars286) - (letrec ((lvl287 - (lambda (vars288 ls289 w290) - (if (pair? vars288) - (lvl287 - (cdr vars288) - (cons (wrap142 (car vars288) w290 #f) ls289) - w290) - (if (id?114 vars288) - (cons (wrap142 vars288 w290 #f) ls289) - (if (null? vars288) - ls289 - (if (syntax-object?98 vars288) - (lvl287 - (syntax-object-expression99 vars288) - ls289 - (join-wraps133 - w290 - (syntax-object-wrap100 vars288))) - (cons vars288 ls289)))))))) - (lvl287 vars286 (quote ()) (quote (())))))) - (gen-var161 - (lambda (id291) - (let ((id292 (if (syntax-object?98 id291) - (syntax-object-expression99 id291) - id291))) - (gensym (symbol->string id292))))) - (strip160 - (lambda (x293 w294) - (if (memq (quote top) (wrap-marks117 w294)) - x293 - (letrec ((f295 (lambda (x296) - (if (syntax-object?98 x296) - (strip160 - (syntax-object-expression99 x296) - (syntax-object-wrap100 x296)) - (if (pair? x296) - (let ((a297 (f295 (car x296))) - (d298 (f295 (cdr x296)))) - (if (if (eq? a297 (car x296)) - (eq? d298 (cdr x296)) - #f) - x296 - (cons a297 d298))) - (if (vector? x296) - (let ((old299 (vector->list x296))) - (let ((new300 (map f295 old299))) - (if (and-map*17 eq? old299 new300) - x296 - (list->vector new300)))) - x296)))))) - (f295 x293))))) - (ellipsis?159 - (lambda (x301) - (if (nonsymbol-id?113 x301) - (free-id=?137 - x301 + (andmap2420 first2417)) + (letrec ((andmap2424 + (lambda (first2425 rest2426) + (let ((x2427 (car first2425)) + (xr2428 (map car rest2426)) + (first2429 (cdr first2425)) + (rest2430 (map cdr rest2426))) + (if (null? first2429) + (apply f2418 (cons x2427 xr2428)) + (if (apply f2418 (cons x2427 xr2428)) + (andmap2424 first2429 rest2430) + #f)))))) + (andmap2424 first2417 rest2416)))))))) + (letrec ((lambda-var-list2524 + (lambda (vars2648) + (letrec ((lvl2649 + (lambda (vars2650 ls2651 w2652) + (if (pair? vars2650) + (lvl2649 + (cdr vars2650) + (cons (wrap2504 (car vars2650) w2652 #f) + ls2651) + w2652) + (if (id?2476 vars2650) + (cons (wrap2504 vars2650 w2652 #f) ls2651) + (if (null? vars2650) + ls2651 + (if (syntax-object?2460 vars2650) + (lvl2649 + (syntax-object-expression2461 vars2650) + ls2651 + (join-wraps2495 + w2652 + (syntax-object-wrap2462 vars2650))) + (cons vars2650 ls2651)))))))) + (lvl2649 vars2648 (quote ()) (quote (())))))) + (gen-var2523 + (lambda (id2653) + (let ((id2654 + (if (syntax-object?2460 id2653) + (syntax-object-expression2461 id2653) + id2653))) + (gensym (symbol->string id2654))))) + (strip2522 + (lambda (x2655 w2656) + (if (memq (quote top) (wrap-marks2479 w2656)) + x2655 + (letrec ((f2657 (lambda (x2658) + (if (syntax-object?2460 x2658) + (strip2522 + (syntax-object-expression2461 x2658) + (syntax-object-wrap2462 x2658)) + (if (pair? x2658) + (let ((a2659 (f2657 (car x2658))) + (d2660 (f2657 (cdr x2658)))) + (if (if (eq? a2659 (car x2658)) + (eq? d2660 (cdr x2658)) + #f) + x2658 + (cons a2659 d2660))) + (if (vector? x2658) + (let ((old2661 (vector->list x2658))) + (let ((new2662 (map f2657 old2661))) + (if (and-map*2378 + eq? + old2661 + new2662) + x2658 + (list->vector new2662)))) + x2658)))))) + (f2657 x2655))))) + (ellipsis?2521 + (lambda (x2663) + (if (nonsymbol-id?2475 x2663) + (free-id=?2499 + x2663 '#(syntax-object ... ((top) @@ -192,6 +199,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -313,6 +321,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -424,6 +433,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure and-map*) @@ -431,1128 +441,1172 @@ ("i" "i"))) (hygiene guile))) #f))) - (chi-void158 (lambda () (build-void80 #f))) - (eval-local-transformer157 - (lambda (expanded302 mod303) - (let ((p304 (local-eval-hook77 expanded302 mod303))) - (if (procedure? p304) - p304 + (chi-void2520 (lambda () (build-void2442 #f))) + (eval-local-transformer2519 + (lambda (expanded2664 mod2665) + (let ((p2666 (local-eval-hook2438 expanded2664 mod2665))) + (if (procedure? p2666) + p2666 (syntax-violation #f "nonprocedure transformer" - p304))))) - (chi-local-syntax156 - (lambda (rec?305 e306 r307 w308 s309 mod310 k311) - ((lambda (tmp312) - ((lambda (tmp313) - (if tmp313 - (apply (lambda (_314 id315 val316 e1317 e2318) - (let ((ids319 id315)) - (if (not (valid-bound-ids?139 ids319)) + p2666))))) + (chi-local-syntax2518 + (lambda (rec?2667 e2668 r2669 w2670 s2671 mod2672 k2673) + ((lambda (tmp2674) + ((lambda (tmp2675) + (if tmp2675 + (apply (lambda (_2676 id2677 val2678 e12679 e22680) + (let ((ids2681 id2677)) + (if (not (valid-bound-ids?2501 ids2681)) (syntax-violation #f "duplicate bound keyword" - e306) - (let ((labels321 (gen-labels120 ids319))) - (let ((new-w322 - (make-binding-wrap131 - ids319 - labels321 - w308))) - (k311 (cons e1317 e2318) - (extend-env108 - labels321 - (let ((w324 (if rec?305 - new-w322 - w308)) - (trans-r325 - (macros-only-env110 - r307))) - (map (lambda (x326) - (cons 'macro - (eval-local-transformer157 - (chi150 - x326 - trans-r325 - w324 - mod310) - mod310))) - val316)) - r307) - new-w322 - s309 - mod310)))))) - tmp313) - ((lambda (_328) + e2668) + (let ((labels2683 + (gen-labels2482 ids2681))) + (let ((new-w2684 + (make-binding-wrap2493 + ids2681 + labels2683 + w2670))) + (k2673 (cons e12679 e22680) + (extend-env2470 + labels2683 + (let ((w2686 (if rec?2667 + new-w2684 + w2670)) + (trans-r2687 + (macros-only-env2472 + r2669))) + (map (lambda (x2688) + (cons 'macro + (eval-local-transformer2519 + (chi2512 + x2688 + trans-r2687 + w2686 + mod2672) + mod2672))) + val2678)) + r2669) + new-w2684 + s2671 + mod2672)))))) + tmp2675) + ((lambda (_2690) (syntax-violation #f "bad local syntax definition" - (source-wrap143 e306 w308 s309 mod310))) - tmp312))) + (source-wrap2505 e2668 w2670 s2671 mod2672))) + tmp2674))) ($sc-dispatch - tmp312 + tmp2674 '(any #(each (any any)) any . each-any)))) - e306))) - (chi-lambda-clause155 - (lambda (e329 docstring330 c331 r332 w333 mod334 k335) - ((lambda (tmp336) - ((lambda (tmp337) - (if (if tmp337 - (apply (lambda (args338 doc339 e1340 e2341) - (if (string? (syntax->datum doc339)) - (not docstring330) + e2668))) + (chi-lambda-clause2517 + (lambda (e2691 + docstring2692 + c2693 + r2694 + w2695 + mod2696 + k2697) + ((lambda (tmp2698) + ((lambda (tmp2699) + (if (if tmp2699 + (apply (lambda (args2700 doc2701 e12702 e22703) + (if (string? (syntax->datum doc2701)) + (not docstring2692) #f)) - tmp337) + tmp2699) #f) - (apply (lambda (args342 doc343 e1344 e2345) - (chi-lambda-clause155 - e329 - doc343 - (cons args342 (cons e1344 e2345)) - r332 - w333 - mod334 - k335)) - tmp337) - ((lambda (tmp347) - (if tmp347 - (apply (lambda (id348 e1349 e2350) - (let ((ids351 id348)) - (if (not (valid-bound-ids?139 ids351)) + (apply (lambda (args2704 doc2705 e12706 e22707) + (chi-lambda-clause2517 + e2691 + doc2705 + (cons args2704 (cons e12706 e22707)) + r2694 + w2695 + mod2696 + k2697)) + tmp2699) + ((lambda (tmp2709) + (if tmp2709 + (apply (lambda (id2710 e12711 e22712) + (let ((ids2713 id2710)) + (if (not (valid-bound-ids?2501 ids2713)) (syntax-violation 'lambda "invalid parameter list" - e329) - (let ((labels353 - (gen-labels120 ids351)) - (new-vars354 - (map gen-var161 ids351))) - (k335 (map syntax->datum ids351) - new-vars354 - (if docstring330 - (syntax->datum docstring330) - #f) - (chi-body154 - (cons e1349 e2350) - e329 - (extend-var-env109 - labels353 - new-vars354 - r332) - (make-binding-wrap131 - ids351 - labels353 - w333) - mod334)))))) - tmp347) - ((lambda (tmp356) - (if tmp356 - (apply (lambda (ids357 e1358 e2359) - (let ((old-ids360 - (lambda-var-list162 ids357))) - (if (not (valid-bound-ids?139 - old-ids360)) + e2691) + (let ((labels2715 + (gen-labels2482 ids2713)) + (new-vars2716 + (map gen-var2523 ids2713))) + (k2697 (map syntax->datum ids2713) + new-vars2716 + (if docstring2692 + (syntax->datum + docstring2692) + #f) + (chi-body2516 + (cons e12711 e22712) + e2691 + (extend-var-env2471 + labels2715 + new-vars2716 + r2694) + (make-binding-wrap2493 + ids2713 + labels2715 + w2695) + mod2696)))))) + tmp2709) + ((lambda (tmp2718) + (if tmp2718 + (apply (lambda (ids2719 e12720 e22721) + (let ((old-ids2722 + (lambda-var-list2524 + ids2719))) + (if (not (valid-bound-ids?2501 + old-ids2722)) (syntax-violation 'lambda "invalid parameter list" - e329) - (let ((labels361 - (gen-labels120 - old-ids360)) - (new-vars362 - (map gen-var161 - old-ids360))) - (k335 (letrec ((f363 (lambda (ls1364 - ls2365) - (if (null? ls1364) - (syntax->datum - ls2365) - (f363 (cdr ls1364) - (cons (syntax->datum - (car ls1364)) - ls2365)))))) - (f363 (cdr old-ids360) - (car old-ids360))) - (letrec ((f366 (lambda (ls1367 - ls2368) - (if (null? ls1367) - ls2368 - (f366 (cdr ls1367) - (cons (car ls1367) - ls2368)))))) - (f366 (cdr new-vars362) - (car new-vars362))) - (if docstring330 - (syntax->datum - docstring330) - #f) - (chi-body154 - (cons e1358 e2359) - e329 - (extend-var-env109 - labels361 - new-vars362 - r332) - (make-binding-wrap131 - old-ids360 - labels361 - w333) - mod334)))))) - tmp356) - ((lambda (_370) + e2691) + (let ((labels2723 + (gen-labels2482 + old-ids2722)) + (new-vars2724 + (map gen-var2523 + old-ids2722))) + (k2697 (letrec ((f2725 (lambda (ls12726 + ls22727) + (if (null? ls12726) + (syntax->datum + ls22727) + (f2725 (cdr ls12726) + (cons (syntax->datum + (car ls12726)) + ls22727)))))) + (f2725 (cdr old-ids2722) + (car old-ids2722))) + (letrec ((f2728 (lambda (ls12729 + ls22730) + (if (null? ls12729) + ls22730 + (f2728 (cdr ls12729) + (cons (car ls12729) + ls22730)))))) + (f2728 (cdr new-vars2724) + (car new-vars2724))) + (if docstring2692 + (syntax->datum + docstring2692) + #f) + (chi-body2516 + (cons e12720 e22721) + e2691 + (extend-var-env2471 + labels2723 + new-vars2724 + r2694) + (make-binding-wrap2493 + old-ids2722 + labels2723 + w2695) + mod2696)))))) + tmp2718) + ((lambda (_2732) (syntax-violation 'lambda "bad lambda" - e329)) - tmp336))) + e2691)) + tmp2698))) ($sc-dispatch - tmp336 + tmp2698 '(any any . each-any))))) ($sc-dispatch - tmp336 + tmp2698 '(each-any any . each-any))))) ($sc-dispatch - tmp336 + tmp2698 '(any any any . each-any)))) - c331))) - (chi-body154 - (lambda (body371 outer-form372 r373 w374 mod375) - (let ((r376 (cons (quote ("placeholder" placeholder)) r373))) - (let ((ribcage377 - (make-ribcage121 + c2693))) + (chi-body2516 + (lambda (body2733 outer-form2734 r2735 w2736 mod2737) + (let ((r2738 (cons (quote ("placeholder" placeholder)) r2735))) + (let ((ribcage2739 + (make-ribcage2483 '() '() '()))) - (let ((w378 (make-wrap116 - (wrap-marks117 w374) - (cons ribcage377 (wrap-subst118 w374))))) - (letrec ((parse379 - (lambda (body380 - ids381 - labels382 - var-ids383 - vars384 - vals385 - bindings386) - (if (null? body380) + (let ((w2740 (make-wrap2478 + (wrap-marks2479 w2736) + (cons ribcage2739 (wrap-subst2480 w2736))))) + (letrec ((parse2741 + (lambda (body2742 + ids2743 + labels2744 + var-ids2745 + vars2746 + vals2747 + bindings2748) + (if (null? body2742) (syntax-violation #f "no expressions in body" - outer-form372) - (let ((e388 (cdar body380)) - (er389 (caar body380))) + outer-form2734) + (let ((e2750 (cdar body2742)) + (er2751 (caar body2742))) (call-with-values (lambda () - (syntax-type148 - e388 - er389 + (syntax-type2510 + e2750 + er2751 '(()) - (source-annotation105 er389) - ribcage377 - mod375 + (source-annotation2467 er2751) + ribcage2739 + mod2737 #f)) - (lambda (type390 - value391 - e392 - w393 - s394 - mod395) - (if (memv type390 + (lambda (type2752 + value2753 + e2754 + w2755 + s2756 + mod2757) + (if (memv type2752 '(define-form)) - (let ((id396 (wrap142 - value391 - w393 - mod395)) - (label397 (gen-label119))) - (let ((var398 - (gen-var161 id396))) + (let ((id2758 + (wrap2504 + value2753 + w2755 + mod2757)) + (label2759 (gen-label2481))) + (let ((var2760 + (gen-var2523 id2758))) (begin - (extend-ribcage!130 - ribcage377 - id396 - label397) - (parse379 - (cdr body380) - (cons id396 ids381) - (cons label397 labels382) - (cons id396 var-ids383) - (cons var398 vars384) - (cons (cons er389 - (wrap142 - e392 - w393 - mod395)) - vals385) + (extend-ribcage!2492 + ribcage2739 + id2758 + label2759) + (parse2741 + (cdr body2742) + (cons id2758 ids2743) + (cons label2759 labels2744) + (cons id2758 var-ids2745) + (cons var2760 vars2746) + (cons (cons er2751 + (wrap2504 + e2754 + w2755 + mod2757)) + vals2747) (cons (cons 'lexical - var398) - bindings386))))) - (if (memv type390 + var2760) + bindings2748))))) + (if (memv type2752 '(define-syntax-form)) - (let ((id399 (wrap142 - value391 - w393 - mod395)) - (label400 (gen-label119))) + (let ((id2761 + (wrap2504 + value2753 + w2755 + mod2757)) + (label2762 + (gen-label2481))) (begin - (extend-ribcage!130 - ribcage377 - id399 - label400) - (parse379 - (cdr body380) - (cons id399 ids381) - (cons label400 labels382) - var-ids383 - vars384 - vals385 + (extend-ribcage!2492 + ribcage2739 + id2761 + label2762) + (parse2741 + (cdr body2742) + (cons id2761 ids2743) + (cons label2762 labels2744) + var-ids2745 + vars2746 + vals2747 (cons (cons 'macro - (cons er389 - (wrap142 - e392 - w393 - mod395))) - bindings386)))) - (if (memv type390 + (cons er2751 + (wrap2504 + e2754 + w2755 + mod2757))) + bindings2748)))) + (if (memv type2752 '(begin-form)) - ((lambda (tmp401) - ((lambda (tmp402) - (if tmp402 - (apply (lambda (_403 - e1404) - (parse379 - (letrec ((f405 (lambda (forms406) - (if (null? forms406) - (cdr body380) - (cons (cons er389 - (wrap142 - (car forms406) - w393 - mod395)) - (f405 (cdr forms406))))))) - (f405 e1404)) - ids381 - labels382 - var-ids383 - vars384 - vals385 - bindings386)) - tmp402) + ((lambda (tmp2763) + ((lambda (tmp2764) + (if tmp2764 + (apply (lambda (_2765 + e12766) + (parse2741 + (letrec ((f2767 (lambda (forms2768) + (if (null? forms2768) + (cdr body2742) + (cons (cons er2751 + (wrap2504 + (car forms2768) + w2755 + mod2757)) + (f2767 (cdr forms2768))))))) + (f2767 e12766)) + ids2743 + labels2744 + var-ids2745 + vars2746 + vals2747 + bindings2748)) + tmp2764) (syntax-violation #f "source expression failed to match any pattern" - tmp401))) + tmp2763))) ($sc-dispatch - tmp401 + tmp2763 '(any . each-any)))) - e392) - (if (memv type390 + e2754) + (if (memv type2752 '(local-syntax-form)) - (chi-local-syntax156 - value391 - e392 - er389 - w393 - s394 - mod395 - (lambda (forms408 - er409 - w410 - s411 - mod412) - (parse379 - (letrec ((f413 (lambda (forms414) - (if (null? forms414) - (cdr body380) - (cons (cons er409 - (wrap142 - (car forms414) - w410 - mod412)) - (f413 (cdr forms414))))))) - (f413 forms408)) - ids381 - labels382 - var-ids383 - vars384 - vals385 - bindings386))) - (if (null? ids381) - (build-sequence93 + (chi-local-syntax2518 + value2753 + e2754 + er2751 + w2755 + s2756 + mod2757 + (lambda (forms2770 + er2771 + w2772 + s2773 + mod2774) + (parse2741 + (letrec ((f2775 (lambda (forms2776) + (if (null? forms2776) + (cdr body2742) + (cons (cons er2771 + (wrap2504 + (car forms2776) + w2772 + mod2774)) + (f2775 (cdr forms2776))))))) + (f2775 forms2770)) + ids2743 + labels2744 + var-ids2745 + vars2746 + vals2747 + bindings2748))) + (if (null? ids2743) + (build-sequence2455 #f - (map (lambda (x415) - (chi150 - (cdr x415) - (car x415) + (map (lambda (x2777) + (chi2512 + (cdr x2777) + (car x2777) '(()) - mod395)) - (cons (cons er389 - (source-wrap143 - e392 - w393 - s394 - mod395)) - (cdr body380)))) + mod2757)) + (cons (cons er2751 + (source-wrap2505 + e2754 + w2755 + s2756 + mod2757)) + (cdr body2742)))) (begin - (if (not (valid-bound-ids?139 - ids381)) + (if (not (valid-bound-ids?2501 + ids2743)) (syntax-violation #f "invalid or duplicate identifier in definition" - outer-form372)) - (letrec ((loop416 - (lambda (bs417 - er-cache418 - r-cache419) - (if (not (null? bs417)) - (let ((b420 (car bs417))) - (if (eq? (car b420) + outer-form2734)) + (letrec ((loop2778 + (lambda (bs2779 + er-cache2780 + r-cache2781) + (if (not (null? bs2779)) + (let ((b2782 (car bs2779))) + (if (eq? (car b2782) 'macro) - (let ((er421 (cadr b420))) - (let ((r-cache422 - (if (eq? er421 - er-cache418) - r-cache419 - (macros-only-env110 - er421)))) + (let ((er2783 + (cadr b2782))) + (let ((r-cache2784 + (if (eq? er2783 + er-cache2780) + r-cache2781 + (macros-only-env2472 + er2783)))) (begin (set-cdr! - b420 - (eval-local-transformer157 - (chi150 - (cddr b420) - r-cache422 + b2782 + (eval-local-transformer2519 + (chi2512 + (cddr b2782) + r-cache2784 '(()) - mod395) - mod395)) - (loop416 - (cdr bs417) - er421 - r-cache422)))) - (loop416 - (cdr bs417) - er-cache418 - r-cache419))))))) - (loop416 - bindings386 + mod2757) + mod2757)) + (loop2778 + (cdr bs2779) + er2783 + r-cache2784)))) + (loop2778 + (cdr bs2779) + er-cache2780 + r-cache2781))))))) + (loop2778 + bindings2748 #f #f)) (set-cdr! - r376 - (extend-env108 - labels382 - bindings386 - (cdr r376))) - (build-letrec96 + r2738 + (extend-env2470 + labels2744 + bindings2748 + (cdr r2738))) + (build-letrec2458 #f (map syntax->datum - var-ids383) - vars384 - (map (lambda (x423) - (chi150 - (cdr x423) - (car x423) + var-ids2745) + vars2746 + (map (lambda (x2785) + (chi2512 + (cdr x2785) + (car x2785) '(()) - mod395)) - vals385) - (build-sequence93 + mod2757)) + vals2747) + (build-sequence2455 #f - (map (lambda (x424) - (chi150 - (cdr x424) - (car x424) + (map (lambda (x2786) + (chi2512 + (cdr x2786) + (car x2786) '(()) - mod395)) - (cons (cons er389 - (source-wrap143 - e392 - w393 - s394 - mod395)) - (cdr body380)))))))))))))))))) - (parse379 - (map (lambda (x387) - (cons r376 (wrap142 x387 w378 mod375))) - body371) + mod2757)) + (cons (cons er2751 + (source-wrap2505 + e2754 + w2755 + s2756 + mod2757)) + (cdr body2742)))))))))))))))))) + (parse2741 + (map (lambda (x2749) + (cons r2738 (wrap2504 x2749 w2740 mod2737))) + body2733) '() '() '() '() '() '()))))))) - (chi-macro153 - (lambda (p425 e426 r427 w428 rib429 mod430) - (letrec ((rebuild-macro-output431 - (lambda (x432 m433) - (if (pair? x432) - (cons (rebuild-macro-output431 (car x432) m433) - (rebuild-macro-output431 (cdr x432) m433)) - (if (syntax-object?98 x432) - (let ((w434 (syntax-object-wrap100 x432))) - (let ((ms435 (wrap-marks117 w434)) - (s436 (wrap-subst118 w434))) - (if (if (pair? ms435) - (eq? (car ms435) #f) + (chi-macro2515 + (lambda (p2787 e2788 r2789 w2790 rib2791 mod2792) + (letrec ((rebuild-macro-output2793 + (lambda (x2794 m2795) + (if (pair? x2794) + (cons (rebuild-macro-output2793 + (car x2794) + m2795) + (rebuild-macro-output2793 + (cdr x2794) + m2795)) + (if (syntax-object?2460 x2794) + (let ((w2796 (syntax-object-wrap2462 x2794))) + (let ((ms2797 (wrap-marks2479 w2796)) + (s2798 (wrap-subst2480 w2796))) + (if (if (pair? ms2797) + (eq? (car ms2797) #f) #f) - (make-syntax-object97 - (syntax-object-expression99 x432) - (make-wrap116 - (cdr ms435) - (if rib429 - (cons rib429 (cdr s436)) - (cdr s436))) - (syntax-object-module101 x432)) - (make-syntax-object97 - (syntax-object-expression99 x432) - (make-wrap116 - (cons m433 ms435) - (if rib429 - (cons rib429 - (cons (quote shift) s436)) - (cons (quote shift) s436))) - (let ((pmod437 - (procedure-module p425))) - (if pmod437 + (make-syntax-object2459 + (syntax-object-expression2461 x2794) + (make-wrap2478 + (cdr ms2797) + (if rib2791 + (cons rib2791 (cdr s2798)) + (cdr s2798))) + (syntax-object-module2463 x2794)) + (make-syntax-object2459 + (syntax-object-expression2461 x2794) + (make-wrap2478 + (cons m2795 ms2797) + (if rib2791 + (cons rib2791 + (cons (quote shift) s2798)) + (cons (quote shift) s2798))) + (let ((pmod2799 + (procedure-module p2787))) + (if pmod2799 (cons 'hygiene - (module-name pmod437)) + (module-name pmod2799)) '(hygiene guile))))))) - (if (vector? x432) - (let ((n438 (vector-length x432))) - (let ((v439 (make-vector n438))) - (letrec ((loop440 - (lambda (i441) - (if (fx=74 i441 n438) - (begin (if #f #f) v439) + (if (vector? x2794) + (let ((n2800 (vector-length x2794))) + (let ((v2801 (make-vector n2800))) + (letrec ((loop2802 + (lambda (i2803) + (if (fx=2435 i2803 n2800) + (begin (if #f #f) v2801) (begin (vector-set! - v439 - i441 - (rebuild-macro-output431 + v2801 + i2803 + (rebuild-macro-output2793 (vector-ref - x432 - i441) - m433)) - (loop440 - (fx+72 i441 1))))))) - (loop440 0)))) - (if (symbol? x432) + x2794 + i2803) + m2795)) + (loop2802 + (fx+2433 + i2803 + 1))))))) + (loop2802 0)))) + (if (symbol? x2794) (syntax-violation #f "encountered raw symbol in macro output" - (source-wrap143 e426 w428 s mod430) - x432) - x432))))))) - (rebuild-macro-output431 - (p425 (wrap142 e426 (anti-mark129 w428) mod430)) + (source-wrap2505 e2788 w2790 s mod2792) + x2794) + x2794))))))) + (rebuild-macro-output2793 + (p2787 (wrap2504 e2788 (anti-mark2491 w2790) mod2792)) (string #\m))))) - (chi-application152 - (lambda (x442 e443 r444 w445 s446 mod447) - ((lambda (tmp448) - ((lambda (tmp449) - (if tmp449 - (apply (lambda (e0450 e1451) - (build-application81 - s446 - x442 - (map (lambda (e452) - (chi150 e452 r444 w445 mod447)) - e1451))) - tmp449) + (chi-application2514 + (lambda (x2804 e2805 r2806 w2807 s2808 mod2809) + ((lambda (tmp2810) + ((lambda (tmp2811) + (if tmp2811 + (apply (lambda (e02812 e12813) + (build-application2443 + s2808 + x2804 + (map (lambda (e2814) + (chi2512 e2814 r2806 w2807 mod2809)) + e12813))) + tmp2811) (syntax-violation #f "source expression failed to match any pattern" - tmp448))) - ($sc-dispatch tmp448 (quote (any . each-any))))) - e443))) - (chi-expr151 - (lambda (type454 value455 e456 r457 w458 s459 mod460) - (if (memv type454 (quote (lexical))) - (build-lexical-reference83 + tmp2810))) + ($sc-dispatch tmp2810 (quote (any . each-any))))) + e2805))) + (chi-expr2513 + (lambda (type2816 + value2817 + e2818 + r2819 + w2820 + s2821 + mod2822) + (if (memv type2816 (quote (lexical))) + (build-lexical-reference2445 'value - s459 - e456 - value455) - (if (memv type454 (quote (core core-form))) - (value455 e456 r457 w458 s459 mod460) - (if (memv type454 (quote (module-ref))) + s2821 + e2818 + value2817) + (if (memv type2816 (quote (core core-form))) + (value2817 e2818 r2819 w2820 s2821 mod2822) + (if (memv type2816 (quote (module-ref))) (call-with-values - (lambda () (value455 e456)) - (lambda (id461 mod462) - (build-global-reference86 s459 id461 mod462))) - (if (memv type454 (quote (lexical-call))) - (chi-application152 - (build-lexical-reference83 + (lambda () (value2817 e2818)) + (lambda (id2823 mod2824) + (build-global-reference2448 s2821 id2823 mod2824))) + (if (memv type2816 (quote (lexical-call))) + (chi-application2514 + (build-lexical-reference2445 'fun - (source-annotation105 (car e456)) - (car e456) - value455) - e456 - r457 - w458 - s459 - mod460) - (if (memv type454 (quote (global-call))) - (chi-application152 - (build-global-reference86 - (source-annotation105 (car e456)) - (if (syntax-object?98 value455) - (syntax-object-expression99 value455) - value455) - (if (syntax-object?98 value455) - (syntax-object-module101 value455) - mod460)) - e456 - r457 - w458 - s459 - mod460) - (if (memv type454 (quote (constant))) - (build-data92 - s459 - (strip160 - (source-wrap143 e456 w458 s459 mod460) + (source-annotation2467 (car e2818)) + (car e2818) + value2817) + e2818 + r2819 + w2820 + s2821 + mod2822) + (if (memv type2816 (quote (global-call))) + (chi-application2514 + (build-global-reference2448 + (source-annotation2467 (car e2818)) + (if (syntax-object?2460 value2817) + (syntax-object-expression2461 value2817) + value2817) + (if (syntax-object?2460 value2817) + (syntax-object-module2463 value2817) + mod2822)) + e2818 + r2819 + w2820 + s2821 + mod2822) + (if (memv type2816 (quote (constant))) + (build-data2454 + s2821 + (strip2522 + (source-wrap2505 e2818 w2820 s2821 mod2822) '(()))) - (if (memv type454 (quote (global))) - (build-global-reference86 s459 value455 mod460) - (if (memv type454 (quote (call))) - (chi-application152 - (chi150 (car e456) r457 w458 mod460) - e456 - r457 - w458 - s459 - mod460) - (if (memv type454 (quote (begin-form))) - ((lambda (tmp463) - ((lambda (tmp464) - (if tmp464 - (apply (lambda (_465 e1466 e2467) - (chi-sequence144 - (cons e1466 e2467) - r457 - w458 - s459 - mod460)) - tmp464) + (if (memv type2816 (quote (global))) + (build-global-reference2448 + s2821 + value2817 + mod2822) + (if (memv type2816 (quote (call))) + (chi-application2514 + (chi2512 (car e2818) r2819 w2820 mod2822) + e2818 + r2819 + w2820 + s2821 + mod2822) + (if (memv type2816 (quote (begin-form))) + ((lambda (tmp2825) + ((lambda (tmp2826) + (if tmp2826 + (apply (lambda (_2827 e12828 e22829) + (chi-sequence2506 + (cons e12828 e22829) + r2819 + w2820 + s2821 + mod2822)) + tmp2826) (syntax-violation #f "source expression failed to match any pattern" - tmp463))) + tmp2825))) ($sc-dispatch - tmp463 + tmp2825 '(any any . each-any)))) - e456) - (if (memv type454 (quote (local-syntax-form))) - (chi-local-syntax156 - value455 - e456 - r457 - w458 - s459 - mod460 - chi-sequence144) - (if (memv type454 (quote (eval-when-form))) - ((lambda (tmp469) - ((lambda (tmp470) - (if tmp470 - (apply (lambda (_471 - x472 - e1473 - e2474) - (let ((when-list475 - (chi-when-list147 - e456 - x472 - w458))) + e2818) + (if (memv type2816 + '(local-syntax-form)) + (chi-local-syntax2518 + value2817 + e2818 + r2819 + w2820 + s2821 + mod2822 + chi-sequence2506) + (if (memv type2816 (quote (eval-when-form))) + ((lambda (tmp2831) + ((lambda (tmp2832) + (if tmp2832 + (apply (lambda (_2833 + x2834 + e12835 + e22836) + (let ((when-list2837 + (chi-when-list2509 + e2818 + x2834 + w2820))) (if (memq 'eval - when-list475) - (chi-sequence144 - (cons e1473 e2474) - r457 - w458 - s459 - mod460) - (chi-void158)))) - tmp470) + when-list2837) + (chi-sequence2506 + (cons e12835 + e22836) + r2819 + w2820 + s2821 + mod2822) + (chi-void2520)))) + tmp2832) (syntax-violation #f "source expression failed to match any pattern" - tmp469))) + tmp2831))) ($sc-dispatch - tmp469 + tmp2831 '(any each-any any . each-any)))) - e456) - (if (memv type454 + e2818) + (if (memv type2816 '(define-form define-syntax-form)) (syntax-violation #f "definition in expression context" - e456 - (wrap142 value455 w458 mod460)) - (if (memv type454 (quote (syntax))) + e2818 + (wrap2504 value2817 w2820 mod2822)) + (if (memv type2816 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" - (source-wrap143 - e456 - w458 - s459 - mod460)) - (if (memv type454 + (source-wrap2505 + e2818 + w2820 + s2821 + mod2822)) + (if (memv type2816 '(displaced-lexical)) (syntax-violation #f "reference to identifier outside its scope" - (source-wrap143 - e456 - w458 - s459 - mod460)) + (source-wrap2505 + e2818 + w2820 + s2821 + mod2822)) (syntax-violation #f "unexpected syntax" - (source-wrap143 - e456 - w458 - s459 - mod460)))))))))))))))))) - (chi150 - (lambda (e478 r479 w480 mod481) + (source-wrap2505 + e2818 + w2820 + s2821 + mod2822)))))))))))))))))) + (chi2512 + (lambda (e2840 r2841 w2842 mod2843) (call-with-values (lambda () - (syntax-type148 - e478 - r479 - w480 - (source-annotation105 e478) + (syntax-type2510 + e2840 + r2841 + w2842 + (source-annotation2467 e2840) #f - mod481 + mod2843 #f)) - (lambda (type482 value483 e484 w485 s486 mod487) - (chi-expr151 - type482 - value483 - e484 - r479 - w485 - s486 - mod487))))) - (chi-top149 - (lambda (e488 r489 w490 m491 esew492 mod493) + (lambda (type2844 value2845 e2846 w2847 s2848 mod2849) + (chi-expr2513 + type2844 + value2845 + e2846 + r2841 + w2847 + s2848 + mod2849))))) + (chi-top2511 + (lambda (e2850 r2851 w2852 m2853 esew2854 mod2855) (call-with-values (lambda () - (syntax-type148 - e488 - r489 - w490 - (source-annotation105 e488) + (syntax-type2510 + e2850 + r2851 + w2852 + (source-annotation2467 e2850) #f - mod493 + mod2855 #f)) - (lambda (type501 value502 e503 w504 s505 mod506) - (if (memv type501 (quote (begin-form))) - ((lambda (tmp507) - ((lambda (tmp508) - (if tmp508 - (apply (lambda (_509) (chi-void158)) tmp508) - ((lambda (tmp510) - (if tmp510 - (apply (lambda (_511 e1512 e2513) - (chi-top-sequence145 - (cons e1512 e2513) - r489 - w504 - s505 - m491 - esew492 - mod506)) - tmp510) + (lambda (type2863 value2864 e2865 w2866 s2867 mod2868) + (if (memv type2863 (quote (begin-form))) + ((lambda (tmp2869) + ((lambda (tmp2870) + (if tmp2870 + (apply (lambda (_2871) (chi-void2520)) tmp2870) + ((lambda (tmp2872) + (if tmp2872 + (apply (lambda (_2873 e12874 e22875) + (chi-top-sequence2507 + (cons e12874 e22875) + r2851 + w2866 + s2867 + m2853 + esew2854 + mod2868)) + tmp2872) (syntax-violation #f "source expression failed to match any pattern" - tmp507))) + tmp2869))) ($sc-dispatch - tmp507 + tmp2869 '(any any . each-any))))) - ($sc-dispatch tmp507 (quote (any))))) - e503) - (if (memv type501 (quote (local-syntax-form))) - (chi-local-syntax156 - value502 - e503 - r489 - w504 - s505 - mod506 - (lambda (body515 r516 w517 s518 mod519) - (chi-top-sequence145 - body515 - r516 - w517 - s518 - m491 - esew492 - mod519))) - (if (memv type501 (quote (eval-when-form))) - ((lambda (tmp520) - ((lambda (tmp521) - (if tmp521 - (apply (lambda (_522 x523 e1524 e2525) - (let ((when-list526 - (chi-when-list147 - e503 - x523 - w504)) - (body527 (cons e1524 e2525))) - (if (eq? m491 (quote e)) + ($sc-dispatch tmp2869 (quote (any))))) + e2865) + (if (memv type2863 (quote (local-syntax-form))) + (chi-local-syntax2518 + value2864 + e2865 + r2851 + w2866 + s2867 + mod2868 + (lambda (body2877 r2878 w2879 s2880 mod2881) + (chi-top-sequence2507 + body2877 + r2878 + w2879 + s2880 + m2853 + esew2854 + mod2881))) + (if (memv type2863 (quote (eval-when-form))) + ((lambda (tmp2882) + ((lambda (tmp2883) + (if tmp2883 + (apply (lambda (_2884 x2885 e12886 e22887) + (let ((when-list2888 + (chi-when-list2509 + e2865 + x2885 + w2866)) + (body2889 + (cons e12886 e22887))) + (if (eq? m2853 (quote e)) (if (memq 'eval - when-list526) - (chi-top-sequence145 - body527 - r489 - w504 - s505 + when-list2888) + (chi-top-sequence2507 + body2889 + r2851 + w2866 + s2867 'e '(eval) - mod506) - (chi-void158)) + mod2868) + (chi-void2520)) (if (memq 'load - when-list526) - (if (let ((t530 (memq 'compile - when-list526))) - (if t530 - t530 - (if (eq? m491 + when-list2888) + (if (let ((t2892 (memq 'compile + when-list2888))) + (if t2892 + t2892 + (if (eq? m2853 'c&e) (memq 'eval - when-list526) + when-list2888) #f))) - (chi-top-sequence145 - body527 - r489 - w504 - s505 + (chi-top-sequence2507 + body2889 + r2851 + w2866 + s2867 'c&e '(compile load) - mod506) - (if (memq m491 + mod2868) + (if (memq m2853 '(c c&e)) - (chi-top-sequence145 - body527 - r489 - w504 - s505 + (chi-top-sequence2507 + body2889 + r2851 + w2866 + s2867 'c '(load) - mod506) - (chi-void158))) - (if (let ((t531 (memq 'compile - when-list526))) - (if t531 - t531 - (if (eq? m491 + mod2868) + (chi-void2520))) + (if (let ((t2893 (memq 'compile + when-list2888))) + (if t2893 + t2893 + (if (eq? m2853 'c&e) (memq 'eval - when-list526) + when-list2888) #f))) (begin - (top-level-eval-hook76 - (chi-top-sequence145 - body527 - r489 - w504 - s505 + (top-level-eval-hook2437 + (chi-top-sequence2507 + body2889 + r2851 + w2866 + s2867 'e '(eval) - mod506) - mod506) - (chi-void158)) - (chi-void158)))))) - tmp521) + mod2868) + mod2868) + (chi-void2520)) + (chi-void2520)))))) + tmp2883) (syntax-violation #f "source expression failed to match any pattern" - tmp520))) + tmp2882))) ($sc-dispatch - tmp520 + tmp2882 '(any each-any any . each-any)))) - e503) - (if (memv type501 (quote (define-syntax-form))) - (let ((n532 (id-var-name136 value502 w504)) - (r533 (macros-only-env110 r489))) - (if (memv m491 (quote (c))) - (if (memq (quote compile) esew492) - (let ((e534 (chi-install-global146 - n532 - (chi150 - e503 - r533 - w504 - mod506)))) + e2865) + (if (memv type2863 (quote (define-syntax-form))) + (let ((n2894 (id-var-name2498 value2864 w2866)) + (r2895 (macros-only-env2472 r2851))) + (if (memv m2853 (quote (c))) + (if (memq (quote compile) esew2854) + (let ((e2896 (chi-install-global2508 + n2894 + (chi2512 + e2865 + r2895 + w2866 + mod2868)))) (begin - (top-level-eval-hook76 e534 mod506) - (if (memq (quote load) esew492) - e534 - (chi-void158)))) - (if (memq (quote load) esew492) - (chi-install-global146 - n532 - (chi150 e503 r533 w504 mod506)) - (chi-void158))) - (if (memv m491 (quote (c&e))) - (let ((e535 (chi-install-global146 - n532 - (chi150 - e503 - r533 - w504 - mod506)))) + (top-level-eval-hook2437 e2896 mod2868) + (if (memq (quote load) esew2854) + e2896 + (chi-void2520)))) + (if (memq (quote load) esew2854) + (chi-install-global2508 + n2894 + (chi2512 e2865 r2895 w2866 mod2868)) + (chi-void2520))) + (if (memv m2853 (quote (c&e))) + (let ((e2897 (chi-install-global2508 + n2894 + (chi2512 + e2865 + r2895 + w2866 + mod2868)))) (begin - (top-level-eval-hook76 e535 mod506) - e535)) + (top-level-eval-hook2437 e2897 mod2868) + e2897)) (begin - (if (memq (quote eval) esew492) - (top-level-eval-hook76 - (chi-install-global146 - n532 - (chi150 e503 r533 w504 mod506)) - mod506)) - (chi-void158))))) - (if (memv type501 (quote (define-form))) - (let ((n536 (id-var-name136 value502 w504))) - (let ((type537 - (binding-type106 - (lookup111 n536 r489 mod506)))) - (if (memv type537 + (if (memq (quote eval) esew2854) + (top-level-eval-hook2437 + (chi-install-global2508 + n2894 + (chi2512 e2865 r2895 w2866 mod2868)) + mod2868)) + (chi-void2520))))) + (if (memv type2863 (quote (define-form))) + (let ((n2898 (id-var-name2498 value2864 w2866))) + (let ((type2899 + (binding-type2468 + (lookup2473 n2898 r2851 mod2868)))) + (if (memv type2899 '(global core macro module-ref)) (begin (if (if (not (module-local-variable (current-module) - n536)) + n2898)) (current-module) #f) (module-define! (current-module) - n536 + n2898 #f)) - (let ((x538 (build-global-definition89 - s505 - n536 - (chi150 - e503 - r489 - w504 - mod506)))) + (let ((x2900 (build-global-definition2451 + s2867 + n2898 + (chi2512 + e2865 + r2851 + w2866 + mod2868)))) (begin - (if (eq? m491 (quote c&e)) - (top-level-eval-hook76 x538 mod506)) - x538))) - (if (memv type537 + (if (eq? m2853 (quote c&e)) + (top-level-eval-hook2437 + x2900 + mod2868)) + x2900))) + (if (memv type2899 '(displaced-lexical)) (syntax-violation #f "identifier out of context" - e503 - (wrap142 value502 w504 mod506)) + e2865 + (wrap2504 value2864 w2866 mod2868)) (syntax-violation #f "cannot define keyword at top level" - e503 - (wrap142 value502 w504 mod506)))))) - (let ((x539 (chi-expr151 - type501 - value502 - e503 - r489 - w504 - s505 - mod506))) + e2865 + (wrap2504 value2864 w2866 mod2868)))))) + (let ((x2901 (chi-expr2513 + type2863 + value2864 + e2865 + r2851 + w2866 + s2867 + mod2868))) (begin - (if (eq? m491 (quote c&e)) - (top-level-eval-hook76 x539 mod506)) - x539))))))))))) - (syntax-type148 - (lambda (e540 r541 w542 s543 rib544 mod545 for-car?546) - (if (symbol? e540) - (let ((n547 (id-var-name136 e540 w542))) - (let ((b548 (lookup111 n547 r541 mod545))) - (let ((type549 (binding-type106 b548))) - (if (memv type549 (quote (lexical))) + (if (eq? m2853 (quote c&e)) + (top-level-eval-hook2437 x2901 mod2868)) + x2901))))))))))) + (syntax-type2510 + (lambda (e2902 + r2903 + w2904 + s2905 + rib2906 + mod2907 + for-car?2908) + (if (symbol? e2902) + (let ((n2909 (id-var-name2498 e2902 w2904))) + (let ((b2910 (lookup2473 n2909 r2903 mod2907))) + (let ((type2911 (binding-type2468 b2910))) + (if (memv type2911 (quote (lexical))) (values - type549 - (binding-value107 b548) - e540 - w542 - s543 - mod545) - (if (memv type549 (quote (global))) - (values type549 n547 e540 w542 s543 mod545) - (if (memv type549 (quote (macro))) - (if for-car?546 + type2911 + (binding-value2469 b2910) + e2902 + w2904 + s2905 + mod2907) + (if (memv type2911 (quote (global))) + (values type2911 n2909 e2902 w2904 s2905 mod2907) + (if (memv type2911 (quote (macro))) + (if for-car?2908 (values - type549 - (binding-value107 b548) - e540 - w542 - s543 - mod545) - (syntax-type148 - (chi-macro153 - (binding-value107 b548) - e540 - r541 - w542 - rib544 - mod545) - r541 + type2911 + (binding-value2469 b2910) + e2902 + w2904 + s2905 + mod2907) + (syntax-type2510 + (chi-macro2515 + (binding-value2469 b2910) + e2902 + r2903 + w2904 + rib2906 + mod2907) + r2903 '(()) - s543 - rib544 - mod545 + s2905 + rib2906 + mod2907 #f)) (values - type549 - (binding-value107 b548) - e540 - w542 - s543 - mod545))))))) - (if (pair? e540) - (let ((first550 (car e540))) + type2911 + (binding-value2469 b2910) + e2902 + w2904 + s2905 + mod2907))))))) + (if (pair? e2902) + (let ((first2912 (car e2902))) (call-with-values (lambda () - (syntax-type148 - first550 - r541 - w542 - s543 - rib544 - mod545 + (syntax-type2510 + first2912 + r2903 + w2904 + s2905 + rib2906 + mod2907 #t)) - (lambda (ftype551 fval552 fe553 fw554 fs555 fmod556) - (if (memv ftype551 (quote (lexical))) + (lambda (ftype2913 + fval2914 + fe2915 + fw2916 + fs2917 + fmod2918) + (if (memv ftype2913 (quote (lexical))) (values 'lexical-call - fval552 - e540 - w542 - s543 - mod545) - (if (memv ftype551 (quote (global))) + fval2914 + e2902 + w2904 + s2905 + mod2907) + (if (memv ftype2913 (quote (global))) (values 'global-call - (make-syntax-object97 fval552 w542 fmod556) - e540 - w542 - s543 - mod545) - (if (memv ftype551 (quote (macro))) - (syntax-type148 - (chi-macro153 - fval552 - e540 - r541 - w542 - rib544 - mod545) - r541 + (make-syntax-object2459 fval2914 w2904 fmod2918) + e2902 + w2904 + s2905 + mod2907) + (if (memv ftype2913 (quote (macro))) + (syntax-type2510 + (chi-macro2515 + fval2914 + e2902 + r2903 + w2904 + rib2906 + mod2907) + r2903 '(()) - s543 - rib544 - mod545 - for-car?546) - (if (memv ftype551 (quote (module-ref))) + s2905 + rib2906 + mod2907 + for-car?2908) + (if (memv ftype2913 (quote (module-ref))) (call-with-values - (lambda () (fval552 e540)) - (lambda (sym557 mod558) - (syntax-type148 - sym557 - r541 - w542 - s543 - rib544 - mod558 - for-car?546))) - (if (memv ftype551 (quote (core))) + (lambda () (fval2914 e2902)) + (lambda (sym2919 mod2920) + (syntax-type2510 + sym2919 + r2903 + w2904 + s2905 + rib2906 + mod2920 + for-car?2908))) + (if (memv ftype2913 (quote (core))) (values 'core-form - fval552 - e540 - w542 - s543 - mod545) - (if (memv ftype551 (quote (local-syntax))) + fval2914 + e2902 + w2904 + s2905 + mod2907) + (if (memv ftype2913 (quote (local-syntax))) (values 'local-syntax-form - fval552 - e540 - w542 - s543 - mod545) - (if (memv ftype551 (quote (begin))) + fval2914 + e2902 + w2904 + s2905 + mod2907) + (if (memv ftype2913 (quote (begin))) (values 'begin-form #f - e540 - w542 - s543 - mod545) - (if (memv ftype551 (quote (eval-when))) + e2902 + w2904 + s2905 + mod2907) + (if (memv ftype2913 (quote (eval-when))) (values 'eval-when-form #f - e540 - w542 - s543 - mod545) - (if (memv ftype551 (quote (define))) - ((lambda (tmp559) - ((lambda (tmp560) - (if (if tmp560 - (apply (lambda (_561 - name562 - val563) - (id?114 - name562)) - tmp560) + e2902 + w2904 + s2905 + mod2907) + (if (memv ftype2913 (quote (define))) + ((lambda (tmp2921) + ((lambda (tmp2922) + (if (if tmp2922 + (apply (lambda (_2923 + name2924 + val2925) + (id?2476 + name2924)) + tmp2922) #f) - (apply (lambda (_564 - name565 - val566) + (apply (lambda (_2926 + name2927 + val2928) (values 'define-form - name565 - val566 - w542 - s543 - mod545)) - tmp560) - ((lambda (tmp567) - (if (if tmp567 - (apply (lambda (_568 - name569 - args570 - e1571 - e2572) - (if (id?114 - name569) - (valid-bound-ids?139 - (lambda-var-list162 - args570)) + name2927 + val2928 + w2904 + s2905 + mod2907)) + tmp2922) + ((lambda (tmp2929) + (if (if tmp2929 + (apply (lambda (_2930 + name2931 + args2932 + e12933 + e22934) + (if (id?2476 + name2931) + (valid-bound-ids?2501 + (lambda-var-list2524 + args2932)) #f)) - tmp567) + tmp2929) #f) - (apply (lambda (_573 - name574 - args575 - e1576 - e2577) + (apply (lambda (_2935 + name2936 + args2937 + e12938 + e22939) (values 'define-form - (wrap142 - name574 - w542 - mod545) + (wrap2504 + name2936 + w2904 + mod2907) (cons '#(syntax-object lambda ((top) @@ -1742,6 +1796,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -1863,6 +1918,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -1974,6 +2030,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure @@ -1984,32 +2041,32 @@ "i"))) (hygiene guile)) - (wrap142 - (cons args575 - (cons e1576 - e2577)) - w542 - mod545)) + (wrap2504 + (cons args2937 + (cons e12938 + e22939)) + w2904 + mod2907)) '(()) - s543 - mod545)) - tmp567) - ((lambda (tmp579) - (if (if tmp579 - (apply (lambda (_580 - name581) - (id?114 - name581)) - tmp579) + s2905 + mod2907)) + tmp2929) + ((lambda (tmp2941) + (if (if tmp2941 + (apply (lambda (_2942 + name2943) + (id?2476 + name2943)) + tmp2941) #f) - (apply (lambda (_582 - name583) + (apply (lambda (_2944 + name2945) (values 'define-form - (wrap142 - name583 - w542 - mod545) + (wrap2504 + name2945 + w2904 + mod2907) '(#(syntax-object if ((top) @@ -2190,6 +2247,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -2311,6 +2369,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -2422,6 +2481,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure @@ -2612,6 +2672,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -2733,6 +2794,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -2844,6 +2906,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure @@ -3034,6 +3097,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -3155,6 +3219,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -3266,6 +3331,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure @@ -3277,463 +3343,102 @@ (hygiene guile))) '(()) - s543 - mod545)) - tmp579) + s2905 + mod2907)) + tmp2941) (syntax-violation #f "source expression failed to match any pattern" - tmp559))) + tmp2921))) ($sc-dispatch - tmp559 + tmp2921 '(any any))))) ($sc-dispatch - tmp559 + tmp2921 '(any (any . any) any . each-any))))) ($sc-dispatch - tmp559 + tmp2921 '(any any any)))) - e540) - (if (memv ftype551 + e2902) + (if (memv ftype2913 '(define-syntax)) - ((lambda (tmp584) - ((lambda (tmp585) - (if (if tmp585 - (apply (lambda (_586 - name587 - val588) - (id?114 - name587)) - tmp585) + ((lambda (tmp2946) + ((lambda (tmp2947) + (if (if tmp2947 + (apply (lambda (_2948 + name2949 + val2950) + (id?2476 + name2949)) + tmp2947) #f) - (apply (lambda (_589 - name590 - val591) + (apply (lambda (_2951 + name2952 + val2953) (values 'define-syntax-form - name590 - val591 - w542 - s543 - mod545)) - tmp585) + name2952 + val2953 + w2904 + s2905 + mod2907)) + tmp2947) (syntax-violation #f "source expression failed to match any pattern" - tmp584))) + tmp2946))) ($sc-dispatch - tmp584 + tmp2946 '(any any any)))) - e540) + e2902) (values 'call #f - e540 - w542 - s543 - mod545)))))))))))))) - (if (syntax-object?98 e540) - (syntax-type148 - (syntax-object-expression99 e540) - r541 - (join-wraps133 w542 (syntax-object-wrap100 e540)) - s543 - rib544 - (let ((t592 (syntax-object-module101 e540))) - (if t592 t592 mod545)) - for-car?546) - (if (self-evaluating? e540) + e2902 + w2904 + s2905 + mod2907)))))))))))))) + (if (syntax-object?2460 e2902) + (syntax-type2510 + (syntax-object-expression2461 e2902) + r2903 + (join-wraps2495 + w2904 + (syntax-object-wrap2462 e2902)) + s2905 + rib2906 + (let ((t2954 (syntax-object-module2463 e2902))) + (if t2954 t2954 mod2907)) + for-car?2908) + (if (self-evaluating? e2902) (values 'constant #f - e540 - w542 - s543 - mod545) - (values (quote other) #f e540 w542 s543 mod545))))))) - (chi-when-list147 - (lambda (e593 when-list594 w595) - (letrec ((f596 (lambda (when-list597 situations598) - (if (null? when-list597) - situations598 - (f596 (cdr when-list597) - (cons (let ((x599 (car when-list597))) - (if (free-id=?137 - x599 - '#(syntax-object - compile - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("i")) - #(ribcage () () ()) - #(ribcage - #(f - when-list - situations) - #((top) - (top) - (top)) - #("i" "i" "i")) - #(ribcage () () ()) - #(ribcage - #(e when-list w) - #((top) - (top) - (top)) - #("i" "i" "i")) - #(ribcage - (lambda-var-list - gen-var - strip - ellipsis? - chi-void - eval-local-transformer - chi-local-syntax - chi-lambda-clause - chi-body - chi-macro - chi-application - chi-expr - chi - chi-top - syntax-type - chi-when-list - chi-install-global - chi-top-sequence - chi-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda - build-global-definition - maybe-name-value! - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-conditional - build-application - build-void - get-global-definition-hook - put-global-definition-hook - gensym-hook - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - *mode* - noexpand) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i" - "i")) - #(ribcage - (define-structure - and-map*) - ((top) (top)) - ("i" "i"))) - (hygiene guile))) - 'compile - (if (free-id=?137 - x599 + e2902 + w2904 + s2905 + mod2907) + (values + 'other + #f + e2902 + w2904 + s2905 + mod2907))))))) + (chi-when-list2509 + (lambda (e2955 when-list2956 w2957) + (letrec ((f2958 (lambda (when-list2959 situations2960) + (if (null? when-list2959) + situations2960 + (f2958 (cdr when-list2959) + (cons (let ((x2961 (car when-list2959))) + (if (free-id=?2499 + x2961 '#(syntax-object - load + compile ((top) #(ribcage () () ()) #(ribcage () () ()) @@ -3859,6 +3564,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -3980,6 +3686,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -4091,6 +3798,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure @@ -4098,11 +3806,11 @@ ((top) (top)) ("i" "i"))) (hygiene guile))) - 'load - (if (free-id=?137 - x599 + 'compile + (if (free-id=?2499 + x2961 '#(syntax-object - eval + load ((top) #(ribcage () @@ -4245,6 +3953,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -4366,6 +4075,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -4477,6 +4187,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure @@ -4484,1570 +4195,2077 @@ ((top) (top)) ("i" "i"))) (hygiene guile))) - 'eval - (syntax-violation - 'eval-when - "invalid situation" - e593 - (wrap142 - x599 - w595 - #f)))))) - situations598)))))) - (f596 when-list594 (quote ()))))) - (chi-install-global146 - (lambda (name600 e601) - (build-global-definition89 + 'load + (if (free-id=?2499 + x2961 + '#(syntax-object + eval + ((top) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + () + () + ()) + #(ribcage + #(x) + #((top)) + #("i")) + #(ribcage + () + () + ()) + #(ribcage + #(f + when-list + situations) + #((top) + (top) + (top)) + #("i" + "i" + "i")) + #(ribcage + () + () + ()) + #(ribcage + #(e + when-list + w) + #((top) + (top) + (top)) + #("i" + "i" + "i")) + #(ribcage + (lambda-var-list + gen-var + strip + ellipsis? + chi-void + eval-local-transformer + chi-local-syntax + chi-lambda-clause + chi-body + chi-macro + chi-application + chi-expr + chi + chi-top + syntax-type + chi-when-list + chi-install-global + chi-top-sequence + chi-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda + build-global-definition + maybe-name-value! + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-conditional + build-application + build-void + decorate-source + get-global-definition-hook + put-global-definition-hook + gensym-hook + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + *mode* + noexpand) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i" + "i")) + #(ribcage + (define-structure + and-map*) + ((top) (top)) + ("i" "i"))) + (hygiene + guile))) + 'eval + (syntax-violation + 'eval-when + "invalid situation" + e2955 + (wrap2504 + x2961 + w2957 + #f)))))) + situations2960)))))) + (f2958 when-list2956 (quote ()))))) + (chi-install-global2508 + (lambda (name2962 e2963) + (build-global-definition2451 #f - name600 - (if (let ((v602 (module-variable (current-module) name600))) - (if v602 - (if (variable-bound? v602) - (if (macro? (variable-ref v602)) - (not (eq? (macro-type (variable-ref v602)) + name2962 + (if (let ((v2964 (module-variable (current-module) name2962))) + (if v2964 + (if (variable-bound? v2964) + (if (macro? (variable-ref v2964)) + (not (eq? (macro-type (variable-ref v2964)) 'syncase-macro)) #f) #f) #f)) - (build-application81 + (build-application2443 #f - (build-primref91 + (build-primref2453 #f 'make-extended-syncase-macro) - (list (build-application81 + (list (build-application2443 #f - (build-primref91 #f (quote module-ref)) - (list (build-application81 + (build-primref2453 #f (quote module-ref)) + (list (build-application2443 #f - (build-primref91 + (build-primref2453 #f 'current-module) '()) - (build-data92 #f name600))) - (build-data92 #f (quote macro)) - e601)) - (build-application81 + (build-data2454 #f name2962))) + (build-data2454 #f (quote macro)) + e2963)) + (build-application2443 #f - (build-primref91 #f (quote make-syncase-macro)) - (list (build-data92 #f (quote macro)) e601)))))) - (chi-top-sequence145 - (lambda (body603 r604 w605 s606 m607 esew608 mod609) - (build-sequence93 - s606 - (letrec ((dobody610 - (lambda (body611 r612 w613 m614 esew615 mod616) - (if (null? body611) + (build-primref2453 #f (quote make-syncase-macro)) + (list (build-data2454 #f (quote macro)) e2963)))))) + (chi-top-sequence2507 + (lambda (body2965 + r2966 + w2967 + s2968 + m2969 + esew2970 + mod2971) + (build-sequence2455 + s2968 + (letrec ((dobody2972 + (lambda (body2973 + r2974 + w2975 + m2976 + esew2977 + mod2978) + (if (null? body2973) '() - (let ((first617 - (chi-top149 - (car body611) - r612 - w613 - m614 - esew615 - mod616))) - (cons first617 - (dobody610 - (cdr body611) - r612 - w613 - m614 - esew615 - mod616))))))) - (dobody610 body603 r604 w605 m607 esew608 mod609))))) - (chi-sequence144 - (lambda (body618 r619 w620 s621 mod622) - (build-sequence93 - s621 - (letrec ((dobody623 - (lambda (body624 r625 w626 mod627) - (if (null? body624) + (let ((first2979 + (chi-top2511 + (car body2973) + r2974 + w2975 + m2976 + esew2977 + mod2978))) + (cons first2979 + (dobody2972 + (cdr body2973) + r2974 + w2975 + m2976 + esew2977 + mod2978))))))) + (dobody2972 + body2965 + r2966 + w2967 + m2969 + esew2970 + mod2971))))) + (chi-sequence2506 + (lambda (body2980 r2981 w2982 s2983 mod2984) + (build-sequence2455 + s2983 + (letrec ((dobody2985 + (lambda (body2986 r2987 w2988 mod2989) + (if (null? body2986) '() - (let ((first628 - (chi150 - (car body624) - r625 - w626 - mod627))) - (cons first628 - (dobody623 - (cdr body624) - r625 - w626 - mod627))))))) - (dobody623 body618 r619 w620 mod622))))) - (source-wrap143 - (lambda (x629 w630 s631 defmod632) + (let ((first2990 + (chi2512 + (car body2986) + r2987 + w2988 + mod2989))) + (cons first2990 + (dobody2985 + (cdr body2986) + r2987 + w2988 + mod2989))))))) + (dobody2985 body2980 r2981 w2982 mod2984))))) + (source-wrap2505 + (lambda (x2991 w2992 s2993 defmod2994) (begin - (if (if s631 (pair? x629) #f) - (set-source-properties! x629 s631)) - (wrap142 x629 w630 defmod632)))) - (wrap142 - (lambda (x633 w634 defmod635) - (if (if (null? (wrap-marks117 w634)) - (null? (wrap-subst118 w634)) + (if (if s2993 (pair? x2991) #f) + (set-source-properties! x2991 s2993)) + (wrap2504 x2991 w2992 defmod2994)))) + (wrap2504 + (lambda (x2995 w2996 defmod2997) + (if (if (null? (wrap-marks2479 w2996)) + (null? (wrap-subst2480 w2996)) #f) - x633 - (if (syntax-object?98 x633) - (make-syntax-object97 - (syntax-object-expression99 x633) - (join-wraps133 w634 (syntax-object-wrap100 x633)) - (syntax-object-module101 x633)) - (if (null? x633) - x633 - (make-syntax-object97 x633 w634 defmod635)))))) - (bound-id-member?141 - (lambda (x636 list637) - (if (not (null? list637)) - (let ((t638 (bound-id=?138 x636 (car list637)))) - (if t638 - t638 - (bound-id-member?141 x636 (cdr list637)))) + x2995 + (if (syntax-object?2460 x2995) + (make-syntax-object2459 + (syntax-object-expression2461 x2995) + (join-wraps2495 + w2996 + (syntax-object-wrap2462 x2995)) + (syntax-object-module2463 x2995)) + (if (null? x2995) + x2995 + (make-syntax-object2459 x2995 w2996 defmod2997)))))) + (bound-id-member?2503 + (lambda (x2998 list2999) + (if (not (null? list2999)) + (let ((t3000 (bound-id=?2500 x2998 (car list2999)))) + (if t3000 + t3000 + (bound-id-member?2503 x2998 (cdr list2999)))) #f))) - (distinct-bound-ids?140 - (lambda (ids639) - (letrec ((distinct?640 - (lambda (ids641) - (let ((t642 (null? ids641))) - (if t642 - t642 - (if (not (bound-id-member?141 - (car ids641) - (cdr ids641))) - (distinct?640 (cdr ids641)) + (distinct-bound-ids?2502 + (lambda (ids3001) + (letrec ((distinct?3002 + (lambda (ids3003) + (let ((t3004 (null? ids3003))) + (if t3004 + t3004 + (if (not (bound-id-member?2503 + (car ids3003) + (cdr ids3003))) + (distinct?3002 (cdr ids3003)) #f)))))) - (distinct?640 ids639)))) - (valid-bound-ids?139 - (lambda (ids643) - (if (letrec ((all-ids?644 - (lambda (ids645) - (let ((t646 (null? ids645))) - (if t646 - t646 - (if (id?114 (car ids645)) - (all-ids?644 (cdr ids645)) + (distinct?3002 ids3001)))) + (valid-bound-ids?2501 + (lambda (ids3005) + (if (letrec ((all-ids?3006 + (lambda (ids3007) + (let ((t3008 (null? ids3007))) + (if t3008 + t3008 + (if (id?2476 (car ids3007)) + (all-ids?3006 (cdr ids3007)) #f)))))) - (all-ids?644 ids643)) - (distinct-bound-ids?140 ids643) + (all-ids?3006 ids3005)) + (distinct-bound-ids?2502 ids3005) #f))) - (bound-id=?138 - (lambda (i647 j648) - (if (if (syntax-object?98 i647) - (syntax-object?98 j648) + (bound-id=?2500 + (lambda (i3009 j3010) + (if (if (syntax-object?2460 i3009) + (syntax-object?2460 j3010) #f) - (if (eq? (syntax-object-expression99 i647) - (syntax-object-expression99 j648)) - (same-marks?135 - (wrap-marks117 (syntax-object-wrap100 i647)) - (wrap-marks117 (syntax-object-wrap100 j648))) + (if (eq? (syntax-object-expression2461 i3009) + (syntax-object-expression2461 j3010)) + (same-marks?2497 + (wrap-marks2479 (syntax-object-wrap2462 i3009)) + (wrap-marks2479 (syntax-object-wrap2462 j3010))) #f) - (eq? i647 j648)))) - (free-id=?137 - (lambda (i649 j650) - (if (eq? (let ((x651 i649)) - (if (syntax-object?98 x651) - (syntax-object-expression99 x651) - x651)) - (let ((x652 j650)) - (if (syntax-object?98 x652) - (syntax-object-expression99 x652) - x652))) - (eq? (id-var-name136 i649 (quote (()))) - (id-var-name136 j650 (quote (())))) + (eq? i3009 j3010)))) + (free-id=?2499 + (lambda (i3011 j3012) + (if (eq? (let ((x3013 i3011)) + (if (syntax-object?2460 x3013) + (syntax-object-expression2461 x3013) + x3013)) + (let ((x3014 j3012)) + (if (syntax-object?2460 x3014) + (syntax-object-expression2461 x3014) + x3014))) + (eq? (id-var-name2498 i3011 (quote (()))) + (id-var-name2498 j3012 (quote (())))) #f))) - (id-var-name136 - (lambda (id653 w654) - (letrec ((search-vector-rib657 - (lambda (sym663 - subst664 - marks665 - symnames666 - ribcage667) - (let ((n668 (vector-length symnames666))) - (letrec ((f669 (lambda (i670) - (if (fx=74 i670 n668) - (search655 - sym663 - (cdr subst664) - marks665) - (if (if (eq? (vector-ref - symnames666 - i670) - sym663) - (same-marks?135 - marks665 - (vector-ref - (ribcage-marks124 - ribcage667) - i670)) - #f) - (values - (vector-ref - (ribcage-labels125 - ribcage667) - i670) - marks665) - (f669 (fx+72 i670 1))))))) - (f669 0))))) - (search-list-rib656 - (lambda (sym671 - subst672 - marks673 - symnames674 - ribcage675) - (letrec ((f676 (lambda (symnames677 i678) - (if (null? symnames677) - (search655 - sym671 - (cdr subst672) - marks673) - (if (if (eq? (car symnames677) - sym671) - (same-marks?135 - marks673 - (list-ref - (ribcage-marks124 - ribcage675) - i678)) - #f) - (values - (list-ref - (ribcage-labels125 - ribcage675) - i678) - marks673) - (f676 (cdr symnames677) - (fx+72 i678 1))))))) - (f676 symnames674 0)))) - (search655 - (lambda (sym679 subst680 marks681) - (if (null? subst680) - (values #f marks681) - (let ((fst682 (car subst680))) - (if (eq? fst682 (quote shift)) - (search655 - sym679 - (cdr subst680) - (cdr marks681)) - (let ((symnames683 - (ribcage-symnames123 fst682))) - (if (vector? symnames683) - (search-vector-rib657 - sym679 - subst680 - marks681 - symnames683 - fst682) - (search-list-rib656 - sym679 - subst680 - marks681 - symnames683 - fst682))))))))) - (if (symbol? id653) - (let ((t684 (call-with-values - (lambda () - (search655 - id653 - (wrap-subst118 w654) - (wrap-marks117 w654))) - (lambda (x686 . ignore685) x686)))) - (if t684 t684 id653)) - (if (syntax-object?98 id653) - (let ((id687 (syntax-object-expression99 id653)) - (w1688 (syntax-object-wrap100 id653))) - (let ((marks689 - (join-marks134 - (wrap-marks117 w654) - (wrap-marks117 w1688)))) + (id-var-name2498 + (lambda (id3015 w3016) + (letrec ((search-vector-rib3019 + (lambda (sym3025 + subst3026 + marks3027 + symnames3028 + ribcage3029) + (let ((n3030 (vector-length symnames3028))) + (letrec ((f3031 (lambda (i3032) + (if (fx=2435 i3032 n3030) + (search3017 + sym3025 + (cdr subst3026) + marks3027) + (if (if (eq? (vector-ref + symnames3028 + i3032) + sym3025) + (same-marks?2497 + marks3027 + (vector-ref + (ribcage-marks2486 + ribcage3029) + i3032)) + #f) + (values + (vector-ref + (ribcage-labels2487 + ribcage3029) + i3032) + marks3027) + (f3031 (fx+2433 + i3032 + 1))))))) + (f3031 0))))) + (search-list-rib3018 + (lambda (sym3033 + subst3034 + marks3035 + symnames3036 + ribcage3037) + (letrec ((f3038 (lambda (symnames3039 i3040) + (if (null? symnames3039) + (search3017 + sym3033 + (cdr subst3034) + marks3035) + (if (if (eq? (car symnames3039) + sym3033) + (same-marks?2497 + marks3035 + (list-ref + (ribcage-marks2486 + ribcage3037) + i3040)) + #f) + (values + (list-ref + (ribcage-labels2487 + ribcage3037) + i3040) + marks3035) + (f3038 (cdr symnames3039) + (fx+2433 + i3040 + 1))))))) + (f3038 symnames3036 0)))) + (search3017 + (lambda (sym3041 subst3042 marks3043) + (if (null? subst3042) + (values #f marks3043) + (let ((fst3044 (car subst3042))) + (if (eq? fst3044 (quote shift)) + (search3017 + sym3041 + (cdr subst3042) + (cdr marks3043)) + (let ((symnames3045 + (ribcage-symnames2485 fst3044))) + (if (vector? symnames3045) + (search-vector-rib3019 + sym3041 + subst3042 + marks3043 + symnames3045 + fst3044) + (search-list-rib3018 + sym3041 + subst3042 + marks3043 + symnames3045 + fst3044))))))))) + (if (symbol? id3015) + (let ((t3046 (call-with-values + (lambda () + (search3017 + id3015 + (wrap-subst2480 w3016) + (wrap-marks2479 w3016))) + (lambda (x3048 . ignore3047) x3048)))) + (if t3046 t3046 id3015)) + (if (syntax-object?2460 id3015) + (let ((id3049 (syntax-object-expression2461 id3015)) + (w13050 (syntax-object-wrap2462 id3015))) + (let ((marks3051 + (join-marks2496 + (wrap-marks2479 w3016) + (wrap-marks2479 w13050)))) (call-with-values (lambda () - (search655 id687 (wrap-subst118 w654) marks689)) - (lambda (new-id690 marks691) - (let ((t692 new-id690)) - (if t692 - t692 - (let ((t693 (call-with-values - (lambda () - (search655 - id687 - (wrap-subst118 w1688) - marks691)) - (lambda (x695 . ignore694) - x695)))) - (if t693 t693 id687)))))))) + (search3017 + id3049 + (wrap-subst2480 w3016) + marks3051)) + (lambda (new-id3052 marks3053) + (let ((t3054 new-id3052)) + (if t3054 + t3054 + (let ((t3055 (call-with-values + (lambda () + (search3017 + id3049 + (wrap-subst2480 w13050) + marks3053)) + (lambda (x3057 . ignore3056) + x3057)))) + (if t3055 t3055 id3049)))))))) (syntax-violation 'id-var-name "invalid id" - id653)))))) - (same-marks?135 - (lambda (x696 y697) - (let ((t698 (eq? x696 y697))) - (if t698 - t698 - (if (not (null? x696)) - (if (not (null? y697)) - (if (eq? (car x696) (car y697)) - (same-marks?135 (cdr x696) (cdr y697)) + id3015)))))) + (same-marks?2497 + (lambda (x3058 y3059) + (let ((t3060 (eq? x3058 y3059))) + (if t3060 + t3060 + (if (not (null? x3058)) + (if (not (null? y3059)) + (if (eq? (car x3058) (car y3059)) + (same-marks?2497 (cdr x3058) (cdr y3059)) #f) #f) #f))))) - (join-marks134 - (lambda (m1699 m2700) - (smart-append132 m1699 m2700))) - (join-wraps133 - (lambda (w1701 w2702) - (let ((m1703 (wrap-marks117 w1701)) - (s1704 (wrap-subst118 w1701))) - (if (null? m1703) - (if (null? s1704) - w2702 - (make-wrap116 - (wrap-marks117 w2702) - (smart-append132 s1704 (wrap-subst118 w2702)))) - (make-wrap116 - (smart-append132 m1703 (wrap-marks117 w2702)) - (smart-append132 s1704 (wrap-subst118 w2702))))))) - (smart-append132 - (lambda (m1705 m2706) - (if (null? m2706) m1705 (append m1705 m2706)))) - (make-binding-wrap131 - (lambda (ids707 labels708 w709) - (if (null? ids707) - w709 - (make-wrap116 - (wrap-marks117 w709) - (cons (let ((labelvec710 (list->vector labels708))) - (let ((n711 (vector-length labelvec710))) - (let ((symnamevec712 (make-vector n711)) - (marksvec713 (make-vector n711))) + (join-marks2496 + (lambda (m13061 m23062) + (smart-append2494 m13061 m23062))) + (join-wraps2495 + (lambda (w13063 w23064) + (let ((m13065 (wrap-marks2479 w13063)) + (s13066 (wrap-subst2480 w13063))) + (if (null? m13065) + (if (null? s13066) + w23064 + (make-wrap2478 + (wrap-marks2479 w23064) + (smart-append2494 s13066 (wrap-subst2480 w23064)))) + (make-wrap2478 + (smart-append2494 m13065 (wrap-marks2479 w23064)) + (smart-append2494 s13066 (wrap-subst2480 w23064))))))) + (smart-append2494 + (lambda (m13067 m23068) + (if (null? m23068) m13067 (append m13067 m23068)))) + (make-binding-wrap2493 + (lambda (ids3069 labels3070 w3071) + (if (null? ids3069) + w3071 + (make-wrap2478 + (wrap-marks2479 w3071) + (cons (let ((labelvec3072 (list->vector labels3070))) + (let ((n3073 (vector-length labelvec3072))) + (let ((symnamevec3074 (make-vector n3073)) + (marksvec3075 (make-vector n3073))) (begin - (letrec ((f714 (lambda (ids715 i716) - (if (not (null? ids715)) - (call-with-values - (lambda () - (id-sym-name&marks115 - (car ids715) - w709)) - (lambda (symname717 - marks718) - (begin - (vector-set! - symnamevec712 - i716 - symname717) - (vector-set! - marksvec713 - i716 - marks718) - (f714 (cdr ids715) - (fx+72 i716 - 1))))))))) - (f714 ids707 0)) - (make-ribcage121 - symnamevec712 - marksvec713 - labelvec710))))) - (wrap-subst118 w709)))))) - (extend-ribcage!130 - (lambda (ribcage719 id720 label721) + (letrec ((f3076 (lambda (ids3077 i3078) + (if (not (null? ids3077)) + (call-with-values + (lambda () + (id-sym-name&marks2477 + (car ids3077) + w3071)) + (lambda (symname3079 + marks3080) + (begin + (vector-set! + symnamevec3074 + i3078 + symname3079) + (vector-set! + marksvec3075 + i3078 + marks3080) + (f3076 (cdr ids3077) + (fx+2433 + i3078 + 1))))))))) + (f3076 ids3069 0)) + (make-ribcage2483 + symnamevec3074 + marksvec3075 + labelvec3072))))) + (wrap-subst2480 w3071)))))) + (extend-ribcage!2492 + (lambda (ribcage3081 id3082 label3083) (begin - (set-ribcage-symnames!126 - ribcage719 - (cons (syntax-object-expression99 id720) - (ribcage-symnames123 ribcage719))) - (set-ribcage-marks!127 - ribcage719 - (cons (wrap-marks117 (syntax-object-wrap100 id720)) - (ribcage-marks124 ribcage719))) - (set-ribcage-labels!128 - ribcage719 - (cons label721 (ribcage-labels125 ribcage719)))))) - (anti-mark129 - (lambda (w722) - (make-wrap116 - (cons #f (wrap-marks117 w722)) - (cons (quote shift) (wrap-subst118 w722))))) - (set-ribcage-labels!128 - (lambda (x723 update724) - (vector-set! x723 3 update724))) - (set-ribcage-marks!127 - (lambda (x725 update726) - (vector-set! x725 2 update726))) - (set-ribcage-symnames!126 - (lambda (x727 update728) - (vector-set! x727 1 update728))) - (ribcage-labels125 - (lambda (x729) (vector-ref x729 3))) - (ribcage-marks124 - (lambda (x730) (vector-ref x730 2))) - (ribcage-symnames123 - (lambda (x731) (vector-ref x731 1))) - (ribcage?122 - (lambda (x732) - (if (vector? x732) - (if (= (vector-length x732) 4) - (eq? (vector-ref x732 0) (quote ribcage)) + (set-ribcage-symnames!2488 + ribcage3081 + (cons (syntax-object-expression2461 id3082) + (ribcage-symnames2485 ribcage3081))) + (set-ribcage-marks!2489 + ribcage3081 + (cons (wrap-marks2479 (syntax-object-wrap2462 id3082)) + (ribcage-marks2486 ribcage3081))) + (set-ribcage-labels!2490 + ribcage3081 + (cons label3083 (ribcage-labels2487 ribcage3081)))))) + (anti-mark2491 + (lambda (w3084) + (make-wrap2478 + (cons #f (wrap-marks2479 w3084)) + (cons (quote shift) (wrap-subst2480 w3084))))) + (set-ribcage-labels!2490 + (lambda (x3085 update3086) + (vector-set! x3085 3 update3086))) + (set-ribcage-marks!2489 + (lambda (x3087 update3088) + (vector-set! x3087 2 update3088))) + (set-ribcage-symnames!2488 + (lambda (x3089 update3090) + (vector-set! x3089 1 update3090))) + (ribcage-labels2487 + (lambda (x3091) (vector-ref x3091 3))) + (ribcage-marks2486 + (lambda (x3092) (vector-ref x3092 2))) + (ribcage-symnames2485 + (lambda (x3093) (vector-ref x3093 1))) + (ribcage?2484 + (lambda (x3094) + (if (vector? x3094) + (if (= (vector-length x3094) 4) + (eq? (vector-ref x3094 0) (quote ribcage)) #f) #f))) - (make-ribcage121 - (lambda (symnames733 marks734 labels735) + (make-ribcage2483 + (lambda (symnames3095 marks3096 labels3097) (vector 'ribcage - symnames733 - marks734 - labels735))) - (gen-labels120 - (lambda (ls736) - (if (null? ls736) + symnames3095 + marks3096 + labels3097))) + (gen-labels2482 + (lambda (ls3098) + (if (null? ls3098) '() - (cons (gen-label119) (gen-labels120 (cdr ls736)))))) - (gen-label119 (lambda () (string #\i))) - (wrap-subst118 cdr) - (wrap-marks117 car) - (make-wrap116 cons) - (id-sym-name&marks115 - (lambda (x737 w738) - (if (syntax-object?98 x737) + (cons (gen-label2481) + (gen-labels2482 (cdr ls3098)))))) + (gen-label2481 (lambda () (string #\i))) + (wrap-subst2480 cdr) + (wrap-marks2479 car) + (make-wrap2478 cons) + (id-sym-name&marks2477 + (lambda (x3099 w3100) + (if (syntax-object?2460 x3099) (values - (syntax-object-expression99 x737) - (join-marks134 - (wrap-marks117 w738) - (wrap-marks117 (syntax-object-wrap100 x737)))) - (values x737 (wrap-marks117 w738))))) - (id?114 - (lambda (x739) - (if (symbol? x739) + (syntax-object-expression2461 x3099) + (join-marks2496 + (wrap-marks2479 w3100) + (wrap-marks2479 (syntax-object-wrap2462 x3099)))) + (values x3099 (wrap-marks2479 w3100))))) + (id?2476 + (lambda (x3101) + (if (symbol? x3101) #t - (if (syntax-object?98 x739) - (symbol? (syntax-object-expression99 x739)) + (if (syntax-object?2460 x3101) + (symbol? (syntax-object-expression2461 x3101)) #f)))) - (nonsymbol-id?113 - (lambda (x740) - (if (syntax-object?98 x740) - (symbol? (syntax-object-expression99 x740)) + (nonsymbol-id?2475 + (lambda (x3102) + (if (syntax-object?2460 x3102) + (symbol? (syntax-object-expression2461 x3102)) #f))) - (global-extend112 - (lambda (type741 sym742 val743) - (put-global-definition-hook78 - sym742 - type741 - val743))) - (lookup111 - (lambda (x744 r745 mod746) - (let ((t747 (assq x744 r745))) - (if t747 - (cdr t747) - (if (symbol? x744) - (let ((t748 (get-global-definition-hook79 x744 mod746))) - (if t748 t748 (quote (global)))) + (global-extend2474 + (lambda (type3103 sym3104 val3105) + (put-global-definition-hook2439 + sym3104 + type3103 + val3105))) + (lookup2473 + (lambda (x3106 r3107 mod3108) + (let ((t3109 (assq x3106 r3107))) + (if t3109 + (cdr t3109) + (if (symbol? x3106) + (let ((t3110 (get-global-definition-hook2440 + x3106 + mod3108))) + (if t3110 t3110 (quote (global)))) '(displaced-lexical)))))) - (macros-only-env110 - (lambda (r749) - (if (null? r749) + (macros-only-env2472 + (lambda (r3111) + (if (null? r3111) '() - (let ((a750 (car r749))) - (if (eq? (cadr a750) (quote macro)) - (cons a750 (macros-only-env110 (cdr r749))) - (macros-only-env110 (cdr r749))))))) - (extend-var-env109 - (lambda (labels751 vars752 r753) - (if (null? labels751) - r753 - (extend-var-env109 - (cdr labels751) - (cdr vars752) - (cons (cons (car labels751) - (cons (quote lexical) (car vars752))) - r753))))) - (extend-env108 - (lambda (labels754 bindings755 r756) - (if (null? labels754) - r756 - (extend-env108 - (cdr labels754) - (cdr bindings755) - (cons (cons (car labels754) (car bindings755)) - r756))))) - (binding-value107 cdr) - (binding-type106 car) - (source-annotation105 - (lambda (x757) - (if (syntax-object?98 x757) - (source-annotation105 - (syntax-object-expression99 x757)) - (if (pair? x757) - (let ((props758 (source-properties x757))) - (if (pair? props758) props758 #f)) + (let ((a3112 (car r3111))) + (if (eq? (cadr a3112) (quote macro)) + (cons a3112 (macros-only-env2472 (cdr r3111))) + (macros-only-env2472 (cdr r3111))))))) + (extend-var-env2471 + (lambda (labels3113 vars3114 r3115) + (if (null? labels3113) + r3115 + (extend-var-env2471 + (cdr labels3113) + (cdr vars3114) + (cons (cons (car labels3113) + (cons (quote lexical) (car vars3114))) + r3115))))) + (extend-env2470 + (lambda (labels3116 bindings3117 r3118) + (if (null? labels3116) + r3118 + (extend-env2470 + (cdr labels3116) + (cdr bindings3117) + (cons (cons (car labels3116) (car bindings3117)) + r3118))))) + (binding-value2469 cdr) + (binding-type2468 car) + (source-annotation2467 + (lambda (x3119) + (if (syntax-object?2460 x3119) + (source-annotation2467 + (syntax-object-expression2461 x3119)) + (if (pair? x3119) + (let ((props3120 (source-properties x3119))) + (if (pair? props3120) props3120 #f)) #f)))) - (set-syntax-object-module!104 - (lambda (x759 update760) - (vector-set! x759 3 update760))) - (set-syntax-object-wrap!103 - (lambda (x761 update762) - (vector-set! x761 2 update762))) - (set-syntax-object-expression!102 - (lambda (x763 update764) - (vector-set! x763 1 update764))) - (syntax-object-module101 - (lambda (x765) (vector-ref x765 3))) - (syntax-object-wrap100 - (lambda (x766) (vector-ref x766 2))) - (syntax-object-expression99 - (lambda (x767) (vector-ref x767 1))) - (syntax-object?98 - (lambda (x768) - (if (vector? x768) - (if (= (vector-length x768) 4) - (eq? (vector-ref x768 0) (quote syntax-object)) + (set-syntax-object-module!2466 + (lambda (x3121 update3122) + (vector-set! x3121 3 update3122))) + (set-syntax-object-wrap!2465 + (lambda (x3123 update3124) + (vector-set! x3123 2 update3124))) + (set-syntax-object-expression!2464 + (lambda (x3125 update3126) + (vector-set! x3125 1 update3126))) + (syntax-object-module2463 + (lambda (x3127) (vector-ref x3127 3))) + (syntax-object-wrap2462 + (lambda (x3128) (vector-ref x3128 2))) + (syntax-object-expression2461 + (lambda (x3129) (vector-ref x3129 1))) + (syntax-object?2460 + (lambda (x3130) + (if (vector? x3130) + (if (= (vector-length x3130) 4) + (eq? (vector-ref x3130 0) (quote syntax-object)) #f) #f))) - (make-syntax-object97 - (lambda (expression769 wrap770 module771) + (make-syntax-object2459 + (lambda (expression3131 wrap3132 module3133) (vector 'syntax-object - expression769 - wrap770 - module771))) - (build-letrec96 - (lambda (src772 ids773 vars774 val-exps775 body-exp776) - (if (null? vars774) - body-exp776 - (let ((atom-key777 (fluid-ref *mode*71))) - (if (memv atom-key777 (quote (c))) + expression3131 + wrap3132 + module3133))) + (build-letrec2458 + (lambda (src3134 + ids3135 + vars3136 + val-exps3137 + body-exp3138) + (if (null? vars3136) + body-exp3138 + (let ((atom-key3139 (fluid-ref *mode*2432))) + (if (memv atom-key3139 (quote (c))) (begin - (for-each maybe-name-value!88 ids773 val-exps775) + (for-each + maybe-name-value!2450 + ids3135 + val-exps3137) ((@ (language tree-il) make-letrec) - src772 - ids773 - vars774 - val-exps775 - body-exp776)) - (list 'letrec - (map list vars774 val-exps775) - body-exp776)))))) - (build-named-let95 - (lambda (src778 ids779 vars780 val-exps781 body-exp782) - (let ((f783 (car vars780)) - (f-name784 (car ids779)) - (vars785 (cdr vars780)) - (ids786 (cdr ids779))) - (let ((atom-key787 (fluid-ref *mode*71))) - (if (memv atom-key787 (quote (c))) - (let ((proc788 - (build-lambda90 - src778 - ids786 - vars785 + src3134 + ids3135 + vars3136 + val-exps3137 + body-exp3138)) + (decorate-source2441 + (list 'letrec + (map list vars3136 val-exps3137) + body-exp3138) + src3134)))))) + (build-named-let2457 + (lambda (src3140 + ids3141 + vars3142 + val-exps3143 + body-exp3144) + (let ((f3145 (car vars3142)) + (f-name3146 (car ids3141)) + (vars3147 (cdr vars3142)) + (ids3148 (cdr ids3141))) + (let ((atom-key3149 (fluid-ref *mode*2432))) + (if (memv atom-key3149 (quote (c))) + (let ((proc3150 + (build-lambda2452 + src3140 + ids3148 + vars3147 #f - body-exp782))) + body-exp3144))) (begin - (maybe-name-value!88 f-name784 proc788) - (for-each maybe-name-value!88 ids786 val-exps781) + (maybe-name-value!2450 f-name3146 proc3150) + (for-each + maybe-name-value!2450 + ids3148 + val-exps3143) ((@ (language tree-il) make-letrec) - src778 - (list f-name784) - (list f783) - (list proc788) - (build-application81 - src778 - (build-lexical-reference83 + src3140 + (list f-name3146) + (list f3145) + (list proc3150) + (build-application2443 + src3140 + (build-lexical-reference2445 'fun - src778 - f-name784 - f783) - val-exps781)))) - (list 'let - f783 - (map list vars785 val-exps781) - body-exp782)))))) - (build-let94 - (lambda (src789 ids790 vars791 val-exps792 body-exp793) - (if (null? vars791) - body-exp793 - (let ((atom-key794 (fluid-ref *mode*71))) - (if (memv atom-key794 (quote (c))) + src3140 + f-name3146 + f3145) + val-exps3143)))) + (decorate-source2441 + (list 'let + f3145 + (map list vars3147 val-exps3143) + body-exp3144) + src3140)))))) + (build-let2456 + (lambda (src3151 + ids3152 + vars3153 + val-exps3154 + body-exp3155) + (if (null? vars3153) + body-exp3155 + (let ((atom-key3156 (fluid-ref *mode*2432))) + (if (memv atom-key3156 (quote (c))) (begin - (for-each maybe-name-value!88 ids790 val-exps792) + (for-each + maybe-name-value!2450 + ids3152 + val-exps3154) ((@ (language tree-il) make-let) - src789 - ids790 - vars791 - val-exps792 - body-exp793)) - (list 'let - (map list vars791 val-exps792) - body-exp793)))))) - (build-sequence93 - (lambda (src795 exps796) - (if (null? (cdr exps796)) - (car exps796) - (let ((atom-key797 (fluid-ref *mode*71))) - (if (memv atom-key797 (quote (c))) + src3151 + ids3152 + vars3153 + val-exps3154 + body-exp3155)) + (decorate-source2441 + (list 'let + (map list vars3153 val-exps3154) + body-exp3155) + src3151)))))) + (build-sequence2455 + (lambda (src3157 exps3158) + (if (null? (cdr exps3158)) + (car exps3158) + (let ((atom-key3159 (fluid-ref *mode*2432))) + (if (memv atom-key3159 (quote (c))) ((@ (language tree-il) make-sequence) - src795 - exps796) - (cons (quote begin) exps796)))))) - (build-data92 - (lambda (src798 exp799) - (let ((atom-key800 (fluid-ref *mode*71))) - (if (memv atom-key800 (quote (c))) - ((@ (language tree-il) make-const) src798 exp799) - (if (if (self-evaluating? exp799) - (not (vector? exp799)) - #f) - exp799 - (list (quote quote) exp799)))))) - (build-primref91 - (lambda (src801 name802) + src3157 + exps3158) + (decorate-source2441 + (cons (quote begin) exps3158) + src3157)))))) + (build-data2454 + (lambda (src3160 exp3161) + (let ((atom-key3162 (fluid-ref *mode*2432))) + (if (memv atom-key3162 (quote (c))) + ((@ (language tree-il) make-const) + src3160 + exp3161) + (decorate-source2441 + (if (if (self-evaluating? exp3161) + (not (vector? exp3161)) + #f) + exp3161 + (list (quote quote) exp3161)) + src3160))))) + (build-primref2453 + (lambda (src3163 name3164) (if (equal? (module-name (current-module)) '(guile)) - (let ((atom-key803 (fluid-ref *mode*71))) - (if (memv atom-key803 (quote (c))) + (let ((atom-key3165 (fluid-ref *mode*2432))) + (if (memv atom-key3165 (quote (c))) ((@ (language tree-il) make-toplevel-ref) - src801 - name802) - name802)) - (let ((atom-key804 (fluid-ref *mode*71))) - (if (memv atom-key804 (quote (c))) + src3163 + name3164) + (decorate-source2441 name3164 src3163))) + (let ((atom-key3166 (fluid-ref *mode*2432))) + (if (memv atom-key3166 (quote (c))) ((@ (language tree-il) make-module-ref) - src801 + src3163 '(guile) - name802 + name3164 #f) - (list (quote @@) (quote (guile)) name802)))))) - (build-lambda90 - (lambda (src805 ids806 vars807 docstring808 exp809) - (let ((atom-key810 (fluid-ref *mode*71))) - (if (memv atom-key810 (quote (c))) + (decorate-source2441 + (list (quote @@) (quote (guile)) name3164) + src3163)))))) + (build-lambda2452 + (lambda (src3167 ids3168 vars3169 docstring3170 exp3171) + (let ((atom-key3172 (fluid-ref *mode*2432))) + (if (memv atom-key3172 (quote (c))) ((@ (language tree-il) make-lambda) - src805 - ids806 - vars807 - (if docstring808 - (list (cons (quote documentation) docstring808)) + src3167 + ids3168 + vars3169 + (if docstring3170 + (list (cons (quote documentation) docstring3170)) '()) - exp809) - (cons 'lambda - (cons vars807 - (append - (if docstring808 - (list docstring808) - '()) - (list exp809)))))))) - (build-global-definition89 - (lambda (source811 var812 exp813) - (let ((atom-key814 (fluid-ref *mode*71))) - (if (memv atom-key814 (quote (c))) + exp3171) + (decorate-source2441 + (cons 'lambda + (cons vars3169 + (append + (if docstring3170 + (list docstring3170) + '()) + (list exp3171)))) + src3167))))) + (build-global-definition2451 + (lambda (source3173 var3174 exp3175) + (let ((atom-key3176 (fluid-ref *mode*2432))) + (if (memv atom-key3176 (quote (c))) (begin - (maybe-name-value!88 var812 exp813) + (maybe-name-value!2450 var3174 exp3175) ((@ (language tree-il) make-toplevel-define) - source811 - var812 - exp813)) - (list (quote define) var812 exp813))))) - (maybe-name-value!88 - (lambda (name815 val816) - (if ((@ (language tree-il) lambda?) val816) - (let ((meta817 - ((@ (language tree-il) lambda-meta) val816))) - (if (not (assq (quote name) meta817)) + source3173 + var3174 + exp3175)) + (decorate-source2441 + (list (quote define) var3174 exp3175) + source3173))))) + (maybe-name-value!2450 + (lambda (name3177 val3178) + (if ((@ (language tree-il) lambda?) val3178) + (let ((meta3179 + ((@ (language tree-il) lambda-meta) val3178))) + (if (not (assq (quote name) meta3179)) ((setter (@ (language tree-il) lambda-meta)) - val816 - (acons (quote name) name815 meta817))))))) - (build-global-assignment87 - (lambda (source818 var819 exp820 mod821) - (analyze-variable85 - mod821 - var819 - (lambda (mod822 var823 public?824) - (let ((atom-key825 (fluid-ref *mode*71))) - (if (memv atom-key825 (quote (c))) + val3178 + (acons (quote name) name3177 meta3179))))))) + (build-global-assignment2449 + (lambda (source3180 var3181 exp3182 mod3183) + (analyze-variable2447 + mod3183 + var3181 + (lambda (mod3184 var3185 public?3186) + (let ((atom-key3187 (fluid-ref *mode*2432))) + (if (memv atom-key3187 (quote (c))) ((@ (language tree-il) make-module-set) - source818 - mod822 - var823 - public?824 - exp820) - (list 'set! - (list (if public?824 (quote @) (quote @@)) - mod822 - var823) - exp820)))) - (lambda (var826) - (let ((atom-key827 (fluid-ref *mode*71))) - (if (memv atom-key827 (quote (c))) + source3180 + mod3184 + var3185 + public?3186 + exp3182) + (decorate-source2441 + (list 'set! + (list (if public?3186 (quote @) (quote @@)) + mod3184 + var3185) + exp3182) + source3180)))) + (lambda (var3188) + (let ((atom-key3189 (fluid-ref *mode*2432))) + (if (memv atom-key3189 (quote (c))) ((@ (language tree-il) make-toplevel-set) - source818 - var826 - exp820) - (list (quote set!) var826 exp820))))))) - (build-global-reference86 - (lambda (source828 var829 mod830) - (analyze-variable85 - mod830 - var829 - (lambda (mod831 var832 public?833) - (let ((atom-key834 (fluid-ref *mode*71))) - (if (memv atom-key834 (quote (c))) + source3180 + var3188 + exp3182) + (decorate-source2441 + (list (quote set!) var3188 exp3182) + source3180))))))) + (build-global-reference2448 + (lambda (source3190 var3191 mod3192) + (analyze-variable2447 + mod3192 + var3191 + (lambda (mod3193 var3194 public?3195) + (let ((atom-key3196 (fluid-ref *mode*2432))) + (if (memv atom-key3196 (quote (c))) ((@ (language tree-il) make-module-ref) - source828 - mod831 - var832 - public?833) - (list (if public?833 (quote @) (quote @@)) - mod831 - var832)))) - (lambda (var835) - (let ((atom-key836 (fluid-ref *mode*71))) - (if (memv atom-key836 (quote (c))) + source3190 + mod3193 + var3194 + public?3195) + (decorate-source2441 + (list (if public?3195 (quote @) (quote @@)) + mod3193 + var3194) + source3190)))) + (lambda (var3197) + (let ((atom-key3198 (fluid-ref *mode*2432))) + (if (memv atom-key3198 (quote (c))) ((@ (language tree-il) make-toplevel-ref) - source828 - var835) - var835)))))) - (analyze-variable85 - (lambda (mod837 var838 modref-cont839 bare-cont840) - (if (not mod837) - (bare-cont840 var838) - (let ((kind841 (car mod837)) (mod842 (cdr mod837))) - (if (memv kind841 (quote (public))) - (modref-cont839 mod842 var838 #t) - (if (memv kind841 (quote (private))) - (if (not (equal? mod842 (module-name (current-module)))) - (modref-cont839 mod842 var838 #f) - (bare-cont840 var838)) - (if (memv kind841 (quote (bare))) - (bare-cont840 var838) - (if (memv kind841 (quote (hygiene))) + source3190 + var3197) + (decorate-source2441 var3197 source3190))))))) + (analyze-variable2447 + (lambda (mod3199 var3200 modref-cont3201 bare-cont3202) + (if (not mod3199) + (bare-cont3202 var3200) + (let ((kind3203 (car mod3199)) + (mod3204 (cdr mod3199))) + (if (memv kind3203 (quote (public))) + (modref-cont3201 mod3204 var3200 #t) + (if (memv kind3203 (quote (private))) + (if (not (equal? + mod3204 + (module-name (current-module)))) + (modref-cont3201 mod3204 var3200 #f) + (bare-cont3202 var3200)) + (if (memv kind3203 (quote (bare))) + (bare-cont3202 var3200) + (if (memv kind3203 (quote (hygiene))) (if (if (not (equal? - mod842 + mod3204 (module-name (current-module)))) (module-variable - (resolve-module mod842) - var838) + (resolve-module mod3204) + var3200) #f) - (modref-cont839 mod842 var838 #f) - (bare-cont840 var838)) + (modref-cont3201 mod3204 var3200 #f) + (bare-cont3202 var3200)) (syntax-violation #f "bad module kind" - var838 - mod842))))))))) - (build-lexical-assignment84 - (lambda (source843 name844 var845 exp846) - (let ((atom-key847 (fluid-ref *mode*71))) - (if (memv atom-key847 (quote (c))) + var3200 + mod3204))))))))) + (build-lexical-assignment2446 + (lambda (source3205 name3206 var3207 exp3208) + (let ((atom-key3209 (fluid-ref *mode*2432))) + (if (memv atom-key3209 (quote (c))) ((@ (language tree-il) make-lexical-set) - source843 - name844 - var845 - exp846) - (list (quote set!) var845 exp846))))) - (build-lexical-reference83 - (lambda (type848 source849 name850 var851) - (let ((atom-key852 (fluid-ref *mode*71))) - (if (memv atom-key852 (quote (c))) + source3205 + name3206 + var3207 + exp3208) + (decorate-source2441 + (list (quote set!) var3207 exp3208) + source3205))))) + (build-lexical-reference2445 + (lambda (type3210 source3211 name3212 var3213) + (let ((atom-key3214 (fluid-ref *mode*2432))) + (if (memv atom-key3214 (quote (c))) ((@ (language tree-il) make-lexical-ref) - source849 - name850 - var851) - var851)))) - (build-conditional82 - (lambda (source853 test-exp854 then-exp855 else-exp856) - (let ((atom-key857 (fluid-ref *mode*71))) - (if (memv atom-key857 (quote (c))) + source3211 + name3212 + var3213) + (decorate-source2441 var3213 source3211))))) + (build-conditional2444 + (lambda (source3215 + test-exp3216 + then-exp3217 + else-exp3218) + (let ((atom-key3219 (fluid-ref *mode*2432))) + (if (memv atom-key3219 (quote (c))) ((@ (language tree-il) make-conditional) - source853 - test-exp854 - then-exp855 - else-exp856) - (if (equal? else-exp856 (quote (if #f #f))) - (list (quote if) test-exp854 then-exp855) - (list 'if - test-exp854 - then-exp855 - else-exp856)))))) - (build-application81 - (lambda (source858 fun-exp859 arg-exps860) - (let ((atom-key861 (fluid-ref *mode*71))) - (if (memv atom-key861 (quote (c))) + source3215 + test-exp3216 + then-exp3217 + else-exp3218) + (decorate-source2441 + (if (equal? else-exp3218 (quote (if #f #f))) + (list (quote if) test-exp3216 then-exp3217) + (list 'if + test-exp3216 + then-exp3217 + else-exp3218)) + source3215))))) + (build-application2443 + (lambda (source3220 fun-exp3221 arg-exps3222) + (let ((atom-key3223 (fluid-ref *mode*2432))) + (if (memv atom-key3223 (quote (c))) ((@ (language tree-il) make-application) - source858 - fun-exp859 - arg-exps860) - (cons fun-exp859 arg-exps860))))) - (build-void80 - (lambda (source862) - (let ((atom-key863 (fluid-ref *mode*71))) - (if (memv atom-key863 (quote (c))) - ((@ (language tree-il) make-void) source862) - '(if #f #f))))) - (get-global-definition-hook79 - (lambda (symbol864 module865) + source3220 + fun-exp3221 + arg-exps3222) + (decorate-source2441 + (cons fun-exp3221 arg-exps3222) + source3220))))) + (build-void2442 + (lambda (source3224) + (let ((atom-key3225 (fluid-ref *mode*2432))) + (if (memv atom-key3225 (quote (c))) + ((@ (language tree-il) make-void) source3224) + (decorate-source2441 + '(if #f #f) + source3224))))) + (decorate-source2441 + (lambda (e3226 s3227) (begin - (if (if (not module865) (current-module) #f) + (if (if (pair? e3226) s3227 #f) + (set-source-properties! e3226 s3227)) + e3226))) + (get-global-definition-hook2440 + (lambda (symbol3228 module3229) + (begin + (if (if (not module3229) (current-module) #f) (warn "module system is booted, we should have a module" - symbol864)) - (let ((v866 (module-variable - (if module865 - (resolve-module (cdr module865)) - (current-module)) - symbol864))) - (if v866 - (if (variable-bound? v866) - (let ((val867 (variable-ref v866))) - (if (macro? val867) - (if (syncase-macro-type val867) - (cons (syncase-macro-type val867) - (syncase-macro-binding val867)) + symbol3228)) + (let ((v3230 (module-variable + (if module3229 + (resolve-module (cdr module3229)) + (current-module)) + symbol3228))) + (if v3230 + (if (variable-bound? v3230) + (let ((val3231 (variable-ref v3230))) + (if (macro? val3231) + (if (syncase-macro-type val3231) + (cons (syncase-macro-type val3231) + (syncase-macro-binding val3231)) #f) #f)) #f) #f))))) - (put-global-definition-hook78 - (lambda (symbol868 type869 val870) - (let ((existing871 - (let ((v872 (module-variable - (current-module) - symbol868))) - (if v872 - (if (variable-bound? v872) - (let ((val873 (variable-ref v872))) - (if (macro? val873) - (if (not (syncase-macro-type val873)) - val873 + (put-global-definition-hook2439 + (lambda (symbol3232 type3233 val3234) + (let ((existing3235 + (let ((v3236 (module-variable + (current-module) + symbol3232))) + (if v3236 + (if (variable-bound? v3236) + (let ((val3237 (variable-ref v3236))) + (if (macro? val3237) + (if (not (syncase-macro-type val3237)) + val3237 #f) #f)) #f) #f)))) (module-define! (current-module) - symbol868 - (if existing871 + symbol3232 + (if existing3235 (make-extended-syncase-macro - existing871 - type869 - val870) - (make-syncase-macro type869 val870)))))) - (local-eval-hook77 - (lambda (x874 mod875) + existing3235 + type3233 + val3234) + (make-syncase-macro type3233 val3234)))))) + (local-eval-hook2438 + (lambda (x3238 mod3239) (primitive-eval - (list noexpand70 - (let ((atom-key876 (fluid-ref *mode*71))) - (if (memv atom-key876 (quote (c))) - ((@ (language tree-il) tree-il->scheme) x874) - x874)))))) - (top-level-eval-hook76 - (lambda (x877 mod878) + (list noexpand2431 + (let ((atom-key3240 (fluid-ref *mode*2432))) + (if (memv atom-key3240 (quote (c))) + ((@ (language tree-il) tree-il->scheme) x3238) + x3238)))))) + (top-level-eval-hook2437 + (lambda (x3241 mod3242) (primitive-eval - (list noexpand70 - (let ((atom-key879 (fluid-ref *mode*71))) - (if (memv atom-key879 (quote (c))) - ((@ (language tree-il) tree-il->scheme) x877) - x877)))))) - (fx<75 <) - (fx=74 =) - (fx-73 -) - (fx+72 +) - (*mode*71 (make-fluid)) - (noexpand70 "noexpand")) + (list noexpand2431 + (let ((atom-key3243 (fluid-ref *mode*2432))) + (if (memv atom-key3243 (quote (c))) + ((@ (language tree-il) tree-il->scheme) x3241) + x3241)))))) + (fx<2436 <) + (fx=2435 =) + (fx-2434 -) + (fx+2433 +) + (*mode*2432 (make-fluid)) + (noexpand2431 "noexpand")) (begin - (global-extend112 + (global-extend2474 'local-syntax 'letrec-syntax #t) - (global-extend112 + (global-extend2474 'local-syntax 'let-syntax #f) - (global-extend112 + (global-extend2474 'core 'fluid-let-syntax - (lambda (e880 r881 w882 s883 mod884) - ((lambda (tmp885) - ((lambda (tmp886) - (if (if tmp886 - (apply (lambda (_887 var888 val889 e1890 e2891) - (valid-bound-ids?139 var888)) - tmp886) + (lambda (e3244 r3245 w3246 s3247 mod3248) + ((lambda (tmp3249) + ((lambda (tmp3250) + (if (if tmp3250 + (apply (lambda (_3251 var3252 val3253 e13254 e23255) + (valid-bound-ids?2501 var3252)) + tmp3250) #f) - (apply (lambda (_893 var894 val895 e1896 e2897) - (let ((names898 - (map (lambda (x899) - (id-var-name136 x899 w882)) - var894))) + (apply (lambda (_3257 var3258 val3259 e13260 e23261) + (let ((names3262 + (map (lambda (x3263) + (id-var-name2498 x3263 w3246)) + var3258))) (begin (for-each - (lambda (id901 n902) - (let ((atom-key903 - (binding-type106 - (lookup111 n902 r881 mod884)))) - (if (memv atom-key903 + (lambda (id3265 n3266) + (let ((atom-key3267 + (binding-type2468 + (lookup2473 + n3266 + r3245 + mod3248)))) + (if (memv atom-key3267 '(displaced-lexical)) (syntax-violation 'fluid-let-syntax "identifier out of context" - e880 - (source-wrap143 - id901 - w882 - s883 - mod884))))) - var894 - names898) - (chi-body154 - (cons e1896 e2897) - (source-wrap143 e880 w882 s883 mod884) - (extend-env108 - names898 - (let ((trans-r906 - (macros-only-env110 r881))) - (map (lambda (x907) + e3244 + (source-wrap2505 + id3265 + w3246 + s3247 + mod3248))))) + var3258 + names3262) + (chi-body2516 + (cons e13260 e23261) + (source-wrap2505 e3244 w3246 s3247 mod3248) + (extend-env2470 + names3262 + (let ((trans-r3270 + (macros-only-env2472 r3245))) + (map (lambda (x3271) (cons 'macro - (eval-local-transformer157 - (chi150 - x907 - trans-r906 - w882 - mod884) - mod884))) - val895)) - r881) - w882 - mod884)))) - tmp886) - ((lambda (_909) + (eval-local-transformer2519 + (chi2512 + x3271 + trans-r3270 + w3246 + mod3248) + mod3248))) + val3259)) + r3245) + w3246 + mod3248)))) + tmp3250) + ((lambda (_3273) (syntax-violation 'fluid-let-syntax "bad syntax" - (source-wrap143 e880 w882 s883 mod884))) - tmp885))) + (source-wrap2505 e3244 w3246 s3247 mod3248))) + tmp3249))) ($sc-dispatch - tmp885 + tmp3249 '(any #(each (any any)) any . each-any)))) - e880))) - (global-extend112 + e3244))) + (global-extend2474 'core 'quote - (lambda (e910 r911 w912 s913 mod914) - ((lambda (tmp915) - ((lambda (tmp916) - (if tmp916 - (apply (lambda (_917 e918) - (build-data92 s913 (strip160 e918 w912))) - tmp916) - ((lambda (_919) + (lambda (e3274 r3275 w3276 s3277 mod3278) + ((lambda (tmp3279) + ((lambda (tmp3280) + (if tmp3280 + (apply (lambda (_3281 e3282) + (build-data2454 s3277 (strip2522 e3282 w3276))) + tmp3280) + ((lambda (_3283) (syntax-violation 'quote "bad syntax" - (source-wrap143 e910 w912 s913 mod914))) - tmp915))) - ($sc-dispatch tmp915 (quote (any any))))) - e910))) - (global-extend112 + (source-wrap2505 e3274 w3276 s3277 mod3278))) + tmp3279))) + ($sc-dispatch tmp3279 (quote (any any))))) + e3274))) + (global-extend2474 'core 'syntax - (letrec ((regen927 - (lambda (x928) - (let ((atom-key929 (car x928))) - (if (memv atom-key929 (quote (ref))) - (build-lexical-reference83 + (letrec ((regen3291 + (lambda (x3292) + (let ((atom-key3293 (car x3292))) + (if (memv atom-key3293 (quote (ref))) + (build-lexical-reference2445 'value #f - (cadr x928) - (cadr x928)) - (if (memv atom-key929 (quote (primitive))) - (build-primref91 #f (cadr x928)) - (if (memv atom-key929 (quote (quote))) - (build-data92 #f (cadr x928)) - (if (memv atom-key929 (quote (lambda))) - (build-lambda90 + (cadr x3292) + (cadr x3292)) + (if (memv atom-key3293 (quote (primitive))) + (build-primref2453 #f (cadr x3292)) + (if (memv atom-key3293 (quote (quote))) + (build-data2454 #f (cadr x3292)) + (if (memv atom-key3293 (quote (lambda))) + (build-lambda2452 #f - (cadr x928) - (cadr x928) + (cadr x3292) + (cadr x3292) #f - (regen927 (caddr x928))) - (build-application81 + (regen3291 (caddr x3292))) + (build-application2443 #f - (build-primref91 #f (car x928)) - (map regen927 (cdr x928)))))))))) - (gen-vector926 - (lambda (x930) - (if (eq? (car x930) (quote list)) - (cons (quote vector) (cdr x930)) - (if (eq? (car x930) (quote quote)) - (list (quote quote) (list->vector (cadr x930))) - (list (quote list->vector) x930))))) - (gen-append925 - (lambda (x931 y932) - (if (equal? y932 (quote (quote ()))) - x931 - (list (quote append) x931 y932)))) - (gen-cons924 - (lambda (x933 y934) - (let ((atom-key935 (car y934))) - (if (memv atom-key935 (quote (quote))) - (if (eq? (car x933) (quote quote)) + (build-primref2453 #f (car x3292)) + (map regen3291 (cdr x3292)))))))))) + (gen-vector3290 + (lambda (x3294) + (if (eq? (car x3294) (quote list)) + (cons (quote vector) (cdr x3294)) + (if (eq? (car x3294) (quote quote)) + (list (quote quote) (list->vector (cadr x3294))) + (list (quote list->vector) x3294))))) + (gen-append3289 + (lambda (x3295 y3296) + (if (equal? y3296 (quote (quote ()))) + x3295 + (list (quote append) x3295 y3296)))) + (gen-cons3288 + (lambda (x3297 y3298) + (let ((atom-key3299 (car y3298))) + (if (memv atom-key3299 (quote (quote))) + (if (eq? (car x3297) (quote quote)) (list 'quote - (cons (cadr x933) (cadr y934))) - (if (eq? (cadr y934) (quote ())) - (list (quote list) x933) - (list (quote cons) x933 y934))) - (if (memv atom-key935 (quote (list))) - (cons (quote list) (cons x933 (cdr y934))) - (list (quote cons) x933 y934)))))) - (gen-map923 - (lambda (e936 map-env937) - (let ((formals938 (map cdr map-env937)) - (actuals939 - (map (lambda (x940) (list (quote ref) (car x940))) - map-env937))) - (if (eq? (car e936) (quote ref)) - (car actuals939) + (cons (cadr x3297) (cadr y3298))) + (if (eq? (cadr y3298) (quote ())) + (list (quote list) x3297) + (list (quote cons) x3297 y3298))) + (if (memv atom-key3299 (quote (list))) + (cons (quote list) (cons x3297 (cdr y3298))) + (list (quote cons) x3297 y3298)))))) + (gen-map3287 + (lambda (e3300 map-env3301) + (let ((formals3302 (map cdr map-env3301)) + (actuals3303 + (map (lambda (x3304) + (list (quote ref) (car x3304))) + map-env3301))) + (if (eq? (car e3300) (quote ref)) + (car actuals3303) (if (and-map - (lambda (x941) - (if (eq? (car x941) (quote ref)) - (memq (cadr x941) formals938) + (lambda (x3305) + (if (eq? (car x3305) (quote ref)) + (memq (cadr x3305) formals3302) #f)) - (cdr e936)) + (cdr e3300)) (cons 'map - (cons (list (quote primitive) (car e936)) - (map (let ((r942 (map cons - formals938 - actuals939))) - (lambda (x943) - (cdr (assq (cadr x943) r942)))) - (cdr e936)))) + (cons (list (quote primitive) (car e3300)) + (map (let ((r3306 (map cons + formals3302 + actuals3303))) + (lambda (x3307) + (cdr (assq (cadr x3307) + r3306)))) + (cdr e3300)))) (cons 'map - (cons (list (quote lambda) formals938 e936) - actuals939))))))) - (gen-mappend922 - (lambda (e944 map-env945) + (cons (list (quote lambda) formals3302 e3300) + actuals3303))))))) + (gen-mappend3286 + (lambda (e3308 map-env3309) (list 'apply '(primitive append) - (gen-map923 e944 map-env945)))) - (gen-ref921 - (lambda (src946 var947 level948 maps949) - (if (fx=74 level948 0) - (values var947 maps949) - (if (null? maps949) + (gen-map3287 e3308 map-env3309)))) + (gen-ref3285 + (lambda (src3310 var3311 level3312 maps3313) + (if (fx=2435 level3312 0) + (values var3311 maps3313) + (if (null? maps3313) (syntax-violation 'syntax "missing ellipsis" - src946) + src3310) (call-with-values (lambda () - (gen-ref921 - src946 - var947 - (fx-73 level948 1) - (cdr maps949))) - (lambda (outer-var950 outer-maps951) - (let ((b952 (assq outer-var950 (car maps949)))) - (if b952 - (values (cdr b952) maps949) - (let ((inner-var953 (gen-var161 (quote tmp)))) + (gen-ref3285 + src3310 + var3311 + (fx-2434 level3312 1) + (cdr maps3313))) + (lambda (outer-var3314 outer-maps3315) + (let ((b3316 (assq outer-var3314 (car maps3313)))) + (if b3316 + (values (cdr b3316) maps3313) + (let ((inner-var3317 + (gen-var2523 (quote tmp)))) (values - inner-var953 - (cons (cons (cons outer-var950 - inner-var953) - (car maps949)) - outer-maps951))))))))))) - (gen-syntax920 - (lambda (src954 e955 r956 maps957 ellipsis?958 mod959) - (if (id?114 e955) - (let ((label960 (id-var-name136 e955 (quote (()))))) - (let ((b961 (lookup111 label960 r956 mod959))) - (if (eq? (binding-type106 b961) (quote syntax)) + inner-var3317 + (cons (cons (cons outer-var3314 + inner-var3317) + (car maps3313)) + outer-maps3315))))))))))) + (gen-syntax3284 + (lambda (src3318 + e3319 + r3320 + maps3321 + ellipsis?3322 + mod3323) + (if (id?2476 e3319) + (let ((label3324 (id-var-name2498 e3319 (quote (()))))) + (let ((b3325 (lookup2473 label3324 r3320 mod3323))) + (if (eq? (binding-type2468 b3325) (quote syntax)) (call-with-values (lambda () - (let ((var.lev962 (binding-value107 b961))) - (gen-ref921 - src954 - (car var.lev962) - (cdr var.lev962) - maps957))) - (lambda (var963 maps964) - (values (list (quote ref) var963) maps964))) - (if (ellipsis?958 e955) + (let ((var.lev3326 (binding-value2469 b3325))) + (gen-ref3285 + src3318 + (car var.lev3326) + (cdr var.lev3326) + maps3321))) + (lambda (var3327 maps3328) + (values (list (quote ref) var3327) maps3328))) + (if (ellipsis?3322 e3319) (syntax-violation 'syntax "misplaced ellipsis" - src954) - (values (list (quote quote) e955) maps957))))) - ((lambda (tmp965) - ((lambda (tmp966) - (if (if tmp966 - (apply (lambda (dots967 e968) - (ellipsis?958 dots967)) - tmp966) + src3318) + (values (list (quote quote) e3319) maps3321))))) + ((lambda (tmp3329) + ((lambda (tmp3330) + (if (if tmp3330 + (apply (lambda (dots3331 e3332) + (ellipsis?3322 dots3331)) + tmp3330) #f) - (apply (lambda (dots969 e970) - (gen-syntax920 - src954 - e970 - r956 - maps957 - (lambda (x971) #f) - mod959)) - tmp966) - ((lambda (tmp972) - (if (if tmp972 - (apply (lambda (x973 dots974 y975) - (ellipsis?958 dots974)) - tmp972) + (apply (lambda (dots3333 e3334) + (gen-syntax3284 + src3318 + e3334 + r3320 + maps3321 + (lambda (x3335) #f) + mod3323)) + tmp3330) + ((lambda (tmp3336) + (if (if tmp3336 + (apply (lambda (x3337 dots3338 y3339) + (ellipsis?3322 dots3338)) + tmp3336) #f) - (apply (lambda (x976 dots977 y978) - (letrec ((f979 (lambda (y980 k981) - ((lambda (tmp985) - ((lambda (tmp986) - (if (if tmp986 - (apply (lambda (dots987 - y988) - (ellipsis?958 - dots987)) - tmp986) - #f) - (apply (lambda (dots989 - y990) - (f979 y990 - (lambda (maps991) - (call-with-values - (lambda () - (k981 (cons '() - maps991))) - (lambda (x992 - maps993) - (if (null? (car maps993)) - (syntax-violation - 'syntax - "extra ellipsis" - src954) - (values - (gen-mappend922 - x992 - (car maps993)) - (cdr maps993)))))))) - tmp986) - ((lambda (_994) - (call-with-values - (lambda () - (gen-syntax920 - src954 - y980 - r956 - maps957 - ellipsis?958 - mod959)) - (lambda (y995 - maps996) - (call-with-values - (lambda () - (k981 maps996)) - (lambda (x997 - maps998) - (values - (gen-append925 - x997 - y995) - maps998)))))) - tmp985))) - ($sc-dispatch - tmp985 - '(any . - any)))) - y980)))) - (f979 y978 - (lambda (maps982) - (call-with-values - (lambda () - (gen-syntax920 - src954 - x976 - r956 - (cons '() - maps982) - ellipsis?958 - mod959)) - (lambda (x983 maps984) - (if (null? (car maps984)) - (syntax-violation - 'syntax - "extra ellipsis" - src954) - (values - (gen-map923 - x983 - (car maps984)) - (cdr maps984))))))))) - tmp972) - ((lambda (tmp999) - (if tmp999 - (apply (lambda (x1000 y1001) + (apply (lambda (x3340 dots3341 y3342) + (letrec ((f3343 (lambda (y3344 + k3345) + ((lambda (tmp3349) + ((lambda (tmp3350) + (if (if tmp3350 + (apply (lambda (dots3351 + y3352) + (ellipsis?3322 + dots3351)) + tmp3350) + #f) + (apply (lambda (dots3353 + y3354) + (f3343 y3354 + (lambda (maps3355) + (call-with-values + (lambda () + (k3345 (cons '() + maps3355))) + (lambda (x3356 + maps3357) + (if (null? (car maps3357)) + (syntax-violation + 'syntax + "extra ellipsis" + src3318) + (values + (gen-mappend3286 + x3356 + (car maps3357)) + (cdr maps3357)))))))) + tmp3350) + ((lambda (_3358) + (call-with-values + (lambda () + (gen-syntax3284 + src3318 + y3344 + r3320 + maps3321 + ellipsis?3322 + mod3323)) + (lambda (y3359 + maps3360) + (call-with-values + (lambda () + (k3345 maps3360)) + (lambda (x3361 + maps3362) + (values + (gen-append3289 + x3361 + y3359) + maps3362)))))) + tmp3349))) + ($sc-dispatch + tmp3349 + '(any . + any)))) + y3344)))) + (f3343 y3342 + (lambda (maps3346) + (call-with-values + (lambda () + (gen-syntax3284 + src3318 + x3340 + r3320 + (cons '() + maps3346) + ellipsis?3322 + mod3323)) + (lambda (x3347 + maps3348) + (if (null? (car maps3348)) + (syntax-violation + 'syntax + "extra ellipsis" + src3318) + (values + (gen-map3287 + x3347 + (car maps3348)) + (cdr maps3348))))))))) + tmp3336) + ((lambda (tmp3363) + (if tmp3363 + (apply (lambda (x3364 y3365) (call-with-values (lambda () - (gen-syntax920 - src954 - x1000 - r956 - maps957 - ellipsis?958 - mod959)) - (lambda (x1002 maps1003) + (gen-syntax3284 + src3318 + x3364 + r3320 + maps3321 + ellipsis?3322 + mod3323)) + (lambda (x3366 maps3367) (call-with-values (lambda () - (gen-syntax920 - src954 - y1001 - r956 - maps1003 - ellipsis?958 - mod959)) - (lambda (y1004 - maps1005) + (gen-syntax3284 + src3318 + y3365 + r3320 + maps3367 + ellipsis?3322 + mod3323)) + (lambda (y3368 + maps3369) (values - (gen-cons924 - x1002 - y1004) - maps1005)))))) - tmp999) - ((lambda (tmp1006) - (if tmp1006 - (apply (lambda (e11007 e21008) + (gen-cons3288 + x3366 + y3368) + maps3369)))))) + tmp3363) + ((lambda (tmp3370) + (if tmp3370 + (apply (lambda (e13371 e23372) (call-with-values (lambda () - (gen-syntax920 - src954 - (cons e11007 - e21008) - r956 - maps957 - ellipsis?958 - mod959)) - (lambda (e1010 - maps1011) + (gen-syntax3284 + src3318 + (cons e13371 + e23372) + r3320 + maps3321 + ellipsis?3322 + mod3323)) + (lambda (e3374 + maps3375) (values - (gen-vector926 - e1010) - maps1011)))) - tmp1006) - ((lambda (_1012) + (gen-vector3290 + e3374) + maps3375)))) + tmp3370) + ((lambda (_3376) (values - (list (quote quote) e955) - maps957)) - tmp965))) + (list (quote quote) e3319) + maps3321)) + tmp3329))) ($sc-dispatch - tmp965 + tmp3329 '#(vector (any . each-any)))))) ($sc-dispatch - tmp965 + tmp3329 '(any . any))))) ($sc-dispatch - tmp965 + tmp3329 '(any any . any))))) - ($sc-dispatch tmp965 (quote (any any))))) - e955))))) - (lambda (e1013 r1014 w1015 s1016 mod1017) - (let ((e1018 (source-wrap143 e1013 w1015 s1016 mod1017))) - ((lambda (tmp1019) - ((lambda (tmp1020) - (if tmp1020 - (apply (lambda (_1021 x1022) + ($sc-dispatch tmp3329 (quote (any any))))) + e3319))))) + (lambda (e3377 r3378 w3379 s3380 mod3381) + (let ((e3382 (source-wrap2505 e3377 w3379 s3380 mod3381))) + ((lambda (tmp3383) + ((lambda (tmp3384) + (if tmp3384 + (apply (lambda (_3385 x3386) (call-with-values (lambda () - (gen-syntax920 - e1018 - x1022 - r1014 + (gen-syntax3284 + e3382 + x3386 + r3378 '() - ellipsis?159 - mod1017)) - (lambda (e1023 maps1024) (regen927 e1023)))) - tmp1020) - ((lambda (_1025) + ellipsis?2521 + mod3381)) + (lambda (e3387 maps3388) (regen3291 e3387)))) + tmp3384) + ((lambda (_3389) (syntax-violation 'syntax "bad `syntax' form" - e1018)) - tmp1019))) - ($sc-dispatch tmp1019 (quote (any any))))) - e1018))))) - (global-extend112 + e3382)) + tmp3383))) + ($sc-dispatch tmp3383 (quote (any any))))) + e3382))))) + (global-extend2474 'core 'lambda - (lambda (e1026 r1027 w1028 s1029 mod1030) - ((lambda (tmp1031) - ((lambda (tmp1032) - (if tmp1032 - (apply (lambda (_1033 c1034) - (chi-lambda-clause155 - (source-wrap143 e1026 w1028 s1029 mod1030) + (lambda (e3390 r3391 w3392 s3393 mod3394) + ((lambda (tmp3395) + ((lambda (tmp3396) + (if tmp3396 + (apply (lambda (_3397 c3398) + (chi-lambda-clause2517 + (source-wrap2505 e3390 w3392 s3393 mod3394) #f - c1034 - r1027 - w1028 - mod1030 - (lambda (names1035 - vars1036 - docstring1037 - body1038) - (build-lambda90 - s1029 - names1035 - vars1036 - docstring1037 - body1038)))) - tmp1032) + c3398 + r3391 + w3392 + mod3394 + (lambda (names3399 + vars3400 + docstring3401 + body3402) + (build-lambda2452 + s3393 + names3399 + vars3400 + docstring3401 + body3402)))) + tmp3396) (syntax-violation #f "source expression failed to match any pattern" - tmp1031))) - ($sc-dispatch tmp1031 (quote (any . any))))) - e1026))) - (global-extend112 + tmp3395))) + ($sc-dispatch tmp3395 (quote (any . any))))) + e3390))) + (global-extend2474 'core 'let - (letrec ((chi-let1039 - (lambda (e1040 - r1041 - w1042 - s1043 - mod1044 - constructor1045 - ids1046 - vals1047 - exps1048) - (if (not (valid-bound-ids?139 ids1046)) + (letrec ((chi-let3403 + (lambda (e3404 + r3405 + w3406 + s3407 + mod3408 + constructor3409 + ids3410 + vals3411 + exps3412) + (if (not (valid-bound-ids?2501 ids3410)) (syntax-violation 'let "duplicate bound variable" - e1040) - (let ((labels1049 (gen-labels120 ids1046)) - (new-vars1050 (map gen-var161 ids1046))) - (let ((nw1051 - (make-binding-wrap131 - ids1046 - labels1049 - w1042)) - (nr1052 - (extend-var-env109 - labels1049 - new-vars1050 - r1041))) - (constructor1045 - s1043 - (map syntax->datum ids1046) - new-vars1050 - (map (lambda (x1053) - (chi150 x1053 r1041 w1042 mod1044)) - vals1047) - (chi-body154 - exps1048 - (source-wrap143 e1040 nw1051 s1043 mod1044) - nr1052 - nw1051 - mod1044)))))))) - (lambda (e1054 r1055 w1056 s1057 mod1058) - ((lambda (tmp1059) - ((lambda (tmp1060) - (if (if tmp1060 - (apply (lambda (_1061 id1062 val1063 e11064 e21065) - (and-map id?114 id1062)) - tmp1060) + e3404) + (let ((labels3413 (gen-labels2482 ids3410)) + (new-vars3414 (map gen-var2523 ids3410))) + (let ((nw3415 + (make-binding-wrap2493 + ids3410 + labels3413 + w3406)) + (nr3416 + (extend-var-env2471 + labels3413 + new-vars3414 + r3405))) + (constructor3409 + s3407 + (map syntax->datum ids3410) + new-vars3414 + (map (lambda (x3417) + (chi2512 x3417 r3405 w3406 mod3408)) + vals3411) + (chi-body2516 + exps3412 + (source-wrap2505 e3404 nw3415 s3407 mod3408) + nr3416 + nw3415 + mod3408)))))))) + (lambda (e3418 r3419 w3420 s3421 mod3422) + ((lambda (tmp3423) + ((lambda (tmp3424) + (if (if tmp3424 + (apply (lambda (_3425 id3426 val3427 e13428 e23429) + (and-map id?2476 id3426)) + tmp3424) #f) - (apply (lambda (_1067 id1068 val1069 e11070 e21071) - (chi-let1039 - e1054 - r1055 - w1056 - s1057 - mod1058 - build-let94 - id1068 - val1069 - (cons e11070 e21071))) - tmp1060) - ((lambda (tmp1075) - (if (if tmp1075 - (apply (lambda (_1076 - f1077 - id1078 - val1079 - e11080 - e21081) - (if (id?114 f1077) - (and-map id?114 id1078) + (apply (lambda (_3431 id3432 val3433 e13434 e23435) + (chi-let3403 + e3418 + r3419 + w3420 + s3421 + mod3422 + build-let2456 + id3432 + val3433 + (cons e13434 e23435))) + tmp3424) + ((lambda (tmp3439) + (if (if tmp3439 + (apply (lambda (_3440 + f3441 + id3442 + val3443 + e13444 + e23445) + (if (id?2476 f3441) + (and-map id?2476 id3442) #f)) - tmp1075) + tmp3439) #f) - (apply (lambda (_1083 - f1084 - id1085 - val1086 - e11087 - e21088) - (chi-let1039 - e1054 - r1055 - w1056 - s1057 - mod1058 - build-named-let95 - (cons f1084 id1085) - val1086 - (cons e11087 e21088))) - tmp1075) - ((lambda (_1092) + (apply (lambda (_3447 + f3448 + id3449 + val3450 + e13451 + e23452) + (chi-let3403 + e3418 + r3419 + w3420 + s3421 + mod3422 + build-named-let2457 + (cons f3448 id3449) + val3450 + (cons e13451 e23452))) + tmp3439) + ((lambda (_3456) (syntax-violation 'let "bad let" - (source-wrap143 e1054 w1056 s1057 mod1058))) - tmp1059))) + (source-wrap2505 e3418 w3420 s3421 mod3422))) + tmp3423))) ($sc-dispatch - tmp1059 + tmp3423 '(any any #(each (any any)) any . each-any))))) ($sc-dispatch - tmp1059 + tmp3423 '(any #(each (any any)) any . each-any)))) - e1054)))) - (global-extend112 + e3418)))) + (global-extend2474 'core 'letrec - (lambda (e1093 r1094 w1095 s1096 mod1097) - ((lambda (tmp1098) - ((lambda (tmp1099) - (if (if tmp1099 - (apply (lambda (_1100 id1101 val1102 e11103 e21104) - (and-map id?114 id1101)) - tmp1099) + (lambda (e3457 r3458 w3459 s3460 mod3461) + ((lambda (tmp3462) + ((lambda (tmp3463) + (if (if tmp3463 + (apply (lambda (_3464 id3465 val3466 e13467 e23468) + (and-map id?2476 id3465)) + tmp3463) #f) - (apply (lambda (_1106 id1107 val1108 e11109 e21110) - (let ((ids1111 id1107)) - (if (not (valid-bound-ids?139 ids1111)) + (apply (lambda (_3470 id3471 val3472 e13473 e23474) + (let ((ids3475 id3471)) + (if (not (valid-bound-ids?2501 ids3475)) (syntax-violation 'letrec "duplicate bound variable" - e1093) - (let ((labels1113 (gen-labels120 ids1111)) - (new-vars1114 (map gen-var161 ids1111))) - (let ((w1115 (make-binding-wrap131 - ids1111 - labels1113 - w1095)) - (r1116 (extend-var-env109 - labels1113 - new-vars1114 - r1094))) - (build-letrec96 - s1096 - (map syntax->datum ids1111) - new-vars1114 - (map (lambda (x1117) - (chi150 x1117 r1116 w1115 mod1097)) - val1108) - (chi-body154 - (cons e11109 e21110) - (source-wrap143 - e1093 - w1115 - s1096 - mod1097) - r1116 - w1115 - mod1097))))))) - tmp1099) - ((lambda (_1120) + e3457) + (let ((labels3477 (gen-labels2482 ids3475)) + (new-vars3478 (map gen-var2523 ids3475))) + (let ((w3479 (make-binding-wrap2493 + ids3475 + labels3477 + w3459)) + (r3480 (extend-var-env2471 + labels3477 + new-vars3478 + r3458))) + (build-letrec2458 + s3460 + (map syntax->datum ids3475) + new-vars3478 + (map (lambda (x3481) + (chi2512 + x3481 + r3480 + w3479 + mod3461)) + val3472) + (chi-body2516 + (cons e13473 e23474) + (source-wrap2505 + e3457 + w3479 + s3460 + mod3461) + r3480 + w3479 + mod3461))))))) + tmp3463) + ((lambda (_3484) (syntax-violation 'letrec "bad letrec" - (source-wrap143 e1093 w1095 s1096 mod1097))) - tmp1098))) + (source-wrap2505 e3457 w3459 s3460 mod3461))) + tmp3462))) ($sc-dispatch - tmp1098 + tmp3462 '(any #(each (any any)) any . each-any)))) - e1093))) - (global-extend112 + e3457))) + (global-extend2474 'core 'set! - (lambda (e1121 r1122 w1123 s1124 mod1125) - ((lambda (tmp1126) - ((lambda (tmp1127) - (if (if tmp1127 - (apply (lambda (_1128 id1129 val1130) (id?114 id1129)) - tmp1127) + (lambda (e3485 r3486 w3487 s3488 mod3489) + ((lambda (tmp3490) + ((lambda (tmp3491) + (if (if tmp3491 + (apply (lambda (_3492 id3493 val3494) (id?2476 id3493)) + tmp3491) #f) - (apply (lambda (_1131 id1132 val1133) - (let ((val1134 (chi150 val1133 r1122 w1123 mod1125)) - (n1135 (id-var-name136 id1132 w1123))) - (let ((b1136 (lookup111 n1135 r1122 mod1125))) - (let ((atom-key1137 (binding-type106 b1136))) - (if (memv atom-key1137 (quote (lexical))) - (build-lexical-assignment84 - s1124 - (syntax->datum id1132) - (binding-value107 b1136) - val1134) - (if (memv atom-key1137 (quote (global))) - (build-global-assignment87 - s1124 - n1135 - val1134 - mod1125) - (if (memv atom-key1137 + (apply (lambda (_3495 id3496 val3497) + (let ((val3498 + (chi2512 val3497 r3486 w3487 mod3489)) + (n3499 (id-var-name2498 id3496 w3487))) + (let ((b3500 (lookup2473 n3499 r3486 mod3489))) + (let ((atom-key3501 (binding-type2468 b3500))) + (if (memv atom-key3501 (quote (lexical))) + (build-lexical-assignment2446 + s3488 + (syntax->datum id3496) + (binding-value2469 b3500) + val3498) + (if (memv atom-key3501 (quote (global))) + (build-global-assignment2449 + s3488 + n3499 + val3498 + mod3489) + (if (memv atom-key3501 '(displaced-lexical)) (syntax-violation 'set! "identifier out of context" - (wrap142 id1132 w1123 mod1125)) + (wrap2504 id3496 w3487 mod3489)) (syntax-violation 'set! "bad set!" - (source-wrap143 - e1121 - w1123 - s1124 - mod1125))))))))) - tmp1127) - ((lambda (tmp1138) - (if tmp1138 - (apply (lambda (_1139 head1140 tail1141 val1142) + (source-wrap2505 + e3485 + w3487 + s3488 + mod3489))))))))) + tmp3491) + ((lambda (tmp3502) + (if tmp3502 + (apply (lambda (_3503 head3504 tail3505 val3506) (call-with-values (lambda () - (syntax-type148 - head1140 - r1122 + (syntax-type2510 + head3504 + r3486 '(()) #f #f - mod1125 + mod3489 #t)) - (lambda (type1143 - value1144 - ee1145 - ww1146 - ss1147 - modmod1148) - (if (memv type1143 (quote (module-ref))) - (let ((val1149 - (chi150 - val1142 - r1122 - w1123 - mod1125))) + (lambda (type3507 + value3508 + ee3509 + ww3510 + ss3511 + modmod3512) + (if (memv type3507 (quote (module-ref))) + (let ((val3513 + (chi2512 + val3506 + r3486 + w3487 + mod3489))) (call-with-values (lambda () - (value1144 - (cons head1140 tail1141))) - (lambda (id1151 mod1152) - (build-global-assignment87 - s1124 - id1151 - val1149 - mod1152)))) - (build-application81 - s1124 - (chi150 + (value3508 + (cons head3504 tail3505))) + (lambda (id3515 mod3516) + (build-global-assignment2449 + s3488 + id3515 + val3513 + mod3516)))) + (build-application2443 + s3488 + (chi2512 (list '#(syntax-object setter ((top) @@ -6189,6 +6407,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -6310,6 +6529,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -6421,6 +6641,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure @@ -6428,47 +6649,47 @@ ((top) (top)) ("i" "i"))) (hygiene guile)) - head1140) - r1122 - w1123 - mod1125) - (map (lambda (e1153) - (chi150 - e1153 - r1122 - w1123 - mod1125)) + head3504) + r3486 + w3487 + mod3489) + (map (lambda (e3517) + (chi2512 + e3517 + r3486 + w3487 + mod3489)) (append - tail1141 - (list val1142)))))))) - tmp1138) - ((lambda (_1155) + tail3505 + (list val3506)))))))) + tmp3502) + ((lambda (_3519) (syntax-violation 'set! "bad set!" - (source-wrap143 e1121 w1123 s1124 mod1125))) - tmp1126))) + (source-wrap2505 e3485 w3487 s3488 mod3489))) + tmp3490))) ($sc-dispatch - tmp1126 + tmp3490 '(any (any . each-any) any))))) - ($sc-dispatch tmp1126 (quote (any any any))))) - e1121))) - (global-extend112 + ($sc-dispatch tmp3490 (quote (any any any))))) + e3485))) + (global-extend2474 'module-ref '@ - (lambda (e1156) - ((lambda (tmp1157) - ((lambda (tmp1158) - (if (if tmp1158 - (apply (lambda (_1159 mod1160 id1161) - (if (and-map id?114 mod1160) - (id?114 id1161) + (lambda (e3520) + ((lambda (tmp3521) + ((lambda (tmp3522) + (if (if tmp3522 + (apply (lambda (_3523 mod3524 id3525) + (if (and-map id?2476 mod3524) + (id?2476 id3525) #f)) - tmp1158) + tmp3522) #f) - (apply (lambda (_1163 mod1164 id1165) + (apply (lambda (_3527 mod3528 id3529) (values - (syntax->datum id1165) + (syntax->datum id3529) (syntax->datum (cons '#(syntax-object public @@ -6580,6 +6801,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -6701,6 +6923,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -6812,36 +7035,37 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) - mod1164)))) - tmp1158) + mod3528)))) + tmp3522) (syntax-violation #f "source expression failed to match any pattern" - tmp1157))) - ($sc-dispatch tmp1157 (quote (any each-any any))))) - e1156))) - (global-extend112 + tmp3521))) + ($sc-dispatch tmp3521 (quote (any each-any any))))) + e3520))) + (global-extend2474 'module-ref '@@ - (lambda (e1167) - ((lambda (tmp1168) - ((lambda (tmp1169) - (if (if tmp1169 - (apply (lambda (_1170 mod1171 id1172) - (if (and-map id?114 mod1171) - (id?114 id1172) + (lambda (e3531) + ((lambda (tmp3532) + ((lambda (tmp3533) + (if (if tmp3533 + (apply (lambda (_3534 mod3535 id3536) + (if (and-map id?2476 mod3535) + (id?2476 id3536) #f)) - tmp1169) + tmp3533) #f) - (apply (lambda (_1174 mod1175 id1176) + (apply (lambda (_3538 mod3539 id3540) (values - (syntax->datum id1176) + (syntax->datum id3540) (syntax->datum (cons '#(syntax-object private @@ -6953,6 +7177,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -7074,6 +7299,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -7185,90 +7411,91 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) - mod1175)))) - tmp1169) + mod3539)))) + tmp3533) (syntax-violation #f "source expression failed to match any pattern" - tmp1168))) - ($sc-dispatch tmp1168 (quote (any each-any any))))) - e1167))) - (global-extend112 + tmp3532))) + ($sc-dispatch tmp3532 (quote (any each-any any))))) + e3531))) + (global-extend2474 'core 'if - (lambda (e1178 r1179 w1180 s1181 mod1182) - ((lambda (tmp1183) - ((lambda (tmp1184) - (if tmp1184 - (apply (lambda (_1185 test1186 then1187) - (build-conditional82 - s1181 - (chi150 test1186 r1179 w1180 mod1182) - (chi150 then1187 r1179 w1180 mod1182) - (build-void80 #f))) - tmp1184) - ((lambda (tmp1188) - (if tmp1188 - (apply (lambda (_1189 test1190 then1191 else1192) - (build-conditional82 - s1181 - (chi150 test1190 r1179 w1180 mod1182) - (chi150 then1191 r1179 w1180 mod1182) - (chi150 else1192 r1179 w1180 mod1182))) - tmp1188) + (lambda (e3542 r3543 w3544 s3545 mod3546) + ((lambda (tmp3547) + ((lambda (tmp3548) + (if tmp3548 + (apply (lambda (_3549 test3550 then3551) + (build-conditional2444 + s3545 + (chi2512 test3550 r3543 w3544 mod3546) + (chi2512 then3551 r3543 w3544 mod3546) + (build-void2442 #f))) + tmp3548) + ((lambda (tmp3552) + (if tmp3552 + (apply (lambda (_3553 test3554 then3555 else3556) + (build-conditional2444 + s3545 + (chi2512 test3554 r3543 w3544 mod3546) + (chi2512 then3555 r3543 w3544 mod3546) + (chi2512 else3556 r3543 w3544 mod3546))) + tmp3552) (syntax-violation #f "source expression failed to match any pattern" - tmp1183))) - ($sc-dispatch tmp1183 (quote (any any any any)))))) - ($sc-dispatch tmp1183 (quote (any any any))))) - e1178))) - (global-extend112 + tmp3547))) + ($sc-dispatch tmp3547 (quote (any any any any)))))) + ($sc-dispatch tmp3547 (quote (any any any))))) + e3542))) + (global-extend2474 'begin 'begin '()) - (global-extend112 + (global-extend2474 'define 'define '()) - (global-extend112 + (global-extend2474 'define-syntax 'define-syntax '()) - (global-extend112 + (global-extend2474 'eval-when 'eval-when '()) - (global-extend112 + (global-extend2474 'core 'syntax-case - (letrec ((gen-syntax-case1196 - (lambda (x1197 keys1198 clauses1199 r1200 mod1201) - (if (null? clauses1199) - (build-application81 + (letrec ((gen-syntax-case3560 + (lambda (x3561 keys3562 clauses3563 r3564 mod3565) + (if (null? clauses3563) + (build-application2443 #f - (build-primref91 #f (quote syntax-violation)) - (list (build-data92 #f #f) - (build-data92 + (build-primref2453 #f (quote syntax-violation)) + (list (build-data2454 #f #f) + (build-data2454 #f "source expression failed to match any pattern") - x1197)) - ((lambda (tmp1202) - ((lambda (tmp1203) - (if tmp1203 - (apply (lambda (pat1204 exp1205) - (if (if (id?114 pat1204) + x3561)) + ((lambda (tmp3566) + ((lambda (tmp3567) + (if tmp3567 + (apply (lambda (pat3568 exp3569) + (if (if (id?2476 pat3568) (and-map - (lambda (x1206) - (not (free-id=?137 - pat1204 - x1206))) + (lambda (x3570) + (not (free-id=?2499 + pat3568 + x3570))) (cons '#(syntax-object ... ((top) @@ -7404,6 +7631,7 @@ build-conditional build-application build-void + decorate-source get-global-definition-hook put-global-definition-hook gensym-hook @@ -7525,6 +7753,7 @@ (top) (top) (top) + (top) (top)) ("i" "i" @@ -7636,6 +7865,7 @@ "i" "i" "i" + "i" "i")) #(ribcage (define-structure @@ -7643,620 +7873,623 @@ ((top) (top)) ("i" "i"))) (hygiene guile)) - keys1198)) + keys3562)) #f) - (let ((labels1207 - (list (gen-label119))) - (var1208 (gen-var161 pat1204))) - (build-application81 + (let ((labels3571 + (list (gen-label2481))) + (var3572 + (gen-var2523 pat3568))) + (build-application2443 #f - (build-lambda90 + (build-lambda2452 #f - (list (syntax->datum pat1204)) - (list var1208) + (list (syntax->datum pat3568)) + (list var3572) #f - (chi150 - exp1205 - (extend-env108 - labels1207 + (chi2512 + exp3569 + (extend-env2470 + labels3571 (list (cons 'syntax - (cons var1208 + (cons var3572 0))) - r1200) - (make-binding-wrap131 - (list pat1204) - labels1207 + r3564) + (make-binding-wrap2493 + (list pat3568) + labels3571 '(())) - mod1201)) - (list x1197))) - (gen-clause1195 - x1197 - keys1198 - (cdr clauses1199) - r1200 - pat1204 + mod3565)) + (list x3561))) + (gen-clause3559 + x3561 + keys3562 + (cdr clauses3563) + r3564 + pat3568 #t - exp1205 - mod1201))) - tmp1203) - ((lambda (tmp1209) - (if tmp1209 - (apply (lambda (pat1210 fender1211 exp1212) - (gen-clause1195 - x1197 - keys1198 - (cdr clauses1199) - r1200 - pat1210 - fender1211 - exp1212 - mod1201)) - tmp1209) - ((lambda (_1213) + exp3569 + mod3565))) + tmp3567) + ((lambda (tmp3573) + (if tmp3573 + (apply (lambda (pat3574 fender3575 exp3576) + (gen-clause3559 + x3561 + keys3562 + (cdr clauses3563) + r3564 + pat3574 + fender3575 + exp3576 + mod3565)) + tmp3573) + ((lambda (_3577) (syntax-violation 'syntax-case "invalid clause" - (car clauses1199))) - tmp1202))) - ($sc-dispatch tmp1202 (quote (any any any)))))) - ($sc-dispatch tmp1202 (quote (any any))))) - (car clauses1199))))) - (gen-clause1195 - (lambda (x1214 - keys1215 - clauses1216 - r1217 - pat1218 - fender1219 - exp1220 - mod1221) + (car clauses3563))) + tmp3566))) + ($sc-dispatch tmp3566 (quote (any any any)))))) + ($sc-dispatch tmp3566 (quote (any any))))) + (car clauses3563))))) + (gen-clause3559 + (lambda (x3578 + keys3579 + clauses3580 + r3581 + pat3582 + fender3583 + exp3584 + mod3585) (call-with-values (lambda () - (convert-pattern1193 pat1218 keys1215)) - (lambda (p1222 pvars1223) - (if (not (distinct-bound-ids?140 (map car pvars1223))) + (convert-pattern3557 pat3582 keys3579)) + (lambda (p3586 pvars3587) + (if (not (distinct-bound-ids?2502 + (map car pvars3587))) (syntax-violation 'syntax-case "duplicate pattern variable" - pat1218) + pat3582) (if (not (and-map - (lambda (x1224) - (not (ellipsis?159 (car x1224)))) - pvars1223)) + (lambda (x3588) + (not (ellipsis?2521 (car x3588)))) + pvars3587)) (syntax-violation 'syntax-case "misplaced ellipsis" - pat1218) - (let ((y1225 (gen-var161 (quote tmp)))) - (build-application81 + pat3582) + (let ((y3589 (gen-var2523 (quote tmp)))) + (build-application2443 #f - (build-lambda90 + (build-lambda2452 #f (list (quote tmp)) - (list y1225) + (list y3589) #f - (let ((y1226 (build-lexical-reference83 + (let ((y3590 (build-lexical-reference2445 'value #f 'tmp - y1225))) - (build-conditional82 + y3589))) + (build-conditional2444 #f - ((lambda (tmp1227) - ((lambda (tmp1228) - (if tmp1228 - (apply (lambda () y1226) - tmp1228) - ((lambda (_1229) - (build-conditional82 + ((lambda (tmp3591) + ((lambda (tmp3592) + (if tmp3592 + (apply (lambda () y3590) + tmp3592) + ((lambda (_3593) + (build-conditional2444 #f - y1226 - (build-dispatch-call1194 - pvars1223 - fender1219 - y1226 - r1217 - mod1221) - (build-data92 #f #f))) - tmp1227))) + y3590 + (build-dispatch-call3558 + pvars3587 + fender3583 + y3590 + r3581 + mod3585) + (build-data2454 #f #f))) + tmp3591))) ($sc-dispatch - tmp1227 + tmp3591 '#(atom #t)))) - fender1219) - (build-dispatch-call1194 - pvars1223 - exp1220 - y1226 - r1217 - mod1221) - (gen-syntax-case1196 - x1214 - keys1215 - clauses1216 - r1217 - mod1221)))) - (list (if (eq? p1222 (quote any)) - (build-application81 + fender3583) + (build-dispatch-call3558 + pvars3587 + exp3584 + y3590 + r3581 + mod3585) + (gen-syntax-case3560 + x3578 + keys3579 + clauses3580 + r3581 + mod3585)))) + (list (if (eq? p3586 (quote any)) + (build-application2443 #f - (build-primref91 #f (quote list)) - (list x1214)) - (build-application81 + (build-primref2453 #f (quote list)) + (list x3578)) + (build-application2443 #f - (build-primref91 + (build-primref2453 #f '$sc-dispatch) - (list x1214 - (build-data92 + (list x3578 + (build-data2454 #f - p1222))))))))))))) - (build-dispatch-call1194 - (lambda (pvars1230 exp1231 y1232 r1233 mod1234) - (let ((ids1235 (map car pvars1230)) - (levels1236 (map cdr pvars1230))) - (let ((labels1237 (gen-labels120 ids1235)) - (new-vars1238 (map gen-var161 ids1235))) - (build-application81 + p3586))))))))))))) + (build-dispatch-call3558 + (lambda (pvars3594 exp3595 y3596 r3597 mod3598) + (let ((ids3599 (map car pvars3594)) + (levels3600 (map cdr pvars3594))) + (let ((labels3601 (gen-labels2482 ids3599)) + (new-vars3602 (map gen-var2523 ids3599))) + (build-application2443 #f - (build-primref91 #f (quote apply)) - (list (build-lambda90 + (build-primref2453 #f (quote apply)) + (list (build-lambda2452 #f - (map syntax->datum ids1235) - new-vars1238 + (map syntax->datum ids3599) + new-vars3602 #f - (chi150 - exp1231 - (extend-env108 - labels1237 - (map (lambda (var1239 level1240) + (chi2512 + exp3595 + (extend-env2470 + labels3601 + (map (lambda (var3603 level3604) (cons 'syntax - (cons var1239 level1240))) - new-vars1238 - (map cdr pvars1230)) - r1233) - (make-binding-wrap131 - ids1235 - labels1237 + (cons var3603 level3604))) + new-vars3602 + (map cdr pvars3594)) + r3597) + (make-binding-wrap2493 + ids3599 + labels3601 '(())) - mod1234)) - y1232)))))) - (convert-pattern1193 - (lambda (pattern1241 keys1242) - (letrec ((cvt1243 - (lambda (p1244 n1245 ids1246) - (if (id?114 p1244) - (if (bound-id-member?141 p1244 keys1242) + mod3598)) + y3596)))))) + (convert-pattern3557 + (lambda (pattern3605 keys3606) + (letrec ((cvt3607 + (lambda (p3608 n3609 ids3610) + (if (id?2476 p3608) + (if (bound-id-member?2503 p3608 keys3606) (values - (vector (quote free-id) p1244) - ids1246) + (vector (quote free-id) p3608) + ids3610) (values 'any - (cons (cons p1244 n1245) ids1246))) - ((lambda (tmp1247) - ((lambda (tmp1248) - (if (if tmp1248 - (apply (lambda (x1249 dots1250) - (ellipsis?159 - dots1250)) - tmp1248) + (cons (cons p3608 n3609) ids3610))) + ((lambda (tmp3611) + ((lambda (tmp3612) + (if (if tmp3612 + (apply (lambda (x3613 dots3614) + (ellipsis?2521 + dots3614)) + tmp3612) #f) - (apply (lambda (x1251 dots1252) + (apply (lambda (x3615 dots3616) (call-with-values (lambda () - (cvt1243 - x1251 - (fx+72 n1245 1) - ids1246)) - (lambda (p1253 ids1254) + (cvt3607 + x3615 + (fx+2433 n3609 1) + ids3610)) + (lambda (p3617 ids3618) (values - (if (eq? p1253 + (if (eq? p3617 'any) 'each-any (vector 'each - p1253)) - ids1254)))) - tmp1248) - ((lambda (tmp1255) - (if tmp1255 - (apply (lambda (x1256 y1257) + p3617)) + ids3618)))) + tmp3612) + ((lambda (tmp3619) + (if tmp3619 + (apply (lambda (x3620 y3621) (call-with-values (lambda () - (cvt1243 - y1257 - n1245 - ids1246)) - (lambda (y1258 - ids1259) + (cvt3607 + y3621 + n3609 + ids3610)) + (lambda (y3622 + ids3623) (call-with-values (lambda () - (cvt1243 - x1256 - n1245 - ids1259)) - (lambda (x1260 - ids1261) + (cvt3607 + x3620 + n3609 + ids3623)) + (lambda (x3624 + ids3625) (values - (cons x1260 - y1258) - ids1261)))))) - tmp1255) - ((lambda (tmp1262) - (if tmp1262 + (cons x3624 + y3622) + ids3625)))))) + tmp3619) + ((lambda (tmp3626) + (if tmp3626 (apply (lambda () (values '() - ids1246)) - tmp1262) - ((lambda (tmp1263) - (if tmp1263 - (apply (lambda (x1264) + ids3610)) + tmp3626) + ((lambda (tmp3627) + (if tmp3627 + (apply (lambda (x3628) (call-with-values (lambda () - (cvt1243 - x1264 - n1245 - ids1246)) - (lambda (p1266 - ids1267) + (cvt3607 + x3628 + n3609 + ids3610)) + (lambda (p3630 + ids3631) (values (vector 'vector - p1266) - ids1267)))) - tmp1263) - ((lambda (x1268) + p3630) + ids3631)))) + tmp3627) + ((lambda (x3632) (values (vector 'atom - (strip160 - p1244 + (strip2522 + p3608 '(()))) - ids1246)) - tmp1247))) + ids3610)) + tmp3611))) ($sc-dispatch - tmp1247 + tmp3611 '#(vector each-any))))) ($sc-dispatch - tmp1247 + tmp3611 '())))) ($sc-dispatch - tmp1247 + tmp3611 '(any . any))))) ($sc-dispatch - tmp1247 + tmp3611 '(any any)))) - p1244))))) - (cvt1243 pattern1241 0 (quote ())))))) - (lambda (e1269 r1270 w1271 s1272 mod1273) - (let ((e1274 (source-wrap143 e1269 w1271 s1272 mod1273))) - ((lambda (tmp1275) - ((lambda (tmp1276) - (if tmp1276 - (apply (lambda (_1277 val1278 key1279 m1280) + p3608))))) + (cvt3607 pattern3605 0 (quote ())))))) + (lambda (e3633 r3634 w3635 s3636 mod3637) + (let ((e3638 (source-wrap2505 e3633 w3635 s3636 mod3637))) + ((lambda (tmp3639) + ((lambda (tmp3640) + (if tmp3640 + (apply (lambda (_3641 val3642 key3643 m3644) (if (and-map - (lambda (x1281) - (if (id?114 x1281) - (not (ellipsis?159 x1281)) + (lambda (x3645) + (if (id?2476 x3645) + (not (ellipsis?2521 x3645)) #f)) - key1279) - (let ((x1283 (gen-var161 (quote tmp)))) - (build-application81 - s1272 - (build-lambda90 + key3643) + (let ((x3647 (gen-var2523 (quote tmp)))) + (build-application2443 + s3636 + (build-lambda2452 #f (list (quote tmp)) - (list x1283) + (list x3647) #f - (gen-syntax-case1196 - (build-lexical-reference83 + (gen-syntax-case3560 + (build-lexical-reference2445 'value #f 'tmp - x1283) - key1279 - m1280 - r1270 - mod1273)) - (list (chi150 - val1278 - r1270 + x3647) + key3643 + m3644 + r3634 + mod3637)) + (list (chi2512 + val3642 + r3634 '(()) - mod1273)))) + mod3637)))) (syntax-violation 'syntax-case "invalid literals list" - e1274))) - tmp1276) + e3638))) + tmp3640) (syntax-violation #f "source expression failed to match any pattern" - tmp1275))) + tmp3639))) ($sc-dispatch - tmp1275 + tmp3639 '(any any each-any . each-any)))) - e1274))))) + e3638))))) (set! sc-expand - (lambda (x1287 . rest1286) - (if (if (pair? x1287) - (equal? (car x1287) noexpand70) + (lambda (x3651 . rest3650) + (if (if (pair? x3651) + (equal? (car x3651) noexpand2431) #f) - (cadr x1287) - (let ((m1288 (if (null? rest1286) (quote e) (car rest1286))) - (esew1289 - (if (let ((t1290 (null? rest1286))) - (if t1290 t1290 (null? (cdr rest1286)))) + (cadr x3651) + (let ((m3652 (if (null? rest3650) (quote e) (car rest3650))) + (esew3653 + (if (let ((t3654 (null? rest3650))) + (if t3654 t3654 (null? (cdr rest3650)))) '(eval) - (cadr rest1286)))) + (cadr rest3650)))) (with-fluid* - *mode*71 - m1288 + *mode*2432 + m3652 (lambda () - (chi-top149 - x1287 + (chi-top2511 + x3651 '() '((top)) - m1288 - esew1289 + m3652 + esew3653 (cons 'hygiene (module-name (current-module)))))))))) (set! identifier? - (lambda (x1291) (nonsymbol-id?113 x1291))) + (lambda (x3655) (nonsymbol-id?2475 x3655))) (set! datum->syntax - (lambda (id1292 datum1293) - (make-syntax-object97 - datum1293 - (syntax-object-wrap100 id1292) + (lambda (id3656 datum3657) + (make-syntax-object2459 + datum3657 + (syntax-object-wrap2462 id3656) #f))) (set! syntax->datum - (lambda (x1294) (strip160 x1294 (quote (()))))) + (lambda (x3658) (strip2522 x3658 (quote (()))))) (set! generate-temporaries - (lambda (ls1295) + (lambda (ls3659) (begin - (let ((x1296 ls1295)) - (if (not (list? x1296)) + (let ((x3660 ls3659)) + (if (not (list? x3660)) (syntax-violation 'generate-temporaries "invalid argument" - x1296))) - (map (lambda (x1297) - (wrap142 (gensym) (quote ((top))) #f)) - ls1295)))) + x3660))) + (map (lambda (x3661) + (wrap2504 (gensym) (quote ((top))) #f)) + ls3659)))) (set! free-identifier=? - (lambda (x1298 y1299) + (lambda (x3662 y3663) (begin - (let ((x1300 x1298)) - (if (not (nonsymbol-id?113 x1300)) + (let ((x3664 x3662)) + (if (not (nonsymbol-id?2475 x3664)) (syntax-violation 'free-identifier=? "invalid argument" - x1300))) - (let ((x1301 y1299)) - (if (not (nonsymbol-id?113 x1301)) + x3664))) + (let ((x3665 y3663)) + (if (not (nonsymbol-id?2475 x3665)) (syntax-violation 'free-identifier=? "invalid argument" - x1301))) - (free-id=?137 x1298 y1299)))) + x3665))) + (free-id=?2499 x3662 y3663)))) (set! bound-identifier=? - (lambda (x1302 y1303) + (lambda (x3666 y3667) (begin - (let ((x1304 x1302)) - (if (not (nonsymbol-id?113 x1304)) + (let ((x3668 x3666)) + (if (not (nonsymbol-id?2475 x3668)) (syntax-violation 'bound-identifier=? "invalid argument" - x1304))) - (let ((x1305 y1303)) - (if (not (nonsymbol-id?113 x1305)) + x3668))) + (let ((x3669 y3667)) + (if (not (nonsymbol-id?2475 x3669)) (syntax-violation 'bound-identifier=? "invalid argument" - x1305))) - (bound-id=?138 x1302 y1303)))) + x3669))) + (bound-id=?2500 x3666 y3667)))) (set! syntax-violation - (lambda (who1309 message1308 form1307 . subform1306) + (lambda (who3673 message3672 form3671 . subform3670) (begin - (let ((x1310 who1309)) - (if (not ((lambda (x1311) - (let ((t1312 (not x1311))) - (if t1312 - t1312 - (let ((t1313 (string? x1311))) - (if t1313 t1313 (symbol? x1311)))))) - x1310)) + (let ((x3674 who3673)) + (if (not ((lambda (x3675) + (let ((t3676 (not x3675))) + (if t3676 + t3676 + (let ((t3677 (string? x3675))) + (if t3677 t3677 (symbol? x3675)))))) + x3674)) (syntax-violation 'syntax-violation "invalid argument" - x1310))) - (let ((x1314 message1308)) - (if (not (string? x1314)) + x3674))) + (let ((x3678 message3672)) + (if (not (string? x3678)) (syntax-violation 'syntax-violation "invalid argument" - x1314))) + x3678))) (scm-error 'syntax-error 'sc-expand (string-append - (if who1309 "~a: " "") + (if who3673 "~a: " "") "~a " - (if (null? subform1306) + (if (null? subform3670) "in ~a" "in subform `~s' of `~s'")) - (let ((tail1315 - (cons message1308 - (map (lambda (x1316) (strip160 x1316 (quote (())))) - (append subform1306 (list form1307)))))) - (if who1309 (cons who1309 tail1315) tail1315)) + (let ((tail3679 + (cons message3672 + (map (lambda (x3680) + (strip2522 x3680 (quote (())))) + (append subform3670 (list form3671)))))) + (if who3673 (cons who3673 tail3679) tail3679)) #f)))) - (letrec ((match1321 - (lambda (e1322 p1323 w1324 r1325 mod1326) - (if (not r1325) + (letrec ((match3685 + (lambda (e3686 p3687 w3688 r3689 mod3690) + (if (not r3689) #f - (if (eq? p1323 (quote any)) - (cons (wrap142 e1322 w1324 mod1326) r1325) - (if (syntax-object?98 e1322) - (match*1320 - (syntax-object-expression99 e1322) - p1323 - (join-wraps133 - w1324 - (syntax-object-wrap100 e1322)) - r1325 - (syntax-object-module101 e1322)) - (match*1320 e1322 p1323 w1324 r1325 mod1326)))))) - (match*1320 - (lambda (e1327 p1328 w1329 r1330 mod1331) - (if (null? p1328) - (if (null? e1327) r1330 #f) - (if (pair? p1328) - (if (pair? e1327) - (match1321 - (car e1327) - (car p1328) - w1329 - (match1321 - (cdr e1327) - (cdr p1328) - w1329 - r1330 - mod1331) - mod1331) + (if (eq? p3687 (quote any)) + (cons (wrap2504 e3686 w3688 mod3690) r3689) + (if (syntax-object?2460 e3686) + (match*3684 + (syntax-object-expression2461 e3686) + p3687 + (join-wraps2495 + w3688 + (syntax-object-wrap2462 e3686)) + r3689 + (syntax-object-module2463 e3686)) + (match*3684 e3686 p3687 w3688 r3689 mod3690)))))) + (match*3684 + (lambda (e3691 p3692 w3693 r3694 mod3695) + (if (null? p3692) + (if (null? e3691) r3694 #f) + (if (pair? p3692) + (if (pair? e3691) + (match3685 + (car e3691) + (car p3692) + w3693 + (match3685 + (cdr e3691) + (cdr p3692) + w3693 + r3694 + mod3695) + mod3695) #f) - (if (eq? p1328 (quote each-any)) - (let ((l1332 (match-each-any1318 - e1327 - w1329 - mod1331))) - (if l1332 (cons l1332 r1330) #f)) - (let ((atom-key1333 (vector-ref p1328 0))) - (if (memv atom-key1333 (quote (each))) - (if (null? e1327) - (match-empty1319 (vector-ref p1328 1) r1330) - (let ((l1334 (match-each1317 - e1327 - (vector-ref p1328 1) - w1329 - mod1331))) - (if l1334 - (letrec ((collect1335 - (lambda (l1336) - (if (null? (car l1336)) - r1330 - (cons (map car l1336) - (collect1335 - (map cdr l1336))))))) - (collect1335 l1334)) + (if (eq? p3692 (quote each-any)) + (let ((l3696 (match-each-any3682 + e3691 + w3693 + mod3695))) + (if l3696 (cons l3696 r3694) #f)) + (let ((atom-key3697 (vector-ref p3692 0))) + (if (memv atom-key3697 (quote (each))) + (if (null? e3691) + (match-empty3683 (vector-ref p3692 1) r3694) + (let ((l3698 (match-each3681 + e3691 + (vector-ref p3692 1) + w3693 + mod3695))) + (if l3698 + (letrec ((collect3699 + (lambda (l3700) + (if (null? (car l3700)) + r3694 + (cons (map car l3700) + (collect3699 + (map cdr l3700))))))) + (collect3699 l3698)) #f))) - (if (memv atom-key1333 (quote (free-id))) - (if (id?114 e1327) - (if (free-id=?137 - (wrap142 e1327 w1329 mod1331) - (vector-ref p1328 1)) - r1330 + (if (memv atom-key3697 (quote (free-id))) + (if (id?2476 e3691) + (if (free-id=?2499 + (wrap2504 e3691 w3693 mod3695) + (vector-ref p3692 1)) + r3694 #f) #f) - (if (memv atom-key1333 (quote (atom))) + (if (memv atom-key3697 (quote (atom))) (if (equal? - (vector-ref p1328 1) - (strip160 e1327 w1329)) - r1330 + (vector-ref p3692 1) + (strip2522 e3691 w3693)) + r3694 #f) - (if (memv atom-key1333 (quote (vector))) - (if (vector? e1327) - (match1321 - (vector->list e1327) - (vector-ref p1328 1) - w1329 - r1330 - mod1331) + (if (memv atom-key3697 (quote (vector))) + (if (vector? e3691) + (match3685 + (vector->list e3691) + (vector-ref p3692 1) + w3693 + r3694 + mod3695) #f))))))))))) - (match-empty1319 - (lambda (p1337 r1338) - (if (null? p1337) - r1338 - (if (eq? p1337 (quote any)) - (cons (quote ()) r1338) - (if (pair? p1337) - (match-empty1319 - (car p1337) - (match-empty1319 (cdr p1337) r1338)) - (if (eq? p1337 (quote each-any)) - (cons (quote ()) r1338) - (let ((atom-key1339 (vector-ref p1337 0))) - (if (memv atom-key1339 (quote (each))) - (match-empty1319 (vector-ref p1337 1) r1338) - (if (memv atom-key1339 (quote (free-id atom))) - r1338 - (if (memv atom-key1339 (quote (vector))) - (match-empty1319 - (vector-ref p1337 1) - r1338))))))))))) - (match-each-any1318 - (lambda (e1340 w1341 mod1342) - (if (pair? e1340) - (let ((l1343 (match-each-any1318 - (cdr e1340) - w1341 - mod1342))) - (if l1343 - (cons (wrap142 (car e1340) w1341 mod1342) l1343) + (match-empty3683 + (lambda (p3701 r3702) + (if (null? p3701) + r3702 + (if (eq? p3701 (quote any)) + (cons (quote ()) r3702) + (if (pair? p3701) + (match-empty3683 + (car p3701) + (match-empty3683 (cdr p3701) r3702)) + (if (eq? p3701 (quote each-any)) + (cons (quote ()) r3702) + (let ((atom-key3703 (vector-ref p3701 0))) + (if (memv atom-key3703 (quote (each))) + (match-empty3683 (vector-ref p3701 1) r3702) + (if (memv atom-key3703 (quote (free-id atom))) + r3702 + (if (memv atom-key3703 (quote (vector))) + (match-empty3683 + (vector-ref p3701 1) + r3702))))))))))) + (match-each-any3682 + (lambda (e3704 w3705 mod3706) + (if (pair? e3704) + (let ((l3707 (match-each-any3682 + (cdr e3704) + w3705 + mod3706))) + (if l3707 + (cons (wrap2504 (car e3704) w3705 mod3706) l3707) #f)) - (if (null? e1340) + (if (null? e3704) '() - (if (syntax-object?98 e1340) - (match-each-any1318 - (syntax-object-expression99 e1340) - (join-wraps133 - w1341 - (syntax-object-wrap100 e1340)) - mod1342) + (if (syntax-object?2460 e3704) + (match-each-any3682 + (syntax-object-expression2461 e3704) + (join-wraps2495 + w3705 + (syntax-object-wrap2462 e3704)) + mod3706) #f))))) - (match-each1317 - (lambda (e1344 p1345 w1346 mod1347) - (if (pair? e1344) - (let ((first1348 - (match1321 - (car e1344) - p1345 - w1346 + (match-each3681 + (lambda (e3708 p3709 w3710 mod3711) + (if (pair? e3708) + (let ((first3712 + (match3685 + (car e3708) + p3709 + w3710 '() - mod1347))) - (if first1348 - (let ((rest1349 - (match-each1317 - (cdr e1344) - p1345 - w1346 - mod1347))) - (if rest1349 (cons first1348 rest1349) #f)) + mod3711))) + (if first3712 + (let ((rest3713 + (match-each3681 + (cdr e3708) + p3709 + w3710 + mod3711))) + (if rest3713 (cons first3712 rest3713) #f)) #f)) - (if (null? e1344) + (if (null? e3708) '() - (if (syntax-object?98 e1344) - (match-each1317 - (syntax-object-expression99 e1344) - p1345 - (join-wraps133 - w1346 - (syntax-object-wrap100 e1344)) - (syntax-object-module101 e1344)) + (if (syntax-object?2460 e3708) + (match-each3681 + (syntax-object-expression2461 e3708) + p3709 + (join-wraps2495 + w3710 + (syntax-object-wrap2462 e3708)) + (syntax-object-module2463 e3708)) #f)))))) (set! $sc-dispatch - (lambda (e1350 p1351) - (if (eq? p1351 (quote any)) - (list e1350) - (if (syntax-object?98 e1350) - (match*1320 - (syntax-object-expression99 e1350) - p1351 - (syntax-object-wrap100 e1350) + (lambda (e3714 p3715) + (if (eq? p3715 (quote any)) + (list e3714) + (if (syntax-object?2460 e3714) + (match*3684 + (syntax-object-expression2461 e3714) + p3715 + (syntax-object-wrap2462 e3714) '() - (syntax-object-module101 e1350)) - (match*1320 - e1350 - p1351 + (syntax-object-module2463 e3714)) + (match*3684 + e3714 + p3715 '(()) '() #f))))))))) @@ -8264,11 +8497,11 @@ (define with-syntax (make-syncase-macro 'macro - (lambda (x1352) - ((lambda (tmp1353) - ((lambda (tmp1354) - (if tmp1354 - (apply (lambda (_1355 e11356 e21357) + (lambda (x3716) + ((lambda (tmp3717) + ((lambda (tmp3718) + (if tmp3718 + (apply (lambda (_3719 e13720 e23721) (cons '#(syntax-object begin ((top) @@ -8279,11 +8512,11 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) - (cons e11356 e21357))) - tmp1354) - ((lambda (tmp1359) - (if tmp1359 - (apply (lambda (_1360 out1361 in1362 e11363 e21364) + (cons e13720 e23721))) + tmp3718) + ((lambda (tmp3723) + (if tmp3723 + (apply (lambda (_3724 out3725 in3726 e13727 e23728) (list '#(syntax-object syntax-case ((top) @@ -8294,9 +8527,9 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) - in1362 + in3726 '() - (list out1361 + (list out3725 (cons '#(syntax-object begin ((top) @@ -8314,11 +8547,11 @@ #((top)) #("i"))) (hygiene guile)) - (cons e11363 e21364))))) - tmp1359) - ((lambda (tmp1366) - (if tmp1366 - (apply (lambda (_1367 out1368 in1369 e11370 e21371) + (cons e13727 e23728))))) + tmp3723) + ((lambda (tmp3730) + (if tmp3730 + (apply (lambda (_3731 out3732 in3733 e13734 e23735) (list '#(syntax-object syntax-case ((top) @@ -8346,9 +8579,9 @@ #((top)) #("i"))) (hygiene guile)) - in1369) + in3733) '() - (list out1368 + (list out3732 (cons '#(syntax-object begin ((top) @@ -8370,35 +8603,35 @@ #((top)) #("i"))) (hygiene guile)) - (cons e11370 e21371))))) - tmp1366) + (cons e13734 e23735))))) + tmp3730) (syntax-violation #f "source expression failed to match any pattern" - tmp1353))) + tmp3717))) ($sc-dispatch - tmp1353 + tmp3717 '(any #(each (any any)) any . each-any))))) ($sc-dispatch - tmp1353 + tmp3717 '(any ((any any)) any . each-any))))) ($sc-dispatch - tmp1353 + tmp3717 '(any () any . each-any)))) - x1352)))) + x3716)))) (define syntax-rules (make-syncase-macro 'macro - (lambda (x1375) - ((lambda (tmp1376) - ((lambda (tmp1377) - (if tmp1377 - (apply (lambda (_1378 - k1379 - keyword1380 - pattern1381 - template1382) + (lambda (x3739) + ((lambda (tmp3740) + ((lambda (tmp3741) + (if tmp3741 + (apply (lambda (_3742 + k3743 + keyword3744 + pattern3745 + template3746) (list '#(syntax-object lambda ((top) @@ -8439,8 +8672,8 @@ #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) - (cons k1379 - (map (lambda (tmp1385 tmp1384) + (cons k3743 + (map (lambda (tmp3749 tmp3748) (list (cons '#(syntax-object dummy ((top) @@ -8470,7 +8703,7 @@ #("i"))) (hygiene guile)) - tmp1384) + tmp3748) (list '#(syntax-object syntax ((top) @@ -8500,34 +8733,34 @@ #("i"))) (hygiene guile)) - tmp1385))) - template1382 - pattern1381)))))) - tmp1377) + tmp3749))) + template3746 + pattern3745)))))) + tmp3741) (syntax-violation #f "source expression failed to match any pattern" - tmp1376))) + tmp3740))) ($sc-dispatch - tmp1376 + tmp3740 '(any each-any . #(each ((any . any) any)))))) - x1375)))) + x3739)))) (define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) 'macro - (lambda (x1386) - ((lambda (tmp1387) - ((lambda (tmp1388) - (if (if tmp1388 - (apply (lambda (let*1389 x1390 v1391 e11392 e21393) - (and-map identifier? x1390)) - tmp1388) + (lambda (x3750) + ((lambda (tmp3751) + ((lambda (tmp3752) + (if (if tmp3752 + (apply (lambda (let*3753 x3754 v3755 e13756 e23757) + (and-map identifier? x3754)) + tmp3752) #f) - (apply (lambda (let*1395 x1396 v1397 e11398 e21399) - (letrec ((f1400 (lambda (bindings1401) - (if (null? bindings1401) + (apply (lambda (let*3759 x3760 v3761 e13762 e23763) + (letrec ((f3764 (lambda (bindings3765) + (if (null? bindings3765) (cons '#(syntax-object let ((top) @@ -8551,12 +8784,12 @@ #("i"))) (hygiene guile)) (cons '() - (cons e11398 e21399))) - ((lambda (tmp1405) - ((lambda (tmp1406) - (if tmp1406 - (apply (lambda (body1407 - binding1408) + (cons e13762 e23763))) + ((lambda (tmp3769) + ((lambda (tmp3770) + (if tmp3770 + (apply (lambda (body3771 + binding3772) (list '#(syntax-object let ((top) @@ -8604,51 +8837,51 @@ #("i"))) (hygiene guile)) - (list binding1408) - body1407)) - tmp1406) + (list binding3772) + body3771)) + tmp3770) (syntax-violation #f "source expression failed to match any pattern" - tmp1405))) + tmp3769))) ($sc-dispatch - tmp1405 + tmp3769 '(any any)))) - (list (f1400 (cdr bindings1401)) - (car bindings1401))))))) - (f1400 (map list x1396 v1397)))) - tmp1388) + (list (f3764 (cdr bindings3765)) + (car bindings3765))))))) + (f3764 (map list x3760 v3761)))) + tmp3752) (syntax-violation #f "source expression failed to match any pattern" - tmp1387))) + tmp3751))) ($sc-dispatch - tmp1387 + tmp3751 '(any #(each (any any)) any . each-any)))) - x1386)))) + x3750)))) (define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) 'macro - (lambda (orig-x1409) - ((lambda (tmp1410) - ((lambda (tmp1411) - (if tmp1411 - (apply (lambda (_1412 - var1413 - init1414 - step1415 - e01416 - e11417 - c1418) - ((lambda (tmp1419) - ((lambda (tmp1420) - (if tmp1420 - (apply (lambda (step1421) - ((lambda (tmp1422) - ((lambda (tmp1423) - (if tmp1423 + (lambda (orig-x3773) + ((lambda (tmp3774) + ((lambda (tmp3775) + (if tmp3775 + (apply (lambda (_3776 + var3777 + init3778 + step3779 + e03780 + e13781 + c3782) + ((lambda (tmp3783) + ((lambda (tmp3784) + (if tmp3784 + (apply (lambda (step3785) + ((lambda (tmp3786) + ((lambda (tmp3787) + (if tmp3787 (apply (lambda () (list '#(syntax-object let @@ -8729,8 +8962,8 @@ (hygiene guile)) (map list - var1413 - init1414) + var3777 + init3778) (list '#(syntax-object if ((top) @@ -8809,7 +9042,7 @@ #("i"))) (hygiene guile)) - e01416) + e03780) (cons '#(syntax-object begin ((top) @@ -8850,7 +9083,7 @@ (hygiene guile)) (append - c1418 + c3782 (list (cons '#(syntax-object doloop ((top) @@ -8890,12 +9123,12 @@ #("i"))) (hygiene guile)) - step1421))))))) - tmp1423) - ((lambda (tmp1428) - (if tmp1428 - (apply (lambda (e11429 - e21430) + step3785))))))) + tmp3787) + ((lambda (tmp3792) + (if tmp3792 + (apply (lambda (e13793 + e23794) (list '#(syntax-object let ((top) @@ -8989,8 +9222,8 @@ (hygiene guile)) (map list - var1413 - init1414) + var3777 + init3778) (list '#(syntax-object if ((top) @@ -9037,7 +9270,7 @@ #("i"))) (hygiene guile)) - e01416 + e03780 (cons '#(syntax-object begin ((top) @@ -9084,8 +9317,8 @@ #("i"))) (hygiene guile)) - (cons e11429 - e21430)) + (cons e13793 + e23794)) (cons '#(syntax-object begin ((top) @@ -9133,7 +9366,7 @@ (hygiene guile)) (append - c1418 + c3782 (list (cons '#(syntax-object doloop ((top) @@ -9180,75 +9413,75 @@ #("i"))) (hygiene guile)) - step1421))))))) - tmp1428) + step3785))))))) + tmp3792) (syntax-violation #f "source expression failed to match any pattern" - tmp1422))) + tmp3786))) ($sc-dispatch - tmp1422 + tmp3786 '(any . each-any))))) - ($sc-dispatch tmp1422 (quote ())))) - e11417)) - tmp1420) + ($sc-dispatch tmp3786 (quote ())))) + e13781)) + tmp3784) (syntax-violation #f "source expression failed to match any pattern" - tmp1419))) - ($sc-dispatch tmp1419 (quote each-any)))) - (map (lambda (v1437 s1438) - ((lambda (tmp1439) - ((lambda (tmp1440) - (if tmp1440 - (apply (lambda () v1437) tmp1440) - ((lambda (tmp1441) - (if tmp1441 - (apply (lambda (e1442) e1442) - tmp1441) - ((lambda (_1443) + tmp3783))) + ($sc-dispatch tmp3783 (quote each-any)))) + (map (lambda (v3801 s3802) + ((lambda (tmp3803) + ((lambda (tmp3804) + (if tmp3804 + (apply (lambda () v3801) tmp3804) + ((lambda (tmp3805) + (if tmp3805 + (apply (lambda (e3806) e3806) + tmp3805) + ((lambda (_3807) (syntax-violation 'do "bad step expression" - orig-x1409 - s1438)) - tmp1439))) - ($sc-dispatch tmp1439 (quote (any)))))) - ($sc-dispatch tmp1439 (quote ())))) - s1438)) - var1413 - step1415))) - tmp1411) + orig-x3773 + s3802)) + tmp3803))) + ($sc-dispatch tmp3803 (quote (any)))))) + ($sc-dispatch tmp3803 (quote ())))) + s3802)) + var3777 + step3779))) + tmp3775) (syntax-violation #f "source expression failed to match any pattern" - tmp1410))) + tmp3774))) ($sc-dispatch - tmp1410 + tmp3774 '(any #(each (any any . any)) (any . each-any) . each-any)))) - orig-x1409)))) + orig-x3773)))) (define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) 'macro - (letrec ((quasicons1446 - (lambda (x1450 y1451) - ((lambda (tmp1452) - ((lambda (tmp1453) - (if tmp1453 - (apply (lambda (x1454 y1455) - ((lambda (tmp1456) - ((lambda (tmp1457) - (if tmp1457 - (apply (lambda (dy1458) - ((lambda (tmp1459) - ((lambda (tmp1460) - (if tmp1460 - (apply (lambda (dx1461) + (letrec ((quasicons3810 + (lambda (x3814 y3815) + ((lambda (tmp3816) + ((lambda (tmp3817) + (if tmp3817 + (apply (lambda (x3818 y3819) + ((lambda (tmp3820) + ((lambda (tmp3821) + (if tmp3821 + (apply (lambda (dy3822) + ((lambda (tmp3823) + ((lambda (tmp3824) + (if tmp3824 + (apply (lambda (dx3825) (list '#(syntax-object quote ((top) @@ -9297,11 +9530,11 @@ "i"))) (hygiene guile)) - (cons dx1461 - dy1458))) - tmp1460) - ((lambda (_1462) - (if (null? dy1458) + (cons dx3825 + dy3822))) + tmp3824) + ((lambda (_3826) + (if (null? dy3822) (list '#(syntax-object list ((top) @@ -9350,7 +9583,7 @@ "i"))) (hygiene guile)) - x1454) + x3818) (list '#(syntax-object cons ((top) @@ -9399,11 +9632,11 @@ "i"))) (hygiene guile)) - x1454 - y1455))) - tmp1459))) + x3818 + y3819))) + tmp3823))) ($sc-dispatch - tmp1459 + tmp3823 '(#(free-id #(syntax-object quote @@ -9446,11 +9679,11 @@ (hygiene guile))) any)))) - x1454)) - tmp1457) - ((lambda (tmp1463) - (if tmp1463 - (apply (lambda (stuff1464) + x3818)) + tmp3821) + ((lambda (tmp3827) + (if tmp3827 + (apply (lambda (stuff3828) (cons '#(syntax-object list ((top) @@ -9491,10 +9724,10 @@ "i"))) (hygiene guile)) - (cons x1454 - stuff1464))) - tmp1463) - ((lambda (else1465) + (cons x3818 + stuff3828))) + tmp3827) + ((lambda (else3829) (list '#(syntax-object cons ((top) @@ -9526,11 +9759,11 @@ "i" "i"))) (hygiene guile)) - x1454 - y1455)) - tmp1456))) + x3818 + y3819)) + tmp3820))) ($sc-dispatch - tmp1456 + tmp3820 '(#(free-id #(syntax-object list @@ -9559,7 +9792,7 @@ . any))))) ($sc-dispatch - tmp1456 + tmp3820 '(#(free-id #(syntax-object quote @@ -9583,25 +9816,25 @@ #("i" "i" "i" "i"))) (hygiene guile))) any)))) - y1455)) - tmp1453) + y3819)) + tmp3817) (syntax-violation #f "source expression failed to match any pattern" - tmp1452))) - ($sc-dispatch tmp1452 (quote (any any))))) - (list x1450 y1451)))) - (quasiappend1447 - (lambda (x1466 y1467) - ((lambda (tmp1468) - ((lambda (tmp1469) - (if tmp1469 - (apply (lambda (x1470 y1471) - ((lambda (tmp1472) - ((lambda (tmp1473) - (if tmp1473 - (apply (lambda () x1470) tmp1473) - ((lambda (_1474) + tmp3816))) + ($sc-dispatch tmp3816 (quote (any any))))) + (list x3814 y3815)))) + (quasiappend3811 + (lambda (x3830 y3831) + ((lambda (tmp3832) + ((lambda (tmp3833) + (if tmp3833 + (apply (lambda (x3834 y3835) + ((lambda (tmp3836) + ((lambda (tmp3837) + (if tmp3837 + (apply (lambda () x3834) tmp3837) + ((lambda (_3838) (list '#(syntax-object append ((top) @@ -9630,11 +9863,11 @@ (top)) #("i" "i" "i" "i"))) (hygiene guile)) - x1470 - y1471)) - tmp1472))) + x3834 + y3835)) + tmp3836))) ($sc-dispatch - tmp1472 + tmp3836 '(#(free-id #(syntax-object quote @@ -9658,22 +9891,22 @@ #("i" "i" "i" "i"))) (hygiene guile))) ())))) - y1471)) - tmp1469) + y3835)) + tmp3833) (syntax-violation #f "source expression failed to match any pattern" - tmp1468))) - ($sc-dispatch tmp1468 (quote (any any))))) - (list x1466 y1467)))) - (quasivector1448 - (lambda (x1475) - ((lambda (tmp1476) - ((lambda (x1477) - ((lambda (tmp1478) - ((lambda (tmp1479) - (if tmp1479 - (apply (lambda (x1480) + tmp3832))) + ($sc-dispatch tmp3832 (quote (any any))))) + (list x3830 y3831)))) + (quasivector3812 + (lambda (x3839) + ((lambda (tmp3840) + ((lambda (x3841) + ((lambda (tmp3842) + ((lambda (tmp3843) + (if tmp3843 + (apply (lambda (x3844) (list '#(syntax-object quote ((top) @@ -9699,11 +9932,11 @@ #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) - (list->vector x1480))) - tmp1479) - ((lambda (tmp1482) - (if tmp1482 - (apply (lambda (x1483) + (list->vector x3844))) + tmp3843) + ((lambda (tmp3846) + (if tmp3846 + (apply (lambda (x3847) (cons '#(syntax-object vector ((top) @@ -9732,9 +9965,9 @@ (top)) #("i" "i" "i" "i"))) (hygiene guile)) - x1483)) - tmp1482) - ((lambda (_1485) + x3847)) + tmp3846) + ((lambda (_3849) (list '#(syntax-object list->vector ((top) @@ -9760,10 +9993,10 @@ #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) - x1477)) - tmp1478))) + x3841)) + tmp3842))) ($sc-dispatch - tmp1478 + tmp3842 '(#(free-id #(syntax-object list @@ -9783,7 +10016,7 @@ . each-any))))) ($sc-dispatch - tmp1478 + tmp3842 '(#(free-id #(syntax-object quote @@ -9801,18 +10034,18 @@ #("i" "i" "i" "i"))) (hygiene guile))) each-any)))) - x1477)) - tmp1476)) - x1475))) - (quasi1449 - (lambda (p1486 lev1487) - ((lambda (tmp1488) - ((lambda (tmp1489) - (if tmp1489 - (apply (lambda (p1490) - (if (= lev1487 0) - p1490 - (quasicons1446 + x3841)) + tmp3840)) + x3839))) + (quasi3813 + (lambda (p3850 lev3851) + ((lambda (tmp3852) + ((lambda (tmp3853) + (if tmp3853 + (apply (lambda (p3854) + (if (= lev3851 0) + p3854 + (quasicons3810 '(#(syntax-object quote ((top) @@ -9847,18 +10080,18 @@ #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) - (quasi1449 (list p1490) (- lev1487 1))))) - tmp1489) - ((lambda (tmp1491) - (if (if tmp1491 - (apply (lambda (args1492) (= lev1487 0)) - tmp1491) + (quasi3813 (list p3854) (- lev3851 1))))) + tmp3853) + ((lambda (tmp3855) + (if (if tmp3855 + (apply (lambda (args3856) (= lev3851 0)) + tmp3855) #f) - (apply (lambda (args1493) + (apply (lambda (args3857) (syntax-violation 'unquote "unquote takes exactly one argument" - p1486 + p3850 (cons '#(syntax-object unquote ((top) @@ -9879,17 +10112,17 @@ #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) - args1493))) - tmp1491) - ((lambda (tmp1494) - (if tmp1494 - (apply (lambda (p1495 q1496) - (if (= lev1487 0) - (quasiappend1447 - p1495 - (quasi1449 q1496 lev1487)) - (quasicons1446 - (quasicons1446 + args3857))) + tmp3855) + ((lambda (tmp3858) + (if tmp3858 + (apply (lambda (p3859 q3860) + (if (= lev3851 0) + (quasiappend3811 + p3859 + (quasi3813 q3860 lev3851)) + (quasicons3810 + (quasicons3810 '(#(syntax-object quote ((top) @@ -9936,22 +10169,22 @@ (top)) #("i" "i" "i" "i"))) (hygiene guile))) - (quasi1449 - (list p1495) - (- lev1487 1))) - (quasi1449 q1496 lev1487)))) - tmp1494) - ((lambda (tmp1497) - (if (if tmp1497 - (apply (lambda (args1498 q1499) - (= lev1487 0)) - tmp1497) + (quasi3813 + (list p3859) + (- lev3851 1))) + (quasi3813 q3860 lev3851)))) + tmp3858) + ((lambda (tmp3861) + (if (if tmp3861 + (apply (lambda (args3862 q3863) + (= lev3851 0)) + tmp3861) #f) - (apply (lambda (args1500 q1501) + (apply (lambda (args3864 q3865) (syntax-violation 'unquote-splicing "unquote-splicing takes exactly one argument" - p1486 + p3850 (cons '#(syntax-object unquote-splicing ((top) @@ -9981,12 +10214,12 @@ "i" "i"))) (hygiene guile)) - args1500))) - tmp1497) - ((lambda (tmp1502) - (if tmp1502 - (apply (lambda (p1503) - (quasicons1446 + args3864))) + tmp3861) + ((lambda (tmp3866) + (if tmp3866 + (apply (lambda (p3867) + (quasicons3810 '(#(syntax-object quote ((top) @@ -10045,30 +10278,30 @@ "i" "i"))) (hygiene guile))) - (quasi1449 - (list p1503) - (+ lev1487 1)))) - tmp1502) - ((lambda (tmp1504) - (if tmp1504 - (apply (lambda (p1505 q1506) - (quasicons1446 - (quasi1449 - p1505 - lev1487) - (quasi1449 - q1506 - lev1487))) - tmp1504) - ((lambda (tmp1507) - (if tmp1507 - (apply (lambda (x1508) - (quasivector1448 - (quasi1449 - x1508 - lev1487))) - tmp1507) - ((lambda (p1510) + (quasi3813 + (list p3867) + (+ lev3851 1)))) + tmp3866) + ((lambda (tmp3868) + (if tmp3868 + (apply (lambda (p3869 q3870) + (quasicons3810 + (quasi3813 + p3869 + lev3851) + (quasi3813 + q3870 + lev3851))) + tmp3868) + ((lambda (tmp3871) + (if tmp3871 + (apply (lambda (x3872) + (quasivector3812 + (quasi3813 + x3872 + lev3851))) + tmp3871) + ((lambda (p3874) (list '#(syntax-object quote ((top) @@ -10101,16 +10334,16 @@ "i"))) (hygiene guile)) - p1510)) - tmp1488))) + p3874)) + tmp3852))) ($sc-dispatch - tmp1488 + tmp3852 '#(vector each-any))))) ($sc-dispatch - tmp1488 + tmp3852 '(any . any))))) ($sc-dispatch - tmp1488 + tmp3852 '(#(free-id #(syntax-object quasiquote @@ -10130,7 +10363,7 @@ (hygiene guile))) any))))) ($sc-dispatch - tmp1488 + tmp3852 '((#(free-id #(syntax-object unquote-splicing @@ -10153,7 +10386,7 @@ . any))))) ($sc-dispatch - tmp1488 + tmp3852 '((#(free-id #(syntax-object unquote-splicing @@ -10175,7 +10408,7 @@ . any))))) ($sc-dispatch - tmp1488 + tmp3852 '(#(free-id #(syntax-object unquote @@ -10193,7 +10426,7 @@ . any))))) ($sc-dispatch - tmp1488 + tmp3852 '(#(free-id #(syntax-object unquote @@ -10206,44 +10439,44 @@ #("i" "i" "i" "i"))) (hygiene guile))) any)))) - p1486)))) - (lambda (x1511) - ((lambda (tmp1512) - ((lambda (tmp1513) - (if tmp1513 - (apply (lambda (_1514 e1515) (quasi1449 e1515 0)) - tmp1513) + p3850)))) + (lambda (x3875) + ((lambda (tmp3876) + ((lambda (tmp3877) + (if tmp3877 + (apply (lambda (_3878 e3879) (quasi3813 e3879 0)) + tmp3877) (syntax-violation #f "source expression failed to match any pattern" - tmp1512))) - ($sc-dispatch tmp1512 (quote (any any))))) - x1511))))) + tmp3876))) + ($sc-dispatch tmp3876 (quote (any any))))) + x3875))))) (define include (make-syncase-macro 'macro - (lambda (x1516) - (letrec ((read-file1517 - (lambda (fn1518 k1519) - (let ((p1520 (open-input-file fn1518))) - (letrec ((f1521 (lambda (x1522) - (if (eof-object? x1522) + (lambda (x3880) + (letrec ((read-file3881 + (lambda (fn3882 k3883) + (let ((p3884 (open-input-file fn3882))) + (letrec ((f3885 (lambda (x3886) + (if (eof-object? x3886) (begin - (close-input-port p1520) + (close-input-port p3884) '()) - (cons (datum->syntax k1519 x1522) - (f1521 (read p1520))))))) - (f1521 (read p1520))))))) - ((lambda (tmp1523) - ((lambda (tmp1524) - (if tmp1524 - (apply (lambda (k1525 filename1526) - (let ((fn1527 (syntax->datum filename1526))) - ((lambda (tmp1528) - ((lambda (tmp1529) - (if tmp1529 - (apply (lambda (exp1530) + (cons (datum->syntax k3883 x3886) + (f3885 (read p3884))))))) + (f3885 (read p3884))))))) + ((lambda (tmp3887) + ((lambda (tmp3888) + (if tmp3888 + (apply (lambda (k3889 filename3890) + (let ((fn3891 (syntax->datum filename3890))) + ((lambda (tmp3892) + ((lambda (tmp3893) + (if tmp3893 + (apply (lambda (exp3894) (cons '#(syntax-object begin ((top) @@ -10270,73 +10503,73 @@ #((top)) #("i"))) (hygiene guile)) - exp1530)) - tmp1529) + exp3894)) + tmp3893) (syntax-violation #f "source expression failed to match any pattern" - tmp1528))) - ($sc-dispatch tmp1528 (quote each-any)))) - (read-file1517 fn1527 k1525)))) - tmp1524) + tmp3892))) + ($sc-dispatch tmp3892 (quote each-any)))) + (read-file3881 fn3891 k3889)))) + tmp3888) (syntax-violation #f "source expression failed to match any pattern" - tmp1523))) - ($sc-dispatch tmp1523 (quote (any any))))) - x1516))))) + tmp3887))) + ($sc-dispatch tmp3887 (quote (any any))))) + x3880))))) (define unquote (make-syncase-macro 'macro - (lambda (x1532) - ((lambda (tmp1533) - ((lambda (tmp1534) - (if tmp1534 - (apply (lambda (_1535 e1536) + (lambda (x3896) + ((lambda (tmp3897) + ((lambda (tmp3898) + (if tmp3898 + (apply (lambda (_3899 e3900) (syntax-violation 'unquote "expression not valid outside of quasiquote" - x1532)) - tmp1534) + x3896)) + tmp3898) (syntax-violation #f "source expression failed to match any pattern" - tmp1533))) - ($sc-dispatch tmp1533 (quote (any any))))) - x1532)))) + tmp3897))) + ($sc-dispatch tmp3897 (quote (any any))))) + x3896)))) (define unquote-splicing (make-syncase-macro 'macro - (lambda (x1537) - ((lambda (tmp1538) - ((lambda (tmp1539) - (if tmp1539 - (apply (lambda (_1540 e1541) + (lambda (x3901) + ((lambda (tmp3902) + ((lambda (tmp3903) + (if tmp3903 + (apply (lambda (_3904 e3905) (syntax-violation 'unquote-splicing "expression not valid outside of quasiquote" - x1537)) - tmp1539) + x3901)) + tmp3903) (syntax-violation #f "source expression failed to match any pattern" - tmp1538))) - ($sc-dispatch tmp1538 (quote (any any))))) - x1537)))) + tmp3902))) + ($sc-dispatch tmp3902 (quote (any any))))) + x3901)))) (define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) 'macro - (lambda (x1542) - ((lambda (tmp1543) - ((lambda (tmp1544) - (if tmp1544 - (apply (lambda (_1545 e1546 m11547 m21548) - ((lambda (tmp1549) - ((lambda (body1550) + (lambda (x3906) + ((lambda (tmp3907) + ((lambda (tmp3908) + (if tmp3908 + (apply (lambda (_3909 e3910 m13911 m23912) + ((lambda (tmp3913) + ((lambda (body3914) (list '#(syntax-object let ((top) @@ -10365,16 +10598,16 @@ #((top)) #("i"))) (hygiene guile)) - e1546)) - body1550)) - tmp1549)) - (letrec ((f1551 (lambda (clause1552 clauses1553) - (if (null? clauses1553) - ((lambda (tmp1555) - ((lambda (tmp1556) - (if tmp1556 - (apply (lambda (e11557 - e21558) + e3910)) + body3914)) + tmp3913)) + (letrec ((f3915 (lambda (clause3916 clauses3917) + (if (null? clauses3917) + ((lambda (tmp3919) + ((lambda (tmp3920) + (if tmp3920 + (apply (lambda (e13921 + e23922) (cons '#(syntax-object begin ((top) @@ -10422,14 +10655,14 @@ #("i"))) (hygiene guile)) - (cons e11557 - e21558))) - tmp1556) - ((lambda (tmp1560) - (if tmp1560 - (apply (lambda (k1561 - e11562 - e21563) + (cons e13921 + e23922))) + tmp3920) + ((lambda (tmp3924) + (if tmp3924 + (apply (lambda (k3925 + e13926 + e23927) (list '#(syntax-object if ((top) @@ -10630,7 +10863,7 @@ #("i"))) (hygiene guile)) - k1561)) + k3925)) (cons '#(syntax-object begin ((top) @@ -10681,24 +10914,24 @@ #("i"))) (hygiene guile)) - (cons e11562 - e21563)))) - tmp1560) - ((lambda (_1566) + (cons e13926 + e23927)))) + tmp3924) + ((lambda (_3930) (syntax-violation 'case "bad clause" - x1542 - clause1552)) - tmp1555))) + x3906 + clause3916)) + tmp3919))) ($sc-dispatch - tmp1555 + tmp3919 '(each-any any . each-any))))) ($sc-dispatch - tmp1555 + tmp3919 '(#(free-id #(syntax-object else @@ -10724,15 +10957,15 @@ any . each-any)))) - clause1552) - ((lambda (tmp1567) - ((lambda (rest1568) - ((lambda (tmp1569) - ((lambda (tmp1570) - (if tmp1570 - (apply (lambda (k1571 - e11572 - e21573) + clause3916) + ((lambda (tmp3931) + ((lambda (rest3932) + ((lambda (tmp3933) + ((lambda (tmp3934) + (if tmp3934 + (apply (lambda (k3935 + e13936 + e23937) (list '#(syntax-object if ((top) @@ -10949,7 +11182,7 @@ #("i"))) (hygiene guile)) - k1571)) + k3935)) (cons '#(syntax-object begin ((top) @@ -11004,46 +11237,46 @@ #("i"))) (hygiene guile)) - (cons e11572 - e21573)) - rest1568)) - tmp1570) - ((lambda (_1576) + (cons e13936 + e23937)) + rest3932)) + tmp3934) + ((lambda (_3940) (syntax-violation 'case "bad clause" - x1542 - clause1552)) - tmp1569))) + x3906 + clause3916)) + tmp3933))) ($sc-dispatch - tmp1569 + tmp3933 '(each-any any . each-any)))) - clause1552)) - tmp1567)) - (f1551 (car clauses1553) - (cdr clauses1553))))))) - (f1551 m11547 m21548)))) - tmp1544) + clause3916)) + tmp3931)) + (f3915 (car clauses3917) + (cdr clauses3917))))))) + (f3915 m13911 m23912)))) + tmp3908) (syntax-violation #f "source expression failed to match any pattern" - tmp1543))) + tmp3907))) ($sc-dispatch - tmp1543 + tmp3907 '(any any any . each-any)))) - x1542)))) + x3906)))) (define identifier-syntax (make-syncase-macro 'macro - (lambda (x1577) - ((lambda (tmp1578) - ((lambda (tmp1579) - (if tmp1579 - (apply (lambda (_1580 e1581) + (lambda (x3941) + ((lambda (tmp3942) + ((lambda (tmp3943) + (if tmp3943 + (apply (lambda (_3944 e3945) (list '#(syntax-object lambda ((top) @@ -11132,8 +11365,8 @@ #((top)) #("i"))) (hygiene guile)) - e1581)) - (list (cons _1580 + e3945)) + (list (cons _3944 '(#(syntax-object x ((top) @@ -11173,7 +11406,7 @@ #((top)) #("i"))) (hygiene guile)) - (cons e1581 + (cons e3945 '(#(syntax-object x ((top) @@ -11201,11 +11434,11 @@ #("i"))) (hygiene guile))))))))) - tmp1579) + tmp3943) (syntax-violation #f "source expression failed to match any pattern" - tmp1578))) - ($sc-dispatch tmp1578 (quote (any any))))) - x1577)))) + tmp3942))) + ($sc-dispatch tmp3942 (quote (any any))))) + x3941)))) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 5f5e86b0f..cbbcabd72 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -337,39 +337,46 @@ ) +(define (decorate-source e s) + (if (and (pair? e) s) + (set-source-properties! e s)) + e) + ;;; output constructors (define build-void (lambda (source) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-void) source)) - (else '(if #f #f))))) + (else (decorate-source '(if #f #f) source))))) (define build-application (lambda (source fun-exp arg-exps) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-application) source fun-exp arg-exps)) - (else `(,fun-exp . ,arg-exps))))) + (else (decorate-source `(,fun-exp . ,arg-exps) source))))) (define build-conditional (lambda (source test-exp then-exp else-exp) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-conditional) source test-exp then-exp else-exp)) - (else (if (equal? else-exp '(if #f #f)) - `(if ,test-exp ,then-exp) - `(if ,test-exp ,then-exp ,else-exp)))))) + (else (decorate-source + (if (equal? else-exp '(if #f #f)) + `(if ,test-exp ,then-exp) + `(if ,test-exp ,then-exp ,else-exp)) + source))))) (define build-lexical-reference (lambda (type source name var) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-lexical-ref) source name var)) - (else var)))) + (else (decorate-source var source))))) (define build-lexical-assignment (lambda (source name var exp) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-lexical-set) source name var exp)) - (else `(set! ,var ,exp))))) + (else (decorate-source `(set! ,var ,exp) source))))) ;; Before modules are booted, we can't expand into data structures from ;; (language tree-il) -- we need to give the evaluator the @@ -403,11 +410,11 @@ (lambda (mod var public?) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-module-ref) source mod var public?)) - (else (list (if public? '@ '@@) mod var)))) + (else (decorate-source (list (if public? '@ '@@) mod var) source)))) (lambda (var) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-toplevel-ref) source var)) - (else var)))))) + (else (decorate-source var source))))))) (define build-global-assignment (lambda (source var exp mod) @@ -416,11 +423,11 @@ (lambda (mod var public?) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-module-set) source mod var public? exp)) - (else `(set! ,(list (if public? '@ '@@) mod var) ,exp)))) + (else (decorate-source `(set! ,(list (if public? '@ '@@) mod var) ,exp) source)))) (lambda (var) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-toplevel-set) source var exp)) - (else `(set! ,var ,exp))))))) + (else (decorate-source `(set! ,var ,exp) source))))))) ;; FIXME: there is a bug that prevents (set! ((@ (foo) bar) baz) quz) ;; from working. Hack around it. @@ -439,7 +446,7 @@ ((c) (maybe-name-value! var exp) ((@ (language tree-il) make-toplevel-define) source var exp)) - (else `(define ,var ,exp))))) + (else (decorate-source `(define ,var ,exp) source))))) (define build-lambda (lambda (src ids vars docstring exp) @@ -447,25 +454,29 @@ ((c) ((@ (language tree-il) make-lambda) src ids vars (if docstring `((documentation . ,docstring)) '()) exp)) - (else `(lambda ,vars ,@(if docstring (list docstring) '()) - ,exp))))) + (else (decorate-source + `(lambda ,vars ,@(if docstring (list docstring) '()) + ,exp) + src))))) (define build-primref (lambda (src name) (if (equal? (module-name (current-module)) '(guile)) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-toplevel-ref) src name)) - (else name)) + (else (decorate-source name src))) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-module-ref) src '(guile) name #f)) - (else `(@@ (guile) ,name)))))) + (else (decorate-source `(@@ (guile) ,name) src)))))) (define (build-data src exp) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-const) src exp)) - (else (if (and (self-evaluating? exp) (not (vector? exp))) - exp - (list 'quote exp))))) + (else (decorate-source + (if (and (self-evaluating? exp) (not (vector? exp))) + exp + (list 'quote exp)) + src)))) (define build-sequence (lambda (src exps) @@ -473,7 +484,7 @@ (car exps) (case (fluid-ref *mode*) ((c) ((@ (language tree-il) make-sequence) src exps)) - (else `(begin ,@exps)))))) + (else (decorate-source `(begin ,@exps) src)))))) (define build-let (lambda (src ids vars val-exps body-exp) @@ -483,7 +494,9 @@ ((c) (for-each maybe-name-value! ids val-exps) ((@ (language tree-il) make-let) src ids vars val-exps body-exp)) - (else `(let ,(map list vars val-exps) ,body-exp)))))) + (else (decorate-source + `(let ,(map list vars val-exps) ,body-exp) + src)))))) (define build-named-let (lambda (src ids vars val-exps body-exp) @@ -500,7 +513,9 @@ (list f-name) (list f) (list proc) (build-application src (build-lexical-reference 'fun src f-name f) val-exps)))) - (else `(let ,f ,(map list vars val-exps) ,body-exp)))))) + (else (decorate-source + `(let ,f ,(map list vars val-exps) ,body-exp) + src)))))) (define build-letrec (lambda (src ids vars val-exps body-exp) @@ -510,7 +525,9 @@ ((c) (for-each maybe-name-value! ids val-exps) ((@ (language tree-il) make-letrec) src ids vars val-exps body-exp)) - (else `(letrec ,(map list vars val-exps) ,body-exp)))))) + (else (decorate-source + `(letrec ,(map list vars val-exps) ,body-exp) + src)))))) ;; FIXME: wingo: use make-lexical ? (define-syntax build-lexical-var |