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