summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/ice-9/psyntax-pp.scm8643
-rw-r--r--module/ice-9/psyntax.scm8
2 files changed, 4245 insertions, 4406 deletions
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index e2a3d60e3..113269b2e 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,97 +1,90 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
-(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)
+(letrec ((and-map*17
+ (lambda (f57 first56 . rest55)
+ (let ((t58 (null? first56)))
+ (if t58
+ t58
+ (if (null? rest55)
+ (letrec ((andmap59
+ (lambda (first60)
+ (let ((x61 (car first60))
+ (first62 (cdr first60)))
+ (if (null? first62)
+ (f57 x61)
+ (if (f57 x61) (andmap59 first62) #f))))))
+ (andmap59 first56))
+ (letrec ((andmap63
+ (lambda (first64 rest65)
+ (let ((x66 (car first64))
+ (xr67 (map car rest65))
+ (first68 (cdr first64))
+ (rest69 (map cdr rest65)))
+ (if (null? first68)
+ (apply f57 (cons x66 xr67))
+ (if (apply f57 (cons x66 xr67))
+ (andmap63 first68 rest69)
#f))))))
- (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
+ (andmap63 first56 rest55))))))))
+ (letrec ((lambda-var-list163
+ (lambda (vars287)
+ (letrec ((lvl288
+ (lambda (vars289 ls290 w291)
+ (if (pair? vars289)
+ (lvl288
+ (cdr vars289)
+ (cons (wrap143 (car vars289) w291 #f) ls290)
+ w291)
+ (if (id?115 vars289)
+ (cons (wrap143 vars289 w291 #f) ls290)
+ (if (null? vars289)
+ ls290
+ (if (syntax-object?99 vars289)
+ (lvl288
+ (syntax-object-expression100 vars289)
+ ls290
+ (join-wraps134
+ w291
+ (syntax-object-wrap101 vars289)))
+ (cons vars289 ls290))))))))
+ (lvl288 vars287 (quote ()) (quote (()))))))
+ (gen-var162
+ (lambda (id292)
+ (let ((id293 (if (syntax-object?99 id292)
+ (syntax-object-expression100 id292)
+ id292)))
+ (gensym (symbol->string id293)))))
+ (strip161
+ (lambda (x294 w295)
+ (if (memq (quote top) (wrap-marks118 w295))
+ x294
+ (letrec ((f296 (lambda (x297)
+ (if (syntax-object?99 x297)
+ (strip161
+ (syntax-object-expression100 x297)
+ (syntax-object-wrap101 x297))
+ (if (pair? x297)
+ (let ((a298 (f296 (car x297)))
+ (d299 (f296 (cdr x297))))
+ (if (if (eq? a298 (car x297))
+ (eq? d299 (cdr x297))
+ #f)
+ x297
+ (cons a298 d299)))
+ (if (vector? x297)
+ (let ((old300 (vector->list x297)))
+ (let ((new301 (map f296 old300)))
+ (if (and-map*17 eq? old300 new301)
+ x297
+ (list->vector new301))))
+ x297))))))
+ (f296 x294)))))
+ (ellipsis?160
+ (lambda (x302)
+ (if (nonsymbol-id?114 x302)
+ (free-id=?138
+ x302
'#(syntax-object
...
((top)
@@ -441,1632 +434,1590 @@
("i" "i")))
(hygiene guile)))
#f)))
- (chi-void2520 (lambda () (build-void2442 #f)))
- (eval-local-transformer2519
- (lambda (expanded2664 mod2665)
- (let ((p2666 (local-eval-hook2438 expanded2664 mod2665)))
- (if (procedure? p2666)
- p2666
+ (chi-void159 (lambda () (build-void81 #f)))
+ (eval-local-transformer158
+ (lambda (expanded303 mod304)
+ (let ((p305 (local-eval-hook77 expanded303 mod304)))
+ (if (procedure? p305)
+ p305
(syntax-violation
#f
"nonprocedure transformer"
- 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))
+ p305)))))
+ (chi-local-syntax157
+ (lambda (rec?306 e307 r308 w309 s310 mod311 k312)
+ ((lambda (tmp313)
+ ((lambda (tmp314)
+ (if tmp314
+ (apply (lambda (_315 id316 val317 e1318 e2319)
+ (let ((ids320 id316))
+ (if (not (valid-bound-ids?140 ids320))
(syntax-violation
#f
"duplicate bound keyword"
- 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)
+ e307)
+ (let ((labels322 (gen-labels121 ids320)))
+ (let ((new-w323
+ (make-binding-wrap132
+ ids320
+ labels322
+ w309)))
+ (k312 (cons e1318 e2319)
+ (extend-env109
+ labels322
+ (let ((w325 (if rec?306
+ new-w323
+ w309))
+ (trans-r326
+ (macros-only-env111
+ r308)))
+ (map (lambda (x327)
+ (cons 'macro
+ (eval-local-transformer158
+ (chi151
+ x327
+ trans-r326
+ w325
+ mod311)
+ mod311)))
+ val317))
+ r308)
+ new-w323
+ s310
+ mod311))))))
+ tmp314)
+ ((lambda (_329)
(syntax-violation
#f
"bad local syntax definition"
- (source-wrap2505 e2668 w2670 s2671 mod2672)))
- tmp2674)))
+ (source-wrap144 e307 w309 s310 mod311)))
+ tmp313)))
($sc-dispatch
- tmp2674
+ tmp313
'(any #(each (any any)) any . each-any))))
- 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)
+ e307)))
+ (chi-lambda-clause156
+ (lambda (e330 docstring331 c332 r333 w334 mod335 k336)
+ ((lambda (tmp337)
+ ((lambda (tmp338)
+ (if (if tmp338
+ (apply (lambda (args339 doc340 e1341 e2342)
+ (if (string? (syntax->datum doc340))
+ (not docstring331)
#f))
- tmp2699)
+ tmp338)
#f)
- (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))
+ (apply (lambda (args343 doc344 e1345 e2346)
+ (chi-lambda-clause156
+ e330
+ doc344
+ (cons args343 (cons e1345 e2346))
+ r333
+ w334
+ mod335
+ k336))
+ tmp338)
+ ((lambda (tmp348)
+ (if tmp348
+ (apply (lambda (id349 e1350 e2351)
+ (let ((ids352 id349))
+ (if (not (valid-bound-ids?140 ids352))
(syntax-violation
'lambda
"invalid parameter list"
- 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))
+ e330)
+ (let ((labels354
+ (gen-labels121 ids352))
+ (new-vars355
+ (map gen-var162 ids352)))
+ (k336 (map syntax->datum ids352)
+ new-vars355
+ (if docstring331
+ (syntax->datum docstring331)
+ #f)
+ (chi-body155
+ (cons e1350 e2351)
+ e330
+ (extend-var-env110
+ labels354
+ new-vars355
+ r333)
+ (make-binding-wrap132
+ ids352
+ labels354
+ w334)
+ mod335))))))
+ tmp348)
+ ((lambda (tmp357)
+ (if tmp357
+ (apply (lambda (ids358 e1359 e2360)
+ (let ((old-ids361
+ (lambda-var-list163 ids358)))
+ (if (not (valid-bound-ids?140
+ old-ids361))
(syntax-violation
'lambda
"invalid parameter list"
- 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)
+ e330)
+ (let ((labels362
+ (gen-labels121
+ old-ids361))
+ (new-vars363
+ (map gen-var162
+ old-ids361)))
+ (k336 (letrec ((f364 (lambda (ls1365
+ ls2366)
+ (if (null? ls1365)
+ (syntax->datum
+ ls2366)
+ (f364 (cdr ls1365)
+ (cons (syntax->datum
+ (car ls1365))
+ ls2366))))))
+ (f364 (cdr old-ids361)
+ (car old-ids361)))
+ (letrec ((f367 (lambda (ls1368
+ ls2369)
+ (if (null? ls1368)
+ ls2369
+ (f367 (cdr ls1368)
+ (cons (car ls1368)
+ ls2369))))))
+ (f367 (cdr new-vars363)
+ (car new-vars363)))
+ (if docstring331
+ (syntax->datum
+ docstring331)
+ #f)
+ (chi-body155
+ (cons e1359 e2360)
+ e330
+ (extend-var-env110
+ labels362
+ new-vars363
+ r333)
+ (make-binding-wrap132
+ old-ids361
+ labels362
+ w334)
+ mod335))))))
+ tmp357)
+ ((lambda (_371)
(syntax-violation
'lambda
"bad lambda"
- e2691))
- tmp2698)))
+ e330))
+ tmp337)))
($sc-dispatch
- tmp2698
+ tmp337
'(any any . each-any)))))
($sc-dispatch
- tmp2698
+ tmp337
'(each-any any . each-any)))))
($sc-dispatch
- tmp2698
+ tmp337
'(any any any . each-any))))
- c2693)))
- (chi-body2516
- (lambda (body2733 outer-form2734 r2735 w2736 mod2737)
- (let ((r2738 (cons (quote ("placeholder" placeholder)) r2735)))
- (let ((ribcage2739
- (make-ribcage2483
+ c332)))
+ (chi-body155
+ (lambda (body372 outer-form373 r374 w375 mod376)
+ (let ((r377 (cons (quote ("placeholder" placeholder)) r374)))
+ (let ((ribcage378
+ (make-ribcage122
'()
'()
'())))
- (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)
+ (let ((w379 (make-wrap117
+ (wrap-marks118 w375)
+ (cons ribcage378 (wrap-subst119 w375)))))
+ (letrec ((parse380
+ (lambda (body381
+ ids382
+ labels383
+ var-ids384
+ vars385
+ vals386
+ bindings387)
+ (if (null? body381)
(syntax-violation
#f
"no expressions in body"
- outer-form2734)
- (let ((e2750 (cdar body2742))
- (er2751 (caar body2742)))
+ outer-form373)
+ (let ((e389 (cdar body381))
+ (er390 (caar body381)))
(call-with-values
(lambda ()
- (syntax-type2510
- e2750
- er2751
+ (syntax-type149
+ e389
+ er390
'(())
- (source-annotation2467 er2751)
- ribcage2739
- mod2737
+ (source-annotation106 er390)
+ ribcage378
+ mod376
#f))
- (lambda (type2752
- value2753
- e2754
- w2755
- s2756
- mod2757)
- (if (memv type2752
+ (lambda (type391
+ value392
+ e393
+ w394
+ s395
+ mod396)
+ (if (memv type391
'(define-form))
- (let ((id2758
- (wrap2504
- value2753
- w2755
- mod2757))
- (label2759 (gen-label2481)))
- (let ((var2760
- (gen-var2523 id2758)))
+ (let ((id397 (wrap143
+ value392
+ w394
+ mod396))
+ (label398 (gen-label120)))
+ (let ((var399
+ (gen-var162 id397)))
(begin
- (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)
+ (extend-ribcage!131
+ ribcage378
+ id397
+ label398)
+ (parse380
+ (cdr body381)
+ (cons id397 ids382)
+ (cons label398 labels383)
+ (cons id397 var-ids384)
+ (cons var399 vars385)
+ (cons (cons er390
+ (wrap143
+ e393
+ w394
+ mod396))
+ vals386)
(cons (cons 'lexical
- var2760)
- bindings2748)))))
- (if (memv type2752
+ var399)
+ bindings387)))))
+ (if (memv type391
'(define-syntax-form))
- (let ((id2761
- (wrap2504
- value2753
- w2755
- mod2757))
- (label2762
- (gen-label2481)))
+ (let ((id400 (wrap143
+ value392
+ w394
+ mod396))
+ (label401 (gen-label120)))
(begin
- (extend-ribcage!2492
- ribcage2739
- id2761
- label2762)
- (parse2741
- (cdr body2742)
- (cons id2761 ids2743)
- (cons label2762 labels2744)
- var-ids2745
- vars2746
- vals2747
+ (extend-ribcage!131
+ ribcage378
+ id400
+ label401)
+ (parse380
+ (cdr body381)
+ (cons id400 ids382)
+ (cons label401 labels383)
+ var-ids384
+ vars385
+ vals386
(cons (cons 'macro
- (cons er2751
- (wrap2504
- e2754
- w2755
- mod2757)))
- bindings2748))))
- (if (memv type2752
+ (cons er390
+ (wrap143
+ e393
+ w394
+ mod396)))
+ bindings387))))
+ (if (memv type391
'(begin-form))
- ((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)
+ ((lambda (tmp402)
+ ((lambda (tmp403)
+ (if tmp403
+ (apply (lambda (_404
+ e1405)
+ (parse380
+ (letrec ((f406 (lambda (forms407)
+ (if (null? forms407)
+ (cdr body381)
+ (cons (cons er390
+ (wrap143
+ (car forms407)
+ w394
+ mod396))
+ (f406 (cdr forms407)))))))
+ (f406 e1405))
+ ids382
+ labels383
+ var-ids384
+ vars385
+ vals386
+ bindings387))
+ tmp403)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp2763)))
+ tmp402)))
($sc-dispatch
- tmp2763
+ tmp402
'(any . each-any))))
- e2754)
- (if (memv type2752
+ e393)
+ (if (memv type391
'(local-syntax-form))
- (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
+ (chi-local-syntax157
+ value392
+ e393
+ er390
+ w394
+ s395
+ mod396
+ (lambda (forms409
+ er410
+ w411
+ s412
+ mod413)
+ (parse380
+ (letrec ((f414 (lambda (forms415)
+ (if (null? forms415)
+ (cdr body381)
+ (cons (cons er410
+ (wrap143
+ (car forms415)
+ w411
+ mod413))
+ (f414 (cdr forms415)))))))
+ (f414 forms409))
+ ids382
+ labels383
+ var-ids384
+ vars385
+ vals386
+ bindings387)))
+ (if (null? ids382)
+ (build-sequence94
#f
- (map (lambda (x2777)
- (chi2512
- (cdr x2777)
- (car x2777)
+ (map (lambda (x416)
+ (chi151
+ (cdr x416)
+ (car x416)
'(())
- mod2757))
- (cons (cons er2751
- (source-wrap2505
- e2754
- w2755
- s2756
- mod2757))
- (cdr body2742))))
+ mod396))
+ (cons (cons er390
+ (source-wrap144
+ e393
+ w394
+ s395
+ mod396))
+ (cdr body381))))
(begin
- (if (not (valid-bound-ids?2501
- ids2743))
+ (if (not (valid-bound-ids?140
+ ids382))
(syntax-violation
#f
"invalid or duplicate identifier in definition"
- outer-form2734))
- (letrec ((loop2778
- (lambda (bs2779
- er-cache2780
- r-cache2781)
- (if (not (null? bs2779))
- (let ((b2782 (car bs2779)))
- (if (eq? (car b2782)
+ outer-form373))
+ (letrec ((loop417
+ (lambda (bs418
+ er-cache419
+ r-cache420)
+ (if (not (null? bs418))
+ (let ((b421 (car bs418)))
+ (if (eq? (car b421)
'macro)
- (let ((er2783
- (cadr b2782)))
- (let ((r-cache2784
- (if (eq? er2783
- er-cache2780)
- r-cache2781
- (macros-only-env2472
- er2783))))
+ (let ((er422 (cadr b421)))
+ (let ((r-cache423
+ (if (eq? er422
+ er-cache419)
+ r-cache420
+ (macros-only-env111
+ er422))))
(begin
(set-cdr!
- b2782
- (eval-local-transformer2519
- (chi2512
- (cddr b2782)
- r-cache2784
+ b421
+ (eval-local-transformer158
+ (chi151
+ (cddr b421)
+ r-cache423
'(())
- mod2757)
- mod2757))
- (loop2778
- (cdr bs2779)
- er2783
- r-cache2784))))
- (loop2778
- (cdr bs2779)
- er-cache2780
- r-cache2781)))))))
- (loop2778
- bindings2748
+ mod396)
+ mod396))
+ (loop417
+ (cdr bs418)
+ er422
+ r-cache423))))
+ (loop417
+ (cdr bs418)
+ er-cache419
+ r-cache420)))))))
+ (loop417
+ bindings387
#f
#f))
(set-cdr!
- r2738
- (extend-env2470
- labels2744
- bindings2748
- (cdr r2738)))
- (build-letrec2458
+ r377
+ (extend-env109
+ labels383
+ bindings387
+ (cdr r377)))
+ (build-letrec97
#f
(map syntax->datum
- var-ids2745)
- vars2746
- (map (lambda (x2785)
- (chi2512
- (cdr x2785)
- (car x2785)
+ var-ids384)
+ vars385
+ (map (lambda (x424)
+ (chi151
+ (cdr x424)
+ (car x424)
'(())
- mod2757))
- vals2747)
- (build-sequence2455
+ mod396))
+ vals386)
+ (build-sequence94
#f
- (map (lambda (x2786)
- (chi2512
- (cdr x2786)
- (car x2786)
+ (map (lambda (x425)
+ (chi151
+ (cdr x425)
+ (car x425)
'(())
- mod2757))
- (cons (cons er2751
- (source-wrap2505
- e2754
- w2755
- s2756
- mod2757))
- (cdr body2742))))))))))))))))))
- (parse2741
- (map (lambda (x2749)
- (cons r2738 (wrap2504 x2749 w2740 mod2737)))
- body2733)
+ mod396))
+ (cons (cons er390
+ (source-wrap144
+ e393
+ w394
+ s395
+ mod396))
+ (cdr body381))))))))))))))))))
+ (parse380
+ (map (lambda (x388)
+ (cons r377 (wrap143 x388 w379 mod376)))
+ body372)
'()
'()
'()
'()
'()
'())))))))
- (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)
+ (chi-macro154
+ (lambda (p426 e427 r428 w429 rib430 mod431)
+ (letrec ((rebuild-macro-output432
+ (lambda (x433 m434)
+ (if (pair? x433)
+ (cons (rebuild-macro-output432 (car x433) m434)
+ (rebuild-macro-output432 (cdr x433) m434))
+ (if (syntax-object?99 x433)
+ (let ((w435 (syntax-object-wrap101 x433)))
+ (let ((ms436 (wrap-marks118 w435))
+ (s437 (wrap-subst119 w435)))
+ (if (if (pair? ms436)
+ (eq? (car ms436) #f)
#f)
- (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
+ (make-syntax-object98
+ (syntax-object-expression100 x433)
+ (make-wrap117
+ (cdr ms436)
+ (if rib430
+ (cons rib430 (cdr s437))
+ (cdr s437)))
+ (syntax-object-module102 x433))
+ (make-syntax-object98
+ (syntax-object-expression100 x433)
+ (make-wrap117
+ (cons m434 ms436)
+ (if rib430
+ (cons rib430
+ (cons (quote shift) s437))
+ (cons (quote shift) s437)))
+ (let ((pmod438
+ (procedure-module p426)))
+ (if pmod438
(cons 'hygiene
- (module-name pmod2799))
+ (module-name pmod438))
'(hygiene guile)))))))
- (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)
+ (if (vector? x433)
+ (let ((n439 (vector-length x433)))
+ (let ((v440 (make-vector n439)))
+ (letrec ((loop441
+ (lambda (i442)
+ (if (fx=74 i442 n439)
+ (begin (if #f #f) v440)
(begin
(vector-set!
- v2801
- i2803
- (rebuild-macro-output2793
+ v440
+ i442
+ (rebuild-macro-output432
(vector-ref
- x2794
- i2803)
- m2795))
- (loop2802
- (fx+2433
- i2803
- 1)))))))
- (loop2802 0))))
- (if (symbol? x2794)
+ x433
+ i442)
+ m434))
+ (loop441
+ (fx+72 i442 1)))))))
+ (loop441 0))))
+ (if (symbol? x433)
(syntax-violation
#f
"encountered raw symbol in macro output"
- (source-wrap2505 e2788 w2790 s mod2792)
- x2794)
- x2794)))))))
- (rebuild-macro-output2793
- (p2787 (wrap2504 e2788 (anti-mark2491 w2790) mod2792))
+ (source-wrap144 e427 w429 s mod431)
+ x433)
+ x433)))))))
+ (rebuild-macro-output432
+ (p426 (wrap143 e427 (anti-mark130 w429) mod431))
(string #\m)))))
- (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)
+ (chi-application153
+ (lambda (x443 e444 r445 w446 s447 mod448)
+ ((lambda (tmp449)
+ ((lambda (tmp450)
+ (if tmp450
+ (apply (lambda (e0451 e1452)
+ (build-application82
+ s447
+ x443
+ (map (lambda (e453)
+ (chi151 e453 r445 w446 mod448))
+ e1452)))
+ tmp450)
(syntax-violation
#f
"source expression failed to match any pattern"
- 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
+ tmp449)))
+ ($sc-dispatch tmp449 (quote (any . each-any)))))
+ e444)))
+ (chi-expr152
+ (lambda (type455 value456 e457 r458 w459 s460 mod461)
+ (if (memv type455 (quote (lexical)))
+ (build-lexical-reference84
'value
- s2821
- e2818
- value2817)
- (if (memv type2816 (quote (core core-form)))
- (value2817 e2818 r2819 w2820 s2821 mod2822)
- (if (memv type2816 (quote (module-ref)))
+ s460
+ e457
+ value456)
+ (if (memv type455 (quote (core core-form)))
+ (value456 e457 r458 w459 s460 mod461)
+ (if (memv type455 (quote (module-ref)))
(call-with-values
- (lambda () (value2817 e2818))
- (lambda (id2823 mod2824)
- (build-global-reference2448 s2821 id2823 mod2824)))
- (if (memv type2816 (quote (lexical-call)))
- (chi-application2514
- (build-lexical-reference2445
+ (lambda () (value456 e457))
+ (lambda (id462 mod463)
+ (build-global-reference87 s460 id462 mod463)))
+ (if (memv type455 (quote (lexical-call)))
+ (chi-application153
+ (build-lexical-reference84
'fun
- (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)
+ (source-annotation106 (car e457))
+ (car e457)
+ value456)
+ e457
+ r458
+ w459
+ s460
+ mod461)
+ (if (memv type455 (quote (global-call)))
+ (chi-application153
+ (build-global-reference87
+ (source-annotation106 (car e457))
+ (if (syntax-object?99 value456)
+ (syntax-object-expression100 value456)
+ value456)
+ (if (syntax-object?99 value456)
+ (syntax-object-module102 value456)
+ mod461))
+ e457
+ r458
+ w459
+ s460
+ mod461)
+ (if (memv type455 (quote (constant)))
+ (build-data93
+ s460
+ (strip161
+ (source-wrap144 e457 w459 s460 mod461)
'(())))
- (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)
+ (if (memv type455 (quote (global)))
+ (build-global-reference87 s460 value456 mod461)
+ (if (memv type455 (quote (call)))
+ (chi-application153
+ (chi151 (car e457) r458 w459 mod461)
+ e457
+ r458
+ w459
+ s460
+ mod461)
+ (if (memv type455 (quote (begin-form)))
+ ((lambda (tmp464)
+ ((lambda (tmp465)
+ (if tmp465
+ (apply (lambda (_466 e1467 e2468)
+ (chi-sequence145
+ (cons e1467 e2468)
+ r458
+ w459
+ s460
+ mod461))
+ tmp465)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp2825)))
+ tmp464)))
($sc-dispatch
- tmp2825
+ tmp464
'(any any . each-any))))
- 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)))
+ e457)
+ (if (memv type455 (quote (local-syntax-form)))
+ (chi-local-syntax157
+ value456
+ e457
+ r458
+ w459
+ s460
+ mod461
+ chi-sequence145)
+ (if (memv type455 (quote (eval-when-form)))
+ ((lambda (tmp470)
+ ((lambda (tmp471)
+ (if tmp471
+ (apply (lambda (_472
+ x473
+ e1474
+ e2475)
+ (let ((when-list476
+ (chi-when-list148
+ e457
+ x473
+ w459)))
(if (memq 'eval
- when-list2837)
- (chi-sequence2506
- (cons e12835
- e22836)
- r2819
- w2820
- s2821
- mod2822)
- (chi-void2520))))
- tmp2832)
+ when-list476)
+ (chi-sequence145
+ (cons e1474 e2475)
+ r458
+ w459
+ s460
+ mod461)
+ (chi-void159))))
+ tmp471)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp2831)))
+ tmp470)))
($sc-dispatch
- tmp2831
+ tmp470
'(any each-any any . each-any))))
- e2818)
- (if (memv type2816
+ e457)
+ (if (memv type455
'(define-form
define-syntax-form))
(syntax-violation
#f
"definition in expression context"
- e2818
- (wrap2504 value2817 w2820 mod2822))
- (if (memv type2816 (quote (syntax)))
+ e457
+ (wrap143 value456 w459 mod461))
+ (if (memv type455 (quote (syntax)))
(syntax-violation
#f
"reference to pattern variable outside syntax form"
- (source-wrap2505
- e2818
- w2820
- s2821
- mod2822))
- (if (memv type2816
+ (source-wrap144
+ e457
+ w459
+ s460
+ mod461))
+ (if (memv type455
'(displaced-lexical))
(syntax-violation
#f
"reference to identifier outside its scope"
- (source-wrap2505
- e2818
- w2820
- s2821
- mod2822))
+ (source-wrap144
+ e457
+ w459
+ s460
+ mod461))
(syntax-violation
#f
"unexpected syntax"
- (source-wrap2505
- e2818
- w2820
- s2821
- mod2822))))))))))))))))))
- (chi2512
- (lambda (e2840 r2841 w2842 mod2843)
+ (source-wrap144
+ e457
+ w459
+ s460
+ mod461))))))))))))))))))
+ (chi151
+ (lambda (e479 r480 w481 mod482)
(call-with-values
(lambda ()
- (syntax-type2510
- e2840
- r2841
- w2842
- (source-annotation2467 e2840)
+ (syntax-type149
+ e479
+ r480
+ w481
+ (source-annotation106 e479)
#f
- mod2843
+ mod482
#f))
- (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)
+ (lambda (type483 value484 e485 w486 s487 mod488)
+ (chi-expr152
+ type483
+ value484
+ e485
+ r480
+ w486
+ s487
+ mod488)))))
+ (chi-top150
+ (lambda (e489 r490 w491 m492 esew493 mod494)
(call-with-values
(lambda ()
- (syntax-type2510
- e2850
- r2851
- w2852
- (source-annotation2467 e2850)
+ (syntax-type149
+ e489
+ r490
+ w491
+ (source-annotation106 e489)
#f
- mod2855
+ mod494
#f))
- (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)
+ (lambda (type502 value503 e504 w505 s506 mod507)
+ (if (memv type502 (quote (begin-form)))
+ ((lambda (tmp508)
+ ((lambda (tmp509)
+ (if tmp509
+ (apply (lambda (_510) (chi-void159)) tmp509)
+ ((lambda (tmp511)
+ (if tmp511
+ (apply (lambda (_512 e1513 e2514)
+ (chi-top-sequence146
+ (cons e1513 e2514)
+ r490
+ w505
+ s506
+ m492
+ esew493
+ mod507))
+ tmp511)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp2869)))
+ tmp508)))
($sc-dispatch
- tmp2869
+ tmp508
'(any any . each-any)))))
- ($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))
+ ($sc-dispatch tmp508 (quote (any)))))
+ e504)
+ (if (memv type502 (quote (local-syntax-form)))
+ (chi-local-syntax157
+ value503
+ e504
+ r490
+ w505
+ s506
+ mod507
+ (lambda (body516 r517 w518 s519 mod520)
+ (chi-top-sequence146
+ body516
+ r517
+ w518
+ s519
+ m492
+ esew493
+ mod520)))
+ (if (memv type502 (quote (eval-when-form)))
+ ((lambda (tmp521)
+ ((lambda (tmp522)
+ (if tmp522
+ (apply (lambda (_523 x524 e1525 e2526)
+ (let ((when-list527
+ (chi-when-list148
+ e504
+ x524
+ w505))
+ (body528 (cons e1525 e2526)))
+ (if (eq? m492 (quote e))
(if (memq 'eval
- when-list2888)
- (chi-top-sequence2507
- body2889
- r2851
- w2866
- s2867
+ when-list527)
+ (chi-top-sequence146
+ body528
+ r490
+ w505
+ s506
'e
'(eval)
- mod2868)
- (chi-void2520))
+ mod507)
+ (chi-void159))
(if (memq 'load
- when-list2888)
- (if (let ((t2892 (memq 'compile
- when-list2888)))
- (if t2892
- t2892
- (if (eq? m2853
+ when-list527)
+ (if (let ((t531 (memq 'compile
+ when-list527)))
+ (if t531
+ t531
+ (if (eq? m492
'c&e)
(memq 'eval
- when-list2888)
+ when-list527)
#f)))
- (chi-top-sequence2507
- body2889
- r2851
- w2866
- s2867
+ (chi-top-sequence146
+ body528
+ r490
+ w505
+ s506
'c&e
'(compile load)
- mod2868)
- (if (memq m2853
+ mod507)
+ (if (memq m492
'(c c&e))
- (chi-top-sequence2507
- body2889
- r2851
- w2866
- s2867
+ (chi-top-sequence146
+ body528
+ r490
+ w505
+ s506
'c
'(load)
- mod2868)
- (chi-void2520)))
- (if (let ((t2893 (memq 'compile
- when-list2888)))
- (if t2893
- t2893
- (if (eq? m2853
+ mod507)
+ (chi-void159)))
+ (if (let ((t532 (memq 'compile
+ when-list527)))
+ (if t532
+ t532
+ (if (eq? m492
'c&e)
(memq 'eval
- when-list2888)
+ when-list527)
#f)))
(begin
- (top-level-eval-hook2437
- (chi-top-sequence2507
- body2889
- r2851
- w2866
- s2867
+ (top-level-eval-hook76
+ (chi-top-sequence146
+ body528
+ r490
+ w505
+ s506
'e
'(eval)
- mod2868)
- mod2868)
- (chi-void2520))
- (chi-void2520))))))
- tmp2883)
+ mod507)
+ mod507)
+ (chi-void159))
+ (chi-void159))))))
+ tmp522)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp2882)))
+ tmp521)))
($sc-dispatch
- tmp2882
+ tmp521
'(any each-any any . each-any))))
- 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))))
+ e504)
+ (if (memv type502 (quote (define-syntax-form)))
+ (let ((n533 (id-var-name137 value503 w505))
+ (r534 (macros-only-env111 r490)))
+ (if (memv m492 (quote (c)))
+ (if (memq (quote compile) esew493)
+ (let ((e535 (chi-install-global147
+ n533
+ (chi151
+ e504
+ r534
+ w505
+ mod507))))
(begin
- (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))))
+ (top-level-eval-hook76 e535 mod507)
+ (if (memq (quote load) esew493)
+ e535
+ (chi-void159))))
+ (if (memq (quote load) esew493)
+ (chi-install-global147
+ n533
+ (chi151 e504 r534 w505 mod507))
+ (chi-void159)))
+ (if (memv m492 (quote (c&e)))
+ (let ((e536 (chi-install-global147
+ n533
+ (chi151
+ e504
+ r534
+ w505
+ mod507))))
(begin
- (top-level-eval-hook2437 e2897 mod2868)
- e2897))
+ (top-level-eval-hook76 e536 mod507)
+ e536))
(begin
- (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
+ (if (memq (quote eval) esew493)
+ (top-level-eval-hook76
+ (chi-install-global147
+ n533
+ (chi151 e504 r534 w505 mod507))
+ mod507))
+ (chi-void159)))))
+ (if (memv type502 (quote (define-form)))
+ (let ((n537 (id-var-name137 value503 w505)))
+ (let ((type538
+ (binding-type107
+ (lookup112 n537 r490 mod507))))
+ (if (memv type538
'(global core macro module-ref))
(begin
(if (if (not (module-local-variable
(current-module)
- n2898))
+ n537))
(current-module)
#f)
(module-define!
(current-module)
- n2898
+ n537
#f))
- (let ((x2900 (build-global-definition2451
- s2867
- n2898
- (chi2512
- e2865
- r2851
- w2866
- mod2868))))
+ (let ((x539 (build-global-definition90
+ s506
+ n537
+ (chi151
+ e504
+ r490
+ w505
+ mod507))))
(begin
- (if (eq? m2853 (quote c&e))
- (top-level-eval-hook2437
- x2900
- mod2868))
- x2900)))
- (if (memv type2899
+ (if (eq? m492 (quote c&e))
+ (top-level-eval-hook76 x539 mod507))
+ x539)))
+ (if (memv type538
'(displaced-lexical))
(syntax-violation
#f
"identifier out of context"
- e2865
- (wrap2504 value2864 w2866 mod2868))
+ e504
+ (wrap143 value503 w505 mod507))
(syntax-violation
#f
"cannot define keyword at top level"
- e2865
- (wrap2504 value2864 w2866 mod2868))))))
- (let ((x2901 (chi-expr2513
- type2863
- value2864
- e2865
- r2851
- w2866
- s2867
- mod2868)))
+ e504
+ (wrap143 value503 w505 mod507))))))
+ (let ((x540 (chi-expr152
+ type502
+ value503
+ e504
+ r490
+ w505
+ s506
+ mod507)))
(begin
- (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)))
+ (if (eq? m492 (quote c&e))
+ (top-level-eval-hook76 x540 mod507))
+ x540)))))))))))
+ (syntax-type149
+ (lambda (e541 r542 w543 s544 rib545 mod546 for-car?547)
+ (if (symbol? e541)
+ (let ((n548 (id-var-name137 e541 w543)))
+ (let ((b549 (lookup112 n548 r542 mod546)))
+ (let ((type550 (binding-type107 b549)))
+ (if (memv type550 (quote (lexical)))
(values
- 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
+ type550
+ (binding-value108 b549)
+ e541
+ w543
+ s544
+ mod546)
+ (if (memv type550 (quote (global)))
+ (values type550 n548 e541 w543 s544 mod546)
+ (if (memv type550 (quote (macro)))
+ (if for-car?547
(values
- type2911
- (binding-value2469 b2910)
- e2902
- w2904
- s2905
- mod2907)
- (syntax-type2510
- (chi-macro2515
- (binding-value2469 b2910)
- e2902
- r2903
- w2904
- rib2906
- mod2907)
- r2903
+ type550
+ (binding-value108 b549)
+ e541
+ w543
+ s544
+ mod546)
+ (syntax-type149
+ (chi-macro154
+ (binding-value108 b549)
+ e541
+ r542
+ w543
+ rib545
+ mod546)
+ r542
'(())
- s2905
- rib2906
- mod2907
+ s544
+ rib545
+ mod546
#f))
(values
- type2911
- (binding-value2469 b2910)
- e2902
- w2904
- s2905
- mod2907)))))))
- (if (pair? e2902)
- (let ((first2912 (car e2902)))
+ type550
+ (binding-value108 b549)
+ e541
+ w543
+ s544
+ mod546)))))))
+ (if (pair? e541)
+ (let ((first551 (car e541)))
(call-with-values
(lambda ()
- (syntax-type2510
- first2912
- r2903
- w2904
- s2905
- rib2906
- mod2907
+ (syntax-type149
+ first551
+ r542
+ w543
+ s544
+ rib545
+ mod546
#t))
- (lambda (ftype2913
- fval2914
- fe2915
- fw2916
- fs2917
- fmod2918)
- (if (memv ftype2913 (quote (lexical)))
+ (lambda (ftype552 fval553 fe554 fw555 fs556 fmod557)
+ (if (memv ftype552 (quote (lexical)))
(values
'lexical-call
- fval2914
- e2902
- w2904
- s2905
- mod2907)
- (if (memv ftype2913 (quote (global)))
+ fval553
+ e541
+ w543
+ s544
+ mod546)
+ (if (memv ftype552 (quote (global)))
(values
'global-call
- (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
+ (make-syntax-object98 fval553 w543 fmod557)
+ e541
+ w543
+ s544
+ mod546)
+ (if (memv ftype552 (quote (macro)))
+ (syntax-type149
+ (chi-macro154
+ fval553
+ e541
+ r542
+ w543
+ rib545
+ mod546)
+ r542
'(())
- s2905
- rib2906
- mod2907
- for-car?2908)
- (if (memv ftype2913 (quote (module-ref)))
+ s544
+ rib545
+ mod546
+ for-car?547)
+ (if (memv ftype552 (quote (module-ref)))
(call-with-values
- (lambda () (fval2914 e2902))
- (lambda (sym2919 mod2920)
- (syntax-type2510
- sym2919
- r2903
- w2904
- s2905
- rib2906
- mod2920
- for-car?2908)))
- (if (memv ftype2913 (quote (core)))
+ (lambda () (fval553 e541))
+ (lambda (sym558 mod559)
+ (syntax-type149
+ sym558
+ r542
+ w543
+ s544
+ rib545
+ mod559
+ for-car?547)))
+ (if (memv ftype552 (quote (core)))
(values
'core-form
- fval2914
- e2902
- w2904
- s2905
- mod2907)
- (if (memv ftype2913 (quote (local-syntax)))
+ fval553
+ e541
+ w543
+ s544
+ mod546)
+ (if (memv ftype552 (quote (local-syntax)))
(values
'local-syntax-form
- fval2914
- e2902
- w2904
- s2905
- mod2907)
- (if (memv ftype2913 (quote (begin)))
+ fval553
+ e541
+ w543
+ s544
+ mod546)
+ (if (memv ftype552 (quote (begin)))
(values
'begin-form
#f
- e2902
- w2904
- s2905
- mod2907)
- (if (memv ftype2913 (quote (eval-when)))
+ e541
+ w543
+ s544
+ mod546)
+ (if (memv ftype552 (quote (eval-when)))
(values
'eval-when-form
#f
- 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)
+ e541
+ w543
+ s544
+ mod546)
+ (if (memv ftype552 (quote (define)))
+ ((lambda (tmp560)
+ ((lambda (tmp561)
+ (if (if tmp561
+ (apply (lambda (_562
+ name563
+ val564)
+ (id?115
+ name563))
+ tmp561)
#f)
- (apply (lambda (_2926
- name2927
- val2928)
+ (apply (lambda (_565
+ name566
+ val567)
(values
'define-form
- 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))
+ name566
+ val567
+ w543
+ s544
+ mod546))
+ tmp561)
+ ((lambda (tmp568)
+ (if (if tmp568
+ (apply (lambda (_569
+ name570
+ args571
+ e1572
+ e2573)
+ (if (id?115
+ name570)
+ (valid-bound-ids?140
+ (lambda-var-list163
+ args571))
#f))
- tmp2929)
+ tmp568)
#f)
- (apply (lambda (_2935
- name2936
- args2937
- e12938
- e22939)
+ (apply (lambda (_574
+ name575
+ args576
+ e1577
+ e2578)
(values
'define-form
- (wrap2504
- name2936
- w2904
- mod2907)
- (cons '#(syntax-object
- lambda
- ((top)
- #(ribcage
- #(_
- name
- args
- e1
- e2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("i"
- "i"
- "i"
- "i"
- "i"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(ftype
- fval
- fe
- fw
- fs
- fmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("i"
- "i"
- "i"
- "i"
- "i"
- "i"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(first)
- #((top))
- #("i"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(e
- r
- w
- s
- rib
- mod
- for-car?)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("i"
- "i"
- "i"
- "i"
- "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))
- (wrap2504
- (cons args2937
- (cons e12938
- e22939))
- w2904
- mod2907))
+ (wrap143
+ name575
+ w543
+ mod546)
+ (decorate-source80
+ (cons '#(syntax-object
+ lambda
+ ((top)
+ #(ribcage
+ #(_
+ name
+ args
+ e1
+ e2)
+ #((top)
+ (top)
+ (top)
+ (top)
+ (top))
+ #("i"
+ "i"
+ "i"
+ "i"
+ "i"))
+ #(ribcage
+ ()
+ ()
+ ())
+ #(ribcage
+ ()
+ ()
+ ())
+ #(ribcage
+ #(ftype
+ fval
+ fe
+ fw
+ fs
+ fmod)
+ #((top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top))
+ #("i"
+ "i"
+ "i"
+ "i"
+ "i"
+ "i"))
+ #(ribcage
+ ()
+ ()
+ ())
+ #(ribcage
+ #(first)
+ #((top))
+ #("i"))
+ #(ribcage
+ ()
+ ()
+ ())
+ #(ribcage
+ ()
+ ()
+ ())
+ #(ribcage
+ ()
+ ()
+ ())
+ #(ribcage
+ #(e
+ r
+ w
+ s
+ rib
+ mod
+ for-car?)
+ #((top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top))
+ #("i"
+ "i"
+ "i"
+ "i"
+ "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))
+ (wrap143
+ (cons args576
+ (cons e1577
+ e2578))
+ w543
+ mod546))
+ s544)
'(())
- s2905
- mod2907))
- tmp2929)
- ((lambda (tmp2941)
- (if (if tmp2941
- (apply (lambda (_2942
- name2943)
- (id?2476
- name2943))
- tmp2941)
+ s544
+ mod546))
+ tmp568)
+ ((lambda (tmp580)
+ (if (if tmp580
+ (apply (lambda (_581
+ name582)
+ (id?115
+ name582))
+ tmp580)
#f)
- (apply (lambda (_2944
- name2945)
+ (apply (lambda (_583
+ name584)
(values
'define-form
- (wrap2504
- name2945
- w2904
- mod2907)
+ (wrap143
+ name584
+ w543
+ mod546)
'(#(syntax-object
if
((top)
@@ -3343,102 +3294,466 @@
(hygiene
guile)))
'(())
- s2905
- mod2907))
- tmp2941)
+ s544
+ mod546))
+ tmp580)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp2921)))
+ tmp560)))
($sc-dispatch
- tmp2921
+ tmp560
'(any any)))))
($sc-dispatch
- tmp2921
+ tmp560
'(any (any . any)
any
.
each-any)))))
($sc-dispatch
- tmp2921
+ tmp560
'(any any any))))
- e2902)
- (if (memv ftype2913
+ e541)
+ (if (memv ftype552
'(define-syntax))
- ((lambda (tmp2946)
- ((lambda (tmp2947)
- (if (if tmp2947
- (apply (lambda (_2948
- name2949
- val2950)
- (id?2476
- name2949))
- tmp2947)
+ ((lambda (tmp585)
+ ((lambda (tmp586)
+ (if (if tmp586
+ (apply (lambda (_587
+ name588
+ val589)
+ (id?115
+ name588))
+ tmp586)
#f)
- (apply (lambda (_2951
- name2952
- val2953)
+ (apply (lambda (_590
+ name591
+ val592)
(values
'define-syntax-form
- name2952
- val2953
- w2904
- s2905
- mod2907))
- tmp2947)
+ name591
+ val592
+ w543
+ s544
+ mod546))
+ tmp586)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp2946)))
+ tmp585)))
($sc-dispatch
- tmp2946
+ tmp585
'(any any any))))
- e2902)
+ e541)
(values
'call
#f
- 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)
+ e541
+ w543
+ s544
+ mod546))))))))))))))
+ (if (syntax-object?99 e541)
+ (syntax-type149
+ (syntax-object-expression100 e541)
+ r542
+ (join-wraps134 w543 (syntax-object-wrap101 e541))
+ s544
+ rib545
+ (let ((t593 (syntax-object-module102 e541)))
+ (if t593 t593 mod546))
+ for-car?547)
+ (if (self-evaluating? e541)
(values
'constant
#f
- 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
+ e541
+ w543
+ s544
+ mod546)
+ (values (quote other) #f e541 w543 s544 mod546)))))))
+ (chi-when-list148
+ (lambda (e594 when-list595 w596)
+ (letrec ((f597 (lambda (when-list598 situations599)
+ (if (null? when-list598)
+ situations599
+ (f597 (cdr when-list598)
+ (cons (let ((x600 (car when-list598)))
+ (if (free-id=?138
+ x600
+ '#(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
+ 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)))
+ 'compile
+ (if (free-id=?138
+ x600
'#(syntax-object
- compile
+ load
((top)
#(ribcage () () ())
#(ribcage () () ())
@@ -3806,11 +4121,11 @@
((top) (top))
("i" "i")))
(hygiene guile)))
- 'compile
- (if (free-id=?2499
- x2961
+ 'load
+ (if (free-id=?138
+ x600
'#(syntax-object
- load
+ eval
((top)
#(ribcage
()
@@ -4195,2077 +4510,1604 @@
((top) (top))
("i" "i")))
(hygiene guile)))
- '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
+ 'eval
+ (syntax-violation
+ 'eval-when
+ "invalid situation"
+ e594
+ (wrap143
+ x600
+ w596
+ #f))))))
+ situations599))))))
+ (f597 when-list595 (quote ())))))
+ (chi-install-global147
+ (lambda (name601 e602)
+ (build-global-definition90
#f
- 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))
+ name601
+ (if (let ((v603 (module-variable (current-module) name601)))
+ (if v603
+ (if (variable-bound? v603)
+ (if (macro? (variable-ref v603))
+ (not (eq? (macro-type (variable-ref v603))
'syncase-macro))
#f)
#f)
#f))
- (build-application2443
+ (build-application82
#f
- (build-primref2453
+ (build-primref92
#f
'make-extended-syncase-macro)
- (list (build-application2443
+ (list (build-application82
#f
- (build-primref2453 #f (quote module-ref))
- (list (build-application2443
+ (build-primref92 #f (quote module-ref))
+ (list (build-application82
#f
- (build-primref2453
+ (build-primref92
#f
'current-module)
'())
- (build-data2454 #f name2962)))
- (build-data2454 #f (quote macro))
- e2963))
- (build-application2443
+ (build-data93 #f name601)))
+ (build-data93 #f (quote macro))
+ e602))
+ (build-application82
#f
- (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)
+ (build-primref92 #f (quote make-syncase-macro))
+ (list (build-data93 #f (quote macro)) e602))))))
+ (chi-top-sequence146
+ (lambda (body604 r605 w606 s607 m608 esew609 mod610)
+ (build-sequence94
+ s607
+ (letrec ((dobody611
+ (lambda (body612 r613 w614 m615 esew616 mod617)
+ (if (null? body612)
'()
- (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 ((first618
+ (chi-top150
+ (car body612)
+ r613
+ w614
+ m615
+ esew616
+ mod617)))
+ (cons first618
+ (dobody611
+ (cdr body612)
+ r613
+ w614
+ m615
+ esew616
+ mod617)))))))
+ (dobody611 body604 r605 w606 m608 esew609 mod610)))))
+ (chi-sequence145
+ (lambda (body619 r620 w621 s622 mod623)
+ (build-sequence94
+ s622
+ (letrec ((dobody624
+ (lambda (body625 r626 w627 mod628)
+ (if (null? body625)
'()
- (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 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))
+ (let ((first629
+ (chi151
+ (car body625)
+ r626
+ w627
+ mod628)))
+ (cons first629
+ (dobody624
+ (cdr body625)
+ r626
+ w627
+ mod628)))))))
+ (dobody624 body619 r620 w621 mod623)))))
+ (source-wrap144
+ (lambda (x630 w631 s632 defmod633)
+ (wrap143
+ (decorate-source80 x630 s632)
+ w631
+ defmod633)))
+ (wrap143
+ (lambda (x634 w635 defmod636)
+ (if (if (null? (wrap-marks118 w635))
+ (null? (wrap-subst119 w635))
#f)
- 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))))
+ x634
+ (if (syntax-object?99 x634)
+ (make-syntax-object98
+ (syntax-object-expression100 x634)
+ (join-wraps134 w635 (syntax-object-wrap101 x634))
+ (syntax-object-module102 x634))
+ (if (null? x634)
+ x634
+ (make-syntax-object98 x634 w635 defmod636))))))
+ (bound-id-member?142
+ (lambda (x637 list638)
+ (if (not (null? list638))
+ (let ((t639 (bound-id=?139 x637 (car list638))))
+ (if t639
+ t639
+ (bound-id-member?142 x637 (cdr list638))))
#f)))
- (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))
+ (distinct-bound-ids?141
+ (lambda (ids640)
+ (letrec ((distinct?641
+ (lambda (ids642)
+ (let ((t643 (null? ids642)))
+ (if t643
+ t643
+ (if (not (bound-id-member?142
+ (car ids642)
+ (cdr ids642)))
+ (distinct?641 (cdr ids642))
#f))))))
- (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))
+ (distinct?641 ids640))))
+ (valid-bound-ids?140
+ (lambda (ids644)
+ (if (letrec ((all-ids?645
+ (lambda (ids646)
+ (let ((t647 (null? ids646)))
+ (if t647
+ t647
+ (if (id?115 (car ids646))
+ (all-ids?645 (cdr ids646))
#f))))))
- (all-ids?3006 ids3005))
- (distinct-bound-ids?2502 ids3005)
+ (all-ids?645 ids644))
+ (distinct-bound-ids?141 ids644)
#f)))
- (bound-id=?2500
- (lambda (i3009 j3010)
- (if (if (syntax-object?2460 i3009)
- (syntax-object?2460 j3010)
+ (bound-id=?139
+ (lambda (i648 j649)
+ (if (if (syntax-object?99 i648)
+ (syntax-object?99 j649)
#f)
- (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)))
+ (if (eq? (syntax-object-expression100 i648)
+ (syntax-object-expression100 j649))
+ (same-marks?136
+ (wrap-marks118 (syntax-object-wrap101 i648))
+ (wrap-marks118 (syntax-object-wrap101 j649)))
#f)
- (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 (()))))
+ (eq? i648 j649))))
+ (free-id=?138
+ (lambda (i650 j651)
+ (if (eq? (let ((x652 i650))
+ (if (syntax-object?99 x652)
+ (syntax-object-expression100 x652)
+ x652))
+ (let ((x653 j651))
+ (if (syntax-object?99 x653)
+ (syntax-object-expression100 x653)
+ x653)))
+ (eq? (id-var-name137 i650 (quote (())))
+ (id-var-name137 j651 (quote (()))))
#f)))
- (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))))
+ (id-var-name137
+ (lambda (id654 w655)
+ (letrec ((search-vector-rib658
+ (lambda (sym664
+ subst665
+ marks666
+ symnames667
+ ribcage668)
+ (let ((n669 (vector-length symnames667)))
+ (letrec ((f670 (lambda (i671)
+ (if (fx=74 i671 n669)
+ (search656
+ sym664
+ (cdr subst665)
+ marks666)
+ (if (if (eq? (vector-ref
+ symnames667
+ i671)
+ sym664)
+ (same-marks?136
+ marks666
+ (vector-ref
+ (ribcage-marks125
+ ribcage668)
+ i671))
+ #f)
+ (values
+ (vector-ref
+ (ribcage-labels126
+ ribcage668)
+ i671)
+ marks666)
+ (f670 (fx+72 i671 1)))))))
+ (f670 0)))))
+ (search-list-rib657
+ (lambda (sym672
+ subst673
+ marks674
+ symnames675
+ ribcage676)
+ (letrec ((f677 (lambda (symnames678 i679)
+ (if (null? symnames678)
+ (search656
+ sym672
+ (cdr subst673)
+ marks674)
+ (if (if (eq? (car symnames678)
+ sym672)
+ (same-marks?136
+ marks674
+ (list-ref
+ (ribcage-marks125
+ ribcage676)
+ i679))
+ #f)
+ (values
+ (list-ref
+ (ribcage-labels126
+ ribcage676)
+ i679)
+ marks674)
+ (f677 (cdr symnames678)
+ (fx+72 i679 1)))))))
+ (f677 symnames675 0))))
+ (search656
+ (lambda (sym680 subst681 marks682)
+ (if (null? subst681)
+ (values #f marks682)
+ (let ((fst683 (car subst681)))
+ (if (eq? fst683 (quote shift))
+ (search656
+ sym680
+ (cdr subst681)
+ (cdr marks682))
+ (let ((symnames684
+ (ribcage-symnames124 fst683)))
+ (if (vector? symnames684)
+ (search-vector-rib658
+ sym680
+ subst681
+ marks682
+ symnames684
+ fst683)
+ (search-list-rib657
+ sym680
+ subst681
+ marks682
+ symnames684
+ fst683)))))))))
+ (if (symbol? id654)
+ (let ((t685 (call-with-values
+ (lambda ()
+ (search656
+ id654
+ (wrap-subst119 w655)
+ (wrap-marks118 w655)))
+ (lambda (x687 . ignore686) x687))))
+ (if t685 t685 id654))
+ (if (syntax-object?99 id654)
+ (let ((id688 (syntax-object-expression100 id654))
+ (w1689 (syntax-object-wrap101 id654)))
+ (let ((marks690
+ (join-marks135
+ (wrap-marks118 w655)
+ (wrap-marks118 w1689))))
(call-with-values
(lambda ()
- (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))))))))
+ (search656 id688 (wrap-subst119 w655) marks690))
+ (lambda (new-id691 marks692)
+ (let ((t693 new-id691))
+ (if t693
+ t693
+ (let ((t694 (call-with-values
+ (lambda ()
+ (search656
+ id688
+ (wrap-subst119 w1689)
+ marks692))
+ (lambda (x696 . ignore695)
+ x696))))
+ (if t694 t694 id688))))))))
(syntax-violation
'id-var-name
"invalid id"
- 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))
+ id654))))))
+ (same-marks?136
+ (lambda (x697 y698)
+ (let ((t699 (eq? x697 y698)))
+ (if t699
+ t699
+ (if (not (null? x697))
+ (if (not (null? y698))
+ (if (eq? (car x697) (car y698))
+ (same-marks?136 (cdr x697) (cdr y698))
#f)
#f)
#f)))))
- (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)))
+ (join-marks135
+ (lambda (m1700 m2701)
+ (smart-append133 m1700 m2701)))
+ (join-wraps134
+ (lambda (w1702 w2703)
+ (let ((m1704 (wrap-marks118 w1702))
+ (s1705 (wrap-subst119 w1702)))
+ (if (null? m1704)
+ (if (null? s1705)
+ w2703
+ (make-wrap117
+ (wrap-marks118 w2703)
+ (smart-append133 s1705 (wrap-subst119 w2703))))
+ (make-wrap117
+ (smart-append133 m1704 (wrap-marks118 w2703))
+ (smart-append133 s1705 (wrap-subst119 w2703)))))))
+ (smart-append133
+ (lambda (m1706 m2707)
+ (if (null? m2707) m1706 (append m1706 m2707))))
+ (make-binding-wrap132
+ (lambda (ids708 labels709 w710)
+ (if (null? ids708)
+ w710
+ (make-wrap117
+ (wrap-marks118 w710)
+ (cons (let ((labelvec711 (list->vector labels709)))
+ (let ((n712 (vector-length labelvec711)))
+ (let ((symnamevec713 (make-vector n712))
+ (marksvec714 (make-vector n712)))
(begin
- (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)
+ (letrec ((f715 (lambda (ids716 i717)
+ (if (not (null? ids716))
+ (call-with-values
+ (lambda ()
+ (id-sym-name&marks116
+ (car ids716)
+ w710))
+ (lambda (symname718
+ marks719)
+ (begin
+ (vector-set!
+ symnamevec713
+ i717
+ symname718)
+ (vector-set!
+ marksvec714
+ i717
+ marks719)
+ (f715 (cdr ids716)
+ (fx+72 i717
+ 1)))))))))
+ (f715 ids708 0))
+ (make-ribcage122
+ symnamevec713
+ marksvec714
+ labelvec711)))))
+ (wrap-subst119 w710))))))
+ (extend-ribcage!131
+ (lambda (ribcage720 id721 label722)
(begin
- (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))
+ (set-ribcage-symnames!127
+ ribcage720
+ (cons (syntax-object-expression100 id721)
+ (ribcage-symnames124 ribcage720)))
+ (set-ribcage-marks!128
+ ribcage720
+ (cons (wrap-marks118 (syntax-object-wrap101 id721))
+ (ribcage-marks125 ribcage720)))
+ (set-ribcage-labels!129
+ ribcage720
+ (cons label722 (ribcage-labels126 ribcage720))))))
+ (anti-mark130
+ (lambda (w723)
+ (make-wrap117
+ (cons #f (wrap-marks118 w723))
+ (cons (quote shift) (wrap-subst119 w723)))))
+ (set-ribcage-labels!129
+ (lambda (x724 update725)
+ (vector-set! x724 3 update725)))
+ (set-ribcage-marks!128
+ (lambda (x726 update727)
+ (vector-set! x726 2 update727)))
+ (set-ribcage-symnames!127
+ (lambda (x728 update729)
+ (vector-set! x728 1 update729)))
+ (ribcage-labels126
+ (lambda (x730) (vector-ref x730 3)))
+ (ribcage-marks125
+ (lambda (x731) (vector-ref x731 2)))
+ (ribcage-symnames124
+ (lambda (x732) (vector-ref x732 1)))
+ (ribcage?123
+ (lambda (x733)
+ (if (vector? x733)
+ (if (= (vector-length x733) 4)
+ (eq? (vector-ref x733 0) (quote ribcage))
#f)
#f)))
- (make-ribcage2483
- (lambda (symnames3095 marks3096 labels3097)
+ (make-ribcage122
+ (lambda (symnames734 marks735 labels736)
(vector
'ribcage
- symnames3095
- marks3096
- labels3097)))
- (gen-labels2482
- (lambda (ls3098)
- (if (null? ls3098)
+ symnames734
+ marks735
+ labels736)))
+ (gen-labels121
+ (lambda (ls737)
+ (if (null? ls737)
'()
- (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)
+ (cons (gen-label120) (gen-labels121 (cdr ls737))))))
+ (gen-label120 (lambda () (string #\i)))
+ (wrap-subst119 cdr)
+ (wrap-marks118 car)
+ (make-wrap117 cons)
+ (id-sym-name&marks116
+ (lambda (x738 w739)
+ (if (syntax-object?99 x738)
(values
- (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)
+ (syntax-object-expression100 x738)
+ (join-marks135
+ (wrap-marks118 w739)
+ (wrap-marks118 (syntax-object-wrap101 x738))))
+ (values x738 (wrap-marks118 w739)))))
+ (id?115
+ (lambda (x740)
+ (if (symbol? x740)
#t
- (if (syntax-object?2460 x3101)
- (symbol? (syntax-object-expression2461 x3101))
+ (if (syntax-object?99 x740)
+ (symbol? (syntax-object-expression100 x740))
#f))))
- (nonsymbol-id?2475
- (lambda (x3102)
- (if (syntax-object?2460 x3102)
- (symbol? (syntax-object-expression2461 x3102))
+ (nonsymbol-id?114
+ (lambda (x741)
+ (if (syntax-object?99 x741)
+ (symbol? (syntax-object-expression100 x741))
#f)))
- (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))))
+ (global-extend113
+ (lambda (type742 sym743 val744)
+ (put-global-definition-hook78
+ sym743
+ type742
+ val744)))
+ (lookup112
+ (lambda (x745 r746 mod747)
+ (let ((t748 (assq x745 r746)))
+ (if t748
+ (cdr t748)
+ (if (symbol? x745)
+ (let ((t749 (get-global-definition-hook79 x745 mod747)))
+ (if t749 t749 (quote (global))))
'(displaced-lexical))))))
- (macros-only-env2472
- (lambda (r3111)
- (if (null? r3111)
+ (macros-only-env111
+ (lambda (r750)
+ (if (null? r750)
'()
- (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))
+ (let ((a751 (car r750)))
+ (if (eq? (cadr a751) (quote macro))
+ (cons a751 (macros-only-env111 (cdr r750)))
+ (macros-only-env111 (cdr r750)))))))
+ (extend-var-env110
+ (lambda (labels752 vars753 r754)
+ (if (null? labels752)
+ r754
+ (extend-var-env110
+ (cdr labels752)
+ (cdr vars753)
+ (cons (cons (car labels752)
+ (cons (quote lexical) (car vars753)))
+ r754)))))
+ (extend-env109
+ (lambda (labels755 bindings756 r757)
+ (if (null? labels755)
+ r757
+ (extend-env109
+ (cdr labels755)
+ (cdr bindings756)
+ (cons (cons (car labels755) (car bindings756))
+ r757)))))
+ (binding-value108 cdr)
+ (binding-type107 car)
+ (source-annotation106
+ (lambda (x758)
+ (if (syntax-object?99 x758)
+ (source-annotation106
+ (syntax-object-expression100 x758))
+ (if (pair? x758)
+ (let ((props759 (source-properties x758)))
+ (if (pair? props759) props759 #f))
#f))))
- (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))
+ (set-syntax-object-module!105
+ (lambda (x760 update761)
+ (vector-set! x760 3 update761)))
+ (set-syntax-object-wrap!104
+ (lambda (x762 update763)
+ (vector-set! x762 2 update763)))
+ (set-syntax-object-expression!103
+ (lambda (x764 update765)
+ (vector-set! x764 1 update765)))
+ (syntax-object-module102
+ (lambda (x766) (vector-ref x766 3)))
+ (syntax-object-wrap101
+ (lambda (x767) (vector-ref x767 2)))
+ (syntax-object-expression100
+ (lambda (x768) (vector-ref x768 1)))
+ (syntax-object?99
+ (lambda (x769)
+ (if (vector? x769)
+ (if (= (vector-length x769) 4)
+ (eq? (vector-ref x769 0) (quote syntax-object))
#f)
#f)))
- (make-syntax-object2459
- (lambda (expression3131 wrap3132 module3133)
+ (make-syntax-object98
+ (lambda (expression770 wrap771 module772)
(vector
'syntax-object
- 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)))
+ expression770
+ wrap771
+ module772)))
+ (build-letrec97
+ (lambda (src773 ids774 vars775 val-exps776 body-exp777)
+ (if (null? vars775)
+ body-exp777
+ (let ((atom-key778 (fluid-ref *mode*71)))
+ (if (memv atom-key778 (quote (c)))
(begin
- (for-each
- maybe-name-value!2450
- ids3135
- val-exps3137)
+ (for-each maybe-name-value!89 ids774 val-exps776)
((@ (language tree-il) make-letrec)
- src3134
- ids3135
- vars3136
- val-exps3137
- body-exp3138))
- (decorate-source2441
+ src773
+ ids774
+ vars775
+ val-exps776
+ body-exp777))
+ (decorate-source80
(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
+ (map list vars775 val-exps776)
+ body-exp777)
+ src773))))))
+ (build-named-let96
+ (lambda (src779 ids780 vars781 val-exps782 body-exp783)
+ (let ((f784 (car vars781))
+ (f-name785 (car ids780))
+ (vars786 (cdr vars781))
+ (ids787 (cdr ids780)))
+ (let ((atom-key788 (fluid-ref *mode*71)))
+ (if (memv atom-key788 (quote (c)))
+ (let ((proc789
+ (build-lambda91
+ src779
+ ids787
+ vars786
#f
- body-exp3144)))
+ body-exp783)))
(begin
- (maybe-name-value!2450 f-name3146 proc3150)
- (for-each
- maybe-name-value!2450
- ids3148
- val-exps3143)
+ (maybe-name-value!89 f-name785 proc789)
+ (for-each maybe-name-value!89 ids787 val-exps782)
((@ (language tree-il) make-letrec)
- src3140
- (list f-name3146)
- (list f3145)
- (list proc3150)
- (build-application2443
- src3140
- (build-lexical-reference2445
+ src779
+ (list f-name785)
+ (list f784)
+ (list proc789)
+ (build-application82
+ src779
+ (build-lexical-reference84
'fun
- src3140
- f-name3146
- f3145)
- val-exps3143))))
- (decorate-source2441
+ src779
+ f-name785
+ f784)
+ val-exps782))))
+ (decorate-source80
(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)))
+ f784
+ (map list vars786 val-exps782)
+ body-exp783)
+ src779))))))
+ (build-let95
+ (lambda (src790 ids791 vars792 val-exps793 body-exp794)
+ (if (null? vars792)
+ body-exp794
+ (let ((atom-key795 (fluid-ref *mode*71)))
+ (if (memv atom-key795 (quote (c)))
(begin
- (for-each
- maybe-name-value!2450
- ids3152
- val-exps3154)
+ (for-each maybe-name-value!89 ids791 val-exps793)
((@ (language tree-il) make-let)
- src3151
- ids3152
- vars3153
- val-exps3154
- body-exp3155))
- (decorate-source2441
+ src790
+ ids791
+ vars792
+ val-exps793
+ body-exp794))
+ (decorate-source80
(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)))
+ (map list vars792 val-exps793)
+ body-exp794)
+ src790))))))
+ (build-sequence94
+ (lambda (src796 exps797)
+ (if (null? (cdr exps797))
+ (car exps797)
+ (let ((atom-key798 (fluid-ref *mode*71)))
+ (if (memv atom-key798 (quote (c)))
((@ (language tree-il) make-sequence)
- 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))
+ src796
+ exps797)
+ (decorate-source80
+ (cons (quote begin) exps797)
+ src796))))))
+ (build-data93
+ (lambda (src799 exp800)
+ (let ((atom-key801 (fluid-ref *mode*71)))
+ (if (memv atom-key801 (quote (c)))
+ ((@ (language tree-il) make-const) src799 exp800)
+ (decorate-source80
+ (if (if (self-evaluating? exp800)
+ (not (vector? exp800))
#f)
- exp3161
- (list (quote quote) exp3161))
- src3160)))))
- (build-primref2453
- (lambda (src3163 name3164)
+ exp800
+ (list (quote quote) exp800))
+ src799)))))
+ (build-primref92
+ (lambda (src802 name803)
(if (equal?
(module-name (current-module))
'(guile))
- (let ((atom-key3165 (fluid-ref *mode*2432)))
- (if (memv atom-key3165 (quote (c)))
+ (let ((atom-key804 (fluid-ref *mode*71)))
+ (if (memv atom-key804 (quote (c)))
((@ (language tree-il) make-toplevel-ref)
- src3163
- name3164)
- (decorate-source2441 name3164 src3163)))
- (let ((atom-key3166 (fluid-ref *mode*2432)))
- (if (memv atom-key3166 (quote (c)))
+ src802
+ name803)
+ (decorate-source80 name803 src802)))
+ (let ((atom-key805 (fluid-ref *mode*71)))
+ (if (memv atom-key805 (quote (c)))
((@ (language tree-il) make-module-ref)
- src3163
+ src802
'(guile)
- name3164
+ name803
#f)
- (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)))
+ (decorate-source80
+ (list (quote @@) (quote (guile)) name803)
+ src802))))))
+ (build-lambda91
+ (lambda (src806 ids807 vars808 docstring809 exp810)
+ (let ((atom-key811 (fluid-ref *mode*71)))
+ (if (memv atom-key811 (quote (c)))
((@ (language tree-il) make-lambda)
- src3167
- ids3168
- vars3169
- (if docstring3170
- (list (cons (quote documentation) docstring3170))
+ src806
+ ids807
+ vars808
+ (if docstring809
+ (list (cons (quote documentation) docstring809))
'())
- exp3171)
- (decorate-source2441
+ exp810)
+ (decorate-source80
(cons 'lambda
- (cons vars3169
+ (cons vars808
(append
- (if docstring3170
- (list docstring3170)
+ (if docstring809
+ (list docstring809)
'())
- (list exp3171))))
- src3167)))))
- (build-global-definition2451
- (lambda (source3173 var3174 exp3175)
- (let ((atom-key3176 (fluid-ref *mode*2432)))
- (if (memv atom-key3176 (quote (c)))
+ (list exp810))))
+ src806)))))
+ (build-global-definition90
+ (lambda (source812 var813 exp814)
+ (let ((atom-key815 (fluid-ref *mode*71)))
+ (if (memv atom-key815 (quote (c)))
(begin
- (maybe-name-value!2450 var3174 exp3175)
+ (maybe-name-value!89 var813 exp814)
((@ (language tree-il) make-toplevel-define)
- 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))
+ source812
+ var813
+ exp814))
+ (decorate-source80
+ (list (quote define) var813 exp814)
+ source812)))))
+ (maybe-name-value!89
+ (lambda (name816 val817)
+ (if ((@ (language tree-il) lambda?) val817)
+ (let ((meta818
+ ((@ (language tree-il) lambda-meta) val817)))
+ (if (not (assq (quote name) meta818))
((setter (@ (language tree-il) lambda-meta))
- 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)))
+ val817
+ (acons (quote name) name816 meta818)))))))
+ (build-global-assignment88
+ (lambda (source819 var820 exp821 mod822)
+ (analyze-variable86
+ mod822
+ var820
+ (lambda (mod823 var824 public?825)
+ (let ((atom-key826 (fluid-ref *mode*71)))
+ (if (memv atom-key826 (quote (c)))
((@ (language tree-il) make-module-set)
- source3180
- mod3184
- var3185
- public?3186
- exp3182)
- (decorate-source2441
+ source819
+ mod823
+ var824
+ public?825
+ exp821)
+ (decorate-source80
(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)))
+ (list (if public?825 (quote @) (quote @@))
+ mod823
+ var824)
+ exp821)
+ source819))))
+ (lambda (var827)
+ (let ((atom-key828 (fluid-ref *mode*71)))
+ (if (memv atom-key828 (quote (c)))
((@ (language tree-il) make-toplevel-set)
- 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)))
+ source819
+ var827
+ exp821)
+ (decorate-source80
+ (list (quote set!) var827 exp821)
+ source819)))))))
+ (build-global-reference87
+ (lambda (source829 var830 mod831)
+ (analyze-variable86
+ mod831
+ var830
+ (lambda (mod832 var833 public?834)
+ (let ((atom-key835 (fluid-ref *mode*71)))
+ (if (memv atom-key835 (quote (c)))
((@ (language tree-il) make-module-ref)
- 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)))
+ source829
+ mod832
+ var833
+ public?834)
+ (decorate-source80
+ (list (if public?834 (quote @) (quote @@))
+ mod832
+ var833)
+ source829))))
+ (lambda (var836)
+ (let ((atom-key837 (fluid-ref *mode*71)))
+ (if (memv atom-key837 (quote (c)))
((@ (language tree-il) make-toplevel-ref)
- 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)))
+ source829
+ var836)
+ (decorate-source80 var836 source829)))))))
+ (analyze-variable86
+ (lambda (mod838 var839 modref-cont840 bare-cont841)
+ (if (not mod838)
+ (bare-cont841 var839)
+ (let ((kind842 (car mod838)) (mod843 (cdr mod838)))
+ (if (memv kind842 (quote (public)))
+ (modref-cont840 mod843 var839 #t)
+ (if (memv kind842 (quote (private)))
+ (if (not (equal? mod843 (module-name (current-module))))
+ (modref-cont840 mod843 var839 #f)
+ (bare-cont841 var839))
+ (if (memv kind842 (quote (bare)))
+ (bare-cont841 var839)
+ (if (memv kind842 (quote (hygiene)))
(if (if (not (equal?
- mod3204
+ mod843
(module-name (current-module))))
(module-variable
- (resolve-module mod3204)
- var3200)
+ (resolve-module mod843)
+ var839)
#f)
- (modref-cont3201 mod3204 var3200 #f)
- (bare-cont3202 var3200))
+ (modref-cont840 mod843 var839 #f)
+ (bare-cont841 var839))
(syntax-violation
#f
"bad module kind"
- var3200
- mod3204)))))))))
- (build-lexical-assignment2446
- (lambda (source3205 name3206 var3207 exp3208)
- (let ((atom-key3209 (fluid-ref *mode*2432)))
- (if (memv atom-key3209 (quote (c)))
+ var839
+ mod843)))))))))
+ (build-lexical-assignment85
+ (lambda (source844 name845 var846 exp847)
+ (let ((atom-key848 (fluid-ref *mode*71)))
+ (if (memv atom-key848 (quote (c)))
((@ (language tree-il) make-lexical-set)
- 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)))
+ source844
+ name845
+ var846
+ exp847)
+ (decorate-source80
+ (list (quote set!) var846 exp847)
+ source844)))))
+ (build-lexical-reference84
+ (lambda (type849 source850 name851 var852)
+ (let ((atom-key853 (fluid-ref *mode*71)))
+ (if (memv atom-key853 (quote (c)))
((@ (language tree-il) make-lexical-ref)
- 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)))
+ source850
+ name851
+ var852)
+ (decorate-source80 var852 source850)))))
+ (build-conditional83
+ (lambda (source854 test-exp855 then-exp856 else-exp857)
+ (let ((atom-key858 (fluid-ref *mode*71)))
+ (if (memv atom-key858 (quote (c)))
((@ (language tree-il) make-conditional)
- source3215
- test-exp3216
- then-exp3217
- else-exp3218)
- (decorate-source2441
- (if (equal? else-exp3218 (quote (if #f #f)))
- (list (quote if) test-exp3216 then-exp3217)
+ source854
+ test-exp855
+ then-exp856
+ else-exp857)
+ (decorate-source80
+ (if (equal? else-exp857 (quote (if #f #f)))
+ (list (quote if) test-exp855 then-exp856)
(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)))
+ test-exp855
+ then-exp856
+ else-exp857))
+ source854)))))
+ (build-application82
+ (lambda (source859 fun-exp860 arg-exps861)
+ (let ((atom-key862 (fluid-ref *mode*71)))
+ (if (memv atom-key862 (quote (c)))
((@ (language tree-il) make-application)
- 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)
+ source859
+ fun-exp860
+ arg-exps861)
+ (decorate-source80
+ (cons fun-exp860 arg-exps861)
+ source859)))))
+ (build-void81
+ (lambda (source863)
+ (let ((atom-key864 (fluid-ref *mode*71)))
+ (if (memv atom-key864 (quote (c)))
+ ((@ (language tree-il) make-void) source863)
+ (decorate-source80 (quote (if #f #f)) source863)))))
+ (decorate-source80
+ (lambda (e865 s866)
(begin
- (if (if (pair? e3226) s3227 #f)
- (set-source-properties! e3226 s3227))
- e3226)))
- (get-global-definition-hook2440
- (lambda (symbol3228 module3229)
+ (if (if (pair? e865) s866 #f)
+ (set-source-properties! e865 s866))
+ e865)))
+ (get-global-definition-hook79
+ (lambda (symbol867 module868)
(begin
- (if (if (not module3229) (current-module) #f)
+ (if (if (not module868) (current-module) #f)
(warn "module system is booted, we should have a module"
- 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))
+ symbol867))
+ (let ((v869 (module-variable
+ (if module868
+ (resolve-module (cdr module868))
+ (current-module))
+ symbol867)))
+ (if v869
+ (if (variable-bound? v869)
+ (let ((val870 (variable-ref v869)))
+ (if (macro? val870)
+ (if (syncase-macro-type val870)
+ (cons (syncase-macro-type val870)
+ (syncase-macro-binding val870))
#f)
#f))
#f)
#f)))))
- (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
+ (put-global-definition-hook78
+ (lambda (symbol871 type872 val873)
+ (let ((existing874
+ (let ((v875 (module-variable
+ (current-module)
+ symbol871)))
+ (if v875
+ (if (variable-bound? v875)
+ (let ((val876 (variable-ref v875)))
+ (if (macro? val876)
+ (if (not (syncase-macro-type val876))
+ val876
#f)
#f))
#f)
#f))))
(module-define!
(current-module)
- symbol3232
- (if existing3235
+ symbol871
+ (if existing874
(make-extended-syncase-macro
- existing3235
- type3233
- val3234)
- (make-syncase-macro type3233 val3234))))))
- (local-eval-hook2438
- (lambda (x3238 mod3239)
+ existing874
+ type872
+ val873)
+ (make-syncase-macro type872 val873))))))
+ (local-eval-hook77
+ (lambda (x877 mod878)
(primitive-eval
- (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)
+ (list noexpand70
+ (let ((atom-key879 (fluid-ref *mode*71)))
+ (if (memv atom-key879 (quote (c)))
+ ((@ (language tree-il) tree-il->scheme) x877)
+ x877))))))
+ (top-level-eval-hook76
+ (lambda (x880 mod881)
(primitive-eval
- (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"))
+ (list noexpand70
+ (let ((atom-key882 (fluid-ref *mode*71)))
+ (if (memv atom-key882 (quote (c)))
+ ((@ (language tree-il) tree-il->scheme) x880)
+ x880))))))
+ (fx<75 <)
+ (fx=74 =)
+ (fx-73 -)
+ (fx+72 +)
+ (*mode*71 (make-fluid))
+ (noexpand70 "noexpand"))
(begin
- (global-extend2474
+ (global-extend113
'local-syntax
'letrec-syntax
#t)
- (global-extend2474
+ (global-extend113
'local-syntax
'let-syntax
#f)
- (global-extend2474
+ (global-extend113
'core
'fluid-let-syntax
- (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)
+ (lambda (e883 r884 w885 s886 mod887)
+ ((lambda (tmp888)
+ ((lambda (tmp889)
+ (if (if tmp889
+ (apply (lambda (_890 var891 val892 e1893 e2894)
+ (valid-bound-ids?140 var891))
+ tmp889)
#f)
- (apply (lambda (_3257 var3258 val3259 e13260 e23261)
- (let ((names3262
- (map (lambda (x3263)
- (id-var-name2498 x3263 w3246))
- var3258)))
+ (apply (lambda (_896 var897 val898 e1899 e2900)
+ (let ((names901
+ (map (lambda (x902)
+ (id-var-name137 x902 w885))
+ var897)))
(begin
(for-each
- (lambda (id3265 n3266)
- (let ((atom-key3267
- (binding-type2468
- (lookup2473
- n3266
- r3245
- mod3248))))
- (if (memv atom-key3267
+ (lambda (id904 n905)
+ (let ((atom-key906
+ (binding-type107
+ (lookup112 n905 r884 mod887))))
+ (if (memv atom-key906
'(displaced-lexical))
(syntax-violation
'fluid-let-syntax
"identifier out of context"
- 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)
+ e883
+ (source-wrap144
+ id904
+ w885
+ s886
+ mod887)))))
+ var897
+ names901)
+ (chi-body155
+ (cons e1899 e2900)
+ (source-wrap144 e883 w885 s886 mod887)
+ (extend-env109
+ names901
+ (let ((trans-r909
+ (macros-only-env111 r884)))
+ (map (lambda (x910)
(cons 'macro
- (eval-local-transformer2519
- (chi2512
- x3271
- trans-r3270
- w3246
- mod3248)
- mod3248)))
- val3259))
- r3245)
- w3246
- mod3248))))
- tmp3250)
- ((lambda (_3273)
+ (eval-local-transformer158
+ (chi151
+ x910
+ trans-r909
+ w885
+ mod887)
+ mod887)))
+ val898))
+ r884)
+ w885
+ mod887))))
+ tmp889)
+ ((lambda (_912)
(syntax-violation
'fluid-let-syntax
"bad syntax"
- (source-wrap2505 e3244 w3246 s3247 mod3248)))
- tmp3249)))
+ (source-wrap144 e883 w885 s886 mod887)))
+ tmp888)))
($sc-dispatch
- tmp3249
+ tmp888
'(any #(each (any any)) any . each-any))))
- e3244)))
- (global-extend2474
+ e883)))
+ (global-extend113
'core
'quote
- (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)
+ (lambda (e913 r914 w915 s916 mod917)
+ ((lambda (tmp918)
+ ((lambda (tmp919)
+ (if tmp919
+ (apply (lambda (_920 e921)
+ (build-data93 s916 (strip161 e921 w915)))
+ tmp919)
+ ((lambda (_922)
(syntax-violation
'quote
"bad syntax"
- (source-wrap2505 e3274 w3276 s3277 mod3278)))
- tmp3279)))
- ($sc-dispatch tmp3279 (quote (any any)))))
- e3274)))
- (global-extend2474
+ (source-wrap144 e913 w915 s916 mod917)))
+ tmp918)))
+ ($sc-dispatch tmp918 (quote (any any)))))
+ e913)))
+ (global-extend113
'core
'syntax
- (letrec ((regen3291
- (lambda (x3292)
- (let ((atom-key3293 (car x3292)))
- (if (memv atom-key3293 (quote (ref)))
- (build-lexical-reference2445
+ (letrec ((regen930
+ (lambda (x931)
+ (let ((atom-key932 (car x931)))
+ (if (memv atom-key932 (quote (ref)))
+ (build-lexical-reference84
'value
#f
- (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
+ (cadr x931)
+ (cadr x931))
+ (if (memv atom-key932 (quote (primitive)))
+ (build-primref92 #f (cadr x931))
+ (if (memv atom-key932 (quote (quote)))
+ (build-data93 #f (cadr x931))
+ (if (memv atom-key932 (quote (lambda)))
+ (build-lambda91
#f
- (cadr x3292)
- (cadr x3292)
+ (cadr x931)
+ (cadr x931)
#f
- (regen3291 (caddr x3292)))
- (build-application2443
+ (regen930 (caddr x931)))
+ (build-application82
#f
- (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))
+ (build-primref92 #f (car x931))
+ (map regen930 (cdr x931))))))))))
+ (gen-vector929
+ (lambda (x933)
+ (if (eq? (car x933) (quote list))
+ (cons (quote vector) (cdr x933))
+ (if (eq? (car x933) (quote quote))
+ (list (quote quote) (list->vector (cadr x933)))
+ (list (quote list->vector) x933)))))
+ (gen-append928
+ (lambda (x934 y935)
+ (if (equal? y935 (quote (quote ())))
+ x934
+ (list (quote append) x934 y935))))
+ (gen-cons927
+ (lambda (x936 y937)
+ (let ((atom-key938 (car y937)))
+ (if (memv atom-key938 (quote (quote)))
+ (if (eq? (car x936) (quote quote))
(list 'quote
- (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)
+ (cons (cadr x936) (cadr y937)))
+ (if (eq? (cadr y937) (quote ()))
+ (list (quote list) x936)
+ (list (quote cons) x936 y937)))
+ (if (memv atom-key938 (quote (list)))
+ (cons (quote list) (cons x936 (cdr y937)))
+ (list (quote cons) x936 y937))))))
+ (gen-map926
+ (lambda (e939 map-env940)
+ (let ((formals941 (map cdr map-env940))
+ (actuals942
+ (map (lambda (x943) (list (quote ref) (car x943)))
+ map-env940)))
+ (if (eq? (car e939) (quote ref))
+ (car actuals942)
(if (and-map
- (lambda (x3305)
- (if (eq? (car x3305) (quote ref))
- (memq (cadr x3305) formals3302)
+ (lambda (x944)
+ (if (eq? (car x944) (quote ref))
+ (memq (cadr x944) formals941)
#f))
- (cdr e3300))
+ (cdr e939))
(cons 'map
- (cons (list (quote primitive) (car e3300))
- (map (let ((r3306 (map cons
- formals3302
- actuals3303)))
- (lambda (x3307)
- (cdr (assq (cadr x3307)
- r3306))))
- (cdr e3300))))
+ (cons (list (quote primitive) (car e939))
+ (map (let ((r945 (map cons
+ formals941
+ actuals942)))
+ (lambda (x946)
+ (cdr (assq (cadr x946) r945))))
+ (cdr e939))))
(cons 'map
- (cons (list (quote lambda) formals3302 e3300)
- actuals3303)))))))
- (gen-mappend3286
- (lambda (e3308 map-env3309)
+ (cons (list (quote lambda) formals941 e939)
+ actuals942)))))))
+ (gen-mappend925
+ (lambda (e947 map-env948)
(list 'apply
'(primitive append)
- (gen-map3287 e3308 map-env3309))))
- (gen-ref3285
- (lambda (src3310 var3311 level3312 maps3313)
- (if (fx=2435 level3312 0)
- (values var3311 maps3313)
- (if (null? maps3313)
+ (gen-map926 e947 map-env948))))
+ (gen-ref924
+ (lambda (src949 var950 level951 maps952)
+ (if (fx=74 level951 0)
+ (values var950 maps952)
+ (if (null? maps952)
(syntax-violation
'syntax
"missing ellipsis"
- src3310)
+ src949)
(call-with-values
(lambda ()
- (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))))
+ (gen-ref924
+ src949
+ var950
+ (fx-73 level951 1)
+ (cdr maps952)))
+ (lambda (outer-var953 outer-maps954)
+ (let ((b955 (assq outer-var953 (car maps952))))
+ (if b955
+ (values (cdr b955) maps952)
+ (let ((inner-var956 (gen-var162 (quote tmp))))
(values
- 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))
+ inner-var956
+ (cons (cons (cons outer-var953
+ inner-var956)
+ (car maps952))
+ outer-maps954)))))))))))
+ (gen-syntax923
+ (lambda (src957 e958 r959 maps960 ellipsis?961 mod962)
+ (if (id?115 e958)
+ (let ((label963 (id-var-name137 e958 (quote (())))))
+ (let ((b964 (lookup112 label963 r959 mod962)))
+ (if (eq? (binding-type107 b964) (quote syntax))
(call-with-values
(lambda ()
- (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)
+ (let ((var.lev965 (binding-value108 b964)))
+ (gen-ref924
+ src957
+ (car var.lev965)
+ (cdr var.lev965)
+ maps960)))
+ (lambda (var966 maps967)
+ (values (list (quote ref) var966) maps967)))
+ (if (ellipsis?961 e958)
(syntax-violation
'syntax
"misplaced ellipsis"
- src3318)
- (values (list (quote quote) e3319) maps3321)))))
- ((lambda (tmp3329)
- ((lambda (tmp3330)
- (if (if tmp3330
- (apply (lambda (dots3331 e3332)
- (ellipsis?3322 dots3331))
- tmp3330)
+ src957)
+ (values (list (quote quote) e958) maps960)))))
+ ((lambda (tmp968)
+ ((lambda (tmp969)
+ (if (if tmp969
+ (apply (lambda (dots970 e971)
+ (ellipsis?961 dots970))
+ tmp969)
#f)
- (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)
+ (apply (lambda (dots972 e973)
+ (gen-syntax923
+ src957
+ e973
+ r959
+ maps960
+ (lambda (x974) #f)
+ mod962))
+ tmp969)
+ ((lambda (tmp975)
+ (if (if tmp975
+ (apply (lambda (x976 dots977 y978)
+ (ellipsis?961 dots977))
+ tmp975)
#f)
- (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)
+ (apply (lambda (x979 dots980 y981)
+ (letrec ((f982 (lambda (y983 k984)
+ ((lambda (tmp988)
+ ((lambda (tmp989)
+ (if (if tmp989
+ (apply (lambda (dots990
+ y991)
+ (ellipsis?961
+ dots990))
+ tmp989)
+ #f)
+ (apply (lambda (dots992
+ y993)
+ (f982 y993
+ (lambda (maps994)
+ (call-with-values
+ (lambda ()
+ (k984 (cons '()
+ maps994)))
+ (lambda (x995
+ maps996)
+ (if (null? (car maps996))
+ (syntax-violation
+ 'syntax
+ "extra ellipsis"
+ src957)
+ (values
+ (gen-mappend925
+ x995
+ (car maps996))
+ (cdr maps996))))))))
+ tmp989)
+ ((lambda (_997)
+ (call-with-values
+ (lambda ()
+ (gen-syntax923
+ src957
+ y983
+ r959
+ maps960
+ ellipsis?961
+ mod962))
+ (lambda (y998
+ maps999)
+ (call-with-values
+ (lambda ()
+ (k984 maps999))
+ (lambda (x1000
+ maps1001)
+ (values
+ (gen-append928
+ x1000
+ y998)
+ maps1001))))))
+ tmp988)))
+ ($sc-dispatch
+ tmp988
+ '(any .
+ any))))
+ y983))))
+ (f982 y981
+ (lambda (maps985)
+ (call-with-values
+ (lambda ()
+ (gen-syntax923
+ src957
+ x979
+ r959
+ (cons '()
+ maps985)
+ ellipsis?961
+ mod962))
+ (lambda (x986 maps987)
+ (if (null? (car maps987))
+ (syntax-violation
+ 'syntax
+ "extra ellipsis"
+ src957)
+ (values
+ (gen-map926
+ x986
+ (car maps987))
+ (cdr maps987)))))))))
+ tmp975)
+ ((lambda (tmp1002)
+ (if tmp1002
+ (apply (lambda (x1003 y1004)
(call-with-values
(lambda ()
- (gen-syntax3284
- src3318
- x3364
- r3320
- maps3321
- ellipsis?3322
- mod3323))
- (lambda (x3366 maps3367)
+ (gen-syntax923
+ src957
+ x1003
+ r959
+ maps960
+ ellipsis?961
+ mod962))
+ (lambda (x1005 maps1006)
(call-with-values
(lambda ()
- (gen-syntax3284
- src3318
- y3365
- r3320
- maps3367
- ellipsis?3322
- mod3323))
- (lambda (y3368
- maps3369)
+ (gen-syntax923
+ src957
+ y1004
+ r959
+ maps1006
+ ellipsis?961
+ mod962))
+ (lambda (y1007
+ maps1008)
(values
- (gen-cons3288
- x3366
- y3368)
- maps3369))))))
- tmp3363)
- ((lambda (tmp3370)
- (if tmp3370
- (apply (lambda (e13371 e23372)
+ (gen-cons927
+ x1005
+ y1007)
+ maps1008))))))
+ tmp1002)
+ ((lambda (tmp1009)
+ (if tmp1009
+ (apply (lambda (e11010 e21011)
(call-with-values
(lambda ()
- (gen-syntax3284
- src3318
- (cons e13371
- e23372)
- r3320
- maps3321
- ellipsis?3322
- mod3323))
- (lambda (e3374
- maps3375)
+ (gen-syntax923
+ src957
+ (cons e11010
+ e21011)
+ r959
+ maps960
+ ellipsis?961
+ mod962))
+ (lambda (e1013
+ maps1014)
(values
- (gen-vector3290
- e3374)
- maps3375))))
- tmp3370)
- ((lambda (_3376)
+ (gen-vector929
+ e1013)
+ maps1014))))
+ tmp1009)
+ ((lambda (_1015)
(values
- (list (quote quote) e3319)
- maps3321))
- tmp3329)))
+ (list (quote quote) e958)
+ maps960))
+ tmp968)))
($sc-dispatch
- tmp3329
+ tmp968
'#(vector (any . each-any))))))
($sc-dispatch
- tmp3329
+ tmp968
'(any . any)))))
($sc-dispatch
- tmp3329
+ tmp968
'(any any . any)))))
- ($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)
+ ($sc-dispatch tmp968 (quote (any any)))))
+ e958)))))
+ (lambda (e1016 r1017 w1018 s1019 mod1020)
+ (let ((e1021 (source-wrap144 e1016 w1018 s1019 mod1020)))
+ ((lambda (tmp1022)
+ ((lambda (tmp1023)
+ (if tmp1023
+ (apply (lambda (_1024 x1025)
(call-with-values
(lambda ()
- (gen-syntax3284
- e3382
- x3386
- r3378
+ (gen-syntax923
+ e1021
+ x1025
+ r1017
'()
- ellipsis?2521
- mod3381))
- (lambda (e3387 maps3388) (regen3291 e3387))))
- tmp3384)
- ((lambda (_3389)
+ ellipsis?160
+ mod1020))
+ (lambda (e1026 maps1027) (regen930 e1026))))
+ tmp1023)
+ ((lambda (_1028)
(syntax-violation
'syntax
"bad `syntax' form"
- e3382))
- tmp3383)))
- ($sc-dispatch tmp3383 (quote (any any)))))
- e3382)))))
- (global-extend2474
+ e1021))
+ tmp1022)))
+ ($sc-dispatch tmp1022 (quote (any any)))))
+ e1021)))))
+ (global-extend113
'core
'lambda
- (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)
+ (lambda (e1029 r1030 w1031 s1032 mod1033)
+ ((lambda (tmp1034)
+ ((lambda (tmp1035)
+ (if tmp1035
+ (apply (lambda (_1036 c1037)
+ (chi-lambda-clause156
+ (source-wrap144 e1029 w1031 s1032 mod1033)
#f
- c3398
- r3391
- w3392
- mod3394
- (lambda (names3399
- vars3400
- docstring3401
- body3402)
- (build-lambda2452
- s3393
- names3399
- vars3400
- docstring3401
- body3402))))
- tmp3396)
+ c1037
+ r1030
+ w1031
+ mod1033
+ (lambda (names1038
+ vars1039
+ docstring1040
+ body1041)
+ (build-lambda91
+ s1032
+ names1038
+ vars1039
+ docstring1040
+ body1041))))
+ tmp1035)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3395)))
- ($sc-dispatch tmp3395 (quote (any . any)))))
- e3390)))
- (global-extend2474
+ tmp1034)))
+ ($sc-dispatch tmp1034 (quote (any . any)))))
+ e1029)))
+ (global-extend113
'core
'let
- (letrec ((chi-let3403
- (lambda (e3404
- r3405
- w3406
- s3407
- mod3408
- constructor3409
- ids3410
- vals3411
- exps3412)
- (if (not (valid-bound-ids?2501 ids3410))
+ (letrec ((chi-let1042
+ (lambda (e1043
+ r1044
+ w1045
+ s1046
+ mod1047
+ constructor1048
+ ids1049
+ vals1050
+ exps1051)
+ (if (not (valid-bound-ids?140 ids1049))
(syntax-violation
'let
"duplicate bound variable"
- 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)
+ e1043)
+ (let ((labels1052 (gen-labels121 ids1049))
+ (new-vars1053 (map gen-var162 ids1049)))
+ (let ((nw1054
+ (make-binding-wrap132
+ ids1049
+ labels1052
+ w1045))
+ (nr1055
+ (extend-var-env110
+ labels1052
+ new-vars1053
+ r1044)))
+ (constructor1048
+ s1046
+ (map syntax->datum ids1049)
+ new-vars1053
+ (map (lambda (x1056)
+ (chi151 x1056 r1044 w1045 mod1047))
+ vals1050)
+ (chi-body155
+ exps1051
+ (source-wrap144 e1043 nw1054 s1046 mod1047)
+ nr1055
+ nw1054
+ mod1047))))))))
+ (lambda (e1057 r1058 w1059 s1060 mod1061)
+ ((lambda (tmp1062)
+ ((lambda (tmp1063)
+ (if (if tmp1063
+ (apply (lambda (_1064 id1065 val1066 e11067 e21068)
+ (and-map id?115 id1065))
+ tmp1063)
#f)
- (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)
+ (apply (lambda (_1070 id1071 val1072 e11073 e21074)
+ (chi-let1042
+ e1057
+ r1058
+ w1059
+ s1060
+ mod1061
+ build-let95
+ id1071
+ val1072
+ (cons e11073 e21074)))
+ tmp1063)
+ ((lambda (tmp1078)
+ (if (if tmp1078
+ (apply (lambda (_1079
+ f1080
+ id1081
+ val1082
+ e11083
+ e21084)
+ (if (id?115 f1080)
+ (and-map id?115 id1081)
#f))
- tmp3439)
+ tmp1078)
#f)
- (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)
+ (apply (lambda (_1086
+ f1087
+ id1088
+ val1089
+ e11090
+ e21091)
+ (chi-let1042
+ e1057
+ r1058
+ w1059
+ s1060
+ mod1061
+ build-named-let96
+ (cons f1087 id1088)
+ val1089
+ (cons e11090 e21091)))
+ tmp1078)
+ ((lambda (_1095)
(syntax-violation
'let
"bad let"
- (source-wrap2505 e3418 w3420 s3421 mod3422)))
- tmp3423)))
+ (source-wrap144 e1057 w1059 s1060 mod1061)))
+ tmp1062)))
($sc-dispatch
- tmp3423
+ tmp1062
'(any any #(each (any any)) any . each-any)))))
($sc-dispatch
- tmp3423
+ tmp1062
'(any #(each (any any)) any . each-any))))
- e3418))))
- (global-extend2474
+ e1057))))
+ (global-extend113
'core
'letrec
- (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)
+ (lambda (e1096 r1097 w1098 s1099 mod1100)
+ ((lambda (tmp1101)
+ ((lambda (tmp1102)
+ (if (if tmp1102
+ (apply (lambda (_1103 id1104 val1105 e11106 e21107)
+ (and-map id?115 id1104))
+ tmp1102)
#f)
- (apply (lambda (_3470 id3471 val3472 e13473 e23474)
- (let ((ids3475 id3471))
- (if (not (valid-bound-ids?2501 ids3475))
+ (apply (lambda (_1109 id1110 val1111 e11112 e21113)
+ (let ((ids1114 id1110))
+ (if (not (valid-bound-ids?140 ids1114))
(syntax-violation
'letrec
"duplicate bound variable"
- 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)
+ e1096)
+ (let ((labels1116 (gen-labels121 ids1114))
+ (new-vars1117 (map gen-var162 ids1114)))
+ (let ((w1118 (make-binding-wrap132
+ ids1114
+ labels1116
+ w1098))
+ (r1119 (extend-var-env110
+ labels1116
+ new-vars1117
+ r1097)))
+ (build-letrec97
+ s1099
+ (map syntax->datum ids1114)
+ new-vars1117
+ (map (lambda (x1120)
+ (chi151 x1120 r1119 w1118 mod1100))
+ val1111)
+ (chi-body155
+ (cons e11112 e21113)
+ (source-wrap144
+ e1096
+ w1118
+ s1099
+ mod1100)
+ r1119
+ w1118
+ mod1100)))))))
+ tmp1102)
+ ((lambda (_1123)
(syntax-violation
'letrec
"bad letrec"
- (source-wrap2505 e3457 w3459 s3460 mod3461)))
- tmp3462)))
+ (source-wrap144 e1096 w1098 s1099 mod1100)))
+ tmp1101)))
($sc-dispatch
- tmp3462
+ tmp1101
'(any #(each (any any)) any . each-any))))
- e3457)))
- (global-extend2474
+ e1096)))
+ (global-extend113
'core
'set!
- (lambda (e3485 r3486 w3487 s3488 mod3489)
- ((lambda (tmp3490)
- ((lambda (tmp3491)
- (if (if tmp3491
- (apply (lambda (_3492 id3493 val3494) (id?2476 id3493))
- tmp3491)
+ (lambda (e1124 r1125 w1126 s1127 mod1128)
+ ((lambda (tmp1129)
+ ((lambda (tmp1130)
+ (if (if tmp1130
+ (apply (lambda (_1131 id1132 val1133) (id?115 id1132))
+ tmp1130)
#f)
- (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
+ (apply (lambda (_1134 id1135 val1136)
+ (let ((val1137 (chi151 val1136 r1125 w1126 mod1128))
+ (n1138 (id-var-name137 id1135 w1126)))
+ (let ((b1139 (lookup112 n1138 r1125 mod1128)))
+ (let ((atom-key1140 (binding-type107 b1139)))
+ (if (memv atom-key1140 (quote (lexical)))
+ (build-lexical-assignment85
+ s1127
+ (syntax->datum id1135)
+ (binding-value108 b1139)
+ val1137)
+ (if (memv atom-key1140 (quote (global)))
+ (build-global-assignment88
+ s1127
+ n1138
+ val1137
+ mod1128)
+ (if (memv atom-key1140
'(displaced-lexical))
(syntax-violation
'set!
"identifier out of context"
- (wrap2504 id3496 w3487 mod3489))
+ (wrap143 id1135 w1126 mod1128))
(syntax-violation
'set!
"bad set!"
- (source-wrap2505
- e3485
- w3487
- s3488
- mod3489)))))))))
- tmp3491)
- ((lambda (tmp3502)
- (if tmp3502
- (apply (lambda (_3503 head3504 tail3505 val3506)
+ (source-wrap144
+ e1124
+ w1126
+ s1127
+ mod1128)))))))))
+ tmp1130)
+ ((lambda (tmp1141)
+ (if tmp1141
+ (apply (lambda (_1142 head1143 tail1144 val1145)
(call-with-values
(lambda ()
- (syntax-type2510
- head3504
- r3486
+ (syntax-type149
+ head1143
+ r1125
'(())
#f
#f
- mod3489
+ mod1128
#t))
- (lambda (type3507
- value3508
- ee3509
- ww3510
- ss3511
- modmod3512)
- (if (memv type3507 (quote (module-ref)))
- (let ((val3513
- (chi2512
- val3506
- r3486
- w3487
- mod3489)))
+ (lambda (type1146
+ value1147
+ ee1148
+ ww1149
+ ss1150
+ modmod1151)
+ (if (memv type1146 (quote (module-ref)))
+ (let ((val1152
+ (chi151
+ val1145
+ r1125
+ w1126
+ mod1128)))
(call-with-values
(lambda ()
- (value3508
- (cons head3504 tail3505)))
- (lambda (id3515 mod3516)
- (build-global-assignment2449
- s3488
- id3515
- val3513
- mod3516))))
- (build-application2443
- s3488
- (chi2512
+ (value1147
+ (cons head1143 tail1144)))
+ (lambda (id1154 mod1155)
+ (build-global-assignment88
+ s1127
+ id1154
+ val1152
+ mod1155))))
+ (build-application82
+ s1127
+ (chi151
(list '#(syntax-object
setter
((top)
@@ -6649,47 +6491,47 @@
((top) (top))
("i" "i")))
(hygiene guile))
- head3504)
- r3486
- w3487
- mod3489)
- (map (lambda (e3517)
- (chi2512
- e3517
- r3486
- w3487
- mod3489))
+ head1143)
+ r1125
+ w1126
+ mod1128)
+ (map (lambda (e1156)
+ (chi151
+ e1156
+ r1125
+ w1126
+ mod1128))
(append
- tail3505
- (list val3506))))))))
- tmp3502)
- ((lambda (_3519)
+ tail1144
+ (list val1145))))))))
+ tmp1141)
+ ((lambda (_1158)
(syntax-violation
'set!
"bad set!"
- (source-wrap2505 e3485 w3487 s3488 mod3489)))
- tmp3490)))
+ (source-wrap144 e1124 w1126 s1127 mod1128)))
+ tmp1129)))
($sc-dispatch
- tmp3490
+ tmp1129
'(any (any . each-any) any)))))
- ($sc-dispatch tmp3490 (quote (any any any)))))
- e3485)))
- (global-extend2474
+ ($sc-dispatch tmp1129 (quote (any any any)))))
+ e1124)))
+ (global-extend113
'module-ref
'@
- (lambda (e3520)
- ((lambda (tmp3521)
- ((lambda (tmp3522)
- (if (if tmp3522
- (apply (lambda (_3523 mod3524 id3525)
- (if (and-map id?2476 mod3524)
- (id?2476 id3525)
+ (lambda (e1159)
+ ((lambda (tmp1160)
+ ((lambda (tmp1161)
+ (if (if tmp1161
+ (apply (lambda (_1162 mod1163 id1164)
+ (if (and-map id?115 mod1163)
+ (id?115 id1164)
#f))
- tmp3522)
+ tmp1161)
#f)
- (apply (lambda (_3527 mod3528 id3529)
+ (apply (lambda (_1166 mod1167 id1168)
(values
- (syntax->datum id3529)
+ (syntax->datum id1168)
(syntax->datum
(cons '#(syntax-object
public
@@ -7042,30 +6884,30 @@
((top) (top))
("i" "i")))
(hygiene guile))
- mod3528))))
- tmp3522)
+ mod1167))))
+ tmp1161)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3521)))
- ($sc-dispatch tmp3521 (quote (any each-any any)))))
- e3520)))
- (global-extend2474
+ tmp1160)))
+ ($sc-dispatch tmp1160 (quote (any each-any any)))))
+ e1159)))
+ (global-extend113
'module-ref
'@@
- (lambda (e3531)
- ((lambda (tmp3532)
- ((lambda (tmp3533)
- (if (if tmp3533
- (apply (lambda (_3534 mod3535 id3536)
- (if (and-map id?2476 mod3535)
- (id?2476 id3536)
+ (lambda (e1170)
+ ((lambda (tmp1171)
+ ((lambda (tmp1172)
+ (if (if tmp1172
+ (apply (lambda (_1173 mod1174 id1175)
+ (if (and-map id?115 mod1174)
+ (id?115 id1175)
#f))
- tmp3533)
+ tmp1172)
#f)
- (apply (lambda (_3538 mod3539 id3540)
+ (apply (lambda (_1177 mod1178 id1179)
(values
- (syntax->datum id3540)
+ (syntax->datum id1179)
(syntax->datum
(cons '#(syntax-object
private
@@ -7418,84 +7260,84 @@
((top) (top))
("i" "i")))
(hygiene guile))
- mod3539))))
- tmp3533)
+ mod1178))))
+ tmp1172)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3532)))
- ($sc-dispatch tmp3532 (quote (any each-any any)))))
- e3531)))
- (global-extend2474
+ tmp1171)))
+ ($sc-dispatch tmp1171 (quote (any each-any any)))))
+ e1170)))
+ (global-extend113
'core
'if
- (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)
+ (lambda (e1181 r1182 w1183 s1184 mod1185)
+ ((lambda (tmp1186)
+ ((lambda (tmp1187)
+ (if tmp1187
+ (apply (lambda (_1188 test1189 then1190)
+ (build-conditional83
+ s1184
+ (chi151 test1189 r1182 w1183 mod1185)
+ (chi151 then1190 r1182 w1183 mod1185)
+ (build-void81 #f)))
+ tmp1187)
+ ((lambda (tmp1191)
+ (if tmp1191
+ (apply (lambda (_1192 test1193 then1194 else1195)
+ (build-conditional83
+ s1184
+ (chi151 test1193 r1182 w1183 mod1185)
+ (chi151 then1194 r1182 w1183 mod1185)
+ (chi151 else1195 r1182 w1183 mod1185)))
+ tmp1191)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3547)))
- ($sc-dispatch tmp3547 (quote (any any any any))))))
- ($sc-dispatch tmp3547 (quote (any any any)))))
- e3542)))
- (global-extend2474
+ tmp1186)))
+ ($sc-dispatch tmp1186 (quote (any any any any))))))
+ ($sc-dispatch tmp1186 (quote (any any any)))))
+ e1181)))
+ (global-extend113
'begin
'begin
'())
- (global-extend2474
+ (global-extend113
'define
'define
'())
- (global-extend2474
+ (global-extend113
'define-syntax
'define-syntax
'())
- (global-extend2474
+ (global-extend113
'eval-when
'eval-when
'())
- (global-extend2474
+ (global-extend113
'core
'syntax-case
- (letrec ((gen-syntax-case3560
- (lambda (x3561 keys3562 clauses3563 r3564 mod3565)
- (if (null? clauses3563)
- (build-application2443
+ (letrec ((gen-syntax-case1199
+ (lambda (x1200 keys1201 clauses1202 r1203 mod1204)
+ (if (null? clauses1202)
+ (build-application82
#f
- (build-primref2453 #f (quote syntax-violation))
- (list (build-data2454 #f #f)
- (build-data2454
+ (build-primref92 #f (quote syntax-violation))
+ (list (build-data93 #f #f)
+ (build-data93
#f
"source expression failed to match any pattern")
- x3561))
- ((lambda (tmp3566)
- ((lambda (tmp3567)
- (if tmp3567
- (apply (lambda (pat3568 exp3569)
- (if (if (id?2476 pat3568)
+ x1200))
+ ((lambda (tmp1205)
+ ((lambda (tmp1206)
+ (if tmp1206
+ (apply (lambda (pat1207 exp1208)
+ (if (if (id?115 pat1207)
(and-map
- (lambda (x3570)
- (not (free-id=?2499
- pat3568
- x3570)))
+ (lambda (x1209)
+ (not (free-id=?138
+ pat1207
+ x1209)))
(cons '#(syntax-object
...
((top)
@@ -7873,623 +7715,620 @@
((top) (top))
("i" "i")))
(hygiene guile))
- keys3562))
+ keys1201))
#f)
- (let ((labels3571
- (list (gen-label2481)))
- (var3572
- (gen-var2523 pat3568)))
- (build-application2443
+ (let ((labels1210
+ (list (gen-label120)))
+ (var1211 (gen-var162 pat1207)))
+ (build-application82
#f
- (build-lambda2452
+ (build-lambda91
#f
- (list (syntax->datum pat3568))
- (list var3572)
+ (list (syntax->datum pat1207))
+ (list var1211)
#f
- (chi2512
- exp3569
- (extend-env2470
- labels3571
+ (chi151
+ exp1208
+ (extend-env109
+ labels1210
(list (cons 'syntax
- (cons var3572
+ (cons var1211
0)))
- r3564)
- (make-binding-wrap2493
- (list pat3568)
- labels3571
+ r1203)
+ (make-binding-wrap132
+ (list pat1207)
+ labels1210
'(()))
- mod3565))
- (list x3561)))
- (gen-clause3559
- x3561
- keys3562
- (cdr clauses3563)
- r3564
- pat3568
+ mod1204))
+ (list x1200)))
+ (gen-clause1198
+ x1200
+ keys1201
+ (cdr clauses1202)
+ r1203
+ pat1207
#t
- 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)
+ exp1208
+ mod1204)))
+ tmp1206)
+ ((lambda (tmp1212)
+ (if tmp1212
+ (apply (lambda (pat1213 fender1214 exp1215)
+ (gen-clause1198
+ x1200
+ keys1201
+ (cdr clauses1202)
+ r1203
+ pat1213
+ fender1214
+ exp1215
+ mod1204))
+ tmp1212)
+ ((lambda (_1216)
(syntax-violation
'syntax-case
"invalid clause"
- (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)
+ (car clauses1202)))
+ tmp1205)))
+ ($sc-dispatch tmp1205 (quote (any any any))))))
+ ($sc-dispatch tmp1205 (quote (any any)))))
+ (car clauses1202)))))
+ (gen-clause1198
+ (lambda (x1217
+ keys1218
+ clauses1219
+ r1220
+ pat1221
+ fender1222
+ exp1223
+ mod1224)
(call-with-values
(lambda ()
- (convert-pattern3557 pat3582 keys3579))
- (lambda (p3586 pvars3587)
- (if (not (distinct-bound-ids?2502
- (map car pvars3587)))
+ (convert-pattern1196 pat1221 keys1218))
+ (lambda (p1225 pvars1226)
+ (if (not (distinct-bound-ids?141 (map car pvars1226)))
(syntax-violation
'syntax-case
"duplicate pattern variable"
- pat3582)
+ pat1221)
(if (not (and-map
- (lambda (x3588)
- (not (ellipsis?2521 (car x3588))))
- pvars3587))
+ (lambda (x1227)
+ (not (ellipsis?160 (car x1227))))
+ pvars1226))
(syntax-violation
'syntax-case
"misplaced ellipsis"
- pat3582)
- (let ((y3589 (gen-var2523 (quote tmp))))
- (build-application2443
+ pat1221)
+ (let ((y1228 (gen-var162 (quote tmp))))
+ (build-application82
#f
- (build-lambda2452
+ (build-lambda91
#f
(list (quote tmp))
- (list y3589)
+ (list y1228)
#f
- (let ((y3590 (build-lexical-reference2445
+ (let ((y1229 (build-lexical-reference84
'value
#f
'tmp
- y3589)))
- (build-conditional2444
+ y1228)))
+ (build-conditional83
#f
- ((lambda (tmp3591)
- ((lambda (tmp3592)
- (if tmp3592
- (apply (lambda () y3590)
- tmp3592)
- ((lambda (_3593)
- (build-conditional2444
+ ((lambda (tmp1230)
+ ((lambda (tmp1231)
+ (if tmp1231
+ (apply (lambda () y1229)
+ tmp1231)
+ ((lambda (_1232)
+ (build-conditional83
#f
- y3590
- (build-dispatch-call3558
- pvars3587
- fender3583
- y3590
- r3581
- mod3585)
- (build-data2454 #f #f)))
- tmp3591)))
+ y1229
+ (build-dispatch-call1197
+ pvars1226
+ fender1222
+ y1229
+ r1220
+ mod1224)
+ (build-data93 #f #f)))
+ tmp1230)))
($sc-dispatch
- tmp3591
+ tmp1230
'#(atom #t))))
- 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
+ fender1222)
+ (build-dispatch-call1197
+ pvars1226
+ exp1223
+ y1229
+ r1220
+ mod1224)
+ (gen-syntax-case1199
+ x1217
+ keys1218
+ clauses1219
+ r1220
+ mod1224))))
+ (list (if (eq? p1225 (quote any))
+ (build-application82
#f
- (build-primref2453 #f (quote list))
- (list x3578))
- (build-application2443
+ (build-primref92 #f (quote list))
+ (list x1217))
+ (build-application82
#f
- (build-primref2453
+ (build-primref92
#f
'$sc-dispatch)
- (list x3578
- (build-data2454
+ (list x1217
+ (build-data93
#f
- 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
+ p1225)))))))))))))
+ (build-dispatch-call1197
+ (lambda (pvars1233 exp1234 y1235 r1236 mod1237)
+ (let ((ids1238 (map car pvars1233))
+ (levels1239 (map cdr pvars1233)))
+ (let ((labels1240 (gen-labels121 ids1238))
+ (new-vars1241 (map gen-var162 ids1238)))
+ (build-application82
#f
- (build-primref2453 #f (quote apply))
- (list (build-lambda2452
+ (build-primref92 #f (quote apply))
+ (list (build-lambda91
#f
- (map syntax->datum ids3599)
- new-vars3602
+ (map syntax->datum ids1238)
+ new-vars1241
#f
- (chi2512
- exp3595
- (extend-env2470
- labels3601
- (map (lambda (var3603 level3604)
+ (chi151
+ exp1234
+ (extend-env109
+ labels1240
+ (map (lambda (var1242 level1243)
(cons 'syntax
- (cons var3603 level3604)))
- new-vars3602
- (map cdr pvars3594))
- r3597)
- (make-binding-wrap2493
- ids3599
- labels3601
+ (cons var1242 level1243)))
+ new-vars1241
+ (map cdr pvars1233))
+ r1236)
+ (make-binding-wrap132
+ ids1238
+ labels1240
'(()))
- mod3598))
- y3596))))))
- (convert-pattern3557
- (lambda (pattern3605 keys3606)
- (letrec ((cvt3607
- (lambda (p3608 n3609 ids3610)
- (if (id?2476 p3608)
- (if (bound-id-member?2503 p3608 keys3606)
+ mod1237))
+ y1235))))))
+ (convert-pattern1196
+ (lambda (pattern1244 keys1245)
+ (letrec ((cvt1246
+ (lambda (p1247 n1248 ids1249)
+ (if (id?115 p1247)
+ (if (bound-id-member?142 p1247 keys1245)
(values
- (vector (quote free-id) p3608)
- ids3610)
+ (vector (quote free-id) p1247)
+ ids1249)
(values
'any
- (cons (cons p3608 n3609) ids3610)))
- ((lambda (tmp3611)
- ((lambda (tmp3612)
- (if (if tmp3612
- (apply (lambda (x3613 dots3614)
- (ellipsis?2521
- dots3614))
- tmp3612)
+ (cons (cons p1247 n1248) ids1249)))
+ ((lambda (tmp1250)
+ ((lambda (tmp1251)
+ (if (if tmp1251
+ (apply (lambda (x1252 dots1253)
+ (ellipsis?160
+ dots1253))
+ tmp1251)
#f)
- (apply (lambda (x3615 dots3616)
+ (apply (lambda (x1254 dots1255)
(call-with-values
(lambda ()
- (cvt3607
- x3615
- (fx+2433 n3609 1)
- ids3610))
- (lambda (p3617 ids3618)
+ (cvt1246
+ x1254
+ (fx+72 n1248 1)
+ ids1249))
+ (lambda (p1256 ids1257)
(values
- (if (eq? p3617
+ (if (eq? p1256
'any)
'each-any
(vector
'each
- p3617))
- ids3618))))
- tmp3612)
- ((lambda (tmp3619)
- (if tmp3619
- (apply (lambda (x3620 y3621)
+ p1256))
+ ids1257))))
+ tmp1251)
+ ((lambda (tmp1258)
+ (if tmp1258
+ (apply (lambda (x1259 y1260)
(call-with-values
(lambda ()
- (cvt3607
- y3621
- n3609
- ids3610))
- (lambda (y3622
- ids3623)
+ (cvt1246
+ y1260
+ n1248
+ ids1249))
+ (lambda (y1261
+ ids1262)
(call-with-values
(lambda ()
- (cvt3607
- x3620
- n3609
- ids3623))
- (lambda (x3624
- ids3625)
+ (cvt1246
+ x1259
+ n1248
+ ids1262))
+ (lambda (x1263
+ ids1264)
(values
- (cons x3624
- y3622)
- ids3625))))))
- tmp3619)
- ((lambda (tmp3626)
- (if tmp3626
+ (cons x1263
+ y1261)
+ ids1264))))))
+ tmp1258)
+ ((lambda (tmp1265)
+ (if tmp1265
(apply (lambda ()
(values
'()
- ids3610))
- tmp3626)
- ((lambda (tmp3627)
- (if tmp3627
- (apply (lambda (x3628)
+ ids1249))
+ tmp1265)
+ ((lambda (tmp1266)
+ (if tmp1266
+ (apply (lambda (x1267)
(call-with-values
(lambda ()
- (cvt3607
- x3628
- n3609
- ids3610))
- (lambda (p3630
- ids3631)
+ (cvt1246
+ x1267
+ n1248
+ ids1249))
+ (lambda (p1269
+ ids1270)
(values
(vector
'vector
- p3630)
- ids3631))))
- tmp3627)
- ((lambda (x3632)
+ p1269)
+ ids1270))))
+ tmp1266)
+ ((lambda (x1271)
(values
(vector
'atom
- (strip2522
- p3608
+ (strip161
+ p1247
'(())))
- ids3610))
- tmp3611)))
+ ids1249))
+ tmp1250)))
($sc-dispatch
- tmp3611
+ tmp1250
'#(vector
each-any)))))
($sc-dispatch
- tmp3611
+ tmp1250
'()))))
($sc-dispatch
- tmp3611
+ tmp1250
'(any . any)))))
($sc-dispatch
- tmp3611
+ tmp1250
'(any any))))
- 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)
+ p1247)))))
+ (cvt1246 pattern1244 0 (quote ()))))))
+ (lambda (e1272 r1273 w1274 s1275 mod1276)
+ (let ((e1277 (source-wrap144 e1272 w1274 s1275 mod1276)))
+ ((lambda (tmp1278)
+ ((lambda (tmp1279)
+ (if tmp1279
+ (apply (lambda (_1280 val1281 key1282 m1283)
(if (and-map
- (lambda (x3645)
- (if (id?2476 x3645)
- (not (ellipsis?2521 x3645))
+ (lambda (x1284)
+ (if (id?115 x1284)
+ (not (ellipsis?160 x1284))
#f))
- key3643)
- (let ((x3647 (gen-var2523 (quote tmp))))
- (build-application2443
- s3636
- (build-lambda2452
+ key1282)
+ (let ((x1286 (gen-var162 (quote tmp))))
+ (build-application82
+ s1275
+ (build-lambda91
#f
(list (quote tmp))
- (list x3647)
+ (list x1286)
#f
- (gen-syntax-case3560
- (build-lexical-reference2445
+ (gen-syntax-case1199
+ (build-lexical-reference84
'value
#f
'tmp
- x3647)
- key3643
- m3644
- r3634
- mod3637))
- (list (chi2512
- val3642
- r3634
+ x1286)
+ key1282
+ m1283
+ r1273
+ mod1276))
+ (list (chi151
+ val1281
+ r1273
'(())
- mod3637))))
+ mod1276))))
(syntax-violation
'syntax-case
"invalid literals list"
- e3638)))
- tmp3640)
+ e1277)))
+ tmp1279)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3639)))
+ tmp1278)))
($sc-dispatch
- tmp3639
+ tmp1278
'(any any each-any . each-any))))
- e3638)))))
+ e1277)))))
(set! sc-expand
- (lambda (x3651 . rest3650)
- (if (if (pair? x3651)
- (equal? (car x3651) noexpand2431)
+ (lambda (x1290 . rest1289)
+ (if (if (pair? x1290)
+ (equal? (car x1290) noexpand70)
#f)
- (cadr x3651)
- (let ((m3652 (if (null? rest3650) (quote e) (car rest3650)))
- (esew3653
- (if (let ((t3654 (null? rest3650)))
- (if t3654 t3654 (null? (cdr rest3650))))
+ (cadr x1290)
+ (let ((m1291 (if (null? rest1289) (quote e) (car rest1289)))
+ (esew1292
+ (if (let ((t1293 (null? rest1289)))
+ (if t1293 t1293 (null? (cdr rest1289))))
'(eval)
- (cadr rest3650))))
+ (cadr rest1289))))
(with-fluid*
- *mode*2432
- m3652
+ *mode*71
+ m1291
(lambda ()
- (chi-top2511
- x3651
+ (chi-top150
+ x1290
'()
'((top))
- m3652
- esew3653
+ m1291
+ esew1292
(cons 'hygiene
(module-name (current-module))))))))))
(set! identifier?
- (lambda (x3655) (nonsymbol-id?2475 x3655)))
+ (lambda (x1294) (nonsymbol-id?114 x1294)))
(set! datum->syntax
- (lambda (id3656 datum3657)
- (make-syntax-object2459
- datum3657
- (syntax-object-wrap2462 id3656)
+ (lambda (id1295 datum1296)
+ (make-syntax-object98
+ datum1296
+ (syntax-object-wrap101 id1295)
#f)))
(set! syntax->datum
- (lambda (x3658) (strip2522 x3658 (quote (())))))
+ (lambda (x1297) (strip161 x1297 (quote (())))))
(set! generate-temporaries
- (lambda (ls3659)
+ (lambda (ls1298)
(begin
- (let ((x3660 ls3659))
- (if (not (list? x3660))
+ (let ((x1299 ls1298))
+ (if (not (list? x1299))
(syntax-violation
'generate-temporaries
"invalid argument"
- x3660)))
- (map (lambda (x3661)
- (wrap2504 (gensym) (quote ((top))) #f))
- ls3659))))
+ x1299)))
+ (map (lambda (x1300)
+ (wrap143 (gensym) (quote ((top))) #f))
+ ls1298))))
(set! free-identifier=?
- (lambda (x3662 y3663)
+ (lambda (x1301 y1302)
(begin
- (let ((x3664 x3662))
- (if (not (nonsymbol-id?2475 x3664))
+ (let ((x1303 x1301))
+ (if (not (nonsymbol-id?114 x1303))
(syntax-violation
'free-identifier=?
"invalid argument"
- x3664)))
- (let ((x3665 y3663))
- (if (not (nonsymbol-id?2475 x3665))
+ x1303)))
+ (let ((x1304 y1302))
+ (if (not (nonsymbol-id?114 x1304))
(syntax-violation
'free-identifier=?
"invalid argument"
- x3665)))
- (free-id=?2499 x3662 y3663))))
+ x1304)))
+ (free-id=?138 x1301 y1302))))
(set! bound-identifier=?
- (lambda (x3666 y3667)
+ (lambda (x1305 y1306)
(begin
- (let ((x3668 x3666))
- (if (not (nonsymbol-id?2475 x3668))
+ (let ((x1307 x1305))
+ (if (not (nonsymbol-id?114 x1307))
(syntax-violation
'bound-identifier=?
"invalid argument"
- x3668)))
- (let ((x3669 y3667))
- (if (not (nonsymbol-id?2475 x3669))
+ x1307)))
+ (let ((x1308 y1306))
+ (if (not (nonsymbol-id?114 x1308))
(syntax-violation
'bound-identifier=?
"invalid argument"
- x3669)))
- (bound-id=?2500 x3666 y3667))))
+ x1308)))
+ (bound-id=?139 x1305 y1306))))
(set! syntax-violation
- (lambda (who3673 message3672 form3671 . subform3670)
+ (lambda (who1312 message1311 form1310 . subform1309)
(begin
- (let ((x3674 who3673))
- (if (not ((lambda (x3675)
- (let ((t3676 (not x3675)))
- (if t3676
- t3676
- (let ((t3677 (string? x3675)))
- (if t3677 t3677 (symbol? x3675))))))
- x3674))
+ (let ((x1313 who1312))
+ (if (not ((lambda (x1314)
+ (let ((t1315 (not x1314)))
+ (if t1315
+ t1315
+ (let ((t1316 (string? x1314)))
+ (if t1316 t1316 (symbol? x1314))))))
+ x1313))
(syntax-violation
'syntax-violation
"invalid argument"
- x3674)))
- (let ((x3678 message3672))
- (if (not (string? x3678))
+ x1313)))
+ (let ((x1317 message1311))
+ (if (not (string? x1317))
(syntax-violation
'syntax-violation
"invalid argument"
- x3678)))
+ x1317)))
(scm-error
'syntax-error
'sc-expand
(string-append
- (if who3673 "~a: " "")
+ (if who1312 "~a: " "")
"~a "
- (if (null? subform3670)
+ (if (null? subform1309)
"in ~a"
"in subform `~s' of `~s'"))
- (let ((tail3679
- (cons message3672
- (map (lambda (x3680)
- (strip2522 x3680 (quote (()))))
- (append subform3670 (list form3671))))))
- (if who3673 (cons who3673 tail3679) tail3679))
+ (let ((tail1318
+ (cons message1311
+ (map (lambda (x1319) (strip161 x1319 (quote (()))))
+ (append subform1309 (list form1310))))))
+ (if who1312 (cons who1312 tail1318) tail1318))
#f))))
- (letrec ((match3685
- (lambda (e3686 p3687 w3688 r3689 mod3690)
- (if (not r3689)
+ (letrec ((match1324
+ (lambda (e1325 p1326 w1327 r1328 mod1329)
+ (if (not r1328)
#f
- (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)
+ (if (eq? p1326 (quote any))
+ (cons (wrap143 e1325 w1327 mod1329) r1328)
+ (if (syntax-object?99 e1325)
+ (match*1323
+ (syntax-object-expression100 e1325)
+ p1326
+ (join-wraps134
+ w1327
+ (syntax-object-wrap101 e1325))
+ r1328
+ (syntax-object-module102 e1325))
+ (match*1323 e1325 p1326 w1327 r1328 mod1329))))))
+ (match*1323
+ (lambda (e1330 p1331 w1332 r1333 mod1334)
+ (if (null? p1331)
+ (if (null? e1330) r1333 #f)
+ (if (pair? p1331)
+ (if (pair? e1330)
+ (match1324
+ (car e1330)
+ (car p1331)
+ w1332
+ (match1324
+ (cdr e1330)
+ (cdr p1331)
+ w1332
+ r1333
+ mod1334)
+ mod1334)
#f)
- (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))
+ (if (eq? p1331 (quote each-any))
+ (let ((l1335 (match-each-any1321
+ e1330
+ w1332
+ mod1334)))
+ (if l1335 (cons l1335 r1333) #f))
+ (let ((atom-key1336 (vector-ref p1331 0)))
+ (if (memv atom-key1336 (quote (each)))
+ (if (null? e1330)
+ (match-empty1322 (vector-ref p1331 1) r1333)
+ (let ((l1337 (match-each1320
+ e1330
+ (vector-ref p1331 1)
+ w1332
+ mod1334)))
+ (if l1337
+ (letrec ((collect1338
+ (lambda (l1339)
+ (if (null? (car l1339))
+ r1333
+ (cons (map car l1339)
+ (collect1338
+ (map cdr l1339)))))))
+ (collect1338 l1337))
#f)))
- (if (memv atom-key3697 (quote (free-id)))
- (if (id?2476 e3691)
- (if (free-id=?2499
- (wrap2504 e3691 w3693 mod3695)
- (vector-ref p3692 1))
- r3694
+ (if (memv atom-key1336 (quote (free-id)))
+ (if (id?115 e1330)
+ (if (free-id=?138
+ (wrap143 e1330 w1332 mod1334)
+ (vector-ref p1331 1))
+ r1333
#f)
#f)
- (if (memv atom-key3697 (quote (atom)))
+ (if (memv atom-key1336 (quote (atom)))
(if (equal?
- (vector-ref p3692 1)
- (strip2522 e3691 w3693))
- r3694
+ (vector-ref p1331 1)
+ (strip161 e1330 w1332))
+ r1333
#f)
- (if (memv atom-key3697 (quote (vector)))
- (if (vector? e3691)
- (match3685
- (vector->list e3691)
- (vector-ref p3692 1)
- w3693
- r3694
- mod3695)
+ (if (memv atom-key1336 (quote (vector)))
+ (if (vector? e1330)
+ (match1324
+ (vector->list e1330)
+ (vector-ref p1331 1)
+ w1332
+ r1333
+ mod1334)
#f)))))))))))
- (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)
+ (match-empty1322
+ (lambda (p1340 r1341)
+ (if (null? p1340)
+ r1341
+ (if (eq? p1340 (quote any))
+ (cons (quote ()) r1341)
+ (if (pair? p1340)
+ (match-empty1322
+ (car p1340)
+ (match-empty1322 (cdr p1340) r1341))
+ (if (eq? p1340 (quote each-any))
+ (cons (quote ()) r1341)
+ (let ((atom-key1342 (vector-ref p1340 0)))
+ (if (memv atom-key1342 (quote (each)))
+ (match-empty1322 (vector-ref p1340 1) r1341)
+ (if (memv atom-key1342 (quote (free-id atom)))
+ r1341
+ (if (memv atom-key1342 (quote (vector)))
+ (match-empty1322
+ (vector-ref p1340 1)
+ r1341)))))))))))
+ (match-each-any1321
+ (lambda (e1343 w1344 mod1345)
+ (if (pair? e1343)
+ (let ((l1346 (match-each-any1321
+ (cdr e1343)
+ w1344
+ mod1345)))
+ (if l1346
+ (cons (wrap143 (car e1343) w1344 mod1345) l1346)
#f))
- (if (null? e3704)
+ (if (null? e1343)
'()
- (if (syntax-object?2460 e3704)
- (match-each-any3682
- (syntax-object-expression2461 e3704)
- (join-wraps2495
- w3705
- (syntax-object-wrap2462 e3704))
- mod3706)
+ (if (syntax-object?99 e1343)
+ (match-each-any1321
+ (syntax-object-expression100 e1343)
+ (join-wraps134
+ w1344
+ (syntax-object-wrap101 e1343))
+ mod1345)
#f)))))
- (match-each3681
- (lambda (e3708 p3709 w3710 mod3711)
- (if (pair? e3708)
- (let ((first3712
- (match3685
- (car e3708)
- p3709
- w3710
+ (match-each1320
+ (lambda (e1347 p1348 w1349 mod1350)
+ (if (pair? e1347)
+ (let ((first1351
+ (match1324
+ (car e1347)
+ p1348
+ w1349
'()
- mod3711)))
- (if first3712
- (let ((rest3713
- (match-each3681
- (cdr e3708)
- p3709
- w3710
- mod3711)))
- (if rest3713 (cons first3712 rest3713) #f))
+ mod1350)))
+ (if first1351
+ (let ((rest1352
+ (match-each1320
+ (cdr e1347)
+ p1348
+ w1349
+ mod1350)))
+ (if rest1352 (cons first1351 rest1352) #f))
#f))
- (if (null? e3708)
+ (if (null? e1347)
'()
- (if (syntax-object?2460 e3708)
- (match-each3681
- (syntax-object-expression2461 e3708)
- p3709
- (join-wraps2495
- w3710
- (syntax-object-wrap2462 e3708))
- (syntax-object-module2463 e3708))
+ (if (syntax-object?99 e1347)
+ (match-each1320
+ (syntax-object-expression100 e1347)
+ p1348
+ (join-wraps134
+ w1349
+ (syntax-object-wrap101 e1347))
+ (syntax-object-module102 e1347))
#f))))))
(set! $sc-dispatch
- (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)
+ (lambda (e1353 p1354)
+ (if (eq? p1354 (quote any))
+ (list e1353)
+ (if (syntax-object?99 e1353)
+ (match*1323
+ (syntax-object-expression100 e1353)
+ p1354
+ (syntax-object-wrap101 e1353)
'()
- (syntax-object-module2463 e3714))
- (match*3684
- e3714
- p3715
+ (syntax-object-module102 e1353))
+ (match*1323
+ e1353
+ p1354
'(())
'()
#f)))))))))
@@ -8497,11 +8336,11 @@
(define with-syntax
(make-syncase-macro
'macro
- (lambda (x3716)
- ((lambda (tmp3717)
- ((lambda (tmp3718)
- (if tmp3718
- (apply (lambda (_3719 e13720 e23721)
+ (lambda (x1355)
+ ((lambda (tmp1356)
+ ((lambda (tmp1357)
+ (if tmp1357
+ (apply (lambda (_1358 e11359 e21360)
(cons '#(syntax-object
begin
((top)
@@ -8512,11 +8351,11 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- (cons e13720 e23721)))
- tmp3718)
- ((lambda (tmp3723)
- (if tmp3723
- (apply (lambda (_3724 out3725 in3726 e13727 e23728)
+ (cons e11359 e21360)))
+ tmp1357)
+ ((lambda (tmp1362)
+ (if tmp1362
+ (apply (lambda (_1363 out1364 in1365 e11366 e21367)
(list '#(syntax-object
syntax-case
((top)
@@ -8527,9 +8366,9 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- in3726
+ in1365
'()
- (list out3725
+ (list out1364
(cons '#(syntax-object
begin
((top)
@@ -8547,11 +8386,11 @@
#((top))
#("i")))
(hygiene guile))
- (cons e13727 e23728)))))
- tmp3723)
- ((lambda (tmp3730)
- (if tmp3730
- (apply (lambda (_3731 out3732 in3733 e13734 e23735)
+ (cons e11366 e21367)))))
+ tmp1362)
+ ((lambda (tmp1369)
+ (if tmp1369
+ (apply (lambda (_1370 out1371 in1372 e11373 e21374)
(list '#(syntax-object
syntax-case
((top)
@@ -8579,9 +8418,9 @@
#((top))
#("i")))
(hygiene guile))
- in3733)
+ in1372)
'()
- (list out3732
+ (list out1371
(cons '#(syntax-object
begin
((top)
@@ -8603,35 +8442,35 @@
#((top))
#("i")))
(hygiene guile))
- (cons e13734 e23735)))))
- tmp3730)
+ (cons e11373 e21374)))))
+ tmp1369)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3717)))
+ tmp1356)))
($sc-dispatch
- tmp3717
+ tmp1356
'(any #(each (any any)) any . each-any)))))
($sc-dispatch
- tmp3717
+ tmp1356
'(any ((any any)) any . each-any)))))
($sc-dispatch
- tmp3717
+ tmp1356
'(any () any . each-any))))
- x3716))))
+ x1355))))
(define syntax-rules
(make-syncase-macro
'macro
- (lambda (x3739)
- ((lambda (tmp3740)
- ((lambda (tmp3741)
- (if tmp3741
- (apply (lambda (_3742
- k3743
- keyword3744
- pattern3745
- template3746)
+ (lambda (x1378)
+ ((lambda (tmp1379)
+ ((lambda (tmp1380)
+ (if tmp1380
+ (apply (lambda (_1381
+ k1382
+ keyword1383
+ pattern1384
+ template1385)
(list '#(syntax-object
lambda
((top)
@@ -8672,8 +8511,8 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- (cons k3743
- (map (lambda (tmp3749 tmp3748)
+ (cons k1382
+ (map (lambda (tmp1388 tmp1387)
(list (cons '#(syntax-object
dummy
((top)
@@ -8703,7 +8542,7 @@
#("i")))
(hygiene
guile))
- tmp3748)
+ tmp1387)
(list '#(syntax-object
syntax
((top)
@@ -8733,34 +8572,34 @@
#("i")))
(hygiene
guile))
- tmp3749)))
- template3746
- pattern3745))))))
- tmp3741)
+ tmp1388)))
+ template1385
+ pattern1384))))))
+ tmp1380)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3740)))
+ tmp1379)))
($sc-dispatch
- tmp3740
+ tmp1379
'(any each-any . #(each ((any . any) any))))))
- x3739))))
+ x1378))))
(define let*
(make-extended-syncase-macro
(module-ref (current-module) (quote let*))
'macro
- (lambda (x3750)
- ((lambda (tmp3751)
- ((lambda (tmp3752)
- (if (if tmp3752
- (apply (lambda (let*3753 x3754 v3755 e13756 e23757)
- (and-map identifier? x3754))
- tmp3752)
+ (lambda (x1389)
+ ((lambda (tmp1390)
+ ((lambda (tmp1391)
+ (if (if tmp1391
+ (apply (lambda (let*1392 x1393 v1394 e11395 e21396)
+ (and-map identifier? x1393))
+ tmp1391)
#f)
- (apply (lambda (let*3759 x3760 v3761 e13762 e23763)
- (letrec ((f3764 (lambda (bindings3765)
- (if (null? bindings3765)
+ (apply (lambda (let*1398 x1399 v1400 e11401 e21402)
+ (letrec ((f1403 (lambda (bindings1404)
+ (if (null? bindings1404)
(cons '#(syntax-object
let
((top)
@@ -8784,12 +8623,12 @@
#("i")))
(hygiene guile))
(cons '()
- (cons e13762 e23763)))
- ((lambda (tmp3769)
- ((lambda (tmp3770)
- (if tmp3770
- (apply (lambda (body3771
- binding3772)
+ (cons e11401 e21402)))
+ ((lambda (tmp1408)
+ ((lambda (tmp1409)
+ (if tmp1409
+ (apply (lambda (body1410
+ binding1411)
(list '#(syntax-object
let
((top)
@@ -8837,51 +8676,51 @@
#("i")))
(hygiene
guile))
- (list binding3772)
- body3771))
- tmp3770)
+ (list binding1411)
+ body1410))
+ tmp1409)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3769)))
+ tmp1408)))
($sc-dispatch
- tmp3769
+ tmp1408
'(any any))))
- (list (f3764 (cdr bindings3765))
- (car bindings3765)))))))
- (f3764 (map list x3760 v3761))))
- tmp3752)
+ (list (f1403 (cdr bindings1404))
+ (car bindings1404)))))))
+ (f1403 (map list x1399 v1400))))
+ tmp1391)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3751)))
+ tmp1390)))
($sc-dispatch
- tmp3751
+ tmp1390
'(any #(each (any any)) any . each-any))))
- x3750))))
+ x1389))))
(define do
(make-extended-syncase-macro
(module-ref (current-module) (quote do))
'macro
- (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
+ (lambda (orig-x1412)
+ ((lambda (tmp1413)
+ ((lambda (tmp1414)
+ (if tmp1414
+ (apply (lambda (_1415
+ var1416
+ init1417
+ step1418
+ e01419
+ e11420
+ c1421)
+ ((lambda (tmp1422)
+ ((lambda (tmp1423)
+ (if tmp1423
+ (apply (lambda (step1424)
+ ((lambda (tmp1425)
+ ((lambda (tmp1426)
+ (if tmp1426
(apply (lambda ()
(list '#(syntax-object
let
@@ -8962,8 +8801,8 @@
(hygiene
guile))
(map list
- var3777
- init3778)
+ var1416
+ init1417)
(list '#(syntax-object
if
((top)
@@ -9042,7 +8881,7 @@
#("i")))
(hygiene
guile))
- e03780)
+ e01419)
(cons '#(syntax-object
begin
((top)
@@ -9083,7 +8922,7 @@
(hygiene
guile))
(append
- c3782
+ c1421
(list (cons '#(syntax-object
doloop
((top)
@@ -9123,12 +8962,12 @@
#("i")))
(hygiene
guile))
- step3785)))))))
- tmp3787)
- ((lambda (tmp3792)
- (if tmp3792
- (apply (lambda (e13793
- e23794)
+ step1424)))))))
+ tmp1426)
+ ((lambda (tmp1431)
+ (if tmp1431
+ (apply (lambda (e11432
+ e21433)
(list '#(syntax-object
let
((top)
@@ -9222,8 +9061,8 @@
(hygiene
guile))
(map list
- var3777
- init3778)
+ var1416
+ init1417)
(list '#(syntax-object
if
((top)
@@ -9270,7 +9109,7 @@
#("i")))
(hygiene
guile))
- e03780
+ e01419
(cons '#(syntax-object
begin
((top)
@@ -9317,8 +9156,8 @@
#("i")))
(hygiene
guile))
- (cons e13793
- e23794))
+ (cons e11432
+ e21433))
(cons '#(syntax-object
begin
((top)
@@ -9366,7 +9205,7 @@
(hygiene
guile))
(append
- c3782
+ c1421
(list (cons '#(syntax-object
doloop
((top)
@@ -9413,75 +9252,75 @@
#("i")))
(hygiene
guile))
- step3785)))))))
- tmp3792)
+ step1424)))))))
+ tmp1431)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3786)))
+ tmp1425)))
($sc-dispatch
- tmp3786
+ tmp1425
'(any . each-any)))))
- ($sc-dispatch tmp3786 (quote ()))))
- e13781))
- tmp3784)
+ ($sc-dispatch tmp1425 (quote ()))))
+ e11420))
+ tmp1423)
(syntax-violation
#f
"source expression failed to match any pattern"
- 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)
+ tmp1422)))
+ ($sc-dispatch tmp1422 (quote each-any))))
+ (map (lambda (v1440 s1441)
+ ((lambda (tmp1442)
+ ((lambda (tmp1443)
+ (if tmp1443
+ (apply (lambda () v1440) tmp1443)
+ ((lambda (tmp1444)
+ (if tmp1444
+ (apply (lambda (e1445) e1445)
+ tmp1444)
+ ((lambda (_1446)
(syntax-violation
'do
"bad step expression"
- orig-x3773
- s3802))
- tmp3803)))
- ($sc-dispatch tmp3803 (quote (any))))))
- ($sc-dispatch tmp3803 (quote ()))))
- s3802))
- var3777
- step3779)))
- tmp3775)
+ orig-x1412
+ s1441))
+ tmp1442)))
+ ($sc-dispatch tmp1442 (quote (any))))))
+ ($sc-dispatch tmp1442 (quote ()))))
+ s1441))
+ var1416
+ step1418)))
+ tmp1414)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3774)))
+ tmp1413)))
($sc-dispatch
- tmp3774
+ tmp1413
'(any #(each (any any . any))
(any . each-any)
.
each-any))))
- orig-x3773))))
+ orig-x1412))))
(define quasiquote
(make-extended-syncase-macro
(module-ref (current-module) (quote quasiquote))
'macro
- (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)
+ (letrec ((quasicons1449
+ (lambda (x1453 y1454)
+ ((lambda (tmp1455)
+ ((lambda (tmp1456)
+ (if tmp1456
+ (apply (lambda (x1457 y1458)
+ ((lambda (tmp1459)
+ ((lambda (tmp1460)
+ (if tmp1460
+ (apply (lambda (dy1461)
+ ((lambda (tmp1462)
+ ((lambda (tmp1463)
+ (if tmp1463
+ (apply (lambda (dx1464)
(list '#(syntax-object
quote
((top)
@@ -9530,11 +9369,11 @@
"i")))
(hygiene
guile))
- (cons dx3825
- dy3822)))
- tmp3824)
- ((lambda (_3826)
- (if (null? dy3822)
+ (cons dx1464
+ dy1461)))
+ tmp1463)
+ ((lambda (_1465)
+ (if (null? dy1461)
(list '#(syntax-object
list
((top)
@@ -9583,7 +9422,7 @@
"i")))
(hygiene
guile))
- x3818)
+ x1457)
(list '#(syntax-object
cons
((top)
@@ -9632,11 +9471,11 @@
"i")))
(hygiene
guile))
- x3818
- y3819)))
- tmp3823)))
+ x1457
+ y1458)))
+ tmp1462)))
($sc-dispatch
- tmp3823
+ tmp1462
'(#(free-id
#(syntax-object
quote
@@ -9679,11 +9518,11 @@
(hygiene
guile)))
any))))
- x3818))
- tmp3821)
- ((lambda (tmp3827)
- (if tmp3827
- (apply (lambda (stuff3828)
+ x1457))
+ tmp1460)
+ ((lambda (tmp1466)
+ (if tmp1466
+ (apply (lambda (stuff1467)
(cons '#(syntax-object
list
((top)
@@ -9724,10 +9563,10 @@
"i")))
(hygiene
guile))
- (cons x3818
- stuff3828)))
- tmp3827)
- ((lambda (else3829)
+ (cons x1457
+ stuff1467)))
+ tmp1466)
+ ((lambda (else1468)
(list '#(syntax-object
cons
((top)
@@ -9759,11 +9598,11 @@
"i"
"i")))
(hygiene guile))
- x3818
- y3819))
- tmp3820)))
+ x1457
+ y1458))
+ tmp1459)))
($sc-dispatch
- tmp3820
+ tmp1459
'(#(free-id
#(syntax-object
list
@@ -9792,7 +9631,7 @@
.
any)))))
($sc-dispatch
- tmp3820
+ tmp1459
'(#(free-id
#(syntax-object
quote
@@ -9816,25 +9655,25 @@
#("i" "i" "i" "i")))
(hygiene guile)))
any))))
- y3819))
- tmp3817)
+ y1458))
+ tmp1456)
(syntax-violation
#f
"source expression failed to match any pattern"
- 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)
+ tmp1455)))
+ ($sc-dispatch tmp1455 (quote (any any)))))
+ (list x1453 y1454))))
+ (quasiappend1450
+ (lambda (x1469 y1470)
+ ((lambda (tmp1471)
+ ((lambda (tmp1472)
+ (if tmp1472
+ (apply (lambda (x1473 y1474)
+ ((lambda (tmp1475)
+ ((lambda (tmp1476)
+ (if tmp1476
+ (apply (lambda () x1473) tmp1476)
+ ((lambda (_1477)
(list '#(syntax-object
append
((top)
@@ -9863,11 +9702,11 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile))
- x3834
- y3835))
- tmp3836)))
+ x1473
+ y1474))
+ tmp1475)))
($sc-dispatch
- tmp3836
+ tmp1475
'(#(free-id
#(syntax-object
quote
@@ -9891,22 +9730,22 @@
#("i" "i" "i" "i")))
(hygiene guile)))
()))))
- y3835))
- tmp3833)
+ y1474))
+ tmp1472)
(syntax-violation
#f
"source expression failed to match any pattern"
- 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)
+ tmp1471)))
+ ($sc-dispatch tmp1471 (quote (any any)))))
+ (list x1469 y1470))))
+ (quasivector1451
+ (lambda (x1478)
+ ((lambda (tmp1479)
+ ((lambda (x1480)
+ ((lambda (tmp1481)
+ ((lambda (tmp1482)
+ (if tmp1482
+ (apply (lambda (x1483)
(list '#(syntax-object
quote
((top)
@@ -9932,11 +9771,11 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- (list->vector x3844)))
- tmp3843)
- ((lambda (tmp3846)
- (if tmp3846
- (apply (lambda (x3847)
+ (list->vector x1483)))
+ tmp1482)
+ ((lambda (tmp1485)
+ (if tmp1485
+ (apply (lambda (x1486)
(cons '#(syntax-object
vector
((top)
@@ -9965,9 +9804,9 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile))
- x3847))
- tmp3846)
- ((lambda (_3849)
+ x1486))
+ tmp1485)
+ ((lambda (_1488)
(list '#(syntax-object
list->vector
((top)
@@ -9993,10 +9832,10 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- x3841))
- tmp3842)))
+ x1480))
+ tmp1481)))
($sc-dispatch
- tmp3842
+ tmp1481
'(#(free-id
#(syntax-object
list
@@ -10016,7 +9855,7 @@
.
each-any)))))
($sc-dispatch
- tmp3842
+ tmp1481
'(#(free-id
#(syntax-object
quote
@@ -10034,18 +9873,18 @@
#("i" "i" "i" "i")))
(hygiene guile)))
each-any))))
- x3841))
- tmp3840))
- x3839)))
- (quasi3813
- (lambda (p3850 lev3851)
- ((lambda (tmp3852)
- ((lambda (tmp3853)
- (if tmp3853
- (apply (lambda (p3854)
- (if (= lev3851 0)
- p3854
- (quasicons3810
+ x1480))
+ tmp1479))
+ x1478)))
+ (quasi1452
+ (lambda (p1489 lev1490)
+ ((lambda (tmp1491)
+ ((lambda (tmp1492)
+ (if tmp1492
+ (apply (lambda (p1493)
+ (if (= lev1490 0)
+ p1493
+ (quasicons1449
'(#(syntax-object
quote
((top)
@@ -10080,18 +9919,18 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile)))
- (quasi3813 (list p3854) (- lev3851 1)))))
- tmp3853)
- ((lambda (tmp3855)
- (if (if tmp3855
- (apply (lambda (args3856) (= lev3851 0))
- tmp3855)
+ (quasi1452 (list p1493) (- lev1490 1)))))
+ tmp1492)
+ ((lambda (tmp1494)
+ (if (if tmp1494
+ (apply (lambda (args1495) (= lev1490 0))
+ tmp1494)
#f)
- (apply (lambda (args3857)
+ (apply (lambda (args1496)
(syntax-violation
'unquote
"unquote takes exactly one argument"
- p3850
+ p1489
(cons '#(syntax-object
unquote
((top)
@@ -10112,17 +9951,17 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- args3857)))
- tmp3855)
- ((lambda (tmp3858)
- (if tmp3858
- (apply (lambda (p3859 q3860)
- (if (= lev3851 0)
- (quasiappend3811
- p3859
- (quasi3813 q3860 lev3851))
- (quasicons3810
- (quasicons3810
+ args1496)))
+ tmp1494)
+ ((lambda (tmp1497)
+ (if tmp1497
+ (apply (lambda (p1498 q1499)
+ (if (= lev1490 0)
+ (quasiappend1450
+ p1498
+ (quasi1452 q1499 lev1490))
+ (quasicons1449
+ (quasicons1449
'(#(syntax-object
quote
((top)
@@ -10169,22 +10008,22 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile)))
- (quasi3813
- (list p3859)
- (- lev3851 1)))
- (quasi3813 q3860 lev3851))))
- tmp3858)
- ((lambda (tmp3861)
- (if (if tmp3861
- (apply (lambda (args3862 q3863)
- (= lev3851 0))
- tmp3861)
+ (quasi1452
+ (list p1498)
+ (- lev1490 1)))
+ (quasi1452 q1499 lev1490))))
+ tmp1497)
+ ((lambda (tmp1500)
+ (if (if tmp1500
+ (apply (lambda (args1501 q1502)
+ (= lev1490 0))
+ tmp1500)
#f)
- (apply (lambda (args3864 q3865)
+ (apply (lambda (args1503 q1504)
(syntax-violation
'unquote-splicing
"unquote-splicing takes exactly one argument"
- p3850
+ p1489
(cons '#(syntax-object
unquote-splicing
((top)
@@ -10214,12 +10053,12 @@
"i"
"i")))
(hygiene guile))
- args3864)))
- tmp3861)
- ((lambda (tmp3866)
- (if tmp3866
- (apply (lambda (p3867)
- (quasicons3810
+ args1503)))
+ tmp1500)
+ ((lambda (tmp1505)
+ (if tmp1505
+ (apply (lambda (p1506)
+ (quasicons1449
'(#(syntax-object
quote
((top)
@@ -10278,30 +10117,30 @@
"i"
"i")))
(hygiene guile)))
- (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)
+ (quasi1452
+ (list p1506)
+ (+ lev1490 1))))
+ tmp1505)
+ ((lambda (tmp1507)
+ (if tmp1507
+ (apply (lambda (p1508 q1509)
+ (quasicons1449
+ (quasi1452
+ p1508
+ lev1490)
+ (quasi1452
+ q1509
+ lev1490)))
+ tmp1507)
+ ((lambda (tmp1510)
+ (if tmp1510
+ (apply (lambda (x1511)
+ (quasivector1451
+ (quasi1452
+ x1511
+ lev1490)))
+ tmp1510)
+ ((lambda (p1513)
(list '#(syntax-object
quote
((top)
@@ -10334,16 +10173,16 @@
"i")))
(hygiene
guile))
- p3874))
- tmp3852)))
+ p1513))
+ tmp1491)))
($sc-dispatch
- tmp3852
+ tmp1491
'#(vector each-any)))))
($sc-dispatch
- tmp3852
+ tmp1491
'(any . any)))))
($sc-dispatch
- tmp3852
+ tmp1491
'(#(free-id
#(syntax-object
quasiquote
@@ -10363,7 +10202,7 @@
(hygiene guile)))
any)))))
($sc-dispatch
- tmp3852
+ tmp1491
'((#(free-id
#(syntax-object
unquote-splicing
@@ -10386,7 +10225,7 @@
.
any)))))
($sc-dispatch
- tmp3852
+ tmp1491
'((#(free-id
#(syntax-object
unquote-splicing
@@ -10408,7 +10247,7 @@
.
any)))))
($sc-dispatch
- tmp3852
+ tmp1491
'(#(free-id
#(syntax-object
unquote
@@ -10426,7 +10265,7 @@
.
any)))))
($sc-dispatch
- tmp3852
+ tmp1491
'(#(free-id
#(syntax-object
unquote
@@ -10439,44 +10278,44 @@
#("i" "i" "i" "i")))
(hygiene guile)))
any))))
- p3850))))
- (lambda (x3875)
- ((lambda (tmp3876)
- ((lambda (tmp3877)
- (if tmp3877
- (apply (lambda (_3878 e3879) (quasi3813 e3879 0))
- tmp3877)
+ p1489))))
+ (lambda (x1514)
+ ((lambda (tmp1515)
+ ((lambda (tmp1516)
+ (if tmp1516
+ (apply (lambda (_1517 e1518) (quasi1452 e1518 0))
+ tmp1516)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3876)))
- ($sc-dispatch tmp3876 (quote (any any)))))
- x3875)))))
+ tmp1515)))
+ ($sc-dispatch tmp1515 (quote (any any)))))
+ x1514)))))
(define include
(make-syncase-macro
'macro
- (lambda (x3880)
- (letrec ((read-file3881
- (lambda (fn3882 k3883)
- (let ((p3884 (open-input-file fn3882)))
- (letrec ((f3885 (lambda (x3886)
- (if (eof-object? x3886)
+ (lambda (x1519)
+ (letrec ((read-file1520
+ (lambda (fn1521 k1522)
+ (let ((p1523 (open-input-file fn1521)))
+ (letrec ((f1524 (lambda (x1525)
+ (if (eof-object? x1525)
(begin
- (close-input-port p3884)
+ (close-input-port p1523)
'())
- (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 (datum->syntax k1522 x1525)
+ (f1524 (read p1523)))))))
+ (f1524 (read p1523)))))))
+ ((lambda (tmp1526)
+ ((lambda (tmp1527)
+ (if tmp1527
+ (apply (lambda (k1528 filename1529)
+ (let ((fn1530 (syntax->datum filename1529)))
+ ((lambda (tmp1531)
+ ((lambda (tmp1532)
+ (if tmp1532
+ (apply (lambda (exp1533)
(cons '#(syntax-object
begin
((top)
@@ -10503,73 +10342,73 @@
#((top))
#("i")))
(hygiene guile))
- exp3894))
- tmp3893)
+ exp1533))
+ tmp1532)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3892)))
- ($sc-dispatch tmp3892 (quote each-any))))
- (read-file3881 fn3891 k3889))))
- tmp3888)
+ tmp1531)))
+ ($sc-dispatch tmp1531 (quote each-any))))
+ (read-file1520 fn1530 k1528))))
+ tmp1527)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3887)))
- ($sc-dispatch tmp3887 (quote (any any)))))
- x3880)))))
+ tmp1526)))
+ ($sc-dispatch tmp1526 (quote (any any)))))
+ x1519)))))
(define unquote
(make-syncase-macro
'macro
- (lambda (x3896)
- ((lambda (tmp3897)
- ((lambda (tmp3898)
- (if tmp3898
- (apply (lambda (_3899 e3900)
+ (lambda (x1535)
+ ((lambda (tmp1536)
+ ((lambda (tmp1537)
+ (if tmp1537
+ (apply (lambda (_1538 e1539)
(syntax-violation
'unquote
"expression not valid outside of quasiquote"
- x3896))
- tmp3898)
+ x1535))
+ tmp1537)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3897)))
- ($sc-dispatch tmp3897 (quote (any any)))))
- x3896))))
+ tmp1536)))
+ ($sc-dispatch tmp1536 (quote (any any)))))
+ x1535))))
(define unquote-splicing
(make-syncase-macro
'macro
- (lambda (x3901)
- ((lambda (tmp3902)
- ((lambda (tmp3903)
- (if tmp3903
- (apply (lambda (_3904 e3905)
+ (lambda (x1540)
+ ((lambda (tmp1541)
+ ((lambda (tmp1542)
+ (if tmp1542
+ (apply (lambda (_1543 e1544)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
- x3901))
- tmp3903)
+ x1540))
+ tmp1542)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3902)))
- ($sc-dispatch tmp3902 (quote (any any)))))
- x3901))))
+ tmp1541)))
+ ($sc-dispatch tmp1541 (quote (any any)))))
+ x1540))))
(define case
(make-extended-syncase-macro
(module-ref (current-module) (quote case))
'macro
- (lambda (x3906)
- ((lambda (tmp3907)
- ((lambda (tmp3908)
- (if tmp3908
- (apply (lambda (_3909 e3910 m13911 m23912)
- ((lambda (tmp3913)
- ((lambda (body3914)
+ (lambda (x1545)
+ ((lambda (tmp1546)
+ ((lambda (tmp1547)
+ (if tmp1547
+ (apply (lambda (_1548 e1549 m11550 m21551)
+ ((lambda (tmp1552)
+ ((lambda (body1553)
(list '#(syntax-object
let
((top)
@@ -10598,16 +10437,16 @@
#((top))
#("i")))
(hygiene guile))
- e3910))
- body3914))
- tmp3913))
- (letrec ((f3915 (lambda (clause3916 clauses3917)
- (if (null? clauses3917)
- ((lambda (tmp3919)
- ((lambda (tmp3920)
- (if tmp3920
- (apply (lambda (e13921
- e23922)
+ e1549))
+ body1553))
+ tmp1552))
+ (letrec ((f1554 (lambda (clause1555 clauses1556)
+ (if (null? clauses1556)
+ ((lambda (tmp1558)
+ ((lambda (tmp1559)
+ (if tmp1559
+ (apply (lambda (e11560
+ e21561)
(cons '#(syntax-object
begin
((top)
@@ -10655,14 +10494,14 @@
#("i")))
(hygiene
guile))
- (cons e13921
- e23922)))
- tmp3920)
- ((lambda (tmp3924)
- (if tmp3924
- (apply (lambda (k3925
- e13926
- e23927)
+ (cons e11560
+ e21561)))
+ tmp1559)
+ ((lambda (tmp1563)
+ (if tmp1563
+ (apply (lambda (k1564
+ e11565
+ e21566)
(list '#(syntax-object
if
((top)
@@ -10863,7 +10702,7 @@
#("i")))
(hygiene
guile))
- k3925))
+ k1564))
(cons '#(syntax-object
begin
((top)
@@ -10914,24 +10753,24 @@
#("i")))
(hygiene
guile))
- (cons e13926
- e23927))))
- tmp3924)
- ((lambda (_3930)
+ (cons e11565
+ e21566))))
+ tmp1563)
+ ((lambda (_1569)
(syntax-violation
'case
"bad clause"
- x3906
- clause3916))
- tmp3919)))
+ x1545
+ clause1555))
+ tmp1558)))
($sc-dispatch
- tmp3919
+ tmp1558
'(each-any
any
.
each-any)))))
($sc-dispatch
- tmp3919
+ tmp1558
'(#(free-id
#(syntax-object
else
@@ -10957,15 +10796,15 @@
any
.
each-any))))
- clause3916)
- ((lambda (tmp3931)
- ((lambda (rest3932)
- ((lambda (tmp3933)
- ((lambda (tmp3934)
- (if tmp3934
- (apply (lambda (k3935
- e13936
- e23937)
+ clause1555)
+ ((lambda (tmp1570)
+ ((lambda (rest1571)
+ ((lambda (tmp1572)
+ ((lambda (tmp1573)
+ (if tmp1573
+ (apply (lambda (k1574
+ e11575
+ e21576)
(list '#(syntax-object
if
((top)
@@ -11182,7 +11021,7 @@
#("i")))
(hygiene
guile))
- k3935))
+ k1574))
(cons '#(syntax-object
begin
((top)
@@ -11237,46 +11076,46 @@
#("i")))
(hygiene
guile))
- (cons e13936
- e23937))
- rest3932))
- tmp3934)
- ((lambda (_3940)
+ (cons e11575
+ e21576))
+ rest1571))
+ tmp1573)
+ ((lambda (_1579)
(syntax-violation
'case
"bad clause"
- x3906
- clause3916))
- tmp3933)))
+ x1545
+ clause1555))
+ tmp1572)))
($sc-dispatch
- tmp3933
+ tmp1572
'(each-any
any
.
each-any))))
- clause3916))
- tmp3931))
- (f3915 (car clauses3917)
- (cdr clauses3917)))))))
- (f3915 m13911 m23912))))
- tmp3908)
+ clause1555))
+ tmp1570))
+ (f1554 (car clauses1556)
+ (cdr clauses1556)))))))
+ (f1554 m11550 m21551))))
+ tmp1547)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3907)))
+ tmp1546)))
($sc-dispatch
- tmp3907
+ tmp1546
'(any any any . each-any))))
- x3906))))
+ x1545))))
(define identifier-syntax
(make-syncase-macro
'macro
- (lambda (x3941)
- ((lambda (tmp3942)
- ((lambda (tmp3943)
- (if tmp3943
- (apply (lambda (_3944 e3945)
+ (lambda (x1580)
+ ((lambda (tmp1581)
+ ((lambda (tmp1582)
+ (if tmp1582
+ (apply (lambda (_1583 e1584)
(list '#(syntax-object
lambda
((top)
@@ -11365,8 +11204,8 @@
#((top))
#("i")))
(hygiene guile))
- e3945))
- (list (cons _3944
+ e1584))
+ (list (cons _1583
'(#(syntax-object
x
((top)
@@ -11406,7 +11245,7 @@
#((top))
#("i")))
(hygiene guile))
- (cons e3945
+ (cons e1584
'(#(syntax-object
x
((top)
@@ -11434,11 +11273,11 @@
#("i")))
(hygiene
guile)))))))))
- tmp3943)
+ tmp1582)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp3942)))
- ($sc-dispatch tmp3942 (quote (any any)))))
- x3941))))
+ tmp1581)))
+ ($sc-dispatch tmp1581 (quote (any any)))))
+ x1580))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index cbbcabd72..f1f6e9ae0 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -941,9 +941,7 @@
(define source-wrap
(lambda (x w s defmod)
- (if (and s (pair? x))
- (set-source-properties! x s))
- (wrap x w defmod)))
+ (wrap (decorate-source x s) w defmod)))
;;; expanding
@@ -1101,7 +1099,9 @@
(valid-bound-ids? (lambda-var-list (syntax args))))
; need lambda here...
(values 'define-form (wrap (syntax name) w mod)
- (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w mod))
+ (decorate-source
+ (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w mod))
+ s)
empty-wrap s mod))
((_ name)
(id? (syntax name))