summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2012-02-14 23:22:51 -0500
committerMark H Weaver <mhw@netris.org>2012-02-15 11:24:43 -0500
commit32fbc38fbb3c7544a45f7be3cf0a981a31681cbb (patch)
tree97d44f21af7c615d4417509829f4387f0478e6d3
parent76b9bac565182dd7d0ffe416c3382ac7d59d93ab (diff)
downloadguile-32fbc38fbb3c7544a45f7be3cf0a981a31681cbb.tar.gz
psyntax: access source properties for all supported objects
* module/ice-9/psyntax.scm (decorate-source): Set source properties on any object that satisfies 'supports-source-properties?'. Previously we used 'pair?' as the predicate. (source-annotation): Apply 'source-properties' to _any_ kind of source expression, where previously only pairs were queried. If the argument is a syntax-object, apply the source-properties to the syntax-object's expression. In the peculiar case of a syntax-object whose expression is also a syntax-object: previously we would iterate, but with this commit we now call 'syntax-object-expression' only once. * module/ice-9/psyntax-pp.scm: Regenerate.
-rw-r--r--module/ice-9/psyntax-pp.scm12795
-rw-r--r--module/ice-9/psyntax.scm15
2 files changed, 6438 insertions, 6372 deletions
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 41d7db426..dd6b6cada 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,1268 +1,1270 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
-(let ((session-id-4255 (if #f #f))
- (transformer-environment-4316 (if #f #f)))
+(let ((session-id-4256 (if #f #f))
+ (transformer-environment-4317 (if #f #f)))
(letrec*
- ((top-level-eval-hook-4253
- (lambda (x-27423 mod-27424)
- (primitive-eval x-27423)))
- (get-global-definition-hook-4257
- (lambda (symbol-15686 module-15687)
+ ((top-level-eval-hook-4254
+ (lambda (x-27424 mod-27425)
+ (primitive-eval x-27424)))
+ (get-global-definition-hook-4258
+ (lambda (symbol-15687 module-15688)
(begin
- (if (if (not module-15687) (current-module) #f)
+ (if (if (not module-15688) (current-module) #f)
(warn "module system is booted, we should have a module"
- symbol-15686))
- (let ((v-15688
+ symbol-15687))
+ (let ((v-15689
(module-variable
- (if module-15687
- (resolve-module (cdr module-15687))
+ (if module-15688
+ (resolve-module (cdr module-15688))
(current-module))
- symbol-15686)))
- (if v-15688
- (if (variable-bound? v-15688)
- (let ((val-15690 (variable-ref v-15688)))
- (if (macro? val-15690)
- (if (macro-type val-15690)
- (cons (macro-type val-15690)
- (macro-binding val-15690))
+ symbol-15687)))
+ (if v-15689
+ (if (variable-bound? v-15689)
+ (let ((val-15691 (variable-ref v-15689)))
+ (if (macro? val-15691)
+ (if (macro-type val-15691)
+ (cons (macro-type val-15691)
+ (macro-binding val-15691))
#f)
#f))
#f)
#f)))))
- (maybe-name-value!-4259
- (lambda (name-15967 val-15968)
- (if (if (struct? val-15968)
- (eq? (struct-vtable val-15968)
+ (maybe-name-value!-4260
+ (lambda (name-15968 val-15969)
+ (if (if (struct? val-15969)
+ (eq? (struct-vtable val-15969)
(vector-ref %expanded-vtables 13))
#f)
- (let ((meta-15975 (struct-ref val-15968 1)))
- (if (not (assq 'name meta-15975))
- (let ((v-15980
- (cons (cons 'name name-15967) meta-15975)))
- (struct-set! val-15968 1 v-15980)))))))
- (build-application-4261
- (lambda (source-15692 fun-exp-15693 arg-exps-15694)
+ (let ((meta-15976 (struct-ref val-15969 1)))
+ (if (not (assq 'name meta-15976))
+ (let ((v-15981
+ (cons (cons 'name name-15968) meta-15976)))
+ (struct-set! val-15969 1 v-15981)))))))
+ (build-application-4262
+ (lambda (source-15693 fun-exp-15694 arg-exps-15695)
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
- source-15692
- fun-exp-15693
- arg-exps-15694)))
- (build-conditional-4262
- (lambda (source-15700
- test-exp-15701
- then-exp-15702
- else-exp-15703)
+ source-15693
+ fun-exp-15694
+ arg-exps-15695)))
+ (build-conditional-4263
+ (lambda (source-15701
+ test-exp-15702
+ then-exp-15703
+ else-exp-15704)
(make-struct/no-tail
(vector-ref %expanded-vtables 10)
- source-15700
- test-exp-15701
- then-exp-15702
- else-exp-15703)))
- (build-dynlet-4263
- (lambda (source-15710 fluids-15711 vals-15712 body-15713)
+ source-15701
+ test-exp-15702
+ then-exp-15703
+ else-exp-15704)))
+ (build-dynlet-4264
+ (lambda (source-15711 fluids-15712 vals-15713 body-15714)
(make-struct/no-tail
(vector-ref %expanded-vtables 17)
- source-15710
- fluids-15711
- vals-15712
- body-15713)))
- (build-lexical-reference-4264
- (lambda (type-27425 source-27426 name-27427 var-27428)
+ source-15711
+ fluids-15712
+ vals-15713
+ body-15714)))
+ (build-lexical-reference-4265
+ (lambda (type-27426 source-27427 name-27428 var-27429)
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
- source-27426
- name-27427
- var-27428)))
- (build-lexical-assignment-4265
- (lambda (source-15720 name-15721 var-15722 exp-15723)
+ source-27427
+ name-27428
+ var-27429)))
+ (build-lexical-assignment-4266
+ (lambda (source-15721 name-15722 var-15723 exp-15724)
(begin
- (if (if (struct? exp-15723)
- (eq? (struct-vtable exp-15723)
+ (if (if (struct? exp-15724)
+ (eq? (struct-vtable exp-15724)
(vector-ref %expanded-vtables 13))
#f)
- (let ((meta-15739 (struct-ref exp-15723 1)))
- (if (not (assq 'name meta-15739))
- (let ((v-15746
- (cons (cons 'name name-15721) meta-15739)))
- (struct-set! exp-15723 1 v-15746)))))
+ (let ((meta-15740 (struct-ref exp-15724 1)))
+ (if (not (assq 'name meta-15740))
+ (let ((v-15747
+ (cons (cons 'name name-15722) meta-15740)))
+ (struct-set! exp-15724 1 v-15747)))))
(make-struct/no-tail
(vector-ref %expanded-vtables 4)
- source-15720
- name-15721
- var-15722
- exp-15723))))
- (analyze-variable-4266
- (lambda (mod-27434
- var-27435
- modref-cont-27436
- bare-cont-27437)
- (if (not mod-27434)
- (bare-cont-27437 var-27435)
- (let ((kind-27438 (car mod-27434))
- (mod-27439 (cdr mod-27434)))
- (if (eqv? kind-27438 'public)
- (modref-cont-27436 mod-27439 var-27435 #t)
- (if (eqv? kind-27438 'private)
- (if (not (equal? mod-27439 (module-name (current-module))))
- (modref-cont-27436 mod-27439 var-27435 #f)
- (bare-cont-27437 var-27435))
- (if (eqv? kind-27438 'bare)
- (bare-cont-27437 var-27435)
- (if (eqv? kind-27438 'hygiene)
+ source-15721
+ name-15722
+ var-15723
+ exp-15724))))
+ (analyze-variable-4267
+ (lambda (mod-27435
+ var-27436
+ modref-cont-27437
+ bare-cont-27438)
+ (if (not mod-27435)
+ (bare-cont-27438 var-27436)
+ (let ((kind-27439 (car mod-27435))
+ (mod-27440 (cdr mod-27435)))
+ (if (eqv? kind-27439 'public)
+ (modref-cont-27437 mod-27440 var-27436 #t)
+ (if (eqv? kind-27439 'private)
+ (if (not (equal? mod-27440 (module-name (current-module))))
+ (modref-cont-27437 mod-27440 var-27436 #f)
+ (bare-cont-27438 var-27436))
+ (if (eqv? kind-27439 'bare)
+ (bare-cont-27438 var-27436)
+ (if (eqv? kind-27439 'hygiene)
(if (if (not (equal?
- mod-27439
+ mod-27440
(module-name (current-module))))
(module-variable
- (resolve-module mod-27439)
- var-27435)
+ (resolve-module mod-27440)
+ var-27436)
#f)
- (modref-cont-27436 mod-27439 var-27435 #f)
- (bare-cont-27437 var-27435))
+ (modref-cont-27437 mod-27440 var-27436 #f)
+ (bare-cont-27438 var-27436))
(syntax-violation
#f
"bad module kind"
- var-27435
- mod-27439)))))))))
- (build-global-reference-4267
- (lambda (source-27466 var-27467 mod-27468)
- (analyze-variable-4266
- mod-27468
- var-27467
- (lambda (mod-27471 var-27472 public?-27473)
+ var-27436
+ mod-27440)))))))))
+ (build-global-reference-4268
+ (lambda (source-27467 var-27468 mod-27469)
+ (analyze-variable-4267
+ mod-27469
+ var-27468
+ (lambda (mod-27472 var-27473 public?-27474)
(make-struct/no-tail
(vector-ref %expanded-vtables 5)
- source-27466
- mod-27471
- var-27472
- public?-27473))
- (lambda (var-27481)
+ source-27467
+ mod-27472
+ var-27473
+ public?-27474))
+ (lambda (var-27482)
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
- source-27466
- var-27481)))))
- (build-global-assignment-4268
- (lambda (source-15755 var-15756 exp-15757 mod-15758)
+ source-27467
+ var-27482)))))
+ (build-global-assignment-4269
+ (lambda (source-15756 var-15757 exp-15758 mod-15759)
(begin
- (if (if (struct? exp-15757)
- (eq? (struct-vtable exp-15757)
+ (if (if (struct? exp-15758)
+ (eq? (struct-vtable exp-15758)
(vector-ref %expanded-vtables 13))
#f)
- (let ((meta-15774 (struct-ref exp-15757 1)))
- (if (not (assq 'name meta-15774))
- (let ((v-15781
- (cons (cons 'name var-15756) meta-15774)))
- (struct-set! exp-15757 1 v-15781)))))
- (analyze-variable-4266
- mod-15758
- var-15756
- (lambda (mod-15786 var-15787 public?-15788)
+ (let ((meta-15775 (struct-ref exp-15758 1)))
+ (if (not (assq 'name meta-15775))
+ (let ((v-15782
+ (cons (cons 'name var-15757) meta-15775)))
+ (struct-set! exp-15758 1 v-15782)))))
+ (analyze-variable-4267
+ mod-15759
+ var-15757
+ (lambda (mod-15787 var-15788 public?-15789)
(make-struct/no-tail
(vector-ref %expanded-vtables 6)
- source-15755
- mod-15786
- var-15787
- public?-15788
- exp-15757))
- (lambda (var-15796)
+ source-15756
+ mod-15787
+ var-15788
+ public?-15789
+ exp-15758))
+ (lambda (var-15797)
(make-struct/no-tail
(vector-ref %expanded-vtables 8)
- source-15755
- var-15796
- exp-15757))))))
- (build-global-definition-4269
- (lambda (source-27487 var-27488 exp-27489)
+ source-15756
+ var-15797
+ exp-15758))))))
+ (build-global-definition-4270
+ (lambda (source-27488 var-27489 exp-27490)
(begin
- (if (if (struct? exp-27489)
- (eq? (struct-vtable exp-27489)
+ (if (if (struct? exp-27490)
+ (eq? (struct-vtable exp-27490)
(vector-ref %expanded-vtables 13))
#f)
- (let ((meta-27505 (struct-ref exp-27489 1)))
- (if (not (assq 'name meta-27505))
- (let ((v-27512
- (cons (cons 'name var-27488) meta-27505)))
- (struct-set! exp-27489 1 v-27512)))))
+ (let ((meta-27506 (struct-ref exp-27490 1)))
+ (if (not (assq 'name meta-27506))
+ (let ((v-27513
+ (cons (cons 'name var-27489) meta-27506)))
+ (struct-set! exp-27490 1 v-27513)))))
(make-struct/no-tail
(vector-ref %expanded-vtables 9)
- source-27487
- var-27488
- exp-27489))))
- (build-simple-lambda-4270
- (lambda (src-15802
- req-15803
- rest-15804
- vars-15805
- meta-15806
- exp-15807)
- (let ((body-15813
+ source-27488
+ var-27489
+ exp-27490))))
+ (build-simple-lambda-4271
+ (lambda (src-15803
+ req-15804
+ rest-15805
+ vars-15806
+ meta-15807
+ exp-15808)
+ (let ((body-15814
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
- src-15802
- req-15803
+ src-15803
+ req-15804
#f
- rest-15804
+ rest-15805
#f
'()
- vars-15805
- exp-15807
+ vars-15806
+ exp-15808
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
- src-15802
- meta-15806
- body-15813))))
- (build-sequence-4275
- (lambda (src-27520 exps-27521)
- (if (null? (cdr exps-27521))
- (car exps-27521)
+ src-15803
+ meta-15807
+ body-15814))))
+ (build-sequence-4276
+ (lambda (src-27521 exps-27522)
+ (if (null? (cdr exps-27522))
+ (car exps-27522)
(make-struct/no-tail
(vector-ref %expanded-vtables 12)
- src-27520
- exps-27521))))
- (build-let-4276
- (lambda (src-15825
- ids-15826
- vars-15827
- val-exps-15828
- body-exp-15829)
+ src-27521
+ exps-27522))))
+ (build-let-4277
+ (lambda (src-15826
+ ids-15827
+ vars-15828
+ val-exps-15829
+ body-exp-15830)
(begin
(for-each
- maybe-name-value!-4259
- ids-15826
- val-exps-15828)
- (if (null? vars-15827)
- body-exp-15829
+ maybe-name-value!-4260
+ ids-15827
+ val-exps-15829)
+ (if (null? vars-15828)
+ body-exp-15830
(make-struct/no-tail
(vector-ref %expanded-vtables 15)
- src-15825
- ids-15826
- vars-15827
- val-exps-15828
- body-exp-15829)))))
- (build-named-let-4277
- (lambda (src-15853
- ids-15854
- vars-15855
- val-exps-15856
- body-exp-15857)
- (let ((f-15858 (car vars-15855))
- (f-name-15859 (car ids-15854))
- (vars-15860 (cdr vars-15855))
- (ids-15861 (cdr ids-15854)))
- (let ((proc-15862
- (let ((body-15882
+ src-15826
+ ids-15827
+ vars-15828
+ val-exps-15829
+ body-exp-15830)))))
+ (build-named-let-4278
+ (lambda (src-15854
+ ids-15855
+ vars-15856
+ val-exps-15857
+ body-exp-15858)
+ (let ((f-15859 (car vars-15856))
+ (f-name-15860 (car ids-15855))
+ (vars-15861 (cdr vars-15856))
+ (ids-15862 (cdr ids-15855)))
+ (let ((proc-15863
+ (let ((body-15883
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
- src-15853
- ids-15861
+ src-15854
+ ids-15862
#f
#f
#f
'()
- vars-15860
- body-exp-15857
+ vars-15861
+ body-exp-15858
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
- src-15853
+ src-15854
'()
- body-15882))))
+ body-15883))))
(begin
- (if (if (struct? proc-15862)
- (eq? (struct-vtable proc-15862)
+ (if (if (struct? proc-15863)
+ (eq? (struct-vtable proc-15863)
(vector-ref %expanded-vtables 13))
#f)
- (let ((meta-15906 (struct-ref proc-15862 1)))
- (if (not (assq 'name meta-15906))
- (let ((v-15913
- (cons (cons 'name f-name-15859) meta-15906)))
- (struct-set! proc-15862 1 v-15913)))))
+ (let ((meta-15907 (struct-ref proc-15863 1)))
+ (if (not (assq 'name meta-15907))
+ (let ((v-15914
+ (cons (cons 'name f-name-15860) meta-15907)))
+ (struct-set! proc-15863 1 v-15914)))))
(for-each
- maybe-name-value!-4259
- ids-15861
- val-exps-15856)
- (let ((names-15937 (list f-name-15859))
- (gensyms-15938 (list f-15858))
- (vals-15939 (list proc-15862))
- (body-15940
- (let ((fun-exp-15944
+ maybe-name-value!-4260
+ ids-15862
+ val-exps-15857)
+ (let ((names-15938 (list f-name-15860))
+ (gensyms-15939 (list f-15859))
+ (vals-15940 (list proc-15863))
+ (body-15941
+ (let ((fun-exp-15945
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
- src-15853
- f-name-15859
- f-15858)))
+ src-15854
+ f-name-15860
+ f-15859)))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
- src-15853
- fun-exp-15944
- val-exps-15856))))
+ src-15854
+ fun-exp-15945
+ val-exps-15857))))
(make-struct/no-tail
(vector-ref %expanded-vtables 16)
- src-15853
+ src-15854
#f
- names-15937
- gensyms-15938
- vals-15939
- body-15940)))))))
- (build-letrec-4278
- (lambda (src-15960
- in-order?-15961
- ids-15962
- vars-15963
- val-exps-15964
- body-exp-15965)
- (if (null? vars-15963)
- body-exp-15965
+ names-15938
+ gensyms-15939
+ vals-15940
+ body-15941)))))))
+ (build-letrec-4279
+ (lambda (src-15961
+ in-order?-15962
+ ids-15963
+ vars-15964
+ val-exps-15965
+ body-exp-15966)
+ (if (null? vars-15964)
+ body-exp-15966
(begin
(for-each
- maybe-name-value!-4259
- ids-15962
- val-exps-15964)
+ maybe-name-value!-4260
+ ids-15963
+ val-exps-15965)
(make-struct/no-tail
(vector-ref %expanded-vtables 16)
- src-15960
- in-order?-15961
- ids-15962
- vars-15963
- val-exps-15964
- body-exp-15965)))))
- (source-annotation-4287
- (lambda (x-15991)
- (if (if (vector? x-15991)
- (if (= (vector-length x-15991) 4)
- (eq? (vector-ref x-15991 0) 'syntax-object)
+ src-15961
+ in-order?-15962
+ ids-15963
+ vars-15964
+ val-exps-15965
+ body-exp-15966)))))
+ (source-annotation-4288
+ (lambda (x-15992)
+ (if (if (vector? x-15992)
+ (if (= (vector-length x-15992) 4)
+ (eq? (vector-ref x-15992 0) 'syntax-object)
#f)
#f)
- (source-annotation-4287 (vector-ref x-15991 1))
- (if (pair? x-15991)
- (let ((props-16006 (source-properties x-15991)))
- (if (pair? props-16006) props-16006 #f))
- #f))))
- (extend-env-4288
- (lambda (labels-16008 bindings-16009 r-16010)
- (if (null? labels-16008)
- r-16010
- (extend-env-4288
- (cdr labels-16008)
- (cdr bindings-16009)
- (cons (cons (car labels-16008) (car bindings-16009))
- r-16010)))))
- (extend-var-env-4289
- (lambda (labels-16011 vars-16012 r-16013)
- (if (null? labels-16011)
- r-16013
- (extend-var-env-4289
- (cdr labels-16011)
- (cdr vars-16012)
- (cons (cons (car labels-16011)
- (cons 'lexical (car vars-16012)))
- r-16013)))))
- (macros-only-env-4290
- (lambda (r-16014)
- (if (null? r-16014)
+ (source-annotation-4288 (vector-ref x-15992 1))
+ (let ((props-16007 (source-properties x-15992)))
+ (if (pair? props-16007) props-16007 #f)))))
+ (extend-env-4289
+ (lambda (labels-16009 bindings-16010 r-16011)
+ (if (null? labels-16009)
+ r-16011
+ (extend-env-4289
+ (cdr labels-16009)
+ (cdr bindings-16010)
+ (cons (cons (car labels-16009) (car bindings-16010))
+ r-16011)))))
+ (extend-var-env-4290
+ (lambda (labels-16012 vars-16013 r-16014)
+ (if (null? labels-16012)
+ r-16014
+ (extend-var-env-4290
+ (cdr labels-16012)
+ (cdr vars-16013)
+ (cons (cons (car labels-16012)
+ (cons 'lexical (car vars-16013)))
+ r-16014)))))
+ (macros-only-env-4291
+ (lambda (r-16015)
+ (if (null? r-16015)
'()
- (let ((a-16015 (car r-16014)))
- (if (eq? (car (cdr a-16015)) 'macro)
- (cons a-16015
- (macros-only-env-4290 (cdr r-16014)))
- (macros-only-env-4290 (cdr r-16014)))))))
- (global-extend-4292
- (lambda (type-16017 sym-16018 val-16019)
+ (let ((a-16016 (car r-16015)))
+ (if (eq? (car (cdr a-16016)) 'macro)
+ (cons a-16016
+ (macros-only-env-4291 (cdr r-16015)))
+ (macros-only-env-4291 (cdr r-16015)))))))
+ (global-extend-4293
+ (lambda (type-16018 sym-16019 val-16020)
(module-define!
(current-module)
- sym-16018
+ sym-16019
(make-syntax-transformer
- sym-16018
- type-16017
- val-16019))))
- (id?-4294
- (lambda (x-9600)
- (if (symbol? x-9600)
+ sym-16019
+ type-16018
+ val-16020))))
+ (id?-4295
+ (lambda (x-9601)
+ (if (symbol? x-9601)
#t
- (if (if (vector? x-9600)
- (if (= (vector-length x-9600) 4)
- (eq? (vector-ref x-9600 0) 'syntax-object)
+ (if (if (vector? x-9601)
+ (if (= (vector-length x-9601) 4)
+ (eq? (vector-ref x-9601 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-9600 1))
+ (symbol? (vector-ref x-9601 1))
#f))))
- (gen-labels-4297
- (lambda (ls-16029)
- (if (null? ls-16029)
+ (gen-labels-4298
+ (lambda (ls-16030)
+ (if (null? ls-16030)
'()
(cons (string-append
"l-"
- (session-id-4255)
+ (session-id-4256)
(symbol->string (gensym "-")))
- (gen-labels-4297 (cdr ls-16029))))))
- (make-binding-wrap-4308
- (lambda (ids-16033 labels-16034 w-16035)
- (if (null? ids-16033)
- w-16035
- (cons (car w-16035)
- (cons (let ((labelvec-16036 (list->vector labels-16034)))
- (let ((n-16037 (vector-length labelvec-16036)))
- (let ((symnamevec-16038 (make-vector n-16037))
- (marksvec-16039 (make-vector n-16037)))
+ (gen-labels-4298 (cdr ls-16030))))))
+ (make-binding-wrap-4309
+ (lambda (ids-16034 labels-16035 w-16036)
+ (if (null? ids-16034)
+ w-16036
+ (cons (car w-16036)
+ (cons (let ((labelvec-16037 (list->vector labels-16035)))
+ (let ((n-16038 (vector-length labelvec-16037)))
+ (let ((symnamevec-16039 (make-vector n-16038))
+ (marksvec-16040 (make-vector n-16038)))
(begin
(letrec*
- ((f-16040
- (lambda (ids-16043 i-16044)
- (if (not (null? ids-16043))
+ ((f-16041
+ (lambda (ids-16044 i-16045)
+ (if (not (null? ids-16044))
(call-with-values
(lambda ()
- (let ((x-16047 (car ids-16043)))
- (if (if (vector? x-16047)
+ (let ((x-16048 (car ids-16044)))
+ (if (if (vector? x-16048)
(if (= (vector-length
- x-16047)
+ x-16048)
4)
(eq? (vector-ref
- x-16047
+ x-16048
0)
'syntax-object)
#f)
#f)
(values
- (vector-ref x-16047 1)
- (let ((m1-16063
- (car w-16035))
- (m2-16064
+ (vector-ref x-16048 1)
+ (let ((m1-16064
+ (car w-16036))
+ (m2-16065
(car (vector-ref
- x-16047
+ x-16048
2))))
- (if (null? m2-16064)
- m1-16063
+ (if (null? m2-16065)
+ m1-16064
(append
- m1-16063
- m2-16064))))
+ m1-16064
+ m2-16065))))
(values
- x-16047
- (car w-16035)))))
- (lambda (symname-16084 marks-16085)
+ x-16048
+ (car w-16036)))))
+ (lambda (symname-16085 marks-16086)
(begin
(vector-set!
- symnamevec-16038
- i-16044
- symname-16084)
+ symnamevec-16039
+ i-16045
+ symname-16085)
(vector-set!
- marksvec-16039
- i-16044
- marks-16085)
- (f-16040
- (cdr ids-16043)
- (#{1+}# i-16044)))))))))
- (f-16040 ids-16033 0))
+ marksvec-16040
+ i-16045
+ marks-16086)
+ (f-16041
+ (cdr ids-16044)
+ (#{1+}# i-16045)))))))))
+ (f-16041 ids-16034 0))
(vector
'ribcage
- symnamevec-16038
- marksvec-16039
- labelvec-16036)))))
- (cdr w-16035))))))
- (join-wraps-4310
- (lambda (w1-16094 w2-16095)
- (let ((m1-16096 (car w1-16094))
- (s1-16097 (cdr w1-16094)))
- (if (null? m1-16096)
- (if (null? s1-16097)
- w2-16095
- (cons (car w2-16095)
- (let ((m2-16104 (cdr w2-16095)))
- (if (null? m2-16104)
- s1-16097
- (append s1-16097 m2-16104)))))
- (cons (let ((m2-16113 (car w2-16095)))
- (if (null? m2-16113)
- m1-16096
- (append m1-16096 m2-16113)))
- (let ((m2-16122 (cdr w2-16095)))
- (if (null? m2-16122)
- s1-16097
- (append s1-16097 m2-16122))))))))
- (same-marks?-4312
- (lambda (x-16127 y-16128)
- (if (eq? x-16127 y-16128)
- (eq? x-16127 y-16128)
- (if (not (null? x-16127))
- (if (not (null? y-16128))
- (if (eq? (car x-16127) (car y-16128))
- (same-marks?-4312 (cdr x-16127) (cdr y-16128))
+ symnamevec-16039
+ marksvec-16040
+ labelvec-16037)))))
+ (cdr w-16036))))))
+ (join-wraps-4311
+ (lambda (w1-16095 w2-16096)
+ (let ((m1-16097 (car w1-16095))
+ (s1-16098 (cdr w1-16095)))
+ (if (null? m1-16097)
+ (if (null? s1-16098)
+ w2-16096
+ (cons (car w2-16096)
+ (let ((m2-16105 (cdr w2-16096)))
+ (if (null? m2-16105)
+ s1-16098
+ (append s1-16098 m2-16105)))))
+ (cons (let ((m2-16114 (car w2-16096)))
+ (if (null? m2-16114)
+ m1-16097
+ (append m1-16097 m2-16114)))
+ (let ((m2-16123 (cdr w2-16096)))
+ (if (null? m2-16123)
+ s1-16098
+ (append s1-16098 m2-16123))))))))
+ (same-marks?-4313
+ (lambda (x-16128 y-16129)
+ (if (eq? x-16128 y-16129)
+ (eq? x-16128 y-16129)
+ (if (not (null? x-16128))
+ (if (not (null? y-16129))
+ (if (eq? (car x-16128) (car y-16129))
+ (same-marks?-4313 (cdr x-16128) (cdr y-16129))
#f)
#f)
#f))))
- (id-var-name-4313
- (lambda (id-16136 w-16137)
+ (id-var-name-4314
+ (lambda (id-16137 w-16138)
(letrec*
- ((search-16138
- (lambda (sym-16199 subst-16200 marks-16201)
- (if (null? subst-16200)
- (values #f marks-16201)
- (let ((fst-16202 (car subst-16200)))
- (if (eq? fst-16202 'shift)
- (search-16138
- sym-16199
- (cdr subst-16200)
- (cdr marks-16201))
- (let ((symnames-16204 (vector-ref fst-16202 1)))
- (if (vector? symnames-16204)
- (let ((n-16216 (vector-length symnames-16204)))
+ ((search-16139
+ (lambda (sym-16200 subst-16201 marks-16202)
+ (if (null? subst-16201)
+ (values #f marks-16202)
+ (let ((fst-16203 (car subst-16201)))
+ (if (eq? fst-16203 'shift)
+ (search-16139
+ sym-16200
+ (cdr subst-16201)
+ (cdr marks-16202))
+ (let ((symnames-16205 (vector-ref fst-16203 1)))
+ (if (vector? symnames-16205)
+ (let ((n-16217 (vector-length symnames-16205)))
(letrec*
- ((f-16217
- (lambda (i-16219)
- (if (= i-16219 n-16216)
- (search-16138
- sym-16199
- (cdr subst-16200)
- marks-16201)
+ ((f-16218
+ (lambda (i-16220)
+ (if (= i-16220 n-16217)
+ (search-16139
+ sym-16200
+ (cdr subst-16201)
+ marks-16202)
(if (if (eq? (vector-ref
- symnames-16204
- i-16219)
- sym-16199)
- (same-marks?-4312
- marks-16201
+ symnames-16205
+ i-16220)
+ sym-16200)
+ (same-marks?-4313
+ marks-16202
(vector-ref
- (vector-ref fst-16202 2)
- i-16219))
+ (vector-ref fst-16203 2)
+ i-16220))
#f)
(values
(vector-ref
- (vector-ref fst-16202 3)
- i-16219)
- marks-16201)
- (f-16217 (#{1+}# i-16219)))))))
- (f-16217 0)))
+ (vector-ref fst-16203 3)
+ i-16220)
+ marks-16202)
+ (f-16218 (#{1+}# i-16220)))))))
+ (f-16218 0)))
(letrec*
- ((f-16252
- (lambda (symnames-16254 i-16255)
- (if (null? symnames-16254)
- (search-16138
- sym-16199
- (cdr subst-16200)
- marks-16201)
- (if (if (eq? (car symnames-16254) sym-16199)
- (same-marks?-4312
- marks-16201
+ ((f-16253
+ (lambda (symnames-16255 i-16256)
+ (if (null? symnames-16255)
+ (search-16139
+ sym-16200
+ (cdr subst-16201)
+ marks-16202)
+ (if (if (eq? (car symnames-16255) sym-16200)
+ (same-marks?-4313
+ marks-16202
(list-ref
- (vector-ref fst-16202 2)
- i-16255))
+ (vector-ref fst-16203 2)
+ i-16256))
#f)
(values
(list-ref
- (vector-ref fst-16202 3)
- i-16255)
- marks-16201)
- (f-16252
- (cdr symnames-16254)
- (#{1+}# i-16255)))))))
- (f-16252 symnames-16204 0))))))))))
- (if (symbol? id-16136)
- (let ((t-16141
- (search-16138
- id-16136
- (cdr w-16137)
- (car w-16137))))
- (if t-16141 t-16141 id-16136))
- (if (if (vector? id-16136)
- (if (= (vector-length id-16136) 4)
- (eq? (vector-ref id-16136 0) 'syntax-object)
+ (vector-ref fst-16203 3)
+ i-16256)
+ marks-16202)
+ (f-16253
+ (cdr symnames-16255)
+ (#{1+}# i-16256)))))))
+ (f-16253 symnames-16205 0))))))))))
+ (if (symbol? id-16137)
+ (let ((t-16142
+ (search-16139
+ id-16137
+ (cdr w-16138)
+ (car w-16138))))
+ (if t-16142 t-16142 id-16137))
+ (if (if (vector? id-16137)
+ (if (= (vector-length id-16137) 4)
+ (eq? (vector-ref id-16137 0) 'syntax-object)
#f)
#f)
- (let ((id-16156 (vector-ref id-16136 1))
- (w1-16157 (vector-ref id-16136 2)))
- (let ((marks-16158
- (let ((m1-16168 (car w-16137))
- (m2-16169 (car w1-16157)))
- (if (null? m2-16169)
- m1-16168
- (append m1-16168 m2-16169)))))
+ (let ((id-16157 (vector-ref id-16137 1))
+ (w1-16158 (vector-ref id-16137 2)))
+ (let ((marks-16159
+ (let ((m1-16169 (car w-16138))
+ (m2-16170 (car w1-16158)))
+ (if (null? m2-16170)
+ m1-16169
+ (append m1-16169 m2-16170)))))
(call-with-values
(lambda ()
- (search-16138 id-16156 (cdr w-16137) marks-16158))
- (lambda (new-id-16185 marks-16186)
- (if new-id-16185
- new-id-16185
- (let ((t-16194
- (search-16138
- id-16156
- (cdr w1-16157)
- marks-16186)))
- (if t-16194 t-16194 id-16156)))))))
+ (search-16139 id-16157 (cdr w-16138) marks-16159))
+ (lambda (new-id-16186 marks-16187)
+ (if new-id-16186
+ new-id-16186
+ (let ((t-16195
+ (search-16139
+ id-16157
+ (cdr w1-16158)
+ marks-16187)))
+ (if t-16195 t-16195 id-16157)))))))
(syntax-violation
'id-var-name
"invalid id"
- id-16136))))))
- (locally-bound-identifiers-4314
- (lambda (w-16277 mod-16278)
+ id-16137))))))
+ (locally-bound-identifiers-4315
+ (lambda (w-16278 mod-16279)
(letrec*
- ((scan-16279
- (lambda (subst-16284 results-16285)
- (if (null? subst-16284)
- results-16285
- (let ((fst-16286 (car subst-16284)))
- (if (eq? fst-16286 'shift)
- (scan-16279 (cdr subst-16284) results-16285)
- (let ((symnames-16288 (vector-ref fst-16286 1))
- (marks-16289 (vector-ref fst-16286 2)))
- (if (vector? symnames-16288)
- (scan-vector-rib-16281
- subst-16284
- symnames-16288
- marks-16289
- results-16285)
- (scan-list-rib-16280
- subst-16284
- symnames-16288
- marks-16289
- results-16285))))))))
- (scan-list-rib-16280
- (lambda (subst-16387
- symnames-16388
- marks-16389
- results-16390)
+ ((scan-16280
+ (lambda (subst-16285 results-16286)
+ (if (null? subst-16285)
+ results-16286
+ (let ((fst-16287 (car subst-16285)))
+ (if (eq? fst-16287 'shift)
+ (scan-16280 (cdr subst-16285) results-16286)
+ (let ((symnames-16289 (vector-ref fst-16287 1))
+ (marks-16290 (vector-ref fst-16287 2)))
+ (if (vector? symnames-16289)
+ (scan-vector-rib-16282
+ subst-16285
+ symnames-16289
+ marks-16290
+ results-16286)
+ (scan-list-rib-16281
+ subst-16285
+ symnames-16289
+ marks-16290
+ results-16286))))))))
+ (scan-list-rib-16281
+ (lambda (subst-16388
+ symnames-16389
+ marks-16390
+ results-16391)
(letrec*
- ((f-16391
- (lambda (symnames-16491 marks-16492 results-16493)
- (if (null? symnames-16491)
- (scan-16279 (cdr subst-16387) results-16493)
- (f-16391
- (cdr symnames-16491)
- (cdr marks-16492)
- (cons (wrap-4323
- (car symnames-16491)
- (let ((w-16501
- (cons (car marks-16492)
- subst-16387)))
- (cons (cons #f (car w-16501))
- (cons 'shift (cdr w-16501))))
- mod-16278)
- results-16493))))))
- (f-16391
- symnames-16388
- marks-16389
- results-16390))))
- (scan-vector-rib-16281
- (lambda (subst-16502
- symnames-16503
- marks-16504
- results-16505)
- (let ((n-16506 (vector-length symnames-16503)))
+ ((f-16392
+ (lambda (symnames-16492 marks-16493 results-16494)
+ (if (null? symnames-16492)
+ (scan-16280 (cdr subst-16388) results-16494)
+ (f-16392
+ (cdr symnames-16492)
+ (cdr marks-16493)
+ (cons (wrap-4324
+ (car symnames-16492)
+ (let ((w-16502
+ (cons (car marks-16493)
+ subst-16388)))
+ (cons (cons #f (car w-16502))
+ (cons 'shift (cdr w-16502))))
+ mod-16279)
+ results-16494))))))
+ (f-16392
+ symnames-16389
+ marks-16390
+ results-16391))))
+ (scan-vector-rib-16282
+ (lambda (subst-16503
+ symnames-16504
+ marks-16505
+ results-16506)
+ (let ((n-16507 (vector-length symnames-16504)))
(letrec*
- ((f-16507
- (lambda (i-16590 results-16591)
- (if (= i-16590 n-16506)
- (scan-16279 (cdr subst-16502) results-16591)
- (f-16507
- (#{1+}# i-16590)
- (cons (wrap-4323
- (vector-ref symnames-16503 i-16590)
- (let ((w-16599
+ ((f-16508
+ (lambda (i-16591 results-16592)
+ (if (= i-16591 n-16507)
+ (scan-16280 (cdr subst-16503) results-16592)
+ (f-16508
+ (#{1+}# i-16591)
+ (cons (wrap-4324
+ (vector-ref symnames-16504 i-16591)
+ (let ((w-16600
(cons (vector-ref
- marks-16504
- i-16590)
- subst-16502)))
- (cons (cons #f (car w-16599))
- (cons 'shift (cdr w-16599))))
- mod-16278)
- results-16591))))))
- (f-16507 0 results-16505))))))
- (scan-16279 (cdr w-16277) '()))))
- (valid-bound-ids?-4320
- (lambda (ids-16600)
+ marks-16505
+ i-16591)
+ subst-16503)))
+ (cons (cons #f (car w-16600))
+ (cons 'shift (cdr w-16600))))
+ mod-16279)
+ results-16592))))))
+ (f-16508 0 results-16506))))))
+ (scan-16280 (cdr w-16278) '()))))
+ (valid-bound-ids?-4321
+ (lambda (ids-16601)
(if (letrec*
- ((all-ids?-16601
- (lambda (ids-16763)
- (if (null? ids-16763)
- (null? ids-16763)
- (if (let ((x-16774 (car ids-16763)))
- (if (symbol? x-16774)
+ ((all-ids?-16602
+ (lambda (ids-16764)
+ (if (null? ids-16764)
+ (null? ids-16764)
+ (if (let ((x-16775 (car ids-16764)))
+ (if (symbol? x-16775)
#t
- (if (if (vector? x-16774)
- (if (= (vector-length x-16774) 4)
- (eq? (vector-ref x-16774 0)
+ (if (if (vector? x-16775)
+ (if (= (vector-length x-16775) 4)
+ (eq? (vector-ref x-16775 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-16774 1))
+ (symbol? (vector-ref x-16775 1))
#f)))
- (all-ids?-16601 (cdr ids-16763))
+ (all-ids?-16602 (cdr ids-16764))
#f)))))
- (all-ids?-16601 ids-16600))
- (distinct-bound-ids?-4321 ids-16600)
+ (all-ids?-16602 ids-16601))
+ (distinct-bound-ids?-4322 ids-16601)
#f)))
- (distinct-bound-ids?-4321
- (lambda (ids-16902)
+ (distinct-bound-ids?-4322
+ (lambda (ids-16903)
(letrec*
- ((distinct?-16903
- (lambda (ids-17015)
- (if (null? ids-17015)
- (null? ids-17015)
- (if (not (bound-id-member?-4322
- (car ids-17015)
- (cdr ids-17015)))
- (distinct?-16903 (cdr ids-17015))
+ ((distinct?-16904
+ (lambda (ids-17016)
+ (if (null? ids-17016)
+ (null? ids-17016)
+ (if (not (bound-id-member?-4323
+ (car ids-17016)
+ (cdr ids-17016)))
+ (distinct?-16904 (cdr ids-17016))
#f)))))
- (distinct?-16903 ids-16902))))
- (bound-id-member?-4322
- (lambda (x-17225 list-17226)
- (if (not (null? list-17226))
- (let ((t-17227
- (let ((j-17308 (car list-17226)))
- (if (if (if (vector? x-17225)
- (if (= (vector-length x-17225) 4)
- (eq? (vector-ref x-17225 0) 'syntax-object)
+ (distinct?-16904 ids-16903))))
+ (bound-id-member?-4323
+ (lambda (x-17226 list-17227)
+ (if (not (null? list-17227))
+ (let ((t-17228
+ (let ((j-17309 (car list-17227)))
+ (if (if (if (vector? x-17226)
+ (if (= (vector-length x-17226) 4)
+ (eq? (vector-ref x-17226 0) 'syntax-object)
#f)
#f)
- (if (vector? j-17308)
- (if (= (vector-length j-17308) 4)
- (eq? (vector-ref j-17308 0) 'syntax-object)
+ (if (vector? j-17309)
+ (if (= (vector-length j-17309) 4)
+ (eq? (vector-ref j-17309 0) 'syntax-object)
#f)
#f)
#f)
- (if (eq? (vector-ref x-17225 1)
- (vector-ref j-17308 1))
- (same-marks?-4312
- (car (vector-ref x-17225 2))
- (car (vector-ref j-17308 2)))
+ (if (eq? (vector-ref x-17226 1)
+ (vector-ref j-17309 1))
+ (same-marks?-4313
+ (car (vector-ref x-17226 2))
+ (car (vector-ref j-17309 2)))
#f)
- (eq? x-17225 j-17308)))))
- (if t-17227
- t-17227
- (bound-id-member?-4322 x-17225 (cdr list-17226))))
+ (eq? x-17226 j-17309)))))
+ (if t-17228
+ t-17228
+ (bound-id-member?-4323 x-17226 (cdr list-17227))))
#f)))
- (wrap-4323
- (lambda (x-17352 w-17353 defmod-17354)
- (if (if (null? (car w-17353))
- (null? (cdr w-17353))
+ (wrap-4324
+ (lambda (x-17353 w-17354 defmod-17355)
+ (if (if (null? (car w-17354))
+ (null? (cdr w-17354))
#f)
- x-17352
- (if (if (vector? x-17352)
- (if (= (vector-length x-17352) 4)
- (eq? (vector-ref x-17352 0) 'syntax-object)
+ x-17353
+ (if (if (vector? x-17353)
+ (if (= (vector-length x-17353) 4)
+ (eq? (vector-ref x-17353 0) 'syntax-object)
#f)
#f)
- (let ((expression-17368 (vector-ref x-17352 1))
- (wrap-17369
- (join-wraps-4310 w-17353 (vector-ref x-17352 2)))
- (module-17370 (vector-ref x-17352 3)))
+ (let ((expression-17369 (vector-ref x-17353 1))
+ (wrap-17370
+ (join-wraps-4311 w-17354 (vector-ref x-17353 2)))
+ (module-17371 (vector-ref x-17353 3)))
(vector
'syntax-object
- expression-17368
- wrap-17369
- module-17370))
- (if (null? x-17352)
- x-17352
+ expression-17369
+ wrap-17370
+ module-17371))
+ (if (null? x-17353)
+ x-17353
(vector
'syntax-object
- x-17352
- w-17353
- defmod-17354))))))
- (source-wrap-4324
- (lambda (x-17387 w-17388 s-17389 defmod-17390)
- (wrap-4323
+ x-17353
+ w-17354
+ defmod-17355))))))
+ (source-wrap-4325
+ (lambda (x-17388 w-17389 s-17390 defmod-17391)
+ (wrap-4324
(begin
- (if (if (pair? x-17387) s-17389 #f)
- (set-source-properties! x-17387 s-17389))
- x-17387)
- w-17388
- defmod-17390)))
- (expand-sequence-4325
- (lambda (body-27526 r-27527 w-27528 s-27529 mod-27530)
- (build-sequence-4275
- s-27529
+ (if (if s-17390
+ (supports-source-properties? x-17388)
+ #f)
+ (set-source-properties! x-17388 s-17390))
+ x-17388)
+ w-17389
+ defmod-17391)))
+ (expand-sequence-4326
+ (lambda (body-27527 r-27528 w-27529 s-27530 mod-27531)
+ (build-sequence-4276
+ s-27530
(letrec*
- ((dobody-27610
- (lambda (body-27950 r-27951 w-27952 mod-27953)
- (if (null? body-27950)
+ ((dobody-27611
+ (lambda (body-27951 r-27952 w-27953 mod-27954)
+ (if (null? body-27951)
'()
- (let ((first-27954
- (let ((e-27958 (car body-27950)))
+ (let ((first-27955
+ (let ((e-27959 (car body-27951)))
(call-with-values
(lambda ()
- (syntax-type-4329
- e-27958
- r-27951
- w-27952
- (source-annotation-4287 e-27958)
+ (syntax-type-4330
+ e-27959
+ r-27952
+ w-27953
+ (source-annotation-4288 e-27959)
#f
- mod-27953
+ mod-27954
#f))
- (lambda (type-27965
- value-27966
- form-27967
- e-27968
- w-27969
- s-27970
- mod-27971)
- (expand-expr-4331
- type-27965
- value-27966
- form-27967
- e-27968
- r-27951
- w-27969
- s-27970
- mod-27971))))))
- (cons first-27954
- (dobody-27610
- (cdr body-27950)
- r-27951
- w-27952
- mod-27953)))))))
- (dobody-27610
- body-27526
- r-27527
- w-27528
- mod-27530)))))
- (expand-top-sequence-4326
- (lambda (body-17408
- r-17409
- w-17410
- s-17411
- m-17412
- esew-17413
- mod-17414)
+ (lambda (type-27966
+ value-27967
+ form-27968
+ e-27969
+ w-27970
+ s-27971
+ mod-27972)
+ (expand-expr-4332
+ type-27966
+ value-27967
+ form-27968
+ e-27969
+ r-27952
+ w-27970
+ s-27971
+ mod-27972))))))
+ (cons first-27955
+ (dobody-27611
+ (cdr body-27951)
+ r-27952
+ w-27953
+ mod-27954)))))))
+ (dobody-27611
+ body-27527
+ r-27528
+ w-27529
+ mod-27531)))))
+ (expand-top-sequence-4327
+ (lambda (body-17409
+ r-17410
+ w-17411
+ s-17412
+ m-17413
+ esew-17414
+ mod-17415)
(letrec*
- ((scan-17415
- (lambda (body-17546
- r-17547
- w-17548
- s-17549
- m-17550
- esew-17551
- mod-17552
- exps-17553)
- (if (null? body-17546)
- exps-17553
+ ((scan-17416
+ (lambda (body-17547
+ r-17548
+ w-17549
+ s-17550
+ m-17551
+ esew-17552
+ mod-17553
+ exps-17554)
+ (if (null? body-17547)
+ exps-17554
(call-with-values
(lambda ()
(call-with-values
(lambda ()
- (let ((e-17554 (car body-17546)))
- (syntax-type-4329
- e-17554
- r-17547
- w-17548
- (let ((t-17558 (source-annotation-4287 e-17554)))
- (if t-17558 t-17558 s-17549))
+ (let ((e-17555 (car body-17547)))
+ (syntax-type-4330
+ e-17555
+ r-17548
+ w-17549
+ (let ((t-17559 (source-annotation-4288 e-17555)))
+ (if t-17559 t-17559 s-17550))
#f
- mod-17552
+ mod-17553
#f)))
- (lambda (type-17793
- value-17794
- form-17795
- e-17796
- w-17797
- s-17798
- mod-17799)
- (if (eqv? type-17793 'begin-form)
- (let ((tmp-17808 ($sc-dispatch e-17796 '(_))))
- (if tmp-17808
- (@apply (lambda () exps-17553) tmp-17808)
- (let ((tmp-17812
+ (lambda (type-17794
+ value-17795
+ form-17796
+ e-17797
+ w-17798
+ s-17799
+ mod-17800)
+ (if (eqv? type-17794 'begin-form)
+ (let ((tmp-17809 ($sc-dispatch e-17797 '(_))))
+ (if tmp-17809
+ (@apply (lambda () exps-17554) tmp-17809)
+ (let ((tmp-17813
($sc-dispatch
- e-17796
+ e-17797
'(_ any . each-any))))
- (if tmp-17812
+ (if tmp-17813
(@apply
- (lambda (e1-17816 e2-17817)
- (scan-17415
- (cons e1-17816 e2-17817)
- r-17547
- w-17797
- s-17798
- m-17550
- esew-17551
- mod-17799
- exps-17553))
- tmp-17812)
+ (lambda (e1-17817 e2-17818)
+ (scan-17416
+ (cons e1-17817 e2-17818)
+ r-17548
+ w-17798
+ s-17799
+ m-17551
+ esew-17552
+ mod-17800
+ exps-17554))
+ tmp-17813)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-17796)))))
- (if (eqv? type-17793 'local-syntax-form)
- (expand-local-syntax-4335
- value-17794
- e-17796
- r-17547
- w-17797
- s-17798
- mod-17799
- (lambda (body-17835
- r-17836
- w-17837
- s-17838
- mod-17839)
- (scan-17415
- body-17835
- r-17836
- w-17837
- s-17838
- m-17550
- esew-17551
- mod-17839
- exps-17553)))
- (if (eqv? type-17793 'eval-when-form)
- (let ((tmp-17847
+ e-17797)))))
+ (if (eqv? type-17794 'local-syntax-form)
+ (expand-local-syntax-4336
+ value-17795
+ e-17797
+ r-17548
+ w-17798
+ s-17799
+ mod-17800
+ (lambda (body-17836
+ r-17837
+ w-17838
+ s-17839
+ mod-17840)
+ (scan-17416
+ body-17836
+ r-17837
+ w-17838
+ s-17839
+ m-17551
+ esew-17552
+ mod-17840
+ exps-17554)))
+ (if (eqv? type-17794 'eval-when-form)
+ (let ((tmp-17848
($sc-dispatch
- e-17796
+ e-17797
'(_ each-any any . each-any))))
- (if tmp-17847
+ (if tmp-17848
(@apply
- (lambda (x-17851 e1-17852 e2-17853)
- (let ((when-list-17854
- (parse-when-list-4328
- e-17796
- x-17851))
- (body-17855
- (cons e1-17852 e2-17853)))
- (if (eq? m-17550 'e)
- (if (memq 'eval when-list-17854)
- (scan-17415
- body-17855
- r-17547
- w-17797
- s-17798
+ (lambda (x-17852 e1-17853 e2-17854)
+ (let ((when-list-17855
+ (parse-when-list-4329
+ e-17797
+ x-17852))
+ (body-17856
+ (cons e1-17853 e2-17854)))
+ (if (eq? m-17551 'e)
+ (if (memq 'eval when-list-17855)
+ (scan-17416
+ body-17856
+ r-17548
+ w-17798
+ s-17799
(if (memq 'expand
- when-list-17854)
+ when-list-17855)
'c&e
'e)
'(eval)
- mod-17799
- exps-17553)
+ mod-17800
+ exps-17554)
(begin
(if (memq 'expand
- when-list-17854)
- (let ((x-17932
- (expand-top-sequence-4326
- body-17855
- r-17547
- w-17797
- s-17798
+ when-list-17855)
+ (let ((x-17933
+ (expand-top-sequence-4327
+ body-17856
+ r-17548
+ w-17798
+ s-17799
'e
'(eval)
- mod-17799)))
- (primitive-eval x-17932)))
- exps-17553))
- (if (memq 'load when-list-17854)
- (if (let ((t-17958
+ mod-17800)))
+ (primitive-eval x-17933)))
+ exps-17554))
+ (if (memq 'load when-list-17855)
+ (if (let ((t-17959
(memq 'compile
- when-list-17854)))
- (if t-17958
- t-17958
- (let ((t-18007
+ when-list-17855)))
+ (if t-17959
+ t-17959
+ (let ((t-18008
(memq 'expand
- when-list-17854)))
- (if t-18007
- t-18007
- (if (eq? m-17550
+ when-list-17855)))
+ (if t-18008
+ t-18008
+ (if (eq? m-17551
'c&e)
(memq 'eval
- when-list-17854)
+ when-list-17855)
#f)))))
- (scan-17415
- body-17855
- r-17547
- w-17797
- s-17798
+ (scan-17416
+ body-17856
+ r-17548
+ w-17798
+ s-17799
'c&e
'(compile load)
- mod-17799
- exps-17553)
- (if (if (eq? m-17550 'c)
+ mod-17800
+ exps-17554)
+ (if (if (eq? m-17551 'c)
#t
- (eq? m-17550 'c&e))
- (scan-17415
- body-17855
- r-17547
- w-17797
- s-17798
+ (eq? m-17551 'c&e))
+ (scan-17416
+ body-17856
+ r-17548
+ w-17798
+ s-17799
'c
'(load)
- mod-17799
- exps-17553)
- exps-17553))
- (if (let ((t-18136
+ mod-17800
+ exps-17554)
+ exps-17554))
+ (if (let ((t-18137
(memq 'compile
- when-list-17854)))
- (if t-18136
- t-18136
- (let ((t-18185
+ when-list-17855)))
+ (if t-18137
+ t-18137
+ (let ((t-18186
(memq 'expand
- when-list-17854)))
- (if t-18185
- t-18185
- (if (eq? m-17550
+ when-list-17855)))
+ (if t-18186
+ t-18186
+ (if (eq? m-17551
'c&e)
(memq 'eval
- when-list-17854)
+ when-list-17855)
#f)))))
(begin
- (let ((x-18309
- (expand-top-sequence-4326
- body-17855
- r-17547
- w-17797
- s-17798
+ (let ((x-18310
+ (expand-top-sequence-4327
+ body-17856
+ r-17548
+ w-17798
+ s-17799
'e
'(eval)
- mod-17799)))
- (primitive-eval x-18309))
- exps-17553)
- exps-17553)))))
- tmp-17847)
+ mod-17800)))
+ (primitive-eval x-18310))
+ exps-17554)
+ exps-17554)))))
+ tmp-17848)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-17796)))
- (if (if (eqv? type-17793 'define-syntax-form)
+ e-17797)))
+ (if (if (eqv? type-17794 'define-syntax-form)
#t
- (eqv? type-17793
+ (eqv? type-17794
'define-syntax-parameter-form))
- (let ((n-18358
- (id-var-name-4313
- value-17794
- w-17797))
- (r-18359
- (macros-only-env-4290 r-17547)))
- (if (eqv? m-17550 'c)
- (if (memq 'compile esew-17551)
- (let ((e-18367
- (expand-install-global-4327
- n-18358
- (expand-4330
- e-17796
- r-18359
- w-17797
- mod-17799))))
+ (let ((n-18359
+ (id-var-name-4314
+ value-17795
+ w-17798))
+ (r-18360
+ (macros-only-env-4291 r-17548)))
+ (if (eqv? m-17551 'c)
+ (if (memq 'compile esew-17552)
+ (let ((e-18368
+ (expand-install-global-4328
+ n-18359
+ (expand-4331
+ e-17797
+ r-18360
+ w-17798
+ mod-17800))))
(begin
- (top-level-eval-hook-4253
- e-18367
- mod-17799)
- (if (memq 'load esew-17551)
- (cons e-18367 exps-17553)
- exps-17553)))
- (if (memq 'load esew-17551)
- (cons (expand-install-global-4327
- n-18358
- (expand-4330
- e-17796
- r-18359
- w-17797
- mod-17799))
- exps-17553)
- exps-17553))
- (if (eqv? m-17550 'c&e)
- (let ((e-19012
- (expand-install-global-4327
- n-18358
- (expand-4330
- e-17796
- r-18359
- w-17797
- mod-17799))))
+ (top-level-eval-hook-4254
+ e-18368
+ mod-17800)
+ (if (memq 'load esew-17552)
+ (cons e-18368 exps-17554)
+ exps-17554)))
+ (if (memq 'load esew-17552)
+ (cons (expand-install-global-4328
+ n-18359
+ (expand-4331
+ e-17797
+ r-18360
+ w-17798
+ mod-17800))
+ exps-17554)
+ exps-17554))
+ (if (eqv? m-17551 'c&e)
+ (let ((e-19013
+ (expand-install-global-4328
+ n-18359
+ (expand-4331
+ e-17797
+ r-18360
+ w-17798
+ mod-17800))))
(begin
- (top-level-eval-hook-4253
- e-19012
- mod-17799)
- (cons e-19012 exps-17553)))
+ (top-level-eval-hook-4254
+ e-19013
+ mod-17800)
+ (cons e-19013 exps-17554)))
(begin
- (if (memq 'eval esew-17551)
- (top-level-eval-hook-4253
- (expand-install-global-4327
- n-18358
- (expand-4330
- e-17796
- r-18359
- w-17797
- mod-17799))
- mod-17799))
- exps-17553))))
- (if (eqv? type-17793 'define-form)
- (let ((n-19689
- (id-var-name-4313
- value-17794
- w-17797)))
- (let ((type-19690
- (car (let ((t-19698
- (assq n-19689
- r-17547)))
- (if t-19698
- (cdr t-19698)
- (if (symbol? n-19689)
- (let ((t-19704
- (get-global-definition-hook-4257
- n-19689
- mod-17799)))
- (if t-19704
- t-19704
+ (if (memq 'eval esew-17552)
+ (top-level-eval-hook-4254
+ (expand-install-global-4328
+ n-18359
+ (expand-4331
+ e-17797
+ r-18360
+ w-17798
+ mod-17800))
+ mod-17800))
+ exps-17554))))
+ (if (eqv? type-17794 'define-form)
+ (let ((n-19690
+ (id-var-name-4314
+ value-17795
+ w-17798)))
+ (let ((type-19691
+ (car (let ((t-19699
+ (assq n-19690
+ r-17548)))
+ (if t-19699
+ (cdr t-19699)
+ (if (symbol? n-19690)
+ (let ((t-19705
+ (get-global-definition-hook-4258
+ n-19690
+ mod-17800)))
+ (if t-19705
+ t-19705
'(global)))
'(displaced-lexical)))))))
- (if (if (eqv? type-19690 'global)
+ (if (if (eqv? type-19691 'global)
#t
- (if (eqv? type-19690 'core)
+ (if (eqv? type-19691 'core)
#t
- (if (eqv? type-19690 'macro)
+ (if (eqv? type-19691 'macro)
#t
- (eqv? type-19690
+ (eqv? type-19691
'module-ref))))
(begin
- (if (if (if (eq? m-17550 'c)
+ (if (if (if (eq? m-17551 'c)
#t
- (eq? m-17550 'c&e))
+ (eq? m-17551 'c&e))
(if (not (module-local-variable
(current-module)
- n-19689))
+ n-19690))
(current-module)
#f)
#f)
- (let ((old-19737
+ (let ((old-19738
(module-variable
(current-module)
- n-19689)))
- (if (if (variable? old-19737)
+ n-19690)))
+ (if (if (variable? old-19738)
(variable-bound?
- old-19737)
+ old-19738)
#f)
(module-define!
(current-module)
- n-19689
- (variable-ref old-19737))
+ n-19690
+ (variable-ref old-19738))
(module-add!
(current-module)
- n-19689
+ n-19690
(make-undefined-variable)))))
- (cons (if (eq? m-17550 'c&e)
- (let ((x-20178
- (build-global-definition-4269
- s-17798
- n-19689
- (expand-4330
- e-17796
- r-17547
- w-17797
- mod-17799))))
+ (cons (if (eq? m-17551 'c&e)
+ (let ((x-20179
+ (build-global-definition-4270
+ s-17799
+ n-19690
+ (expand-4331
+ e-17797
+ r-17548
+ w-17798
+ mod-17800))))
(begin
- (top-level-eval-hook-4253
- x-20178
- mod-17799)
- x-20178))
+ (top-level-eval-hook-4254
+ x-20179
+ mod-17800)
+ x-20179))
(lambda ()
- (build-global-definition-4269
- s-17798
- n-19689
- (expand-4330
- e-17796
- r-17547
- w-17797
- mod-17799))))
- exps-17553))
- (if (eqv? type-19690
+ (build-global-definition-4270
+ s-17799
+ n-19690
+ (expand-4331
+ e-17797
+ r-17548
+ w-17798
+ mod-17800))))
+ exps-17554))
+ (if (eqv? type-19691
'displaced-lexical)
(syntax-violation
#f
"identifier out of context"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? form-17795)
- s-17798
+ (if (if s-17799
+ (supports-source-properties?
+ form-17796)
#f)
(set-source-properties!
- form-17795
- s-17798))
- form-17795)
- w-17797
- mod-17799)
- (wrap-4323
- value-17794
- w-17797
- mod-17799))
+ form-17796
+ s-17799))
+ form-17796)
+ w-17798
+ mod-17800)
+ (wrap-4324
+ value-17795
+ w-17798
+ mod-17800))
(syntax-violation
#f
"cannot define keyword at top level"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? form-17795)
- s-17798
+ (if (if s-17799
+ (supports-source-properties?
+ form-17796)
#f)
(set-source-properties!
- form-17795
- s-17798))
- form-17795)
- w-17797
- mod-17799)
- (wrap-4323
- value-17794
- w-17797
- mod-17799))))))
- (cons (if (eq? m-17550 'c&e)
- (let ((x-20680
- (expand-expr-4331
- type-17793
- value-17794
- form-17795
- e-17796
- r-17547
- w-17797
- s-17798
- mod-17799)))
+ form-17796
+ s-17799))
+ form-17796)
+ w-17798
+ mod-17800)
+ (wrap-4324
+ value-17795
+ w-17798
+ mod-17800))))))
+ (cons (if (eq? m-17551 'c&e)
+ (let ((x-20681
+ (expand-expr-4332
+ type-17794
+ value-17795
+ form-17796
+ e-17797
+ r-17548
+ w-17798
+ s-17799
+ mod-17800)))
(begin
- (primitive-eval x-20680)
- x-20680))
+ (primitive-eval x-20681)
+ x-20681))
(lambda ()
- (expand-expr-4331
- type-17793
- value-17794
- form-17795
- e-17796
- r-17547
- w-17797
- s-17798
- mod-17799)))
- exps-17553)))))))))
- (lambda (exps-20685)
- (scan-17415
- (cdr body-17546)
- r-17547
- w-17548
- s-17549
- m-17550
- esew-17551
- mod-17552
- exps-20685)))))))
+ (expand-expr-4332
+ type-17794
+ value-17795
+ form-17796
+ e-17797
+ r-17548
+ w-17798
+ s-17799
+ mod-17800)))
+ exps-17554)))))))))
+ (lambda (exps-20686)
+ (scan-17416
+ (cdr body-17547)
+ r-17548
+ w-17549
+ s-17550
+ m-17551
+ esew-17552
+ mod-17553
+ exps-20686)))))))
(call-with-values
(lambda ()
- (scan-17415
- body-17408
- r-17409
- w-17410
- s-17411
- m-17412
- esew-17413
- mod-17414
+ (scan-17416
+ body-17409
+ r-17410
+ w-17411
+ s-17412
+ m-17413
+ esew-17414
+ mod-17415
'()))
- (lambda (exps-17418)
- (if (null? exps-17418)
+ (lambda (exps-17419)
+ (if (null? exps-17419)
(make-struct/no-tail
(vector-ref %expanded-vtables 0)
- s-17411)
- (build-sequence-4275
- s-17411
+ s-17412)
+ (build-sequence-4276
+ s-17412
(letrec*
- ((lp-17458
- (lambda (in-17542 out-17543)
- (if (null? in-17542)
- out-17543
- (let ((e-17544 (car in-17542)))
- (lp-17458
- (cdr in-17542)
- (cons (if (procedure? e-17544)
- (e-17544)
- e-17544)
- out-17543)))))))
- (lp-17458 exps-17418 '())))))))))
- (expand-install-global-4327
- (lambda (name-20686 e-20687)
- (let ((exp-20693
- (let ((fun-exp-20703
+ ((lp-17459
+ (lambda (in-17543 out-17544)
+ (if (null? in-17543)
+ out-17544
+ (let ((e-17545 (car in-17543)))
+ (lp-17459
+ (cdr in-17543)
+ (cons (if (procedure? e-17545)
+ (e-17545)
+ e-17545)
+ out-17544)))))))
+ (lp-17459 exps-17419 '())))))))))
+ (expand-install-global-4328
+ (lambda (name-20687 e-20688)
+ (let ((exp-20694
+ (let ((fun-exp-20704
(if (equal? (module-name (current-module)) '(guile))
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
@@ -1274,398 +1276,398 @@
'(guile)
'make-syntax-transformer
#f)))
- (arg-exps-20704
+ (arg-exps-20705
(list (make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
- name-20686)
+ name-20687)
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
'macro)
- e-20687)))
+ e-20688)))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
#f
- fun-exp-20703
- arg-exps-20704))))
+ fun-exp-20704
+ arg-exps-20705))))
(begin
- (if (if (struct? exp-20693)
- (eq? (struct-vtable exp-20693)
+ (if (if (struct? exp-20694)
+ (eq? (struct-vtable exp-20694)
(vector-ref %expanded-vtables 13))
#f)
- (let ((meta-20745 (struct-ref exp-20693 1)))
- (if (not (assq 'name meta-20745))
- (let ((v-20752
- (cons (cons 'name name-20686) meta-20745)))
- (struct-set! exp-20693 1 v-20752)))))
+ (let ((meta-20746 (struct-ref exp-20694 1)))
+ (if (not (assq 'name meta-20746))
+ (let ((v-20753
+ (cons (cons 'name name-20687) meta-20746)))
+ (struct-set! exp-20694 1 v-20753)))))
(make-struct/no-tail
(vector-ref %expanded-vtables 9)
#f
- name-20686
- exp-20693)))))
- (parse-when-list-4328
- (lambda (e-20763 when-list-20764)
- (let ((result-20765 (strip-4343 when-list-20764 '(()))))
+ name-20687
+ exp-20694)))))
+ (parse-when-list-4329
+ (lambda (e-20764 when-list-20765)
+ (let ((result-20766 (strip-4344 when-list-20765 '(()))))
(letrec*
- ((lp-20766
- (lambda (l-20820)
- (if (null? l-20820)
- result-20765
- (if (let ((t-20822 (car l-20820)))
- (if (eq? t-20822 'compile)
+ ((lp-20767
+ (lambda (l-20821)
+ (if (null? l-20821)
+ result-20766
+ (if (let ((t-20823 (car l-20821)))
+ (if (eq? t-20823 'compile)
#t
- (if (eq? t-20822 'load)
+ (if (eq? t-20823 'load)
#t
- (if (eq? t-20822 'eval)
+ (if (eq? t-20823 'eval)
#t
- (eq? t-20822 'expand)))))
- (lp-20766 (cdr l-20820))
+ (eq? t-20823 'expand)))))
+ (lp-20767 (cdr l-20821))
(syntax-violation
'eval-when
"invalid situation"
- e-20763
- (car l-20820)))))))
- (lp-20766 result-20765)))))
- (syntax-type-4329
- (lambda (e-20824
- r-20825
- w-20826
- s-20827
- rib-20828
- mod-20829
- for-car?-20830)
- (if (symbol? e-20824)
- (let ((n-20831 (id-var-name-4313 e-20824 w-20826)))
- (let ((b-20832
- (let ((t-20841 (assq n-20831 r-20825)))
- (if t-20841
- (cdr t-20841)
- (if (symbol? n-20831)
- (let ((t-20847
- (get-global-definition-hook-4257
- n-20831
- mod-20829)))
- (if t-20847 t-20847 '(global)))
+ e-20764
+ (car l-20821)))))))
+ (lp-20767 result-20766)))))
+ (syntax-type-4330
+ (lambda (e-20825
+ r-20826
+ w-20827
+ s-20828
+ rib-20829
+ mod-20830
+ for-car?-20831)
+ (if (symbol? e-20825)
+ (let ((n-20832 (id-var-name-4314 e-20825 w-20827)))
+ (let ((b-20833
+ (let ((t-20842 (assq n-20832 r-20826)))
+ (if t-20842
+ (cdr t-20842)
+ (if (symbol? n-20832)
+ (let ((t-20848
+ (get-global-definition-hook-4258
+ n-20832
+ mod-20830)))
+ (if t-20848 t-20848 '(global)))
'(displaced-lexical))))))
- (let ((type-20833 (car b-20832)))
- (if (eqv? type-20833 'lexical)
+ (let ((type-20834 (car b-20833)))
+ (if (eqv? type-20834 'lexical)
(values
- type-20833
- (cdr b-20832)
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (if (eqv? type-20833 'global)
+ type-20834
+ (cdr b-20833)
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (if (eqv? type-20834 'global)
(values
- type-20833
- n-20831
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (if (eqv? type-20833 'macro)
- (if for-car?-20830
+ type-20834
+ n-20832
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (if (eqv? type-20834 'macro)
+ (if for-car?-20831
(values
- type-20833
- (cdr b-20832)
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (syntax-type-4329
- (expand-macro-4333
- (cdr b-20832)
- e-20824
- r-20825
- w-20826
- s-20827
- rib-20828
- mod-20829)
- r-20825
+ type-20834
+ (cdr b-20833)
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (syntax-type-4330
+ (expand-macro-4334
+ (cdr b-20833)
+ e-20825
+ r-20826
+ w-20827
+ s-20828
+ rib-20829
+ mod-20830)
+ r-20826
'(())
- s-20827
- rib-20828
- mod-20829
+ s-20828
+ rib-20829
+ mod-20830
#f))
(values
- type-20833
- (cdr b-20832)
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)))))))
- (if (pair? e-20824)
- (let ((first-20875 (car e-20824)))
+ type-20834
+ (cdr b-20833)
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)))))))
+ (if (pair? e-20825)
+ (let ((first-20876 (car e-20825)))
(call-with-values
(lambda ()
- (syntax-type-4329
- first-20875
- r-20825
- w-20826
- s-20827
- rib-20828
- mod-20829
+ (syntax-type-4330
+ first-20876
+ r-20826
+ w-20827
+ s-20828
+ rib-20829
+ mod-20830
#t))
- (lambda (ftype-20877
- fval-20878
- fform-20879
- fe-20880
- fw-20881
- fs-20882
- fmod-20883)
- (if (eqv? ftype-20877 'lexical)
+ (lambda (ftype-20878
+ fval-20879
+ fform-20880
+ fe-20881
+ fw-20882
+ fs-20883
+ fmod-20884)
+ (if (eqv? ftype-20878 'lexical)
(values
'lexical-call
- fval-20878
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (if (eqv? ftype-20877 'global)
+ fval-20879
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (if (eqv? ftype-20878 'global)
(values
'global-call
(vector
'syntax-object
- fval-20878
- w-20826
- fmod-20883)
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (if (eqv? ftype-20877 'macro)
- (syntax-type-4329
- (expand-macro-4333
- fval-20878
- e-20824
- r-20825
- w-20826
- s-20827
- rib-20828
- mod-20829)
- r-20825
+ fval-20879
+ w-20827
+ fmod-20884)
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (if (eqv? ftype-20878 'macro)
+ (syntax-type-4330
+ (expand-macro-4334
+ fval-20879
+ e-20825
+ r-20826
+ w-20827
+ s-20828
+ rib-20829
+ mod-20830)
+ r-20826
'(())
- s-20827
- rib-20828
- mod-20829
- for-car?-20830)
- (if (eqv? ftype-20877 'module-ref)
+ s-20828
+ rib-20829
+ mod-20830
+ for-car?-20831)
+ (if (eqv? ftype-20878 'module-ref)
(call-with-values
- (lambda () (fval-20878 e-20824 r-20825 w-20826))
- (lambda (e-20917
- r-20918
- w-20919
- s-20920
- mod-20921)
- (syntax-type-4329
- e-20917
- r-20918
- w-20919
- s-20920
- rib-20828
- mod-20921
- for-car?-20830)))
- (if (eqv? ftype-20877 'core)
+ (lambda () (fval-20879 e-20825 r-20826 w-20827))
+ (lambda (e-20918
+ r-20919
+ w-20920
+ s-20921
+ mod-20922)
+ (syntax-type-4330
+ e-20918
+ r-20919
+ w-20920
+ s-20921
+ rib-20829
+ mod-20922
+ for-car?-20831)))
+ (if (eqv? ftype-20878 'core)
(values
'core-form
- fval-20878
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (if (eqv? ftype-20877 'local-syntax)
+ fval-20879
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (if (eqv? ftype-20878 'local-syntax)
(values
'local-syntax-form
- fval-20878
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (if (eqv? ftype-20877 'begin)
+ fval-20879
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (if (eqv? ftype-20878 'begin)
(values
'begin-form
#f
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (if (eqv? ftype-20877 'eval-when)
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (if (eqv? ftype-20878 'eval-when)
(values
'eval-when-form
#f
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
- (if (eqv? ftype-20877 'define)
- (let ((tmp-20953
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
+ (if (eqv? ftype-20878 'define)
+ (let ((tmp-20954
($sc-dispatch
- e-20824
+ e-20825
'(_ any any))))
- (if (if tmp-20953
+ (if (if tmp-20954
(@apply
- (lambda (name-20957 val-20958)
- (if (symbol? name-20957)
+ (lambda (name-20958 val-20959)
+ (if (symbol? name-20958)
#t
- (if (if (vector? name-20957)
+ (if (if (vector? name-20958)
(if (= (vector-length
- name-20957)
+ name-20958)
4)
(eq? (vector-ref
- name-20957
+ name-20958
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-20957
+ name-20958
1))
#f)))
- tmp-20953)
+ tmp-20954)
#f)
(@apply
- (lambda (name-20985 val-20986)
+ (lambda (name-20986 val-20987)
(values
'define-form
- name-20985
- e-20824
- val-20986
- w-20826
- s-20827
- mod-20829))
- tmp-20953)
- (let ((tmp-20987
+ name-20986
+ e-20825
+ val-20987
+ w-20827
+ s-20828
+ mod-20830))
+ tmp-20954)
+ (let ((tmp-20988
($sc-dispatch
- e-20824
+ e-20825
'(_ (any . any)
any
.
each-any))))
- (if (if tmp-20987
+ (if (if tmp-20988
(@apply
- (lambda (name-20991
- args-20992
- e1-20993
- e2-20994)
+ (lambda (name-20992
+ args-20993
+ e1-20994
+ e2-20995)
(if (if (symbol?
- name-20991)
+ name-20992)
#t
(if (if (vector?
- name-20991)
+ name-20992)
(if (= (vector-length
- name-20991)
+ name-20992)
4)
(eq? (vector-ref
- name-20991
+ name-20992
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-20991
+ name-20992
1))
#f))
- (valid-bound-ids?-4320
+ (valid-bound-ids?-4321
(letrec*
- ((lvl-21143
- (lambda (vars-21145
- ls-21146
- w-21147)
- (if (pair? vars-21145)
- (lvl-21143
- (cdr vars-21145)
- (cons (wrap-4323
- (car vars-21145)
- w-21147
+ ((lvl-21144
+ (lambda (vars-21146
+ ls-21147
+ w-21148)
+ (if (pair? vars-21146)
+ (lvl-21144
+ (cdr vars-21146)
+ (cons (wrap-4324
+ (car vars-21146)
+ w-21148
#f)
- ls-21146)
- w-21147)
+ ls-21147)
+ w-21148)
(if (if (symbol?
- vars-21145)
+ vars-21146)
#t
(if (if (vector?
- vars-21145)
+ vars-21146)
(if (= (vector-length
- vars-21145)
+ vars-21146)
4)
(eq? (vector-ref
- vars-21145
+ vars-21146
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- vars-21145
+ vars-21146
1))
#f))
- (cons (wrap-4323
- vars-21145
- w-21147
+ (cons (wrap-4324
+ vars-21146
+ w-21148
#f)
- ls-21146)
- (if (null? vars-21145)
- ls-21146
+ ls-21147)
+ (if (null? vars-21146)
+ ls-21147
(if (if (vector?
- vars-21145)
+ vars-21146)
(if (= (vector-length
- vars-21145)
+ vars-21146)
4)
(eq? (vector-ref
- vars-21145
+ vars-21146
0)
'syntax-object)
#f)
#f)
- (lvl-21143
+ (lvl-21144
(vector-ref
- vars-21145
+ vars-21146
1)
- ls-21146
- (join-wraps-4310
- w-21147
+ ls-21147
+ (join-wraps-4311
+ w-21148
(vector-ref
- vars-21145
+ vars-21146
2)))
- (cons vars-21145
- ls-21146))))))))
- (lvl-21143
- args-20992
+ (cons vars-21146
+ ls-21147))))))))
+ (lvl-21144
+ args-20993
'()
'(()))))
#f))
- tmp-20987)
+ tmp-20988)
#f)
(@apply
- (lambda (name-21191
- args-21192
- e1-21193
- e2-21194)
+ (lambda (name-21192
+ args-21193
+ e1-21194
+ e2-21195)
(values
'define-form
- (wrap-4323
- name-21191
- w-20826
- mod-20829)
- (wrap-4323
- e-20824
- w-20826
- mod-20829)
- (let ((e-21202
+ (wrap-4324
+ name-21192
+ w-20827
+ mod-20830)
+ (wrap-4324
+ e-20825
+ w-20827
+ mod-20830)
+ (let ((e-21203
(cons '#(syntax-object
lambda
((top)
@@ -1678,19 +1680,19 @@
(top)
(top)
(top))
- #("l-*-1901"
- "l-*-1902"
+ #("l-*-1902"
"l-*-1903"
- "l-*-1904"))
+ "l-*-1904"
+ "l-*-1905"))
#(ribcage
()
()
())
#(ribcage
#(key)
- #((m-*-1866
+ #((m-*-1867
top))
- #("l-*-1867"))
+ #("l-*-1868"))
#(ribcage
()
()
@@ -1714,13 +1716,13 @@
(top)
(top)
(top))
- #("l-*-1859"
- "l-*-1860"
+ #("l-*-1860"
"l-*-1861"
"l-*-1862"
"l-*-1863"
"l-*-1864"
- "l-*-1865"))
+ "l-*-1865"
+ "l-*-1866"))
#(ribcage
()
()
@@ -1728,7 +1730,7 @@
#(ribcage
#(first)
#((top))
- #("l-*-1850"))
+ #("l-*-1851"))
#(ribcage
()
()
@@ -1752,13 +1754,13 @@
(top)
(top)
(top))
- #("l-*-1826"
- "l-*-1827"
+ #("l-*-1827"
"l-*-1828"
"l-*-1829"
"l-*-1830"
"l-*-1831"
- "l-*-1832"))
+ "l-*-1832"
+ "l-*-1833"))
#(ribcage
(lambda-var-list
gen-var
@@ -2192,76 +2194,77 @@
"l-*-45")))
(hygiene
guile))
- (wrap-4323
- (cons args-21192
- (cons e1-21193
- e2-21194))
- w-20826
- mod-20829))))
+ (wrap-4324
+ (cons args-21193
+ (cons e1-21194
+ e2-21195))
+ w-20827
+ mod-20830))))
(begin
- (if (if (pair? e-21202)
- s-20827
+ (if (if s-20828
+ (supports-source-properties?
+ e-21203)
#f)
(set-source-properties!
- e-21202
- s-20827))
- e-21202))
+ e-21203
+ s-20828))
+ e-21203))
'(())
- s-20827
- mod-20829))
- tmp-20987)
- (let ((tmp-21209
+ s-20828
+ mod-20830))
+ tmp-20988)
+ (let ((tmp-21210
($sc-dispatch
- e-20824
+ e-20825
'(_ any))))
- (if (if tmp-21209
+ (if (if tmp-21210
(@apply
- (lambda (name-21213)
+ (lambda (name-21214)
(if (symbol?
- name-21213)
+ name-21214)
#t
(if (if (vector?
- name-21213)
+ name-21214)
(if (= (vector-length
- name-21213)
+ name-21214)
4)
(eq? (vector-ref
- name-21213
+ name-21214
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-21213
+ name-21214
1))
#f)))
- tmp-21209)
+ tmp-21210)
#f)
(@apply
- (lambda (name-21240)
+ (lambda (name-21241)
(values
'define-form
- (wrap-4323
- name-21240
- w-20826
- mod-20829)
- (wrap-4323
- e-20824
- w-20826
- mod-20829)
+ (wrap-4324
+ name-21241
+ w-20827
+ mod-20830)
+ (wrap-4324
+ e-20825
+ w-20827
+ mod-20830)
'(#(syntax-object
if
((top)
#(ribcage
#(name)
#((top))
- #("l-*-1914"))
+ #("l-*-1915"))
#(ribcage () () ())
#(ribcage
#(key)
- #((m-*-1866 top))
- #("l-*-1867"))
+ #((m-*-1867 top))
+ #("l-*-1868"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -2279,18 +2282,18 @@
(top)
(top)
(top))
- #("l-*-1859"
- "l-*-1860"
+ #("l-*-1860"
"l-*-1861"
"l-*-1862"
"l-*-1863"
"l-*-1864"
- "l-*-1865"))
+ "l-*-1865"
+ "l-*-1866"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-1850"))
+ #("l-*-1851"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -2308,13 +2311,13 @@
(top)
(top)
(top))
- #("l-*-1826"
- "l-*-1827"
+ #("l-*-1827"
"l-*-1828"
"l-*-1829"
"l-*-1830"
"l-*-1831"
- "l-*-1832"))
+ "l-*-1832"
+ "l-*-1833"))
#(ribcage
(lambda-var-list
gen-var
@@ -2753,12 +2756,12 @@
#(ribcage
#(name)
#((top))
- #("l-*-1914"))
+ #("l-*-1915"))
#(ribcage () () ())
#(ribcage
#(key)
- #((m-*-1866 top))
- #("l-*-1867"))
+ #((m-*-1867 top))
+ #("l-*-1868"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -2776,18 +2779,18 @@
(top)
(top)
(top))
- #("l-*-1859"
- "l-*-1860"
+ #("l-*-1860"
"l-*-1861"
"l-*-1862"
"l-*-1863"
"l-*-1864"
- "l-*-1865"))
+ "l-*-1865"
+ "l-*-1866"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-1850"))
+ #("l-*-1851"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -2805,13 +2808,13 @@
(top)
(top)
(top))
- #("l-*-1826"
- "l-*-1827"
+ #("l-*-1827"
"l-*-1828"
"l-*-1829"
"l-*-1830"
"l-*-1831"
- "l-*-1832"))
+ "l-*-1832"
+ "l-*-1833"))
#(ribcage
(lambda-var-list
gen-var
@@ -3250,12 +3253,12 @@
#(ribcage
#(name)
#((top))
- #("l-*-1914"))
+ #("l-*-1915"))
#(ribcage () () ())
#(ribcage
#(key)
- #((m-*-1866 top))
- #("l-*-1867"))
+ #((m-*-1867 top))
+ #("l-*-1868"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -3273,18 +3276,18 @@
(top)
(top)
(top))
- #("l-*-1859"
- "l-*-1860"
+ #("l-*-1860"
"l-*-1861"
"l-*-1862"
"l-*-1863"
"l-*-1864"
- "l-*-1865"))
+ "l-*-1865"
+ "l-*-1866"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-1850"))
+ #("l-*-1851"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -3302,13 +3305,13 @@
(top)
(top)
(top))
- #("l-*-1826"
- "l-*-1827"
+ #("l-*-1827"
"l-*-1828"
"l-*-1829"
"l-*-1830"
"l-*-1831"
- "l-*-1832"))
+ "l-*-1832"
+ "l-*-1833"))
#(ribcage
(lambda-var-list
gen-var
@@ -3742,298 +3745,300 @@
"l-*-45")))
(hygiene guile)))
'(())
- s-20827
- mod-20829))
- tmp-21209)
+ s-20828
+ mod-20830))
+ tmp-21210)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-20824)))))))
- (if (eqv? ftype-20877 'define-syntax)
- (let ((tmp-21264
+ e-20825)))))))
+ (if (eqv? ftype-20878 'define-syntax)
+ (let ((tmp-21265
($sc-dispatch
- e-20824
+ e-20825
'(_ any any))))
- (if (if tmp-21264
+ (if (if tmp-21265
(@apply
- (lambda (name-21268 val-21269)
- (if (symbol? name-21268)
+ (lambda (name-21269 val-21270)
+ (if (symbol? name-21269)
#t
(if (if (vector?
- name-21268)
+ name-21269)
(if (= (vector-length
- name-21268)
+ name-21269)
4)
(eq? (vector-ref
- name-21268
+ name-21269
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-21268
+ name-21269
1))
#f)))
- tmp-21264)
+ tmp-21265)
#f)
(@apply
- (lambda (name-21296 val-21297)
+ (lambda (name-21297 val-21298)
(values
'define-syntax-form
- name-21296
- e-20824
- val-21297
- w-20826
- s-20827
- mod-20829))
- tmp-21264)
+ name-21297
+ e-20825
+ val-21298
+ w-20827
+ s-20828
+ mod-20830))
+ tmp-21265)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-20824)))
- (if (eqv? ftype-20877
+ e-20825)))
+ (if (eqv? ftype-20878
'define-syntax-parameter)
- (let ((tmp-21311
+ (let ((tmp-21312
($sc-dispatch
- e-20824
+ e-20825
'(_ any any))))
- (if (if tmp-21311
+ (if (if tmp-21312
(@apply
- (lambda (name-21315
- val-21316)
- (if (symbol? name-21315)
+ (lambda (name-21316
+ val-21317)
+ (if (symbol? name-21316)
#t
(if (if (vector?
- name-21315)
+ name-21316)
(if (= (vector-length
- name-21315)
+ name-21316)
4)
(eq? (vector-ref
- name-21315
+ name-21316
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-21315
+ name-21316
1))
#f)))
- tmp-21311)
+ tmp-21312)
#f)
(@apply
- (lambda (name-21343 val-21344)
+ (lambda (name-21344 val-21345)
(values
'define-syntax-parameter-form
- name-21343
- e-20824
- val-21344
- w-20826
- s-20827
- mod-20829))
- tmp-21311)
+ name-21344
+ e-20825
+ val-21345
+ w-20827
+ s-20828
+ mod-20830))
+ tmp-21312)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-20824)))
+ e-20825)))
(values
'call
#f
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)))))))))))))))
- (if (if (vector? e-20824)
- (if (= (vector-length e-20824) 4)
- (eq? (vector-ref e-20824 0) 'syntax-object)
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)))))))))))))))
+ (if (if (vector? e-20825)
+ (if (= (vector-length e-20825) 4)
+ (eq? (vector-ref e-20825 0) 'syntax-object)
#f)
#f)
- (syntax-type-4329
- (vector-ref e-20824 1)
- r-20825
- (join-wraps-4310 w-20826 (vector-ref e-20824 2))
- (let ((t-21371 (source-annotation-4287 e-20824)))
- (if t-21371 t-21371 s-20827))
- rib-20828
- (let ((t-21606 (vector-ref e-20824 3)))
- (if t-21606 t-21606 mod-20829))
- for-car?-20830)
- (if (self-evaluating? e-20824)
+ (syntax-type-4330
+ (vector-ref e-20825 1)
+ r-20826
+ (join-wraps-4311 w-20827 (vector-ref e-20825 2))
+ (let ((t-21372 (source-annotation-4288 e-20825)))
+ (if t-21372 t-21372 s-20828))
+ rib-20829
+ (let ((t-21607 (vector-ref e-20825 3)))
+ (if t-21607 t-21607 mod-20830))
+ for-car?-20831)
+ (if (self-evaluating? e-20825)
(values
'constant
#f
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)
(values
'other
#f
- e-20824
- e-20824
- w-20826
- s-20827
- mod-20829)))))))
- (expand-4330
- (lambda (e-21615 r-21616 w-21617 mod-21618)
+ e-20825
+ e-20825
+ w-20827
+ s-20828
+ mod-20830)))))))
+ (expand-4331
+ (lambda (e-21616 r-21617 w-21618 mod-21619)
(call-with-values
(lambda ()
- (syntax-type-4329
- e-21615
- r-21616
- w-21617
- (source-annotation-4287 e-21615)
+ (syntax-type-4330
+ e-21616
+ r-21617
+ w-21618
+ (source-annotation-4288 e-21616)
#f
- mod-21618
+ mod-21619
#f))
- (lambda (type-21773
- value-21774
- form-21775
- e-21776
- w-21777
- s-21778
- mod-21779)
- (expand-expr-4331
- type-21773
- value-21774
- form-21775
- e-21776
- r-21616
- w-21777
- s-21778
- mod-21779)))))
- (expand-expr-4331
- (lambda (type-21782
- value-21783
- form-21784
- e-21785
- r-21786
- w-21787
- s-21788
- mod-21789)
- (if (eqv? type-21782 'lexical)
+ (lambda (type-21774
+ value-21775
+ form-21776
+ e-21777
+ w-21778
+ s-21779
+ mod-21780)
+ (expand-expr-4332
+ type-21774
+ value-21775
+ form-21776
+ e-21777
+ r-21617
+ w-21778
+ s-21779
+ mod-21780)))))
+ (expand-expr-4332
+ (lambda (type-21783
+ value-21784
+ form-21785
+ e-21786
+ r-21787
+ w-21788
+ s-21789
+ mod-21790)
+ (if (eqv? type-21783 'lexical)
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
- s-21788
- e-21785
- value-21783)
- (if (if (eqv? type-21782 'core)
+ s-21789
+ e-21786
+ value-21784)
+ (if (if (eqv? type-21783 'core)
#t
- (eqv? type-21782 'core-form))
- (value-21783
- e-21785
- r-21786
- w-21787
- s-21788
- mod-21789)
- (if (eqv? type-21782 'module-ref)
+ (eqv? type-21783 'core-form))
+ (value-21784
+ e-21786
+ r-21787
+ w-21788
+ s-21789
+ mod-21790)
+ (if (eqv? type-21783 'module-ref)
(call-with-values
- (lambda () (value-21783 e-21785 r-21786 w-21787))
- (lambda (e-21825 r-21826 w-21827 s-21828 mod-21829)
- (expand-4330 e-21825 r-21826 w-21827 mod-21829)))
- (if (eqv? type-21782 'lexical-call)
- (expand-application-4332
- (let ((id-21907 (car e-21785)))
- (build-lexical-reference-4264
+ (lambda () (value-21784 e-21786 r-21787 w-21788))
+ (lambda (e-21826 r-21827 w-21828 s-21829 mod-21830)
+ (expand-4331 e-21826 r-21827 w-21828 mod-21830)))
+ (if (eqv? type-21783 'lexical-call)
+ (expand-application-4333
+ (let ((id-21908 (car e-21786)))
+ (build-lexical-reference-4265
'fun
- (source-annotation-4287 id-21907)
- (if (if (vector? id-21907)
- (if (= (vector-length id-21907) 4)
- (eq? (vector-ref id-21907 0) 'syntax-object)
+ (source-annotation-4288 id-21908)
+ (if (if (vector? id-21908)
+ (if (= (vector-length id-21908) 4)
+ (eq? (vector-ref id-21908 0) 'syntax-object)
#f)
#f)
- (syntax->datum id-21907)
- id-21907)
- value-21783))
- e-21785
- r-21786
- w-21787
- s-21788
- mod-21789)
- (if (eqv? type-21782 'global-call)
- (expand-application-4332
- (build-global-reference-4267
- (source-annotation-4287 (car e-21785))
- (if (if (vector? value-21783)
- (if (= (vector-length value-21783) 4)
- (eq? (vector-ref value-21783 0) 'syntax-object)
+ (syntax->datum id-21908)
+ id-21908)
+ value-21784))
+ e-21786
+ r-21787
+ w-21788
+ s-21789
+ mod-21790)
+ (if (eqv? type-21783 'global-call)
+ (expand-application-4333
+ (build-global-reference-4268
+ (source-annotation-4288 (car e-21786))
+ (if (if (vector? value-21784)
+ (if (= (vector-length value-21784) 4)
+ (eq? (vector-ref value-21784 0) 'syntax-object)
#f)
#f)
- (vector-ref value-21783 1)
- value-21783)
- (if (if (vector? value-21783)
- (if (= (vector-length value-21783) 4)
- (eq? (vector-ref value-21783 0) 'syntax-object)
+ (vector-ref value-21784 1)
+ value-21784)
+ (if (if (vector? value-21784)
+ (if (= (vector-length value-21784) 4)
+ (eq? (vector-ref value-21784 0) 'syntax-object)
#f)
#f)
- (vector-ref value-21783 3)
- mod-21789))
- e-21785
- r-21786
- w-21787
- s-21788
- mod-21789)
- (if (eqv? type-21782 'constant)
- (let ((exp-22250
- (strip-4343
- (wrap-4323
+ (vector-ref value-21784 3)
+ mod-21790))
+ e-21786
+ r-21787
+ w-21788
+ s-21789
+ mod-21790)
+ (if (eqv? type-21783 'constant)
+ (let ((exp-22251
+ (strip-4344
+ (wrap-4324
(begin
- (if (if (pair? e-21785) s-21788 #f)
- (set-source-properties! e-21785 s-21788))
- e-21785)
- w-21787
- mod-21789)
+ (if (if s-21789
+ (supports-source-properties? e-21786)
+ #f)
+ (set-source-properties! e-21786 s-21789))
+ e-21786)
+ w-21788
+ mod-21790)
'(()))))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
- s-21788
- exp-22250))
- (if (eqv? type-21782 'global)
- (analyze-variable-4266
- mod-21789
- value-21783
- (lambda (mod-22289 var-22290 public?-22291)
+ s-21789
+ exp-22251))
+ (if (eqv? type-21783 'global)
+ (analyze-variable-4267
+ mod-21790
+ value-21784
+ (lambda (mod-22290 var-22291 public?-22292)
(make-struct/no-tail
(vector-ref %expanded-vtables 5)
- s-21788
- mod-22289
- var-22290
- public?-22291))
- (lambda (var-22300)
+ s-21789
+ mod-22290
+ var-22291
+ public?-22292))
+ (lambda (var-22301)
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
- s-21788
- var-22300)))
- (if (eqv? type-21782 'call)
- (expand-application-4332
- (expand-4330
- (car e-21785)
- r-21786
- w-21787
- mod-21789)
- e-21785
- r-21786
- w-21787
- s-21788
- mod-21789)
- (if (eqv? type-21782 'begin-form)
- (let ((tmp-22381
- ($sc-dispatch e-21785 '(_ any . each-any))))
- (if tmp-22381
+ s-21789
+ var-22301)))
+ (if (eqv? type-21783 'call)
+ (expand-application-4333
+ (expand-4331
+ (car e-21786)
+ r-21787
+ w-21788
+ mod-21790)
+ e-21786
+ r-21787
+ w-21788
+ s-21789
+ mod-21790)
+ (if (eqv? type-21783 'begin-form)
+ (let ((tmp-22382
+ ($sc-dispatch e-21786 '(_ any . each-any))))
+ (if tmp-22382
(@apply
- (lambda (e1-22385 e2-22386)
- (expand-sequence-4325
- (cons e1-22385 e2-22386)
- r-21786
- w-21787
- s-21788
- mod-21789))
- tmp-22381)
- (let ((tmp-22473 ($sc-dispatch e-21785 '(_))))
- (if tmp-22473
+ (lambda (e1-22386 e2-22387)
+ (expand-sequence-4326
+ (cons e1-22386 e2-22387)
+ r-21787
+ w-21788
+ s-21789
+ mod-21790))
+ tmp-22382)
+ (let ((tmp-22474 ($sc-dispatch e-21786 '(_))))
+ (if tmp-22474
(@apply
(lambda ()
(if (include-deprecated-features)
@@ -4046,801 +4051,831 @@
(syntax-violation
#f
"sequence of zero expressions"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-21785)
- s-21788
+ (if (if s-21789
+ (supports-source-properties?
+ e-21786)
#f)
(set-source-properties!
- e-21785
- s-21788))
- e-21785)
- w-21787
- mod-21789))))
- tmp-22473)
+ e-21786
+ s-21789))
+ e-21786)
+ w-21788
+ mod-21790))))
+ tmp-22474)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-21785)))))
- (if (eqv? type-21782 'local-syntax-form)
- (expand-local-syntax-4335
- value-21783
- e-21785
- r-21786
- w-21787
- s-21788
- mod-21789
- expand-sequence-4325)
- (if (eqv? type-21782 'eval-when-form)
- (let ((tmp-22590
+ e-21786)))))
+ (if (eqv? type-21783 'local-syntax-form)
+ (expand-local-syntax-4336
+ value-21784
+ e-21786
+ r-21787
+ w-21788
+ s-21789
+ mod-21790
+ expand-sequence-4326)
+ (if (eqv? type-21783 'eval-when-form)
+ (let ((tmp-22591
($sc-dispatch
- e-21785
+ e-21786
'(_ each-any any . each-any))))
- (if tmp-22590
+ (if tmp-22591
(@apply
- (lambda (x-22594 e1-22595 e2-22596)
- (let ((when-list-22597
- (parse-when-list-4328
- e-21785
- x-22594)))
- (if (memq 'eval when-list-22597)
- (expand-sequence-4325
- (cons e1-22595 e2-22596)
- r-21786
- w-21787
- s-21788
- mod-21789)
+ (lambda (x-22595 e1-22596 e2-22597)
+ (let ((when-list-22598
+ (parse-when-list-4329
+ e-21786
+ x-22595)))
+ (if (memq 'eval when-list-22598)
+ (expand-sequence-4326
+ (cons e1-22596 e2-22597)
+ r-21787
+ w-21788
+ s-21789
+ mod-21790)
(make-struct/no-tail
(vector-ref %expanded-vtables 0)
#f))))
- tmp-22590)
+ tmp-22591)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-21785)))
- (if (if (eqv? type-21782 'define-form)
+ e-21786)))
+ (if (if (eqv? type-21783 'define-form)
#t
- (if (eqv? type-21782 'define-syntax-form)
+ (if (eqv? type-21783 'define-syntax-form)
#t
- (eqv? type-21782
+ (eqv? type-21783
'define-syntax-parameter-form)))
(syntax-violation
#f
"definition in expression context, where definitions are not allowed,"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? form-21784) s-21788 #f)
+ (if (if s-21789
+ (supports-source-properties?
+ form-21785)
+ #f)
(set-source-properties!
- form-21784
- s-21788))
- form-21784)
- w-21787
- mod-21789))
- (if (eqv? type-21782 'syntax)
+ form-21785
+ s-21789))
+ form-21785)
+ w-21788
+ mod-21790))
+ (if (eqv? type-21783 'syntax)
(syntax-violation
#f
"reference to pattern variable outside syntax form"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-21785) s-21788 #f)
+ (if (if s-21789
+ (supports-source-properties?
+ e-21786)
+ #f)
(set-source-properties!
- e-21785
- s-21788))
- e-21785)
- w-21787
- mod-21789))
- (if (eqv? type-21782 'displaced-lexical)
+ e-21786
+ s-21789))
+ e-21786)
+ w-21788
+ mod-21790))
+ (if (eqv? type-21783 'displaced-lexical)
(syntax-violation
#f
"reference to identifier outside its scope"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-21785) s-21788 #f)
+ (if (if s-21789
+ (supports-source-properties?
+ e-21786)
+ #f)
(set-source-properties!
- e-21785
- s-21788))
- e-21785)
- w-21787
- mod-21789))
+ e-21786
+ s-21789))
+ e-21786)
+ w-21788
+ mod-21790))
(syntax-violation
#f
"unexpected syntax"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-21785) s-21788 #f)
+ (if (if s-21789
+ (supports-source-properties?
+ e-21786)
+ #f)
(set-source-properties!
- e-21785
- s-21788))
- e-21785)
- w-21787
- mod-21789))))))))))))))))))
- (expand-application-4332
- (lambda (x-22866
- e-22867
- r-22868
- w-22869
- s-22870
- mod-22871)
- (let ((tmp-22873
- ($sc-dispatch e-22867 '(any . each-any))))
- (if tmp-22873
+ e-21786
+ s-21789))
+ e-21786)
+ w-21788
+ mod-21790))))))))))))))))))
+ (expand-application-4333
+ (lambda (x-22867
+ e-22868
+ r-22869
+ w-22870
+ s-22871
+ mod-22872)
+ (let ((tmp-22874
+ ($sc-dispatch e-22868 '(any . each-any))))
+ (if tmp-22874
(@apply
- (lambda (e0-22877 e1-22878)
- (build-application-4261
- s-22870
- x-22866
- (map (lambda (e-22958)
- (expand-4330 e-22958 r-22868 w-22869 mod-22871))
- e1-22878)))
- tmp-22873)
+ (lambda (e0-22878 e1-22879)
+ (build-application-4262
+ s-22871
+ x-22867
+ (map (lambda (e-22959)
+ (expand-4331 e-22959 r-22869 w-22870 mod-22872))
+ e1-22879)))
+ tmp-22874)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-22867)))))
- (expand-macro-4333
- (lambda (p-23034
- e-23035
- r-23036
- w-23037
- s-23038
- rib-23039
- mod-23040)
+ e-22868)))))
+ (expand-macro-4334
+ (lambda (p-23035
+ e-23036
+ r-23037
+ w-23038
+ s-23039
+ rib-23040
+ mod-23041)
(letrec*
- ((rebuild-macro-output-23041
- (lambda (x-23074 m-23075)
- (if (pair? x-23074)
- (let ((e-23079
- (cons (rebuild-macro-output-23041
- (car x-23074)
- m-23075)
- (rebuild-macro-output-23041
- (cdr x-23074)
- m-23075))))
+ ((rebuild-macro-output-23042
+ (lambda (x-23075 m-23076)
+ (if (pair? x-23075)
+ (let ((e-23080
+ (cons (rebuild-macro-output-23042
+ (car x-23075)
+ m-23076)
+ (rebuild-macro-output-23042
+ (cdr x-23075)
+ m-23076))))
(begin
- (if (if (pair? e-23079) s-23038 #f)
- (set-source-properties! e-23079 s-23038))
- e-23079))
- (if (if (vector? x-23074)
- (if (= (vector-length x-23074) 4)
- (eq? (vector-ref x-23074 0) 'syntax-object)
+ (if (if s-23039
+ (supports-source-properties? e-23080)
+ #f)
+ (set-source-properties! e-23080 s-23039))
+ e-23080))
+ (if (if (vector? x-23075)
+ (if (= (vector-length x-23075) 4)
+ (eq? (vector-ref x-23075 0) 'syntax-object)
#f)
#f)
- (let ((w-23095 (vector-ref x-23074 2)))
- (let ((ms-23096 (car w-23095))
- (ss-23097 (cdr w-23095)))
- (if (if (pair? ms-23096) (eq? (car ms-23096) #f) #f)
- (let ((expression-23105 (vector-ref x-23074 1))
- (wrap-23106
- (cons (cdr ms-23096)
- (if rib-23039
- (cons rib-23039 (cdr ss-23097))
- (cdr ss-23097))))
- (module-23107 (vector-ref x-23074 3)))
+ (let ((w-23096 (vector-ref x-23075 2)))
+ (let ((ms-23097 (car w-23096))
+ (ss-23098 (cdr w-23096)))
+ (if (if (pair? ms-23097) (eq? (car ms-23097) #f) #f)
+ (let ((expression-23106 (vector-ref x-23075 1))
+ (wrap-23107
+ (cons (cdr ms-23097)
+ (if rib-23040
+ (cons rib-23040 (cdr ss-23098))
+ (cdr ss-23098))))
+ (module-23108 (vector-ref x-23075 3)))
(vector
'syntax-object
- expression-23105
- wrap-23106
- module-23107))
- (let ((expression-23117
- (let ((e-23122 (vector-ref x-23074 1)))
+ expression-23106
+ wrap-23107
+ module-23108))
+ (let ((expression-23118
+ (let ((e-23123 (vector-ref x-23075 1)))
(begin
- (if (if (pair? e-23122) s-23038 #f)
+ (if (if s-23039
+ (supports-source-properties?
+ e-23123)
+ #f)
(set-source-properties!
- e-23122
- s-23038))
- e-23122)))
- (wrap-23118
- (cons (cons m-23075 ms-23096)
- (if rib-23039
- (cons rib-23039
- (cons 'shift ss-23097))
- (cons 'shift ss-23097))))
- (module-23119 (vector-ref x-23074 3)))
+ e-23123
+ s-23039))
+ e-23123)))
+ (wrap-23119
+ (cons (cons m-23076 ms-23097)
+ (if rib-23040
+ (cons rib-23040
+ (cons 'shift ss-23098))
+ (cons 'shift ss-23098))))
+ (module-23120 (vector-ref x-23075 3)))
(vector
'syntax-object
- expression-23117
- wrap-23118
- module-23119)))))
- (if (vector? x-23074)
- (let ((n-23134 (vector-length x-23074)))
- (let ((v-23135
- (let ((e-23143 (make-vector n-23134)))
+ expression-23118
+ wrap-23119
+ module-23120)))))
+ (if (vector? x-23075)
+ (let ((n-23135 (vector-length x-23075)))
+ (let ((v-23136
+ (let ((e-23144 (make-vector n-23135)))
(begin
- (if (if (pair? e-23143) s-23038 #f)
- (set-source-properties! e-23143 s-23038))
- e-23143))))
+ (if (if s-23039
+ (supports-source-properties? e-23144)
+ #f)
+ (set-source-properties! e-23144 s-23039))
+ e-23144))))
(letrec*
- ((loop-23136
- (lambda (i-23188)
- (if (= i-23188 n-23134)
- v-23135
+ ((loop-23137
+ (lambda (i-23189)
+ (if (= i-23189 n-23135)
+ v-23136
(begin
(vector-set!
- v-23135
- i-23188
- (rebuild-macro-output-23041
- (vector-ref x-23074 i-23188)
- m-23075))
- (loop-23136 (#{1+}# i-23188)))))))
- (loop-23136 0))))
- (if (symbol? x-23074)
+ v-23136
+ i-23189
+ (rebuild-macro-output-23042
+ (vector-ref x-23075 i-23189)
+ m-23076))
+ (loop-23137 (#{1+}# i-23189)))))))
+ (loop-23137 0))))
+ (if (symbol? x-23075)
(syntax-violation
#f
"encountered raw symbol in macro output"
- (let ((s-23194 (cdr w-23037)))
- (wrap-4323
+ (let ((s-23195 (cdr w-23038)))
+ (wrap-4324
(begin
- (if (if (pair? e-23035) s-23194 #f)
- (set-source-properties! e-23035 s-23194))
- e-23035)
- w-23037
- mod-23040))
- x-23074)
+ (if (if s-23195
+ (supports-source-properties? e-23036)
+ #f)
+ (set-source-properties! e-23036 s-23195))
+ e-23036)
+ w-23038
+ mod-23041))
+ x-23075)
(begin
- (if (if (pair? x-23074) s-23038 #f)
- (set-source-properties! x-23074 s-23038))
- x-23074))))))))
+ (if (if s-23039
+ (supports-source-properties? x-23075)
+ #f)
+ (set-source-properties! x-23075 s-23039))
+ x-23075))))))))
(with-fluids
- ((transformer-environment-4316
- (lambda (k-23042)
- (k-23042
- e-23035
- r-23036
- w-23037
- s-23038
- rib-23039
- mod-23040))))
- (rebuild-macro-output-23041
- (p-23034
- (let ((w-23049
- (cons (cons #f (car w-23037))
- (cons 'shift (cdr w-23037)))))
- (wrap-4323
+ ((transformer-environment-4317
+ (lambda (k-23043)
+ (k-23043
+ e-23036
+ r-23037
+ w-23038
+ s-23039
+ rib-23040
+ mod-23041))))
+ (rebuild-macro-output-23042
+ (p-23035
+ (let ((w-23050
+ (cons (cons #f (car w-23038))
+ (cons 'shift (cdr w-23038)))))
+ (wrap-4324
(begin
- (if (if (pair? e-23035) s-23038 #f)
- (set-source-properties! e-23035 s-23038))
- e-23035)
- w-23049
- mod-23040)))
+ (if (if s-23039
+ (supports-source-properties? e-23036)
+ #f)
+ (set-source-properties! e-23036 s-23039))
+ e-23036)
+ w-23050
+ mod-23041)))
(gensym
- (string-append "m-" (session-id-4255) "-")))))))
- (expand-body-4334
- (lambda (body-23226
- outer-form-23227
- r-23228
- w-23229
- mod-23230)
- (let ((r-23231
- (cons '("placeholder" placeholder) r-23228)))
- (let ((ribcage-23232 (vector 'ribcage '() '() '())))
- (let ((w-23233
- (cons (car w-23229)
- (cons ribcage-23232 (cdr w-23229)))))
+ (string-append "m-" (session-id-4256) "-")))))))
+ (expand-body-4335
+ (lambda (body-23227
+ outer-form-23228
+ r-23229
+ w-23230
+ mod-23231)
+ (let ((r-23232
+ (cons '("placeholder" placeholder) r-23229)))
+ (let ((ribcage-23233 (vector 'ribcage '() '() '())))
+ (let ((w-23234
+ (cons (car w-23230)
+ (cons ribcage-23233 (cdr w-23230)))))
(letrec*
- ((parse-23234
- (lambda (body-23247
- ids-23248
- labels-23249
- var-ids-23250
- vars-23251
- vals-23252
- bindings-23253)
- (if (null? body-23247)
+ ((parse-23235
+ (lambda (body-23248
+ ids-23249
+ labels-23250
+ var-ids-23251
+ vars-23252
+ vals-23253
+ bindings-23254)
+ (if (null? body-23248)
(syntax-violation
#f
"no expressions in body"
- outer-form-23227)
- (let ((e-23254 (cdr (car body-23247)))
- (er-23255 (car (car body-23247))))
+ outer-form-23228)
+ (let ((e-23255 (cdr (car body-23248)))
+ (er-23256 (car (car body-23248))))
(call-with-values
(lambda ()
- (syntax-type-4329
- e-23254
- er-23255
+ (syntax-type-4330
+ e-23255
+ er-23256
'(())
- (source-annotation-4287 er-23255)
- ribcage-23232
- mod-23230
+ (source-annotation-4288 er-23256)
+ ribcage-23233
+ mod-23231
#f))
- (lambda (type-23412
- value-23413
- form-23414
- e-23415
- w-23416
- s-23417
- mod-23418)
- (if (eqv? type-23412 'define-form)
- (let ((id-23426
- (wrap-4323
- value-23413
- w-23416
- mod-23418))
- (label-23427
+ (lambda (type-23413
+ value-23414
+ form-23415
+ e-23416
+ w-23417
+ s-23418
+ mod-23419)
+ (if (eqv? type-23413 'define-form)
+ (let ((id-23427
+ (wrap-4324
+ value-23414
+ w-23417
+ mod-23419))
+ (label-23428
(string-append
"l-"
- (session-id-4255)
+ (session-id-4256)
(symbol->string (gensym "-")))))
- (let ((var-23428
- (let ((id-23488
- (if (if (vector? id-23426)
+ (let ((var-23429
+ (let ((id-23489
+ (if (if (vector? id-23427)
(if (= (vector-length
- id-23426)
+ id-23427)
4)
(eq? (vector-ref
- id-23426
+ id-23427
0)
'syntax-object)
#f)
#f)
- (vector-ref id-23426 1)
- id-23426)))
+ (vector-ref id-23427 1)
+ id-23427)))
(gensym
(string-append
- (symbol->string id-23488)
+ (symbol->string id-23489)
"-")))))
(begin
- (let ((update-23478
- (cons (vector-ref id-23426 1)
+ (let ((update-23479
+ (cons (vector-ref id-23427 1)
(vector-ref
- ribcage-23232
+ ribcage-23233
1))))
(vector-set!
- ribcage-23232
+ ribcage-23233
1
- update-23478))
- (let ((update-23480
+ update-23479))
+ (let ((update-23481
(cons (car (vector-ref
- id-23426
+ id-23427
2))
(vector-ref
- ribcage-23232
+ ribcage-23233
2))))
(vector-set!
- ribcage-23232
+ ribcage-23233
2
- update-23480))
- (let ((update-23482
- (cons label-23427
+ update-23481))
+ (let ((update-23483
+ (cons label-23428
(vector-ref
- ribcage-23232
+ ribcage-23233
3))))
(vector-set!
- ribcage-23232
+ ribcage-23233
3
- update-23482))
- (parse-23234
- (cdr body-23247)
- (cons id-23426 ids-23248)
- (cons label-23427 labels-23249)
- (cons id-23426 var-ids-23250)
- (cons var-23428 vars-23251)
- (cons (cons er-23255
- (wrap-4323
- e-23415
- w-23416
- mod-23418))
- vals-23252)
- (cons (cons 'lexical var-23428)
- bindings-23253)))))
- (if (if (eqv? type-23412 'define-syntax-form)
+ update-23483))
+ (parse-23235
+ (cdr body-23248)
+ (cons id-23427 ids-23249)
+ (cons label-23428 labels-23250)
+ (cons id-23427 var-ids-23251)
+ (cons var-23429 vars-23252)
+ (cons (cons er-23256
+ (wrap-4324
+ e-23416
+ w-23417
+ mod-23419))
+ vals-23253)
+ (cons (cons 'lexical var-23429)
+ bindings-23254)))))
+ (if (if (eqv? type-23413 'define-syntax-form)
#t
- (eqv? type-23412
+ (eqv? type-23413
'define-syntax-parameter-form))
- (let ((id-23524
- (wrap-4323
- value-23413
- w-23416
- mod-23418))
- (label-23525
+ (let ((id-23525
+ (wrap-4324
+ value-23414
+ w-23417
+ mod-23419))
+ (label-23526
(string-append
"l-"
- (session-id-4255)
+ (session-id-4256)
(symbol->string (gensym "-")))))
(begin
- (let ((update-23575
- (cons (vector-ref id-23524 1)
+ (let ((update-23576
+ (cons (vector-ref id-23525 1)
(vector-ref
- ribcage-23232
+ ribcage-23233
1))))
(vector-set!
- ribcage-23232
+ ribcage-23233
1
- update-23575))
- (let ((update-23577
+ update-23576))
+ (let ((update-23578
(cons (car (vector-ref
- id-23524
+ id-23525
2))
(vector-ref
- ribcage-23232
+ ribcage-23233
2))))
(vector-set!
- ribcage-23232
+ ribcage-23233
2
- update-23577))
- (let ((update-23579
- (cons label-23525
+ update-23578))
+ (let ((update-23580
+ (cons label-23526
(vector-ref
- ribcage-23232
+ ribcage-23233
3))))
(vector-set!
- ribcage-23232
+ ribcage-23233
3
- update-23579))
- (parse-23234
- (cdr body-23247)
- (cons id-23524 ids-23248)
- (cons label-23525 labels-23249)
- var-ids-23250
- vars-23251
- vals-23252
+ update-23580))
+ (parse-23235
+ (cdr body-23248)
+ (cons id-23525 ids-23249)
+ (cons label-23526 labels-23250)
+ var-ids-23251
+ vars-23252
+ vals-23253
(cons (cons 'macro
- (cons er-23255
- (wrap-4323
- e-23415
- w-23416
- mod-23418)))
- bindings-23253))))
- (if (eqv? type-23412 'begin-form)
- (let ((tmp-23590
+ (cons er-23256
+ (wrap-4324
+ e-23416
+ w-23417
+ mod-23419)))
+ bindings-23254))))
+ (if (eqv? type-23413 'begin-form)
+ (let ((tmp-23591
($sc-dispatch
- e-23415
+ e-23416
'(_ . each-any))))
- (if tmp-23590
+ (if tmp-23591
(@apply
- (lambda (e1-23594)
- (parse-23234
+ (lambda (e1-23595)
+ (parse-23235
(letrec*
- ((f-23595
- (lambda (forms-23658)
- (if (null? forms-23658)
- (cdr body-23247)
- (cons (cons er-23255
- (wrap-4323
- (car forms-23658)
- w-23416
- mod-23418))
- (f-23595
- (cdr forms-23658)))))))
- (f-23595 e1-23594))
- ids-23248
- labels-23249
- var-ids-23250
- vars-23251
- vals-23252
- bindings-23253))
- tmp-23590)
+ ((f-23596
+ (lambda (forms-23659)
+ (if (null? forms-23659)
+ (cdr body-23248)
+ (cons (cons er-23256
+ (wrap-4324
+ (car forms-23659)
+ w-23417
+ mod-23419))
+ (f-23596
+ (cdr forms-23659)))))))
+ (f-23596 e1-23595))
+ ids-23249
+ labels-23250
+ var-ids-23251
+ vars-23252
+ vals-23253
+ bindings-23254))
+ tmp-23591)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-23415)))
- (if (eqv? type-23412 'local-syntax-form)
- (expand-local-syntax-4335
- value-23413
- e-23415
- er-23255
- w-23416
- s-23417
- mod-23418
- (lambda (forms-23675
- er-23676
- w-23677
- s-23678
- mod-23679)
- (parse-23234
+ e-23416)))
+ (if (eqv? type-23413 'local-syntax-form)
+ (expand-local-syntax-4336
+ value-23414
+ e-23416
+ er-23256
+ w-23417
+ s-23418
+ mod-23419
+ (lambda (forms-23676
+ er-23677
+ w-23678
+ s-23679
+ mod-23680)
+ (parse-23235
(letrec*
- ((f-23680
- (lambda (forms-23743)
- (if (null? forms-23743)
- (cdr body-23247)
- (cons (cons er-23676
- (wrap-4323
- (car forms-23743)
- w-23677
- mod-23679))
- (f-23680
- (cdr forms-23743)))))))
- (f-23680 forms-23675))
- ids-23248
- labels-23249
- var-ids-23250
- vars-23251
- vals-23252
- bindings-23253)))
- (if (null? ids-23248)
- (build-sequence-4275
+ ((f-23681
+ (lambda (forms-23744)
+ (if (null? forms-23744)
+ (cdr body-23248)
+ (cons (cons er-23677
+ (wrap-4324
+ (car forms-23744)
+ w-23678
+ mod-23680))
+ (f-23681
+ (cdr forms-23744)))))))
+ (f-23681 forms-23676))
+ ids-23249
+ labels-23250
+ var-ids-23251
+ vars-23252
+ vals-23253
+ bindings-23254)))
+ (if (null? ids-23249)
+ (build-sequence-4276
#f
- (map (lambda (x-23808)
- (let ((e-23812 (cdr x-23808))
- (r-23813 (car x-23808)))
+ (map (lambda (x-23809)
+ (let ((e-23813 (cdr x-23809))
+ (r-23814 (car x-23809)))
(call-with-values
(lambda ()
- (syntax-type-4329
- e-23812
- r-23813
+ (syntax-type-4330
+ e-23813
+ r-23814
'(())
- (source-annotation-4287
- e-23812)
+ (source-annotation-4288
+ e-23813)
#f
- mod-23418
+ mod-23419
#f))
- (lambda (type-23817
- value-23818
- form-23819
- e-23820
- w-23821
- s-23822
- mod-23823)
- (expand-expr-4331
- type-23817
- value-23818
- form-23819
- e-23820
- r-23813
- w-23821
- s-23822
- mod-23823)))))
- (cons (cons er-23255
- (wrap-4323
+ (lambda (type-23818
+ value-23819
+ form-23820
+ e-23821
+ w-23822
+ s-23823
+ mod-23824)
+ (expand-expr-4332
+ type-23818
+ value-23819
+ form-23820
+ e-23821
+ r-23814
+ w-23822
+ s-23823
+ mod-23824)))))
+ (cons (cons er-23256
+ (wrap-4324
(begin
- (if (if (pair? e-23415)
- s-23417
+ (if (if s-23418
+ (supports-source-properties?
+ e-23416)
#f)
(set-source-properties!
- e-23415
- s-23417))
- e-23415)
- w-23416
- mod-23418))
- (cdr body-23247))))
+ e-23416
+ s-23418))
+ e-23416)
+ w-23417
+ mod-23419))
+ (cdr body-23248))))
(begin
- (if (not (valid-bound-ids?-4320
- ids-23248))
+ (if (not (valid-bound-ids?-4321
+ ids-23249))
(syntax-violation
#f
"invalid or duplicate identifier in definition"
- outer-form-23227))
+ outer-form-23228))
(letrec*
- ((loop-23924
- (lambda (bs-23927
- er-cache-23928
- r-cache-23929)
- (if (not (null? bs-23927))
- (let ((b-23930
- (car bs-23927)))
- (if (eq? (car b-23930)
+ ((loop-23925
+ (lambda (bs-23928
+ er-cache-23929
+ r-cache-23930)
+ (if (not (null? bs-23928))
+ (let ((b-23931
+ (car bs-23928)))
+ (if (eq? (car b-23931)
'macro)
- (let ((er-23932
- (car (cdr b-23930))))
- (let ((r-cache-23933
- (if (eq? er-23932
- er-cache-23928)
- r-cache-23929
- (macros-only-env-4290
- er-23932))))
+ (let ((er-23933
+ (car (cdr b-23931))))
+ (let ((r-cache-23934
+ (if (eq? er-23933
+ er-cache-23929)
+ r-cache-23930
+ (macros-only-env-4291
+ er-23933))))
(begin
(set-cdr!
- b-23930
- (eval-local-transformer-4336
- (expand-4330
- (cdr (cdr b-23930))
- r-cache-23933
+ b-23931
+ (eval-local-transformer-4337
+ (expand-4331
+ (cdr (cdr b-23931))
+ r-cache-23934
'(())
- mod-23418)
- mod-23418))
- (loop-23924
- (cdr bs-23927)
- er-23932
- r-cache-23933))))
- (loop-23924
- (cdr bs-23927)
- er-cache-23928
- r-cache-23929)))))))
- (loop-23924 bindings-23253 #f #f))
+ mod-23419)
+ mod-23419))
+ (loop-23925
+ (cdr bs-23928)
+ er-23933
+ r-cache-23934))))
+ (loop-23925
+ (cdr bs-23928)
+ er-cache-23929
+ r-cache-23930)))))))
+ (loop-23925 bindings-23254 #f #f))
(set-cdr!
- r-23231
- (extend-env-4288
- labels-23249
- bindings-23253
- (cdr r-23231)))
- (build-letrec-4278
+ r-23232
+ (extend-env-4289
+ labels-23250
+ bindings-23254
+ (cdr r-23232)))
+ (build-letrec-4279
#f
#t
(reverse
(map syntax->datum
- var-ids-23250))
- (reverse vars-23251)
- (map (lambda (x-24276)
- (let ((e-24280
- (cdr x-24276))
- (r-24281
- (car x-24276)))
+ var-ids-23251))
+ (reverse vars-23252)
+ (map (lambda (x-24277)
+ (let ((e-24281
+ (cdr x-24277))
+ (r-24282
+ (car x-24277)))
(call-with-values
(lambda ()
- (syntax-type-4329
- e-24280
- r-24281
+ (syntax-type-4330
+ e-24281
+ r-24282
'(())
- (source-annotation-4287
- e-24280)
+ (source-annotation-4288
+ e-24281)
#f
- mod-23418
+ mod-23419
#f))
- (lambda (type-24285
- value-24286
- form-24287
- e-24288
- w-24289
- s-24290
- mod-24291)
- (expand-expr-4331
- type-24285
- value-24286
- form-24287
- e-24288
- r-24281
- w-24289
- s-24290
- mod-24291)))))
- (reverse vals-23252))
- (let ((exps-24297
- (map (lambda (x-24298)
- (let ((e-24301
- (cdr x-24298))
- (r-24302
- (car x-24298)))
+ (lambda (type-24286
+ value-24287
+ form-24288
+ e-24289
+ w-24290
+ s-24291
+ mod-24292)
+ (expand-expr-4332
+ type-24286
+ value-24287
+ form-24288
+ e-24289
+ r-24282
+ w-24290
+ s-24291
+ mod-24292)))))
+ (reverse vals-23253))
+ (let ((exps-24298
+ (map (lambda (x-24299)
+ (let ((e-24302
+ (cdr x-24299))
+ (r-24303
+ (car x-24299)))
(call-with-values
(lambda ()
- (syntax-type-4329
- e-24301
- r-24302
+ (syntax-type-4330
+ e-24302
+ r-24303
'(())
- (source-annotation-4287
- e-24301)
+ (source-annotation-4288
+ e-24302)
#f
- mod-23418
+ mod-23419
#f))
- (lambda (type-24306
- value-24307
- form-24308
- e-24309
- w-24310
- s-24311
- mod-24312)
- (expand-expr-4331
- type-24306
- value-24307
- form-24308
- e-24309
- r-24302
- w-24310
- s-24311
- mod-24312)))))
- (cons (cons er-23255
- (wrap-4323
+ (lambda (type-24307
+ value-24308
+ form-24309
+ e-24310
+ w-24311
+ s-24312
+ mod-24313)
+ (expand-expr-4332
+ type-24307
+ value-24308
+ form-24309
+ e-24310
+ r-24303
+ w-24311
+ s-24312
+ mod-24313)))))
+ (cons (cons er-23256
+ (wrap-4324
(begin
- (if (if (pair? e-23415)
- s-23417
+ (if (if s-23418
+ (supports-source-properties?
+ e-23416)
#f)
(set-source-properties!
- e-23415
- s-23417))
- e-23415)
- w-23416
- mod-23418))
- (cdr body-23247)))))
- (if (null? (cdr exps-24297))
- (car exps-24297)
+ e-23416
+ s-23418))
+ e-23416)
+ w-23417
+ mod-23419))
+ (cdr body-23248)))))
+ (if (null? (cdr exps-24298))
+ (car exps-24298)
(make-struct/no-tail
(vector-ref
%expanded-vtables
12)
#f
- exps-24297)))))))))))))))))
- (parse-23234
- (map (lambda (x-23237)
- (cons r-23231
- (wrap-4323 x-23237 w-23233 mod-23230)))
- body-23226)
+ exps-24298)))))))))))))))))
+ (parse-23235
+ (map (lambda (x-23238)
+ (cons r-23232
+ (wrap-4324 x-23238 w-23234 mod-23231)))
+ body-23227)
'()
'()
'()
'()
'()
'())))))))
- (expand-local-syntax-4335
- (lambda (rec?-24338
- e-24339
- r-24340
- w-24341
- s-24342
- mod-24343
- k-24344)
- (let ((tmp-24346
+ (expand-local-syntax-4336
+ (lambda (rec?-24339
+ e-24340
+ r-24341
+ w-24342
+ s-24343
+ mod-24344
+ k-24345)
+ (let ((tmp-24347
($sc-dispatch
- e-24339
+ e-24340
'(_ #(each (any any)) any . each-any))))
- (if tmp-24346
+ (if tmp-24347
(@apply
- (lambda (id-24350 val-24351 e1-24352 e2-24353)
- (if (not (valid-bound-ids?-4320 id-24350))
+ (lambda (id-24351 val-24352 e1-24353 e2-24354)
+ (if (not (valid-bound-ids?-4321 id-24351))
(syntax-violation
#f
"duplicate bound keyword"
- e-24339)
- (let ((labels-24443 (gen-labels-4297 id-24350)))
- (let ((new-w-24444
- (make-binding-wrap-4308
- id-24350
- labels-24443
- w-24341)))
- (k-24344
- (cons e1-24352 e2-24353)
- (extend-env-4288
- labels-24443
- (let ((trans-r-24480
- (macros-only-env-4290 r-24340)))
+ e-24340)
+ (let ((labels-24444 (gen-labels-4298 id-24351)))
+ (let ((new-w-24445
+ (make-binding-wrap-4309
+ id-24351
+ labels-24444
+ w-24342)))
+ (k-24345
+ (cons e1-24353 e2-24354)
+ (extend-env-4289
+ labels-24444
+ (let ((trans-r-24481
+ (macros-only-env-4291 r-24341)))
(begin
- (if rec?-24338 new-w-24444 w-24341)
- (map (lambda (x-24481)
+ (if rec?-24339 new-w-24445 w-24342)
+ (map (lambda (x-24482)
(cons 'macro
- (eval-local-transformer-4336
- (expand-4330
- x-24481
- trans-r-24480
+ (eval-local-transformer-4337
+ (expand-4331
+ x-24482
+ trans-r-24481
(values
- (if rec?-24338
- new-w-24444
- w-24341))
- mod-24343)
- mod-24343)))
- val-24351)))
- r-24340)
- new-w-24444
- s-24342
- mod-24343)))))
- tmp-24346)
+ (if rec?-24339
+ new-w-24445
+ w-24342))
+ mod-24344)
+ mod-24344)))
+ val-24352)))
+ r-24341)
+ new-w-24445
+ s-24343
+ mod-24344)))))
+ tmp-24347)
(syntax-violation
#f
"bad local syntax definition"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-24339) s-24342 #f)
- (set-source-properties! e-24339 s-24342))
- e-24339)
- w-24341
- mod-24343))))))
- (eval-local-transformer-4336
- (lambda (expanded-24761 mod-24762)
- (let ((p-24763 (primitive-eval expanded-24761)))
- (if (procedure? p-24763)
- p-24763
+ (if (if s-24343
+ (supports-source-properties? e-24340)
+ #f)
+ (set-source-properties! e-24340 s-24343))
+ e-24340)
+ w-24342
+ mod-24344))))))
+ (eval-local-transformer-4337
+ (lambda (expanded-24762 mod-24763)
+ (let ((p-24764 (primitive-eval expanded-24762)))
+ (if (procedure? p-24764)
+ p-24764
(syntax-violation
#f
"nonprocedure transformer"
- p-24763)))))
- (ellipsis?-4338
- (lambda (x-4999)
- (if (if (if (vector? x-4999)
- (if (= (vector-length x-4999) 4)
- (eq? (vector-ref x-4999 0) 'syntax-object)
+ p-24764)))))
+ (ellipsis?-4339
+ (lambda (x-5000)
+ (if (if (if (vector? x-5000)
+ (if (= (vector-length x-5000) 4)
+ (eq? (vector-ref x-5000 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-4999 1))
+ (symbol? (vector-ref x-5000 1))
#f)
- (if (eq? (if (if (vector? x-4999)
- (if (= (vector-length x-4999) 4)
- (eq? (vector-ref x-4999 0) 'syntax-object)
+ (if (eq? (if (if (vector? x-5000)
+ (if (= (vector-length x-5000) 4)
+ (eq? (vector-ref x-5000 0) 'syntax-object)
#f)
#f)
- (vector-ref x-4999 1)
- x-4999)
+ (vector-ref x-5000 1)
+ x-5000)
(if (if (= (vector-length
'#(syntax-object
...
((top)
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-2266"))
+ #(ribcage #(x) #((top)) #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -5278,7 +5313,7 @@
((top)
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-2266"))
+ #(ribcage #(x) #((top)) #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -5707,14 +5742,14 @@
((top) (top) (top))
("l-*-47" "l-*-46" "l-*-45")))
(hygiene guile))))
- (eq? (id-var-name-4313 x-4999 '(()))
- (id-var-name-4313
+ (eq? (id-var-name-4314 x-5000 '(()))
+ (id-var-name-4314
'#(syntax-object
...
((top)
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-2266"))
+ #(ribcage #(x) #((top)) #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -6146,270 +6181,272 @@
'(())))
#f)
#f)))
- (lambda-formals-4339
- (lambda (orig-args-24768)
+ (lambda-formals-4340
+ (lambda (orig-args-24769)
(letrec*
- ((req-24769
- (lambda (args-24773 rreq-24774)
- (let ((tmp-24776 ($sc-dispatch args-24773 '())))
- (if tmp-24776
+ ((req-24770
+ (lambda (args-24774 rreq-24775)
+ (let ((tmp-24777 ($sc-dispatch args-24774 '())))
+ (if tmp-24777
(@apply
- (lambda () (check-24770 (reverse rreq-24774) #f))
- tmp-24776)
- (let ((tmp-24899
- ($sc-dispatch args-24773 '(any . any))))
- (if (if tmp-24899
+ (lambda () (check-24771 (reverse rreq-24775) #f))
+ tmp-24777)
+ (let ((tmp-24900
+ ($sc-dispatch args-24774 '(any . any))))
+ (if (if tmp-24900
(@apply
- (lambda (a-24903 b-24904)
- (if (symbol? a-24903)
+ (lambda (a-24904 b-24905)
+ (if (symbol? a-24904)
#t
- (if (if (vector? a-24903)
- (if (= (vector-length a-24903) 4)
- (eq? (vector-ref a-24903 0)
+ (if (if (vector? a-24904)
+ (if (= (vector-length a-24904) 4)
+ (eq? (vector-ref a-24904 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-24903 1))
+ (symbol? (vector-ref a-24904 1))
#f)))
- tmp-24899)
+ tmp-24900)
#f)
(@apply
- (lambda (a-24931 b-24932)
- (req-24769 b-24932 (cons a-24931 rreq-24774)))
- tmp-24899)
- (let ((tmp-24933 (list args-24773)))
+ (lambda (a-24932 b-24933)
+ (req-24770 b-24933 (cons a-24932 rreq-24775)))
+ tmp-24900)
+ (let ((tmp-24934 (list args-24774)))
(if (@apply
- (lambda (r-24935)
- (if (symbol? r-24935)
+ (lambda (r-24936)
+ (if (symbol? r-24936)
#t
- (if (if (vector? r-24935)
- (if (= (vector-length r-24935) 4)
- (eq? (vector-ref r-24935 0)
+ (if (if (vector? r-24936)
+ (if (= (vector-length r-24936) 4)
+ (eq? (vector-ref r-24936 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref r-24935 1))
+ (symbol? (vector-ref r-24936 1))
#f)))
- tmp-24933)
+ tmp-24934)
(@apply
- (lambda (r-24965)
- (check-24770 (reverse rreq-24774) r-24965))
- tmp-24933)
+ (lambda (r-24966)
+ (check-24771 (reverse rreq-24775) r-24966))
+ tmp-24934)
(syntax-violation
'lambda
"invalid argument list"
- orig-args-24768
- args-24773)))))))))
- (check-24770
- (lambda (req-25096 rest-25097)
- (if (distinct-bound-ids?-4321
- (if rest-25097
- (cons rest-25097 req-25096)
- req-25096))
- (values req-25096 #f rest-25097 #f)
+ orig-args-24769
+ args-24774)))))))))
+ (check-24771
+ (lambda (req-25097 rest-25098)
+ (if (distinct-bound-ids?-4322
+ (if rest-25098
+ (cons rest-25098 req-25097)
+ req-25097))
+ (values req-25097 #f rest-25098 #f)
(syntax-violation
'lambda
"duplicate identifier in argument list"
- orig-args-24768)))))
- (req-24769 orig-args-24768 '()))))
- (expand-simple-lambda-4340
- (lambda (e-25213
- r-25214
- w-25215
- s-25216
- mod-25217
- req-25218
- rest-25219
- meta-25220
- body-25221)
- (let ((ids-25222
- (if rest-25219
- (append req-25218 (list rest-25219))
- req-25218)))
- (let ((vars-25223 (map gen-var-4344 ids-25222)))
- (let ((labels-25224 (gen-labels-4297 ids-25222)))
- (build-simple-lambda-4270
- s-25216
- (map syntax->datum req-25218)
- (if rest-25219 (syntax->datum rest-25219) #f)
- vars-25223
- meta-25220
- (expand-body-4334
- body-25221
- (wrap-4323
+ orig-args-24769)))))
+ (req-24770 orig-args-24769 '()))))
+ (expand-simple-lambda-4341
+ (lambda (e-25214
+ r-25215
+ w-25216
+ s-25217
+ mod-25218
+ req-25219
+ rest-25220
+ meta-25221
+ body-25222)
+ (let ((ids-25223
+ (if rest-25220
+ (append req-25219 (list rest-25220))
+ req-25219)))
+ (let ((vars-25224 (map gen-var-4345 ids-25223)))
+ (let ((labels-25225 (gen-labels-4298 ids-25223)))
+ (build-simple-lambda-4271
+ s-25217
+ (map syntax->datum req-25219)
+ (if rest-25220 (syntax->datum rest-25220) #f)
+ vars-25224
+ meta-25221
+ (expand-body-4335
+ body-25222
+ (wrap-4324
(begin
- (if (if (pair? e-25213) s-25216 #f)
- (set-source-properties! e-25213 s-25216))
- e-25213)
- w-25215
- mod-25217)
- (extend-var-env-4289
- labels-25224
- vars-25223
- r-25214)
- (make-binding-wrap-4308
- ids-25222
- labels-25224
- w-25215)
- mod-25217)))))))
- (lambda*-formals-4341
- (lambda (orig-args-25504)
+ (if (if s-25217
+ (supports-source-properties? e-25214)
+ #f)
+ (set-source-properties! e-25214 s-25217))
+ e-25214)
+ w-25216
+ mod-25218)
+ (extend-var-env-4290
+ labels-25225
+ vars-25224
+ r-25215)
+ (make-binding-wrap-4309
+ ids-25223
+ labels-25225
+ w-25216)
+ mod-25218)))))))
+ (lambda*-formals-4342
+ (lambda (orig-args-25505)
(letrec*
- ((req-25505
- (lambda (args-25512 rreq-25513)
- (let ((tmp-25515 ($sc-dispatch args-25512 '())))
- (if tmp-25515
+ ((req-25506
+ (lambda (args-25513 rreq-25514)
+ (let ((tmp-25516 ($sc-dispatch args-25513 '())))
+ (if tmp-25516
(@apply
(lambda ()
- (check-25509 (reverse rreq-25513) '() #f '()))
- tmp-25515)
- (let ((tmp-25521
- ($sc-dispatch args-25512 '(any . any))))
- (if (if tmp-25521
+ (check-25510 (reverse rreq-25514) '() #f '()))
+ tmp-25516)
+ (let ((tmp-25522
+ ($sc-dispatch args-25513 '(any . any))))
+ (if (if tmp-25522
(@apply
- (lambda (a-25525 b-25526)
- (if (symbol? a-25525)
+ (lambda (a-25526 b-25527)
+ (if (symbol? a-25526)
#t
- (if (if (vector? a-25525)
- (if (= (vector-length a-25525) 4)
- (eq? (vector-ref a-25525 0)
+ (if (if (vector? a-25526)
+ (if (= (vector-length a-25526) 4)
+ (eq? (vector-ref a-25526 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-25525 1))
+ (symbol? (vector-ref a-25526 1))
#f)))
- tmp-25521)
+ tmp-25522)
#f)
(@apply
- (lambda (a-25553 b-25554)
- (req-25505 b-25554 (cons a-25553 rreq-25513)))
- tmp-25521)
- (let ((tmp-25555
- ($sc-dispatch args-25512 '(any . any))))
- (if (if tmp-25555
+ (lambda (a-25554 b-25555)
+ (req-25506 b-25555 (cons a-25554 rreq-25514)))
+ tmp-25522)
+ (let ((tmp-25556
+ ($sc-dispatch args-25513 '(any . any))))
+ (if (if tmp-25556
(@apply
- (lambda (a-25559 b-25560)
- (eq? (syntax->datum a-25559) #:optional))
- tmp-25555)
+ (lambda (a-25560 b-25561)
+ (eq? (syntax->datum a-25560) #:optional))
+ tmp-25556)
#f)
(@apply
- (lambda (a-25561 b-25562)
- (opt-25506 b-25562 (reverse rreq-25513) '()))
- tmp-25555)
- (let ((tmp-25565
- ($sc-dispatch args-25512 '(any . any))))
- (if (if tmp-25565
+ (lambda (a-25562 b-25563)
+ (opt-25507 b-25563 (reverse rreq-25514) '()))
+ tmp-25556)
+ (let ((tmp-25566
+ ($sc-dispatch args-25513 '(any . any))))
+ (if (if tmp-25566
(@apply
- (lambda (a-25569 b-25570)
- (eq? (syntax->datum a-25569) #:key))
- tmp-25565)
+ (lambda (a-25570 b-25571)
+ (eq? (syntax->datum a-25570) #:key))
+ tmp-25566)
#f)
(@apply
- (lambda (a-25571 b-25572)
- (key-25507
- b-25572
- (reverse rreq-25513)
+ (lambda (a-25572 b-25573)
+ (key-25508
+ b-25573
+ (reverse rreq-25514)
'()
'()))
- tmp-25565)
- (let ((tmp-25575
- ($sc-dispatch args-25512 '(any any))))
- (if (if tmp-25575
+ tmp-25566)
+ (let ((tmp-25576
+ ($sc-dispatch args-25513 '(any any))))
+ (if (if tmp-25576
(@apply
- (lambda (a-25579 b-25580)
- (eq? (syntax->datum a-25579)
+ (lambda (a-25580 b-25581)
+ (eq? (syntax->datum a-25580)
#:rest))
- tmp-25575)
+ tmp-25576)
#f)
(@apply
- (lambda (a-25581 b-25582)
- (rest-25508
- b-25582
- (reverse rreq-25513)
+ (lambda (a-25582 b-25583)
+ (rest-25509
+ b-25583
+ (reverse rreq-25514)
'()
'()))
- tmp-25575)
- (let ((tmp-25585 (list args-25512)))
+ tmp-25576)
+ (let ((tmp-25586 (list args-25513)))
(if (@apply
- (lambda (r-25587)
- (if (symbol? r-25587)
+ (lambda (r-25588)
+ (if (symbol? r-25588)
#t
- (if (if (vector? r-25587)
+ (if (if (vector? r-25588)
(if (= (vector-length
- r-25587)
+ r-25588)
4)
(eq? (vector-ref
- r-25587
+ r-25588
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref r-25587 1))
+ (vector-ref r-25588 1))
#f)))
- tmp-25585)
+ tmp-25586)
(@apply
- (lambda (r-25617)
- (rest-25508
- r-25617
- (reverse rreq-25513)
+ (lambda (r-25618)
+ (rest-25509
+ r-25618
+ (reverse rreq-25514)
'()
'()))
- tmp-25585)
+ tmp-25586)
(syntax-violation
'lambda*
"invalid argument list"
- orig-args-25504
- args-25512)))))))))))))))
- (opt-25506
- (lambda (args-25636 req-25637 ropt-25638)
- (let ((tmp-25640 ($sc-dispatch args-25636 '())))
- (if tmp-25640
+ orig-args-25505
+ args-25513)))))))))))))))
+ (opt-25507
+ (lambda (args-25637 req-25638 ropt-25639)
+ (let ((tmp-25641 ($sc-dispatch args-25637 '())))
+ (if tmp-25641
(@apply
(lambda ()
- (check-25509
- req-25637
- (reverse ropt-25638)
+ (check-25510
+ req-25638
+ (reverse ropt-25639)
#f
'()))
- tmp-25640)
- (let ((tmp-25646
- ($sc-dispatch args-25636 '(any . any))))
- (if (if tmp-25646
+ tmp-25641)
+ (let ((tmp-25647
+ ($sc-dispatch args-25637 '(any . any))))
+ (if (if tmp-25647
(@apply
- (lambda (a-25650 b-25651)
- (if (symbol? a-25650)
+ (lambda (a-25651 b-25652)
+ (if (symbol? a-25651)
#t
- (if (if (vector? a-25650)
- (if (= (vector-length a-25650) 4)
- (eq? (vector-ref a-25650 0)
+ (if (if (vector? a-25651)
+ (if (= (vector-length a-25651) 4)
+ (eq? (vector-ref a-25651 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-25650 1))
+ (symbol? (vector-ref a-25651 1))
#f)))
- tmp-25646)
+ tmp-25647)
#f)
(@apply
- (lambda (a-25678 b-25679)
- (opt-25506
- b-25679
- req-25637
- (cons (cons a-25678
+ (lambda (a-25679 b-25680)
+ (opt-25507
+ b-25680
+ req-25638
+ (cons (cons a-25679
'(#(syntax-object
#f
((top)
#(ribcage
#(a b)
#((top) (top))
- #("l-*-2403" "l-*-2404"))
+ #("l-*-2404" "l-*-2405"))
#(ribcage () () ())
#(ribcage
#(args req ropt)
#((top) (top) (top))
- #("l-*-2393"
- "l-*-2394"
- "l-*-2395"))
+ #("l-*-2394"
+ "l-*-2395"
+ "l-*-2396"))
#(ribcage
(check rest key opt req)
((top)
@@ -6417,15 +6454,15 @@
(top)
(top)
(top))
- ("l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"))
+ ("l-*-2340"
+ "l-*-2338"
+ "l-*-2336"
+ "l-*-2334"
+ "l-*-2332"))
#(ribcage
#(orig-args)
#((top))
- #("l-*-2330"))
+ #("l-*-2331"))
#(ribcage
(lambda-var-list
gen-var
@@ -6854,136 +6891,136 @@
((top) (top) (top))
("l-*-47" "l-*-46" "l-*-45")))
(hygiene guile))))
- ropt-25638)))
- tmp-25646)
- (let ((tmp-25680
- ($sc-dispatch args-25636 '((any any) . any))))
- (if (if tmp-25680
+ ropt-25639)))
+ tmp-25647)
+ (let ((tmp-25681
+ ($sc-dispatch args-25637 '((any any) . any))))
+ (if (if tmp-25681
(@apply
- (lambda (a-25684 init-25685 b-25686)
- (if (symbol? a-25684)
+ (lambda (a-25685 init-25686 b-25687)
+ (if (symbol? a-25685)
#t
- (if (if (vector? a-25684)
- (if (= (vector-length a-25684) 4)
- (eq? (vector-ref a-25684 0)
+ (if (if (vector? a-25685)
+ (if (= (vector-length a-25685) 4)
+ (eq? (vector-ref a-25685 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-25684 1))
+ (symbol? (vector-ref a-25685 1))
#f)))
- tmp-25680)
+ tmp-25681)
#f)
(@apply
- (lambda (a-25713 init-25714 b-25715)
- (opt-25506
- b-25715
- req-25637
- (cons (list a-25713 init-25714) ropt-25638)))
- tmp-25680)
- (let ((tmp-25716
- ($sc-dispatch args-25636 '(any . any))))
- (if (if tmp-25716
+ (lambda (a-25714 init-25715 b-25716)
+ (opt-25507
+ b-25716
+ req-25638
+ (cons (list a-25714 init-25715) ropt-25639)))
+ tmp-25681)
+ (let ((tmp-25717
+ ($sc-dispatch args-25637 '(any . any))))
+ (if (if tmp-25717
(@apply
- (lambda (a-25720 b-25721)
- (eq? (syntax->datum a-25720) #:key))
- tmp-25716)
+ (lambda (a-25721 b-25722)
+ (eq? (syntax->datum a-25721) #:key))
+ tmp-25717)
#f)
(@apply
- (lambda (a-25722 b-25723)
- (key-25507
- b-25723
- req-25637
- (reverse ropt-25638)
+ (lambda (a-25723 b-25724)
+ (key-25508
+ b-25724
+ req-25638
+ (reverse ropt-25639)
'()))
- tmp-25716)
- (let ((tmp-25726
- ($sc-dispatch args-25636 '(any any))))
- (if (if tmp-25726
+ tmp-25717)
+ (let ((tmp-25727
+ ($sc-dispatch args-25637 '(any any))))
+ (if (if tmp-25727
(@apply
- (lambda (a-25730 b-25731)
- (eq? (syntax->datum a-25730)
+ (lambda (a-25731 b-25732)
+ (eq? (syntax->datum a-25731)
#:rest))
- tmp-25726)
+ tmp-25727)
#f)
(@apply
- (lambda (a-25732 b-25733)
- (rest-25508
- b-25733
- req-25637
- (reverse ropt-25638)
+ (lambda (a-25733 b-25734)
+ (rest-25509
+ b-25734
+ req-25638
+ (reverse ropt-25639)
'()))
- tmp-25726)
- (let ((tmp-25736 (list args-25636)))
+ tmp-25727)
+ (let ((tmp-25737 (list args-25637)))
(if (@apply
- (lambda (r-25738)
- (if (symbol? r-25738)
+ (lambda (r-25739)
+ (if (symbol? r-25739)
#t
- (if (if (vector? r-25738)
+ (if (if (vector? r-25739)
(if (= (vector-length
- r-25738)
+ r-25739)
4)
(eq? (vector-ref
- r-25738
+ r-25739
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref r-25738 1))
+ (vector-ref r-25739 1))
#f)))
- tmp-25736)
+ tmp-25737)
(@apply
- (lambda (r-25768)
- (rest-25508
- r-25768
- req-25637
- (reverse ropt-25638)
+ (lambda (r-25769)
+ (rest-25509
+ r-25769
+ req-25638
+ (reverse ropt-25639)
'()))
- tmp-25736)
+ tmp-25737)
(syntax-violation
'lambda*
"invalid optional argument list"
- orig-args-25504
- args-25636)))))))))))))))
- (key-25507
- (lambda (args-25787 req-25788 opt-25789 rkey-25790)
- (let ((tmp-25792 ($sc-dispatch args-25787 '())))
- (if tmp-25792
+ orig-args-25505
+ args-25637)))))))))))))))
+ (key-25508
+ (lambda (args-25788 req-25789 opt-25790 rkey-25791)
+ (let ((tmp-25793 ($sc-dispatch args-25788 '())))
+ (if tmp-25793
(@apply
(lambda ()
- (check-25509
- req-25788
- opt-25789
+ (check-25510
+ req-25789
+ opt-25790
#f
- (cons #f (reverse rkey-25790))))
- tmp-25792)
- (let ((tmp-25798
- ($sc-dispatch args-25787 '(any . any))))
- (if (if tmp-25798
+ (cons #f (reverse rkey-25791))))
+ tmp-25793)
+ (let ((tmp-25799
+ ($sc-dispatch args-25788 '(any . any))))
+ (if (if tmp-25799
(@apply
- (lambda (a-25802 b-25803)
- (if (symbol? a-25802)
+ (lambda (a-25803 b-25804)
+ (if (symbol? a-25803)
#t
- (if (if (vector? a-25802)
- (if (= (vector-length a-25802) 4)
- (eq? (vector-ref a-25802 0)
+ (if (if (vector? a-25803)
+ (if (= (vector-length a-25803) 4)
+ (eq? (vector-ref a-25803 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-25802 1))
+ (symbol? (vector-ref a-25803 1))
#f)))
- tmp-25798)
+ tmp-25799)
#f)
(@apply
- (lambda (a-25830 b-25831)
- (let ((tmp-25832
- (symbol->keyword (syntax->datum a-25830))))
- (key-25507
- b-25831
- req-25788
- opt-25789
- (cons (cons tmp-25832
- (cons a-25830
+ (lambda (a-25831 b-25832)
+ (let ((tmp-25833
+ (symbol->keyword (syntax->datum a-25831))))
+ (key-25508
+ b-25832
+ req-25789
+ opt-25790
+ (cons (cons tmp-25833
+ (cons a-25831
'(#(syntax-object
#f
((top)
@@ -6991,12 +7028,12 @@
#(ribcage
#(k)
#((top))
- #("l-*-2466"))
+ #("l-*-2467"))
#(ribcage
#(a b)
#((top) (top))
- #("l-*-2460"
- "l-*-2461"))
+ #("l-*-2461"
+ "l-*-2462"))
#(ribcage () () ())
#(ribcage
#(args req opt rkey)
@@ -7004,10 +7041,10 @@
(top)
(top)
(top))
- #("l-*-2449"
- "l-*-2450"
+ #("l-*-2450"
"l-*-2451"
- "l-*-2452"))
+ "l-*-2452"
+ "l-*-2453"))
#(ribcage
(check rest
key
@@ -7018,15 +7055,15 @@
(top)
(top)
(top))
- ("l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"))
+ ("l-*-2340"
+ "l-*-2338"
+ "l-*-2336"
+ "l-*-2334"
+ "l-*-2332"))
#(ribcage
#(orig-args)
#((top))
- #("l-*-2330"))
+ #("l-*-2331"))
#(ribcage
(lambda-var-list
gen-var
@@ -7457,726 +7494,729 @@
"l-*-46"
"l-*-45")))
(hygiene guile)))))
- rkey-25790))))
- tmp-25798)
- (let ((tmp-25835
- ($sc-dispatch args-25787 '((any any) . any))))
- (if (if tmp-25835
+ rkey-25791))))
+ tmp-25799)
+ (let ((tmp-25836
+ ($sc-dispatch args-25788 '((any any) . any))))
+ (if (if tmp-25836
(@apply
- (lambda (a-25839 init-25840 b-25841)
- (if (symbol? a-25839)
+ (lambda (a-25840 init-25841 b-25842)
+ (if (symbol? a-25840)
#t
- (if (if (vector? a-25839)
- (if (= (vector-length a-25839) 4)
- (eq? (vector-ref a-25839 0)
+ (if (if (vector? a-25840)
+ (if (= (vector-length a-25840) 4)
+ (eq? (vector-ref a-25840 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-25839 1))
+ (symbol? (vector-ref a-25840 1))
#f)))
- tmp-25835)
+ tmp-25836)
#f)
(@apply
- (lambda (a-25868 init-25869 b-25870)
- (let ((tmp-25871
+ (lambda (a-25869 init-25870 b-25871)
+ (let ((tmp-25872
(symbol->keyword
- (syntax->datum a-25868))))
- (key-25507
- b-25870
- req-25788
- opt-25789
- (cons (list tmp-25871 a-25868 init-25869)
- rkey-25790))))
- tmp-25835)
- (let ((tmp-25874
+ (syntax->datum a-25869))))
+ (key-25508
+ b-25871
+ req-25789
+ opt-25790
+ (cons (list tmp-25872 a-25869 init-25870)
+ rkey-25791))))
+ tmp-25836)
+ (let ((tmp-25875
($sc-dispatch
- args-25787
+ args-25788
'((any any any) . any))))
- (if (if tmp-25874
+ (if (if tmp-25875
(@apply
- (lambda (a-25878
- init-25879
- k-25880
- b-25881)
- (if (if (symbol? a-25878)
+ (lambda (a-25879
+ init-25880
+ k-25881
+ b-25882)
+ (if (if (symbol? a-25879)
#t
- (if (if (vector? a-25878)
+ (if (if (vector? a-25879)
(if (= (vector-length
- a-25878)
+ a-25879)
4)
(eq? (vector-ref
- a-25878
+ a-25879
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref a-25878 1))
+ (vector-ref a-25879 1))
#f))
- (keyword? (syntax->datum k-25880))
+ (keyword? (syntax->datum k-25881))
#f))
- tmp-25874)
+ tmp-25875)
#f)
(@apply
- (lambda (a-25908 init-25909 k-25910 b-25911)
- (key-25507
- b-25911
- req-25788
- opt-25789
- (cons (list k-25910 a-25908 init-25909)
- rkey-25790)))
- tmp-25874)
- (let ((tmp-25912
- ($sc-dispatch args-25787 '(any))))
- (if (if tmp-25912
+ (lambda (a-25909 init-25910 k-25911 b-25912)
+ (key-25508
+ b-25912
+ req-25789
+ opt-25790
+ (cons (list k-25911 a-25909 init-25910)
+ rkey-25791)))
+ tmp-25875)
+ (let ((tmp-25913
+ ($sc-dispatch args-25788 '(any))))
+ (if (if tmp-25913
(@apply
- (lambda (aok-25916)
- (eq? (syntax->datum aok-25916)
+ (lambda (aok-25917)
+ (eq? (syntax->datum aok-25917)
#:allow-other-keys))
- tmp-25912)
+ tmp-25913)
#f)
(@apply
- (lambda (aok-25917)
- (check-25509
- req-25788
- opt-25789
+ (lambda (aok-25918)
+ (check-25510
+ req-25789
+ opt-25790
#f
- (cons #t (reverse rkey-25790))))
- tmp-25912)
- (let ((tmp-25920
+ (cons #t (reverse rkey-25791))))
+ tmp-25913)
+ (let ((tmp-25921
($sc-dispatch
- args-25787
+ args-25788
'(any any any))))
- (if (if tmp-25920
+ (if (if tmp-25921
(@apply
- (lambda (aok-25924
- a-25925
- b-25926)
+ (lambda (aok-25925
+ a-25926
+ b-25927)
(if (eq? (syntax->datum
- aok-25924)
+ aok-25925)
#:allow-other-keys)
- (eq? (syntax->datum a-25925)
+ (eq? (syntax->datum a-25926)
#:rest)
#f))
- tmp-25920)
+ tmp-25921)
#f)
(@apply
- (lambda (aok-25927 a-25928 b-25929)
- (rest-25508
- b-25929
- req-25788
- opt-25789
- (cons #t (reverse rkey-25790))))
- tmp-25920)
- (let ((tmp-25932
+ (lambda (aok-25928 a-25929 b-25930)
+ (rest-25509
+ b-25930
+ req-25789
+ opt-25790
+ (cons #t (reverse rkey-25791))))
+ tmp-25921)
+ (let ((tmp-25933
($sc-dispatch
- args-25787
+ args-25788
'(any . any))))
- (if (if tmp-25932
+ (if (if tmp-25933
(@apply
- (lambda (aok-25936 r-25937)
+ (lambda (aok-25937 r-25938)
(if (eq? (syntax->datum
- aok-25936)
+ aok-25937)
#:allow-other-keys)
- (if (symbol? r-25937)
+ (if (symbol? r-25938)
#t
(if (if (vector?
- r-25937)
+ r-25938)
(if (= (vector-length
- r-25937)
+ r-25938)
4)
(eq? (vector-ref
- r-25937
+ r-25938
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- r-25937
+ r-25938
1))
#f))
#f))
- tmp-25932)
+ tmp-25933)
#f)
(@apply
- (lambda (aok-25964 r-25965)
- (rest-25508
- r-25965
- req-25788
- opt-25789
+ (lambda (aok-25965 r-25966)
+ (rest-25509
+ r-25966
+ req-25789
+ opt-25790
(cons #t
- (reverse rkey-25790))))
- tmp-25932)
- (let ((tmp-25968
+ (reverse rkey-25791))))
+ tmp-25933)
+ (let ((tmp-25969
($sc-dispatch
- args-25787
+ args-25788
'(any any))))
- (if (if tmp-25968
+ (if (if tmp-25969
(@apply
- (lambda (a-25972 b-25973)
+ (lambda (a-25973 b-25974)
(eq? (syntax->datum
- a-25972)
+ a-25973)
#:rest))
- tmp-25968)
+ tmp-25969)
#f)
(@apply
- (lambda (a-25974 b-25975)
- (rest-25508
- b-25975
- req-25788
- opt-25789
+ (lambda (a-25975 b-25976)
+ (rest-25509
+ b-25976
+ req-25789
+ opt-25790
(cons #f
(reverse
- rkey-25790))))
- tmp-25968)
- (let ((tmp-25978
- (list args-25787)))
+ rkey-25791))))
+ tmp-25969)
+ (let ((tmp-25979
+ (list args-25788)))
(if (@apply
- (lambda (r-25980)
- (if (symbol? r-25980)
+ (lambda (r-25981)
+ (if (symbol? r-25981)
#t
(if (if (vector?
- r-25980)
+ r-25981)
(if (= (vector-length
- r-25980)
+ r-25981)
4)
(eq? (vector-ref
- r-25980
+ r-25981
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- r-25980
+ r-25981
1))
#f)))
- tmp-25978)
+ tmp-25979)
(@apply
- (lambda (r-26010)
- (rest-25508
- r-26010
- req-25788
- opt-25789
+ (lambda (r-26011)
+ (rest-25509
+ r-26011
+ req-25789
+ opt-25790
(cons #f
(reverse
- rkey-25790))))
- tmp-25978)
+ rkey-25791))))
+ tmp-25979)
(syntax-violation
'lambda*
"invalid keyword argument list"
- orig-args-25504
- args-25787)))))))))))))))))))))
- (rest-25508
- (lambda (args-26038 req-26039 opt-26040 kw-26041)
- (let ((tmp-26043 (list args-26038)))
+ orig-args-25505
+ args-25788)))))))))))))))))))))
+ (rest-25509
+ (lambda (args-26039 req-26040 opt-26041 kw-26042)
+ (let ((tmp-26044 (list args-26039)))
(if (@apply
- (lambda (r-26045)
- (if (symbol? r-26045)
+ (lambda (r-26046)
+ (if (symbol? r-26046)
#t
- (if (if (vector? r-26045)
- (if (= (vector-length r-26045) 4)
- (eq? (vector-ref r-26045 0) 'syntax-object)
+ (if (if (vector? r-26046)
+ (if (= (vector-length r-26046) 4)
+ (eq? (vector-ref r-26046 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref r-26045 1))
+ (symbol? (vector-ref r-26046 1))
#f)))
- tmp-26043)
+ tmp-26044)
(@apply
- (lambda (r-26075)
- (check-25509
- req-26039
- opt-26040
- r-26075
- kw-26041))
- tmp-26043)
+ (lambda (r-26076)
+ (check-25510
+ req-26040
+ opt-26041
+ r-26076
+ kw-26042))
+ tmp-26044)
(syntax-violation
'lambda*
"invalid rest argument"
- orig-args-25504
- args-26038)))))
- (check-25509
- (lambda (req-26079 opt-26080 rest-26081 kw-26082)
- (if (distinct-bound-ids?-4321
+ orig-args-25505
+ args-26039)))))
+ (check-25510
+ (lambda (req-26080 opt-26081 rest-26082 kw-26083)
+ (if (distinct-bound-ids?-4322
(append
- req-26079
- (map car opt-26080)
- (if rest-26081 (list rest-26081) '())
- (if (pair? kw-26082)
- (map cadr (cdr kw-26082))
+ req-26080
+ (map car opt-26081)
+ (if rest-26082 (list rest-26082) '())
+ (if (pair? kw-26083)
+ (map cadr (cdr kw-26083))
'())))
- (values req-26079 opt-26080 rest-26081 kw-26082)
+ (values req-26080 opt-26081 rest-26082 kw-26083)
(syntax-violation
'lambda*
"duplicate identifier in argument list"
- orig-args-25504)))))
- (req-25505 orig-args-25504 '()))))
- (expand-lambda-case-4342
- (lambda (e-26198
- r-26199
- w-26200
- s-26201
- mod-26202
- get-formals-26203
- clauses-26204)
+ orig-args-25505)))))
+ (req-25506 orig-args-25505 '()))))
+ (expand-lambda-case-4343
+ (lambda (e-26199
+ r-26200
+ w-26201
+ s-26202
+ mod-26203
+ get-formals-26204
+ clauses-26205)
(letrec*
- ((parse-req-26205
- (lambda (req-26336
- opt-26337
- rest-26338
- kw-26339
- body-26340)
- (let ((vars-26341 (map gen-var-4344 req-26336))
- (labels-26342 (gen-labels-4297 req-26336)))
- (let ((r*-26343
- (extend-var-env-4289
- labels-26342
- vars-26341
- r-26199))
- (w*-26344
- (make-binding-wrap-4308
- req-26336
- labels-26342
- w-26200)))
- (parse-opt-26206
- (map syntax->datum req-26336)
- opt-26337
- rest-26338
- kw-26339
- body-26340
- (reverse vars-26341)
- r*-26343
- w*-26344
+ ((parse-req-26206
+ (lambda (req-26337
+ opt-26338
+ rest-26339
+ kw-26340
+ body-26341)
+ (let ((vars-26342 (map gen-var-4345 req-26337))
+ (labels-26343 (gen-labels-4298 req-26337)))
+ (let ((r*-26344
+ (extend-var-env-4290
+ labels-26343
+ vars-26342
+ r-26200))
+ (w*-26345
+ (make-binding-wrap-4309
+ req-26337
+ labels-26343
+ w-26201)))
+ (parse-opt-26207
+ (map syntax->datum req-26337)
+ opt-26338
+ rest-26339
+ kw-26340
+ body-26341
+ (reverse vars-26342)
+ r*-26344
+ w*-26345
'()
'())))))
- (parse-opt-26206
- (lambda (req-26530
- opt-26531
- rest-26532
- kw-26533
- body-26534
- vars-26535
- r*-26536
- w*-26537
- out-26538
- inits-26539)
- (if (pair? opt-26531)
- (let ((tmp-26540 (car opt-26531)))
- (let ((tmp-26541 ($sc-dispatch tmp-26540 '(any any))))
- (if tmp-26541
+ (parse-opt-26207
+ (lambda (req-26531
+ opt-26532
+ rest-26533
+ kw-26534
+ body-26535
+ vars-26536
+ r*-26537
+ w*-26538
+ out-26539
+ inits-26540)
+ (if (pair? opt-26532)
+ (let ((tmp-26541 (car opt-26532)))
+ (let ((tmp-26542 ($sc-dispatch tmp-26541 '(any any))))
+ (if tmp-26542
(@apply
- (lambda (id-26543 i-26544)
- (let ((v-26545
- (let ((id-26553
- (if (if (vector? id-26543)
+ (lambda (id-26544 i-26545)
+ (let ((v-26546
+ (let ((id-26554
+ (if (if (vector? id-26544)
(if (= (vector-length
- id-26543)
+ id-26544)
4)
(eq? (vector-ref
- id-26543
+ id-26544
0)
'syntax-object)
#f)
#f)
- (vector-ref id-26543 1)
- id-26543)))
+ (vector-ref id-26544 1)
+ id-26544)))
(gensym
(string-append
- (symbol->string id-26553)
+ (symbol->string id-26554)
"-")))))
- (let ((l-26546 (gen-labels-4297 (list v-26545))))
- (let ((r**-26547
- (extend-var-env-4289
- l-26546
- (list v-26545)
- r*-26536)))
- (let ((w**-26548
- (make-binding-wrap-4308
- (list id-26543)
- l-26546
- w*-26537)))
- (parse-opt-26206
- req-26530
- (cdr opt-26531)
- rest-26532
- kw-26533
- body-26534
- (cons v-26545 vars-26535)
- r**-26547
- w**-26548
- (cons (syntax->datum id-26543) out-26538)
- (cons (expand-4330
- i-26544
- r*-26536
- w*-26537
- mod-26202)
- inits-26539)))))))
- tmp-26541)
+ (let ((l-26547 (gen-labels-4298 (list v-26546))))
+ (let ((r**-26548
+ (extend-var-env-4290
+ l-26547
+ (list v-26546)
+ r*-26537)))
+ (let ((w**-26549
+ (make-binding-wrap-4309
+ (list id-26544)
+ l-26547
+ w*-26538)))
+ (parse-opt-26207
+ req-26531
+ (cdr opt-26532)
+ rest-26533
+ kw-26534
+ body-26535
+ (cons v-26546 vars-26536)
+ r**-26548
+ w**-26549
+ (cons (syntax->datum id-26544) out-26539)
+ (cons (expand-4331
+ i-26545
+ r*-26537
+ w*-26538
+ mod-26203)
+ inits-26540)))))))
+ tmp-26542)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-26540))))
- (if rest-26532
- (let ((v-26791
- (let ((id-26801
- (if (if (vector? rest-26532)
- (if (= (vector-length rest-26532) 4)
- (eq? (vector-ref rest-26532 0)
+ tmp-26541))))
+ (if rest-26533
+ (let ((v-26792
+ (let ((id-26802
+ (if (if (vector? rest-26533)
+ (if (= (vector-length rest-26533) 4)
+ (eq? (vector-ref rest-26533 0)
'syntax-object)
#f)
#f)
- (vector-ref rest-26532 1)
- rest-26532)))
+ (vector-ref rest-26533 1)
+ rest-26533)))
(gensym
(string-append
- (symbol->string id-26801)
+ (symbol->string id-26802)
"-")))))
- (let ((l-26792 (gen-labels-4297 (list v-26791))))
- (let ((r*-26793
- (extend-var-env-4289
- l-26792
- (list v-26791)
- r*-26536)))
- (let ((w*-26794
- (make-binding-wrap-4308
- (list rest-26532)
- l-26792
- w*-26537)))
- (parse-kw-26207
- req-26530
- (if (pair? out-26538) (reverse out-26538) #f)
- (syntax->datum rest-26532)
- (if (pair? kw-26533) (cdr kw-26533) kw-26533)
- body-26534
- (cons v-26791 vars-26535)
- r*-26793
- w*-26794
- (if (pair? kw-26533) (car kw-26533) #f)
+ (let ((l-26793 (gen-labels-4298 (list v-26792))))
+ (let ((r*-26794
+ (extend-var-env-4290
+ l-26793
+ (list v-26792)
+ r*-26537)))
+ (let ((w*-26795
+ (make-binding-wrap-4309
+ (list rest-26533)
+ l-26793
+ w*-26538)))
+ (parse-kw-26208
+ req-26531
+ (if (pair? out-26539) (reverse out-26539) #f)
+ (syntax->datum rest-26533)
+ (if (pair? kw-26534) (cdr kw-26534) kw-26534)
+ body-26535
+ (cons v-26792 vars-26536)
+ r*-26794
+ w*-26795
+ (if (pair? kw-26534) (car kw-26534) #f)
'()
- inits-26539)))))
- (parse-kw-26207
- req-26530
- (if (pair? out-26538) (reverse out-26538) #f)
+ inits-26540)))))
+ (parse-kw-26208
+ req-26531
+ (if (pair? out-26539) (reverse out-26539) #f)
#f
- (if (pair? kw-26533) (cdr kw-26533) kw-26533)
- body-26534
- vars-26535
- r*-26536
- w*-26537
- (if (pair? kw-26533) (car kw-26533) #f)
+ (if (pair? kw-26534) (cdr kw-26534) kw-26534)
+ body-26535
+ vars-26536
+ r*-26537
+ w*-26538
+ (if (pair? kw-26534) (car kw-26534) #f)
'()
- inits-26539)))))
- (parse-kw-26207
- (lambda (req-26972
- opt-26973
- rest-26974
- kw-26975
- body-26976
- vars-26977
- r*-26978
- w*-26979
- aok-26980
- out-26981
- inits-26982)
- (if (pair? kw-26975)
- (let ((tmp-26983 (car kw-26975)))
- (let ((tmp-26984
- ($sc-dispatch tmp-26983 '(any any any))))
- (if tmp-26984
+ inits-26540)))))
+ (parse-kw-26208
+ (lambda (req-26973
+ opt-26974
+ rest-26975
+ kw-26976
+ body-26977
+ vars-26978
+ r*-26979
+ w*-26980
+ aok-26981
+ out-26982
+ inits-26983)
+ (if (pair? kw-26976)
+ (let ((tmp-26984 (car kw-26976)))
+ (let ((tmp-26985
+ ($sc-dispatch tmp-26984 '(any any any))))
+ (if tmp-26985
(@apply
- (lambda (k-26986 id-26987 i-26988)
- (let ((v-26989
- (let ((id-26997
- (if (if (vector? id-26987)
+ (lambda (k-26987 id-26988 i-26989)
+ (let ((v-26990
+ (let ((id-26998
+ (if (if (vector? id-26988)
(if (= (vector-length
- id-26987)
+ id-26988)
4)
(eq? (vector-ref
- id-26987
+ id-26988
0)
'syntax-object)
#f)
#f)
- (vector-ref id-26987 1)
- id-26987)))
+ (vector-ref id-26988 1)
+ id-26988)))
(gensym
(string-append
- (symbol->string id-26997)
+ (symbol->string id-26998)
"-")))))
- (let ((l-26990 (gen-labels-4297 (list v-26989))))
- (let ((r**-26991
- (extend-var-env-4289
- l-26990
- (list v-26989)
- r*-26978)))
- (let ((w**-26992
- (make-binding-wrap-4308
- (list id-26987)
- l-26990
- w*-26979)))
- (parse-kw-26207
- req-26972
- opt-26973
- rest-26974
- (cdr kw-26975)
- body-26976
- (cons v-26989 vars-26977)
- r**-26991
- w**-26992
- aok-26980
- (cons (list (syntax->datum k-26986)
- (syntax->datum id-26987)
- v-26989)
- out-26981)
- (cons (expand-4330
- i-26988
- r*-26978
- w*-26979
- mod-26202)
- inits-26982)))))))
- tmp-26984)
+ (let ((l-26991 (gen-labels-4298 (list v-26990))))
+ (let ((r**-26992
+ (extend-var-env-4290
+ l-26991
+ (list v-26990)
+ r*-26979)))
+ (let ((w**-26993
+ (make-binding-wrap-4309
+ (list id-26988)
+ l-26991
+ w*-26980)))
+ (parse-kw-26208
+ req-26973
+ opt-26974
+ rest-26975
+ (cdr kw-26976)
+ body-26977
+ (cons v-26990 vars-26978)
+ r**-26992
+ w**-26993
+ aok-26981
+ (cons (list (syntax->datum k-26987)
+ (syntax->datum id-26988)
+ v-26990)
+ out-26982)
+ (cons (expand-4331
+ i-26989
+ r*-26979
+ w*-26980
+ mod-26203)
+ inits-26983)))))))
+ tmp-26985)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-26983))))
- (parse-body-26208
- req-26972
- opt-26973
- rest-26974
- (if (if aok-26980 aok-26980 (pair? out-26981))
- (cons aok-26980 (reverse out-26981))
+ tmp-26984))))
+ (parse-body-26209
+ req-26973
+ opt-26974
+ rest-26975
+ (if (if aok-26981 aok-26981 (pair? out-26982))
+ (cons aok-26981 (reverse out-26982))
#f)
- body-26976
- (reverse vars-26977)
- r*-26978
- w*-26979
- (reverse inits-26982)
+ body-26977
+ (reverse vars-26978)
+ r*-26979
+ w*-26980
+ (reverse inits-26983)
'()))))
- (parse-body-26208
- (lambda (req-27244
- opt-27245
- rest-27246
- kw-27247
- body-27248
- vars-27249
- r*-27250
- w*-27251
- inits-27252
- meta-27253)
- (let ((tmp-27255
- ($sc-dispatch body-27248 '(any any . each-any))))
- (if (if tmp-27255
+ (parse-body-26209
+ (lambda (req-27245
+ opt-27246
+ rest-27247
+ kw-27248
+ body-27249
+ vars-27250
+ r*-27251
+ w*-27252
+ inits-27253
+ meta-27254)
+ (let ((tmp-27256
+ ($sc-dispatch body-27249 '(any any . each-any))))
+ (if (if tmp-27256
(@apply
- (lambda (docstring-27259 e1-27260 e2-27261)
- (string? (syntax->datum docstring-27259)))
- tmp-27255)
+ (lambda (docstring-27260 e1-27261 e2-27262)
+ (string? (syntax->datum docstring-27260)))
+ tmp-27256)
#f)
(@apply
- (lambda (docstring-27262 e1-27263 e2-27264)
- (parse-body-26208
- req-27244
- opt-27245
- rest-27246
- kw-27247
- (cons e1-27263 e2-27264)
- vars-27249
- r*-27250
- w*-27251
- inits-27252
+ (lambda (docstring-27263 e1-27264 e2-27265)
+ (parse-body-26209
+ req-27245
+ opt-27246
+ rest-27247
+ kw-27248
+ (cons e1-27264 e2-27265)
+ vars-27250
+ r*-27251
+ w*-27252
+ inits-27253
(append
- meta-27253
+ meta-27254
(list (cons 'documentation
- (syntax->datum docstring-27262))))))
- tmp-27255)
- (let ((tmp-27265
+ (syntax->datum docstring-27263))))))
+ tmp-27256)
+ (let ((tmp-27266
($sc-dispatch
- body-27248
+ body-27249
'(#(vector #(each (any . any)))
any
.
each-any))))
- (if tmp-27265
+ (if tmp-27266
(@apply
- (lambda (k-27269 v-27270 e1-27271 e2-27272)
- (parse-body-26208
- req-27244
- opt-27245
- rest-27246
- kw-27247
- (cons e1-27271 e2-27272)
- vars-27249
- r*-27250
- w*-27251
- inits-27252
+ (lambda (k-27270 v-27271 e1-27272 e2-27273)
+ (parse-body-26209
+ req-27245
+ opt-27246
+ rest-27247
+ kw-27248
+ (cons e1-27272 e2-27273)
+ vars-27250
+ r*-27251
+ w*-27252
+ inits-27253
(append
- meta-27253
- (syntax->datum (map cons k-27269 v-27270)))))
- tmp-27265)
- (let ((tmp-27273
- ($sc-dispatch body-27248 '(any . each-any))))
- (if tmp-27273
+ meta-27254
+ (syntax->datum (map cons k-27270 v-27271)))))
+ tmp-27266)
+ (let ((tmp-27274
+ ($sc-dispatch body-27249 '(any . each-any))))
+ (if tmp-27274
(@apply
- (lambda (e1-27277 e2-27278)
+ (lambda (e1-27278 e2-27279)
(values
- meta-27253
- req-27244
- opt-27245
- rest-27246
- kw-27247
- inits-27252
- vars-27249
- (expand-body-4334
- (cons e1-27277 e2-27278)
- (wrap-4323
+ meta-27254
+ req-27245
+ opt-27246
+ rest-27247
+ kw-27248
+ inits-27253
+ vars-27250
+ (expand-body-4335
+ (cons e1-27278 e2-27279)
+ (wrap-4324
(begin
- (if (if (pair? e-26198) s-26201 #f)
+ (if (if s-26202
+ (supports-source-properties?
+ e-26199)
+ #f)
(set-source-properties!
- e-26198
- s-26201))
- e-26198)
- w-26200
- mod-26202)
- r*-27250
- w*-27251
- mod-26202)))
- tmp-27273)
+ e-26199
+ s-26202))
+ e-26199)
+ w-26201
+ mod-26203)
+ r*-27251
+ w*-27252
+ mod-26203)))
+ tmp-27274)
(syntax-violation
#f
"source expression failed to match any pattern"
- body-27248))))))))))
- (let ((tmp-26210 ($sc-dispatch clauses-26204 '())))
- (if tmp-26210
- (@apply (lambda () (values '() #f)) tmp-26210)
- (let ((tmp-26214
+ body-27249))))))))))
+ (let ((tmp-26211 ($sc-dispatch clauses-26205 '())))
+ (if tmp-26211
+ (@apply (lambda () (values '() #f)) tmp-26211)
+ (let ((tmp-26215
($sc-dispatch
- clauses-26204
+ clauses-26205
'((any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-26214
+ (if tmp-26215
(@apply
- (lambda (args-26218
- e1-26219
- e2-26220
- args*-26221
- e1*-26222
- e2*-26223)
+ (lambda (args-26219
+ e1-26220
+ e2-26221
+ args*-26222
+ e1*-26223
+ e2*-26224)
(call-with-values
- (lambda () (get-formals-26203 args-26218))
- (lambda (req-26224 opt-26225 rest-26226 kw-26227)
+ (lambda () (get-formals-26204 args-26219))
+ (lambda (req-26225 opt-26226 rest-26227 kw-26228)
(call-with-values
(lambda ()
- (parse-req-26205
- req-26224
- opt-26225
- rest-26226
- kw-26227
- (cons e1-26219 e2-26220)))
- (lambda (meta-26292
- req-26293
- opt-26294
- rest-26295
- kw-26296
- inits-26297
- vars-26298
- body-26299)
+ (parse-req-26206
+ req-26225
+ opt-26226
+ rest-26227
+ kw-26228
+ (cons e1-26220 e2-26221)))
+ (lambda (meta-26293
+ req-26294
+ opt-26295
+ rest-26296
+ kw-26297
+ inits-26298
+ vars-26299
+ body-26300)
(call-with-values
(lambda ()
- (expand-lambda-case-4342
- e-26198
- r-26199
- w-26200
- s-26201
- mod-26202
- get-formals-26203
- (map (lambda (tmp-2801-26300
- tmp-2800-26301
- tmp-2799-26302)
- (cons tmp-2799-26302
- (cons tmp-2800-26301
- tmp-2801-26300)))
- e2*-26223
- e1*-26222
- args*-26221)))
- (lambda (meta*-26303 else*-26304)
+ (expand-lambda-case-4343
+ e-26199
+ r-26200
+ w-26201
+ s-26202
+ mod-26203
+ get-formals-26204
+ (map (lambda (tmp-2802-26301
+ tmp-2801-26302
+ tmp-2800-26303)
+ (cons tmp-2800-26303
+ (cons tmp-2801-26302
+ tmp-2802-26301)))
+ e2*-26224
+ e1*-26223
+ args*-26222)))
+ (lambda (meta*-26304 else*-26305)
(values
- (append meta-26292 meta*-26303)
+ (append meta-26293 meta*-26304)
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
- s-26201
- req-26293
- opt-26294
- rest-26295
- kw-26296
- inits-26297
- vars-26298
- body-26299
- else*-26304)))))))))
- tmp-26214)
+ s-26202
+ req-26294
+ opt-26295
+ rest-26296
+ kw-26297
+ inits-26298
+ vars-26299
+ body-26300
+ else*-26305)))))))))
+ tmp-26215)
(syntax-violation
#f
"source expression failed to match any pattern"
- clauses-26204))))))))
- (strip-4343
- (lambda (x-27315 w-27316)
- (if (memq 'top (car w-27316))
- x-27315
+ clauses-26205))))))))
+ (strip-4344
+ (lambda (x-27316 w-27317)
+ (if (memq 'top (car w-27317))
+ x-27316
(letrec*
- ((f-27317
- (lambda (x-27320)
- (if (if (vector? x-27320)
- (if (= (vector-length x-27320) 4)
- (eq? (vector-ref x-27320 0) 'syntax-object)
+ ((f-27318
+ (lambda (x-27321)
+ (if (if (vector? x-27321)
+ (if (= (vector-length x-27321) 4)
+ (eq? (vector-ref x-27321 0) 'syntax-object)
#f)
#f)
- (strip-4343
- (vector-ref x-27320 1)
- (vector-ref x-27320 2))
- (if (pair? x-27320)
- (let ((a-27339 (f-27317 (car x-27320)))
- (d-27340 (f-27317 (cdr x-27320))))
- (if (if (eq? a-27339 (car x-27320))
- (eq? d-27340 (cdr x-27320))
+ (strip-4344
+ (vector-ref x-27321 1)
+ (vector-ref x-27321 2))
+ (if (pair? x-27321)
+ (let ((a-27340 (f-27318 (car x-27321)))
+ (d-27341 (f-27318 (cdr x-27321))))
+ (if (if (eq? a-27340 (car x-27321))
+ (eq? d-27341 (cdr x-27321))
#f)
- x-27320
- (cons a-27339 d-27340)))
- (if (vector? x-27320)
- (let ((old-27343 (vector->list x-27320)))
- (let ((new-27344 (map f-27317 old-27343)))
+ x-27321
+ (cons a-27340 d-27341)))
+ (if (vector? x-27321)
+ (let ((old-27344 (vector->list x-27321)))
+ (let ((new-27345 (map f-27318 old-27344)))
(letrec*
- ((lp-27345
- (lambda (l1-27421 l2-27422)
- (if (null? l1-27421)
- x-27320
- (if (eq? (car l1-27421) (car l2-27422))
- (lp-27345 (cdr l1-27421) (cdr l2-27422))
- (list->vector new-27344))))))
- (lp-27345 old-27343 new-27344))))
- x-27320))))))
- (f-27317 x-27315)))))
- (gen-var-4344
- (lambda (id-26348)
- (let ((id-26349
- (if (if (vector? id-26348)
- (if (= (vector-length id-26348) 4)
- (eq? (vector-ref id-26348 0) 'syntax-object)
+ ((lp-27346
+ (lambda (l1-27422 l2-27423)
+ (if (null? l1-27422)
+ x-27321
+ (if (eq? (car l1-27422) (car l2-27423))
+ (lp-27346 (cdr l1-27422) (cdr l2-27423))
+ (list->vector new-27345))))))
+ (lp-27346 old-27344 new-27345))))
+ x-27321))))))
+ (f-27318 x-27316)))))
+ (gen-var-4345
+ (lambda (id-26349)
+ (let ((id-26350
+ (if (if (vector? id-26349)
+ (if (= (vector-length id-26349) 4)
+ (eq? (vector-ref id-26349 0) 'syntax-object)
#f)
#f)
- (vector-ref id-26348 1)
- id-26348)))
+ (vector-ref id-26349 1)
+ id-26349)))
(gensym
- (string-append (symbol->string id-26349) "-"))))))
+ (string-append (symbol->string id-26350) "-"))))))
(begin
- (set! session-id-4255
- (let ((v-15684
+ (set! session-id-4256
+ (let ((v-15685
(module-variable
(current-module)
'syntax-session-id)))
- (lambda () ((variable-ref v-15684)))))
- (set! transformer-environment-4316
+ (lambda () ((variable-ref v-15685)))))
+ (set! transformer-environment-4317
(make-fluid
- (lambda (k-14716)
+ (lambda (k-14717)
(error "called outside the dynamic extent of a syntax transformer"))))
(module-define!
(current-module)
@@ -8192,1103 +8232,1126 @@
'let-syntax
'local-syntax
#f))
- (global-extend-4292
+ (global-extend-4293
'core
'syntax-parameterize
- (lambda (e-4465 r-4466 w-4467 s-4468 mod-4469)
- (let ((tmp-4471
+ (lambda (e-4466 r-4467 w-4468 s-4469 mod-4470)
+ (let ((tmp-4472
($sc-dispatch
- e-4465
+ e-4466
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-4471
+ (if (if tmp-4472
(@apply
- (lambda (var-4475 val-4476 e1-4477 e2-4478)
- (valid-bound-ids?-4320 var-4475))
- tmp-4471)
+ (lambda (var-4476 val-4477 e1-4478 e2-4479)
+ (valid-bound-ids?-4321 var-4476))
+ tmp-4472)
#f)
(@apply
- (lambda (var-4556 val-4557 e1-4558 e2-4559)
- (let ((names-4560
- (map (lambda (x-4610)
- (id-var-name-4313 x-4610 w-4467))
- var-4556)))
+ (lambda (var-4557 val-4558 e1-4559 e2-4560)
+ (let ((names-4561
+ (map (lambda (x-4611)
+ (id-var-name-4314 x-4611 w-4468))
+ var-4557)))
(begin
(for-each
- (lambda (id-4561 n-4562)
- (let ((key-4563
- (car (let ((t-4570 (assq n-4562 r-4466)))
- (if t-4570
- (cdr t-4570)
- (if (symbol? n-4562)
- (let ((t-4575
- (get-global-definition-hook-4257
- n-4562
- mod-4469)))
- (if t-4575 t-4575 '(global)))
+ (lambda (id-4562 n-4563)
+ (let ((key-4564
+ (car (let ((t-4571 (assq n-4563 r-4467)))
+ (if t-4571
+ (cdr t-4571)
+ (if (symbol? n-4563)
+ (let ((t-4576
+ (get-global-definition-hook-4258
+ n-4563
+ mod-4470)))
+ (if t-4576 t-4576 '(global)))
'(displaced-lexical)))))))
- (if (eqv? key-4563 'displaced-lexical)
+ (if (eqv? key-4564 'displaced-lexical)
(syntax-violation
'syntax-parameterize
"identifier out of context"
- e-4465
- (wrap-4323
+ e-4466
+ (wrap-4324
(begin
- (if (if (pair? id-4561) s-4468 #f)
- (set-source-properties! id-4561 s-4468))
- id-4561)
- w-4467
- mod-4469)))))
- var-4556
- names-4560)
- (expand-body-4334
- (cons e1-4558 e2-4559)
- (wrap-4323
+ (if (if s-4469
+ (supports-source-properties? id-4562)
+ #f)
+ (set-source-properties! id-4562 s-4469))
+ id-4562)
+ w-4468
+ mod-4470)))))
+ var-4557
+ names-4561)
+ (expand-body-4335
+ (cons e1-4559 e2-4560)
+ (wrap-4324
(begin
- (if (if (pair? e-4465) s-4468 #f)
- (set-source-properties! e-4465 s-4468))
- e-4465)
- w-4467
- mod-4469)
- (extend-env-4288
- names-4560
- (let ((trans-r-4696 (macros-only-env-4290 r-4466)))
- (map (lambda (x-4697)
+ (if (if s-4469
+ (supports-source-properties? e-4466)
+ #f)
+ (set-source-properties! e-4466 s-4469))
+ e-4466)
+ w-4468
+ mod-4470)
+ (extend-env-4289
+ names-4561
+ (let ((trans-r-4697 (macros-only-env-4291 r-4467)))
+ (map (lambda (x-4698)
(cons 'macro
- (eval-local-transformer-4336
- (expand-4330
- x-4697
- trans-r-4696
- w-4467
- mod-4469)
- mod-4469)))
- val-4557))
- r-4466)
- w-4467
- mod-4469))))
- tmp-4471)
+ (eval-local-transformer-4337
+ (expand-4331
+ x-4698
+ trans-r-4697
+ w-4468
+ mod-4470)
+ mod-4470)))
+ val-4558))
+ r-4467)
+ w-4468
+ mod-4470))))
+ tmp-4472)
(syntax-violation
'syntax-parameterize
"bad syntax"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-4465) s-4468 #f)
- (set-source-properties! e-4465 s-4468))
- e-4465)
- w-4467
- mod-4469))))))
+ (if (if s-4469
+ (supports-source-properties? e-4466)
+ #f)
+ (set-source-properties! e-4466 s-4469))
+ e-4466)
+ w-4468
+ mod-4470))))))
(module-define!
(current-module)
'quote
(make-syntax-transformer
'quote
'core
- (lambda (e-4906 r-4907 w-4908 s-4909 mod-4910)
- (let ((tmp-4912 ($sc-dispatch e-4906 '(_ any))))
- (if tmp-4912
+ (lambda (e-4907 r-4908 w-4909 s-4910 mod-4911)
+ (let ((tmp-4913 ($sc-dispatch e-4907 '(_ any))))
+ (if tmp-4913
(@apply
- (lambda (e-4915)
- (let ((exp-4919 (strip-4343 e-4915 w-4908)))
+ (lambda (e-4916)
+ (let ((exp-4920 (strip-4344 e-4916 w-4909)))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
- s-4909
- exp-4919)))
- tmp-4912)
+ s-4910
+ exp-4920)))
+ tmp-4913)
(syntax-violation
'quote
"bad syntax"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-4906) s-4909 #f)
- (set-source-properties! e-4906 s-4909))
- e-4906)
- w-4908
- mod-4910)))))))
- (global-extend-4292
+ (if (if s-4910
+ (supports-source-properties? e-4907)
+ #f)
+ (set-source-properties! e-4907 s-4910))
+ e-4907)
+ w-4909
+ mod-4911)))))))
+ (global-extend-4293
'core
'syntax
(letrec*
- ((gen-syntax-5139
- (lambda (src-5241
- e-5242
- r-5243
- maps-5244
- ellipsis?-5245
- mod-5246)
- (if (if (symbol? e-5242)
+ ((gen-syntax-5140
+ (lambda (src-5242
+ e-5243
+ r-5244
+ maps-5245
+ ellipsis?-5246
+ mod-5247)
+ (if (if (symbol? e-5243)
#t
- (if (if (vector? e-5242)
- (if (= (vector-length e-5242) 4)
- (eq? (vector-ref e-5242 0) 'syntax-object)
+ (if (if (vector? e-5243)
+ (if (= (vector-length e-5243) 4)
+ (eq? (vector-ref e-5243 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref e-5242 1))
+ (symbol? (vector-ref e-5243 1))
#f))
- (let ((label-5273 (id-var-name-4313 e-5242 '(()))))
- (let ((b-5274
- (let ((t-5281 (assq label-5273 r-5243)))
- (if t-5281
- (cdr t-5281)
- (if (symbol? label-5273)
- (let ((t-5287
- (get-global-definition-hook-4257
- label-5273
- mod-5246)))
- (if t-5287 t-5287 '(global)))
+ (let ((label-5274 (id-var-name-4314 e-5243 '(()))))
+ (let ((b-5275
+ (let ((t-5282 (assq label-5274 r-5244)))
+ (if t-5282
+ (cdr t-5282)
+ (if (symbol? label-5274)
+ (let ((t-5288
+ (get-global-definition-hook-4258
+ label-5274
+ mod-5247)))
+ (if t-5288 t-5288 '(global)))
'(displaced-lexical))))))
- (if (eq? (car b-5274) 'syntax)
+ (if (eq? (car b-5275) 'syntax)
(call-with-values
(lambda ()
- (let ((var.lev-5296 (cdr b-5274)))
- (gen-ref-5140
- src-5241
- (car var.lev-5296)
- (cdr var.lev-5296)
- maps-5244)))
- (lambda (var-5300 maps-5301)
- (values (list 'ref var-5300) maps-5301)))
- (if (ellipsis?-5245 e-5242)
+ (let ((var.lev-5297 (cdr b-5275)))
+ (gen-ref-5141
+ src-5242
+ (car var.lev-5297)
+ (cdr var.lev-5297)
+ maps-5245)))
+ (lambda (var-5301 maps-5302)
+ (values (list 'ref var-5301) maps-5302)))
+ (if (ellipsis?-5246 e-5243)
(syntax-violation
'syntax
"misplaced ellipsis"
- src-5241)
- (values (list 'quote e-5242) maps-5244)))))
- (let ((tmp-5303 ($sc-dispatch e-5242 '(any any))))
- (if (if tmp-5303
+ src-5242)
+ (values (list 'quote e-5243) maps-5245)))))
+ (let ((tmp-5304 ($sc-dispatch e-5243 '(any any))))
+ (if (if tmp-5304
(@apply
- (lambda (dots-5307 e-5308)
- (ellipsis?-5245 dots-5307))
- tmp-5303)
+ (lambda (dots-5308 e-5309)
+ (ellipsis?-5246 dots-5308))
+ tmp-5304)
#f)
(@apply
- (lambda (dots-5309 e-5310)
- (gen-syntax-5139
- src-5241
- e-5310
- r-5243
- maps-5244
- (lambda (x-5311) #f)
- mod-5246))
- tmp-5303)
- (let ((tmp-5312 ($sc-dispatch e-5242 '(any any . any))))
- (if (if tmp-5312
+ (lambda (dots-5310 e-5311)
+ (gen-syntax-5140
+ src-5242
+ e-5311
+ r-5244
+ maps-5245
+ (lambda (x-5312) #f)
+ mod-5247))
+ tmp-5304)
+ (let ((tmp-5313 ($sc-dispatch e-5243 '(any any . any))))
+ (if (if tmp-5313
(@apply
- (lambda (x-5316 dots-5317 y-5318)
- (ellipsis?-5245 dots-5317))
- tmp-5312)
+ (lambda (x-5317 dots-5318 y-5319)
+ (ellipsis?-5246 dots-5318))
+ tmp-5313)
#f)
(@apply
- (lambda (x-5319 dots-5320 y-5321)
+ (lambda (x-5320 dots-5321 y-5322)
(letrec*
- ((f-5322
- (lambda (y-5330 k-5331)
- (let ((tmp-5333
+ ((f-5323
+ (lambda (y-5331 k-5332)
+ (let ((tmp-5334
($sc-dispatch
- y-5330
+ y-5331
'(any . any))))
- (if (if tmp-5333
+ (if (if tmp-5334
(@apply
- (lambda (dots-5337 y-5338)
- (ellipsis?-5245 dots-5337))
- tmp-5333)
+ (lambda (dots-5338 y-5339)
+ (ellipsis?-5246 dots-5338))
+ tmp-5334)
#f)
(@apply
- (lambda (dots-5339 y-5340)
- (f-5322
- y-5340
- (lambda (maps-5341)
+ (lambda (dots-5340 y-5341)
+ (f-5323
+ y-5341
+ (lambda (maps-5342)
(call-with-values
(lambda ()
- (k-5331
- (cons '() maps-5341)))
- (lambda (x-5342 maps-5343)
- (if (null? (car maps-5343))
+ (k-5332
+ (cons '() maps-5342)))
+ (lambda (x-5343 maps-5344)
+ (if (null? (car maps-5344))
(syntax-violation
'syntax
"extra ellipsis"
- src-5241)
+ src-5242)
(values
- (let ((map-env-5347
- (car maps-5343)))
+ (let ((map-env-5348
+ (car maps-5344)))
(list 'apply
'(primitive
append)
- (gen-map-5142
- x-5342
- map-env-5347)))
- (cdr maps-5343))))))))
- tmp-5333)
+ (gen-map-5143
+ x-5343
+ map-env-5348)))
+ (cdr maps-5344))))))))
+ tmp-5334)
(call-with-values
(lambda ()
- (gen-syntax-5139
- src-5241
- y-5330
- r-5243
- maps-5244
- ellipsis?-5245
- mod-5246))
- (lambda (y-5350 maps-5351)
+ (gen-syntax-5140
+ src-5242
+ y-5331
+ r-5244
+ maps-5245
+ ellipsis?-5246
+ mod-5247))
+ (lambda (y-5351 maps-5352)
(call-with-values
- (lambda () (k-5331 maps-5351))
- (lambda (x-5352 maps-5353)
+ (lambda () (k-5332 maps-5352))
+ (lambda (x-5353 maps-5354)
(values
- (if (equal? y-5350 ''())
- x-5352
+ (if (equal? y-5351 ''())
+ x-5353
(list 'append
- x-5352
- y-5350))
- maps-5353))))))))))
- (f-5322
- y-5321
- (lambda (maps-5325)
+ x-5353
+ y-5351))
+ maps-5354))))))))))
+ (f-5323
+ y-5322
+ (lambda (maps-5326)
(call-with-values
(lambda ()
- (gen-syntax-5139
- src-5241
- x-5319
- r-5243
- (cons '() maps-5325)
- ellipsis?-5245
- mod-5246))
- (lambda (x-5326 maps-5327)
- (if (null? (car maps-5327))
+ (gen-syntax-5140
+ src-5242
+ x-5320
+ r-5244
+ (cons '() maps-5326)
+ ellipsis?-5246
+ mod-5247))
+ (lambda (x-5327 maps-5328)
+ (if (null? (car maps-5328))
(syntax-violation
'syntax
"extra ellipsis"
- src-5241)
+ src-5242)
(values
- (gen-map-5142
- x-5326
- (car maps-5327))
- (cdr maps-5327)))))))))
- tmp-5312)
- (let ((tmp-5369 ($sc-dispatch e-5242 '(any . any))))
- (if tmp-5369
+ (gen-map-5143
+ x-5327
+ (car maps-5328))
+ (cdr maps-5328)))))))))
+ tmp-5313)
+ (let ((tmp-5370 ($sc-dispatch e-5243 '(any . any))))
+ (if tmp-5370
(@apply
- (lambda (x-5373 y-5374)
+ (lambda (x-5374 y-5375)
(call-with-values
(lambda ()
- (gen-syntax-5139
- src-5241
- x-5373
- r-5243
- maps-5244
- ellipsis?-5245
- mod-5246))
- (lambda (x-5375 maps-5376)
+ (gen-syntax-5140
+ src-5242
+ x-5374
+ r-5244
+ maps-5245
+ ellipsis?-5246
+ mod-5247))
+ (lambda (x-5376 maps-5377)
(call-with-values
(lambda ()
- (gen-syntax-5139
- src-5241
- y-5374
- r-5243
- maps-5376
- ellipsis?-5245
- mod-5246))
- (lambda (y-5377 maps-5378)
+ (gen-syntax-5140
+ src-5242
+ y-5375
+ r-5244
+ maps-5377
+ ellipsis?-5246
+ mod-5247))
+ (lambda (y-5378 maps-5379)
(values
- (let ((key-5383 (car y-5377)))
- (if (eqv? key-5383 'quote)
- (if (eq? (car x-5375) 'quote)
+ (let ((key-5384 (car y-5378)))
+ (if (eqv? key-5384 'quote)
+ (if (eq? (car x-5376) 'quote)
(list 'quote
- (cons (car (cdr x-5375))
- (car (cdr y-5377))))
- (if (eq? (car (cdr y-5377))
+ (cons (car (cdr x-5376))
+ (car (cdr y-5378))))
+ (if (eq? (car (cdr y-5378))
'())
- (list 'list x-5375)
- (list 'cons x-5375 y-5377)))
- (if (eqv? key-5383 'list)
+ (list 'list x-5376)
+ (list 'cons x-5376 y-5378)))
+ (if (eqv? key-5384 'list)
(cons 'list
- (cons x-5375
- (cdr y-5377)))
- (list 'cons x-5375 y-5377))))
- maps-5378))))))
- tmp-5369)
- (let ((tmp-5412
+ (cons x-5376
+ (cdr y-5378)))
+ (list 'cons x-5376 y-5378))))
+ maps-5379))))))
+ tmp-5370)
+ (let ((tmp-5413
($sc-dispatch
- e-5242
+ e-5243
'#(vector (any . each-any)))))
- (if tmp-5412
+ (if tmp-5413
(@apply
- (lambda (e1-5416 e2-5417)
+ (lambda (e1-5417 e2-5418)
(call-with-values
(lambda ()
- (gen-syntax-5139
- src-5241
- (cons e1-5416 e2-5417)
- r-5243
- maps-5244
- ellipsis?-5245
- mod-5246))
- (lambda (e-5418 maps-5419)
+ (gen-syntax-5140
+ src-5242
+ (cons e1-5417 e2-5418)
+ r-5244
+ maps-5245
+ ellipsis?-5246
+ mod-5247))
+ (lambda (e-5419 maps-5420)
(values
- (if (eq? (car e-5418) 'list)
- (cons 'vector (cdr e-5418))
- (if (eq? (car e-5418) 'quote)
+ (if (eq? (car e-5419) 'list)
+ (cons 'vector (cdr e-5419))
+ (if (eq? (car e-5419) 'quote)
(list 'quote
(list->vector
- (car (cdr e-5418))))
- (list 'list->vector e-5418)))
- maps-5419))))
- tmp-5412)
+ (car (cdr e-5419))))
+ (list 'list->vector e-5419)))
+ maps-5420))))
+ tmp-5413)
(values
- (list 'quote e-5242)
- maps-5244))))))))))))
- (gen-ref-5140
- (lambda (src-5446 var-5447 level-5448 maps-5449)
- (if (= level-5448 0)
- (values var-5447 maps-5449)
- (if (null? maps-5449)
+ (list 'quote e-5243)
+ maps-5245))))))))))))
+ (gen-ref-5141
+ (lambda (src-5447 var-5448 level-5449 maps-5450)
+ (if (= level-5449 0)
+ (values var-5448 maps-5450)
+ (if (null? maps-5450)
(syntax-violation
'syntax
"missing ellipsis"
- src-5446)
+ src-5447)
(call-with-values
(lambda ()
- (gen-ref-5140
- src-5446
- var-5447
- (#{1-}# level-5448)
- (cdr maps-5449)))
- (lambda (outer-var-5450 outer-maps-5451)
- (let ((b-5452 (assq outer-var-5450 (car maps-5449))))
- (if b-5452
- (values (cdr b-5452) maps-5449)
- (let ((inner-var-5454
+ (gen-ref-5141
+ src-5447
+ var-5448
+ (#{1-}# level-5449)
+ (cdr maps-5450)))
+ (lambda (outer-var-5451 outer-maps-5452)
+ (let ((b-5453 (assq outer-var-5451 (car maps-5450))))
+ (if b-5453
+ (values (cdr b-5453) maps-5450)
+ (let ((inner-var-5455
(gensym
(string-append
(symbol->string 'tmp)
"-"))))
(values
- inner-var-5454
- (cons (cons (cons outer-var-5450 inner-var-5454)
- (car maps-5449))
- outer-maps-5451)))))))))))
- (gen-map-5142
- (lambda (e-5468 map-env-5469)
- (let ((formals-5470 (map cdr map-env-5469))
- (actuals-5471
- (map (lambda (x-5473) (list 'ref (car x-5473)))
- map-env-5469)))
- (if (eq? (car e-5468) 'ref)
- (car actuals-5471)
+ inner-var-5455
+ (cons (cons (cons outer-var-5451 inner-var-5455)
+ (car maps-5450))
+ outer-maps-5452)))))))))))
+ (gen-map-5143
+ (lambda (e-5469 map-env-5470)
+ (let ((formals-5471 (map cdr map-env-5470))
+ (actuals-5472
+ (map (lambda (x-5474) (list 'ref (car x-5474)))
+ map-env-5470)))
+ (if (eq? (car e-5469) 'ref)
+ (car actuals-5472)
(if (and-map
- (lambda (x-5474)
- (if (eq? (car x-5474) 'ref)
- (memq (car (cdr x-5474)) formals-5470)
+ (lambda (x-5475)
+ (if (eq? (car x-5475) 'ref)
+ (memq (car (cdr x-5475)) formals-5471)
#f))
- (cdr e-5468))
+ (cdr e-5469))
(cons 'map
- (cons (list 'primitive (car e-5468))
- (map (let ((r-5476
+ (cons (list 'primitive (car e-5469))
+ (map (let ((r-5477
(map cons
- formals-5470
- actuals-5471)))
- (lambda (x-5477)
- (cdr (assq (car (cdr x-5477))
- r-5476))))
- (cdr e-5468))))
+ formals-5471
+ actuals-5472)))
+ (lambda (x-5478)
+ (cdr (assq (car (cdr x-5478))
+ r-5477))))
+ (cdr e-5469))))
(cons 'map
- (cons (list 'lambda formals-5470 e-5468)
- actuals-5471)))))))
- (regen-5146
- (lambda (x-5479)
- (let ((key-5480 (car x-5479)))
- (if (eqv? key-5480 'ref)
- (let ((name-5490 (car (cdr x-5479)))
- (var-5491 (car (cdr x-5479))))
+ (cons (list 'lambda formals-5471 e-5469)
+ actuals-5472)))))))
+ (regen-5147
+ (lambda (x-5480)
+ (let ((key-5481 (car x-5480)))
+ (if (eqv? key-5481 'ref)
+ (let ((name-5491 (car (cdr x-5480)))
+ (var-5492 (car (cdr x-5480))))
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
#f
- name-5490
- var-5491))
- (if (eqv? key-5480 'primitive)
- (let ((name-5503 (car (cdr x-5479))))
+ name-5491
+ var-5492))
+ (if (eqv? key-5481 'primitive)
+ (let ((name-5504 (car (cdr x-5480))))
(if (equal? (module-name (current-module)) '(guile))
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
#f
- name-5503)
+ name-5504)
(make-struct/no-tail
(vector-ref %expanded-vtables 5)
#f
'(guile)
- name-5503
+ name-5504
#f)))
- (if (eqv? key-5480 'quote)
- (let ((exp-5521 (car (cdr x-5479))))
+ (if (eqv? key-5481 'quote)
+ (let ((exp-5522 (car (cdr x-5480))))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
- exp-5521))
- (if (eqv? key-5480 'lambda)
- (if (list? (car (cdr x-5479)))
- (let ((req-5532 (car (cdr x-5479)))
- (vars-5534 (car (cdr x-5479)))
- (exp-5536
- (regen-5146 (car (cdr (cdr x-5479))))))
- (let ((body-5541
+ exp-5522))
+ (if (eqv? key-5481 'lambda)
+ (if (list? (car (cdr x-5480)))
+ (let ((req-5533 (car (cdr x-5480)))
+ (vars-5535 (car (cdr x-5480)))
+ (exp-5537
+ (regen-5147 (car (cdr (cdr x-5480))))))
+ (let ((body-5542
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
#f
- req-5532
+ req-5533
#f
#f
#f
'()
- vars-5534
- exp-5536
+ vars-5535
+ exp-5537
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
#f
'()
- body-5541)))
- (error "how did we get here" x-5479))
- (let ((fun-exp-5557
- (let ((name-5566 (car x-5479)))
+ body-5542)))
+ (error "how did we get here" x-5480))
+ (let ((fun-exp-5558
+ (let ((name-5567 (car x-5480)))
(if (equal?
(module-name (current-module))
'(guile))
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
#f
- name-5566)
+ name-5567)
(make-struct/no-tail
(vector-ref %expanded-vtables 5)
#f
'(guile)
- name-5566
+ name-5567
#f))))
- (arg-exps-5558 (map regen-5146 (cdr x-5479))))
+ (arg-exps-5559 (map regen-5147 (cdr x-5480))))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
#f
- fun-exp-5557
- arg-exps-5558))))))))))
- (lambda (e-5147 r-5148 w-5149 s-5150 mod-5151)
- (let ((e-5152
- (wrap-4323
+ fun-exp-5558
+ arg-exps-5559))))))))))
+ (lambda (e-5148 r-5149 w-5150 s-5151 mod-5152)
+ (let ((e-5153
+ (wrap-4324
(begin
- (if (if (pair? e-5147) s-5150 #f)
- (set-source-properties! e-5147 s-5150))
- e-5147)
- w-5149
- mod-5151)))
- (let ((tmp-5154 ($sc-dispatch e-5152 '(_ any))))
- (if tmp-5154
+ (if (if s-5151
+ (supports-source-properties? e-5148)
+ #f)
+ (set-source-properties! e-5148 s-5151))
+ e-5148)
+ w-5150
+ mod-5152)))
+ (let ((tmp-5155 ($sc-dispatch e-5153 '(_ any))))
+ (if tmp-5155
(@apply
- (lambda (x-5179)
+ (lambda (x-5180)
(call-with-values
(lambda ()
- (gen-syntax-5139
- e-5152
- x-5179
- r-5148
+ (gen-syntax-5140
+ e-5153
+ x-5180
+ r-5149
'()
- ellipsis?-4338
- mod-5151))
- (lambda (e-5233 maps-5234) (regen-5146 e-5233))))
- tmp-5154)
+ ellipsis?-4339
+ mod-5152))
+ (lambda (e-5234 maps-5235) (regen-5147 e-5234))))
+ tmp-5155)
(syntax-violation
'syntax
"bad `syntax' form"
- e-5152)))))))
- (global-extend-4292
+ e-5153)))))))
+ (global-extend-4293
'core
'lambda
- (lambda (e-5754 r-5755 w-5756 s-5757 mod-5758)
- (let ((tmp-5760
- ($sc-dispatch e-5754 '(_ any any . each-any))))
- (if tmp-5760
+ (lambda (e-5755 r-5756 w-5757 s-5758 mod-5759)
+ (let ((tmp-5761
+ ($sc-dispatch e-5755 '(_ any any . each-any))))
+ (if tmp-5761
(@apply
- (lambda (args-5764 e1-5765 e2-5766)
+ (lambda (args-5765 e1-5766 e2-5767)
(call-with-values
- (lambda () (lambda-formals-4339 args-5764))
- (lambda (req-5769 opt-5770 rest-5771 kw-5772)
+ (lambda () (lambda-formals-4340 args-5765))
+ (lambda (req-5770 opt-5771 rest-5772 kw-5773)
(letrec*
- ((lp-5773
- (lambda (body-5776 meta-5777)
- (let ((tmp-5779
+ ((lp-5774
+ (lambda (body-5777 meta-5778)
+ (let ((tmp-5780
($sc-dispatch
- body-5776
+ body-5777
'(any any . each-any))))
- (if (if tmp-5779
+ (if (if tmp-5780
(@apply
- (lambda (docstring-5783 e1-5784 e2-5785)
+ (lambda (docstring-5784 e1-5785 e2-5786)
(string?
- (syntax->datum docstring-5783)))
- tmp-5779)
+ (syntax->datum docstring-5784)))
+ tmp-5780)
#f)
(@apply
- (lambda (docstring-5786 e1-5787 e2-5788)
- (lp-5773
- (cons e1-5787 e2-5788)
+ (lambda (docstring-5787 e1-5788 e2-5789)
+ (lp-5774
+ (cons e1-5788 e2-5789)
(append
- meta-5777
+ meta-5778
(list (cons 'documentation
(syntax->datum
- docstring-5786))))))
- tmp-5779)
- (let ((tmp-5789
+ docstring-5787))))))
+ tmp-5780)
+ (let ((tmp-5790
($sc-dispatch
- body-5776
+ body-5777
'(#(vector #(each (any . any)))
any
.
each-any))))
- (if tmp-5789
+ (if tmp-5790
(@apply
- (lambda (k-5793 v-5794 e1-5795 e2-5796)
- (lp-5773
- (cons e1-5795 e2-5796)
+ (lambda (k-5794 v-5795 e1-5796 e2-5797)
+ (lp-5774
+ (cons e1-5796 e2-5797)
(append
- meta-5777
+ meta-5778
(syntax->datum
- (map cons k-5793 v-5794)))))
- tmp-5789)
- (expand-simple-lambda-4340
- e-5754
- r-5755
- w-5756
- s-5757
- mod-5758
- req-5769
- rest-5771
- meta-5777
- body-5776))))))))
- (lp-5773 (cons e1-5765 e2-5766) '())))))
- tmp-5760)
- (syntax-violation 'lambda "bad lambda" e-5754)))))
- (global-extend-4292
+ (map cons k-5794 v-5795)))))
+ tmp-5790)
+ (expand-simple-lambda-4341
+ e-5755
+ r-5756
+ w-5757
+ s-5758
+ mod-5759
+ req-5770
+ rest-5772
+ meta-5778
+ body-5777))))))))
+ (lp-5774 (cons e1-5766 e2-5767) '())))))
+ tmp-5761)
+ (syntax-violation 'lambda "bad lambda" e-5755)))))
+ (global-extend-4293
'core
'lambda*
- (lambda (e-6085 r-6086 w-6087 s-6088 mod-6089)
- (let ((tmp-6091
- ($sc-dispatch e-6085 '(_ any any . each-any))))
- (if tmp-6091
+ (lambda (e-6086 r-6087 w-6088 s-6089 mod-6090)
+ (let ((tmp-6092
+ ($sc-dispatch e-6086 '(_ any any . each-any))))
+ (if tmp-6092
(@apply
- (lambda (args-6095 e1-6096 e2-6097)
+ (lambda (args-6096 e1-6097 e2-6098)
(call-with-values
(lambda ()
- (expand-lambda-case-4342
- e-6085
- r-6086
- w-6087
- s-6088
- mod-6089
- lambda*-formals-4341
- (list (cons args-6095 (cons e1-6096 e2-6097)))))
- (lambda (meta-6100 lcase-6101)
+ (expand-lambda-case-4343
+ e-6086
+ r-6087
+ w-6088
+ s-6089
+ mod-6090
+ lambda*-formals-4342
+ (list (cons args-6096 (cons e1-6097 e2-6098)))))
+ (lambda (meta-6101 lcase-6102)
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
- s-6088
- meta-6100
- lcase-6101))))
- tmp-6091)
- (syntax-violation 'lambda "bad lambda*" e-6085)))))
- (global-extend-4292
+ s-6089
+ meta-6101
+ lcase-6102))))
+ tmp-6092)
+ (syntax-violation 'lambda "bad lambda*" e-6086)))))
+ (global-extend-4293
'core
'case-lambda
- (lambda (e-6271 r-6272 w-6273 s-6274 mod-6275)
- (let ((tmp-6277
+ (lambda (e-6272 r-6273 w-6274 s-6275 mod-6276)
+ (let ((tmp-6278
($sc-dispatch
- e-6271
+ e-6272
'(_ (any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-6277
+ (if tmp-6278
(@apply
- (lambda (args-6281
- e1-6282
- e2-6283
- args*-6284
- e1*-6285
- e2*-6286)
+ (lambda (args-6282
+ e1-6283
+ e2-6284
+ args*-6285
+ e1*-6286
+ e2*-6287)
(call-with-values
(lambda ()
- (expand-lambda-case-4342
- e-6271
- r-6272
- w-6273
- s-6274
- mod-6275
- lambda-formals-4339
- (cons (cons args-6281 (cons e1-6282 e2-6283))
- (map (lambda (tmp-3269-6289
- tmp-3268-6290
- tmp-3267-6291)
- (cons tmp-3267-6291
- (cons tmp-3268-6290 tmp-3269-6289)))
- e2*-6286
- e1*-6285
- args*-6284))))
- (lambda (meta-6292 lcase-6293)
+ (expand-lambda-case-4343
+ e-6272
+ r-6273
+ w-6274
+ s-6275
+ mod-6276
+ lambda-formals-4340
+ (cons (cons args-6282 (cons e1-6283 e2-6284))
+ (map (lambda (tmp-3270-6290
+ tmp-3269-6291
+ tmp-3268-6292)
+ (cons tmp-3268-6292
+ (cons tmp-3269-6291 tmp-3270-6290)))
+ e2*-6287
+ e1*-6286
+ args*-6285))))
+ (lambda (meta-6293 lcase-6294)
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
- s-6274
- meta-6292
- lcase-6293))))
- tmp-6277)
+ s-6275
+ meta-6293
+ lcase-6294))))
+ tmp-6278)
(syntax-violation
'case-lambda
"bad case-lambda"
- e-6271)))))
- (global-extend-4292
+ e-6272)))))
+ (global-extend-4293
'core
'case-lambda*
- (lambda (e-6455 r-6456 w-6457 s-6458 mod-6459)
- (let ((tmp-6461
+ (lambda (e-6456 r-6457 w-6458 s-6459 mod-6460)
+ (let ((tmp-6462
($sc-dispatch
- e-6455
+ e-6456
'(_ (any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-6461
+ (if tmp-6462
(@apply
- (lambda (args-6465
- e1-6466
- e2-6467
- args*-6468
- e1*-6469
- e2*-6470)
+ (lambda (args-6466
+ e1-6467
+ e2-6468
+ args*-6469
+ e1*-6470
+ e2*-6471)
(call-with-values
(lambda ()
- (expand-lambda-case-4342
- e-6455
- r-6456
- w-6457
- s-6458
- mod-6459
- lambda*-formals-4341
- (cons (cons args-6465 (cons e1-6466 e2-6467))
- (map (lambda (tmp-3304-6473
- tmp-3303-6474
- tmp-3302-6475)
- (cons tmp-3302-6475
- (cons tmp-3303-6474 tmp-3304-6473)))
- e2*-6470
- e1*-6469
- args*-6468))))
- (lambda (meta-6476 lcase-6477)
+ (expand-lambda-case-4343
+ e-6456
+ r-6457
+ w-6458
+ s-6459
+ mod-6460
+ lambda*-formals-4342
+ (cons (cons args-6466 (cons e1-6467 e2-6468))
+ (map (lambda (tmp-3305-6474
+ tmp-3304-6475
+ tmp-3303-6476)
+ (cons tmp-3303-6476
+ (cons tmp-3304-6475 tmp-3305-6474)))
+ e2*-6471
+ e1*-6470
+ args*-6469))))
+ (lambda (meta-6477 lcase-6478)
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
- s-6458
- meta-6476
- lcase-6477))))
- tmp-6461)
+ s-6459
+ meta-6477
+ lcase-6478))))
+ tmp-6462)
(syntax-violation
'case-lambda
"bad case-lambda*"
- e-6455)))))
- (global-extend-4292
+ e-6456)))))
+ (global-extend-4293
'core
'let
(letrec*
- ((expand-let-6668
- (lambda (e-6817
- r-6818
- w-6819
- s-6820
- mod-6821
- constructor-6822
- ids-6823
- vals-6824
- exps-6825)
- (if (not (valid-bound-ids?-4320 ids-6823))
+ ((expand-let-6669
+ (lambda (e-6818
+ r-6819
+ w-6820
+ s-6821
+ mod-6822
+ constructor-6823
+ ids-6824
+ vals-6825
+ exps-6826)
+ (if (not (valid-bound-ids?-4321 ids-6824))
(syntax-violation
'let
"duplicate bound variable"
- e-6817)
- (let ((labels-6903 (gen-labels-4297 ids-6823))
- (new-vars-6904 (map gen-var-4344 ids-6823)))
- (let ((nw-6905
- (make-binding-wrap-4308
- ids-6823
- labels-6903
- w-6819))
- (nr-6906
- (extend-var-env-4289
- labels-6903
- new-vars-6904
- r-6818)))
- (constructor-6822
- s-6820
- (map syntax->datum ids-6823)
- new-vars-6904
- (map (lambda (x-6923)
- (expand-4330 x-6923 r-6818 w-6819 mod-6821))
- vals-6824)
- (expand-body-4334
- exps-6825
- (source-wrap-4324 e-6817 nw-6905 s-6820 mod-6821)
- nr-6906
- nw-6905
- mod-6821))))))))
- (lambda (e-6669 r-6670 w-6671 s-6672 mod-6673)
- (let ((tmp-6675
+ e-6818)
+ (let ((labels-6904 (gen-labels-4298 ids-6824))
+ (new-vars-6905 (map gen-var-4345 ids-6824)))
+ (let ((nw-6906
+ (make-binding-wrap-4309
+ ids-6824
+ labels-6904
+ w-6820))
+ (nr-6907
+ (extend-var-env-4290
+ labels-6904
+ new-vars-6905
+ r-6819)))
+ (constructor-6823
+ s-6821
+ (map syntax->datum ids-6824)
+ new-vars-6905
+ (map (lambda (x-6924)
+ (expand-4331 x-6924 r-6819 w-6820 mod-6822))
+ vals-6825)
+ (expand-body-4335
+ exps-6826
+ (source-wrap-4325 e-6818 nw-6906 s-6821 mod-6822)
+ nr-6907
+ nw-6906
+ mod-6822))))))))
+ (lambda (e-6670 r-6671 w-6672 s-6673 mod-6674)
+ (let ((tmp-6676
($sc-dispatch
- e-6669
+ e-6670
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-6675
+ (if (if tmp-6676
(@apply
- (lambda (id-6679 val-6680 e1-6681 e2-6682)
- (and-map id?-4294 id-6679))
- tmp-6675)
+ (lambda (id-6680 val-6681 e1-6682 e2-6683)
+ (and-map id?-4295 id-6680))
+ tmp-6676)
#f)
(@apply
- (lambda (id-6698 val-6699 e1-6700 e2-6701)
- (expand-let-6668
- e-6669
- r-6670
- w-6671
- s-6672
- mod-6673
- build-let-4276
- id-6698
- val-6699
- (cons e1-6700 e2-6701)))
- tmp-6675)
- (let ((tmp-6731
+ (lambda (id-6699 val-6700 e1-6701 e2-6702)
+ (expand-let-6669
+ e-6670
+ r-6671
+ w-6672
+ s-6673
+ mod-6674
+ build-let-4277
+ id-6699
+ val-6700
+ (cons e1-6701 e2-6702)))
+ tmp-6676)
+ (let ((tmp-6732
($sc-dispatch
- e-6669
+ e-6670
'(_ any #(each (any any)) any . each-any))))
- (if (if tmp-6731
+ (if (if tmp-6732
(@apply
- (lambda (f-6735 id-6736 val-6737 e1-6738 e2-6739)
- (if (if (symbol? f-6735)
+ (lambda (f-6736 id-6737 val-6738 e1-6739 e2-6740)
+ (if (if (symbol? f-6736)
#t
- (if (if (vector? f-6735)
- (if (= (vector-length f-6735) 4)
- (eq? (vector-ref f-6735 0)
+ (if (if (vector? f-6736)
+ (if (= (vector-length f-6736) 4)
+ (eq? (vector-ref f-6736 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref f-6735 1))
+ (symbol? (vector-ref f-6736 1))
#f))
- (and-map id?-4294 id-6736)
+ (and-map id?-4295 id-6737)
#f))
- tmp-6731)
+ tmp-6732)
#f)
(@apply
- (lambda (f-6781 id-6782 val-6783 e1-6784 e2-6785)
- (expand-let-6668
- e-6669
- r-6670
- w-6671
- s-6672
- mod-6673
- build-named-let-4277
- (cons f-6781 id-6782)
- val-6783
- (cons e1-6784 e2-6785)))
- tmp-6731)
+ (lambda (f-6782 id-6783 val-6784 e1-6785 e2-6786)
+ (expand-let-6669
+ e-6670
+ r-6671
+ w-6672
+ s-6673
+ mod-6674
+ build-named-let-4278
+ (cons f-6782 id-6783)
+ val-6784
+ (cons e1-6785 e2-6786)))
+ tmp-6732)
(syntax-violation
'let
"bad let"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-6669) s-6672 #f)
- (set-source-properties! e-6669 s-6672))
- e-6669)
- w-6671
- mod-6673)))))))))
- (global-extend-4292
+ (if (if s-6673
+ (supports-source-properties? e-6670)
+ #f)
+ (set-source-properties! e-6670 s-6673))
+ e-6670)
+ w-6672
+ mod-6674)))))))))
+ (global-extend-4293
'core
'letrec
- (lambda (e-7335 r-7336 w-7337 s-7338 mod-7339)
- (let ((tmp-7341
+ (lambda (e-7336 r-7337 w-7338 s-7339 mod-7340)
+ (let ((tmp-7342
($sc-dispatch
- e-7335
+ e-7336
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-7341
+ (if (if tmp-7342
(@apply
- (lambda (id-7345 val-7346 e1-7347 e2-7348)
- (and-map id?-4294 id-7345))
- tmp-7341)
+ (lambda (id-7346 val-7347 e1-7348 e2-7349)
+ (and-map id?-4295 id-7346))
+ tmp-7342)
#f)
(@apply
- (lambda (id-7364 val-7365 e1-7366 e2-7367)
- (if (not (valid-bound-ids?-4320 id-7364))
+ (lambda (id-7365 val-7366 e1-7367 e2-7368)
+ (if (not (valid-bound-ids?-4321 id-7365))
(syntax-violation
'letrec
"duplicate bound variable"
- e-7335)
- (let ((labels-7457 (gen-labels-4297 id-7364))
- (new-vars-7458 (map gen-var-4344 id-7364)))
- (let ((w-7459
- (make-binding-wrap-4308
- id-7364
- labels-7457
- w-7337))
- (r-7460
- (extend-var-env-4289
- labels-7457
- new-vars-7458
- r-7336)))
- (build-letrec-4278
- s-7338
+ e-7336)
+ (let ((labels-7458 (gen-labels-4298 id-7365))
+ (new-vars-7459 (map gen-var-4345 id-7365)))
+ (let ((w-7460
+ (make-binding-wrap-4309
+ id-7365
+ labels-7458
+ w-7338))
+ (r-7461
+ (extend-var-env-4290
+ labels-7458
+ new-vars-7459
+ r-7337)))
+ (build-letrec-4279
+ s-7339
#f
- (map syntax->datum id-7364)
- new-vars-7458
- (map (lambda (x-7545)
- (expand-4330 x-7545 r-7460 w-7459 mod-7339))
- val-7365)
- (expand-body-4334
- (cons e1-7366 e2-7367)
- (wrap-4323
+ (map syntax->datum id-7365)
+ new-vars-7459
+ (map (lambda (x-7546)
+ (expand-4331 x-7546 r-7461 w-7460 mod-7340))
+ val-7366)
+ (expand-body-4335
+ (cons e1-7367 e2-7368)
+ (wrap-4324
(begin
- (if (if (pair? e-7335) s-7338 #f)
- (set-source-properties! e-7335 s-7338))
- e-7335)
- w-7459
- mod-7339)
- r-7460
- w-7459
- mod-7339))))))
- tmp-7341)
+ (if (if s-7339
+ (supports-source-properties? e-7336)
+ #f)
+ (set-source-properties! e-7336 s-7339))
+ e-7336)
+ w-7460
+ mod-7340)
+ r-7461
+ w-7460
+ mod-7340))))))
+ tmp-7342)
(syntax-violation
'letrec
"bad letrec"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-7335) s-7338 #f)
- (set-source-properties! e-7335 s-7338))
- e-7335)
- w-7337
- mod-7339))))))
- (global-extend-4292
+ (if (if s-7339
+ (supports-source-properties? e-7336)
+ #f)
+ (set-source-properties! e-7336 s-7339))
+ e-7336)
+ w-7338
+ mod-7340))))))
+ (global-extend-4293
'core
'letrec*
- (lambda (e-7940 r-7941 w-7942 s-7943 mod-7944)
- (let ((tmp-7946
+ (lambda (e-7941 r-7942 w-7943 s-7944 mod-7945)
+ (let ((tmp-7947
($sc-dispatch
- e-7940
+ e-7941
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-7946
+ (if (if tmp-7947
(@apply
- (lambda (id-7950 val-7951 e1-7952 e2-7953)
- (and-map id?-4294 id-7950))
- tmp-7946)
+ (lambda (id-7951 val-7952 e1-7953 e2-7954)
+ (and-map id?-4295 id-7951))
+ tmp-7947)
#f)
(@apply
- (lambda (id-7969 val-7970 e1-7971 e2-7972)
- (if (not (valid-bound-ids?-4320 id-7969))
+ (lambda (id-7970 val-7971 e1-7972 e2-7973)
+ (if (not (valid-bound-ids?-4321 id-7970))
(syntax-violation
'letrec*
"duplicate bound variable"
- e-7940)
- (let ((labels-8062 (gen-labels-4297 id-7969))
- (new-vars-8063 (map gen-var-4344 id-7969)))
- (let ((w-8064
- (make-binding-wrap-4308
- id-7969
- labels-8062
- w-7942))
- (r-8065
- (extend-var-env-4289
- labels-8062
- new-vars-8063
- r-7941)))
- (build-letrec-4278
- s-7943
+ e-7941)
+ (let ((labels-8063 (gen-labels-4298 id-7970))
+ (new-vars-8064 (map gen-var-4345 id-7970)))
+ (let ((w-8065
+ (make-binding-wrap-4309
+ id-7970
+ labels-8063
+ w-7943))
+ (r-8066
+ (extend-var-env-4290
+ labels-8063
+ new-vars-8064
+ r-7942)))
+ (build-letrec-4279
+ s-7944
#t
- (map syntax->datum id-7969)
- new-vars-8063
- (map (lambda (x-8150)
- (expand-4330 x-8150 r-8065 w-8064 mod-7944))
- val-7970)
- (expand-body-4334
- (cons e1-7971 e2-7972)
- (wrap-4323
+ (map syntax->datum id-7970)
+ new-vars-8064
+ (map (lambda (x-8151)
+ (expand-4331 x-8151 r-8066 w-8065 mod-7945))
+ val-7971)
+ (expand-body-4335
+ (cons e1-7972 e2-7973)
+ (wrap-4324
(begin
- (if (if (pair? e-7940) s-7943 #f)
- (set-source-properties! e-7940 s-7943))
- e-7940)
- w-8064
- mod-7944)
- r-8065
- w-8064
- mod-7944))))))
- tmp-7946)
+ (if (if s-7944
+ (supports-source-properties? e-7941)
+ #f)
+ (set-source-properties! e-7941 s-7944))
+ e-7941)
+ w-8065
+ mod-7945)
+ r-8066
+ w-8065
+ mod-7945))))))
+ tmp-7947)
(syntax-violation
'letrec*
"bad letrec*"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-7940) s-7943 #f)
- (set-source-properties! e-7940 s-7943))
- e-7940)
- w-7942
- mod-7944))))))
- (global-extend-4292
+ (if (if s-7944
+ (supports-source-properties? e-7941)
+ #f)
+ (set-source-properties! e-7941 s-7944))
+ e-7941)
+ w-7943
+ mod-7945))))))
+ (global-extend-4293
'core
'set!
- (lambda (e-8584 r-8585 w-8586 s-8587 mod-8588)
- (let ((tmp-8590 ($sc-dispatch e-8584 '(_ any any))))
- (if (if tmp-8590
+ (lambda (e-8585 r-8586 w-8587 s-8588 mod-8589)
+ (let ((tmp-8591 ($sc-dispatch e-8585 '(_ any any))))
+ (if (if tmp-8591
(@apply
- (lambda (id-8594 val-8595)
- (if (symbol? id-8594)
+ (lambda (id-8595 val-8596)
+ (if (symbol? id-8595)
#t
- (if (if (vector? id-8594)
- (if (= (vector-length id-8594) 4)
- (eq? (vector-ref id-8594 0) 'syntax-object)
+ (if (if (vector? id-8595)
+ (if (= (vector-length id-8595) 4)
+ (eq? (vector-ref id-8595 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-8594 1))
+ (symbol? (vector-ref id-8595 1))
#f)))
- tmp-8590)
+ tmp-8591)
#f)
(@apply
- (lambda (id-8622 val-8623)
- (let ((n-8624 (id-var-name-4313 id-8622 w-8586))
- (id-mod-8625
- (if (if (vector? id-8622)
- (if (= (vector-length id-8622) 4)
- (eq? (vector-ref id-8622 0) 'syntax-object)
+ (lambda (id-8623 val-8624)
+ (let ((n-8625 (id-var-name-4314 id-8623 w-8587))
+ (id-mod-8626
+ (if (if (vector? id-8623)
+ (if (= (vector-length id-8623) 4)
+ (eq? (vector-ref id-8623 0) 'syntax-object)
#f)
#f)
- (vector-ref id-8622 3)
- mod-8588)))
- (let ((b-8626
- (let ((t-8667 (assq n-8624 r-8585)))
- (if t-8667
- (cdr t-8667)
- (if (symbol? n-8624)
- (let ((t-8672
- (get-global-definition-hook-4257
- n-8624
- id-mod-8625)))
- (if t-8672 t-8672 '(global)))
+ (vector-ref id-8623 3)
+ mod-8589)))
+ (let ((b-8627
+ (let ((t-8668 (assq n-8625 r-8586)))
+ (if t-8668
+ (cdr t-8668)
+ (if (symbol? n-8625)
+ (let ((t-8673
+ (get-global-definition-hook-4258
+ n-8625
+ id-mod-8626)))
+ (if t-8673 t-8673 '(global)))
'(displaced-lexical))))))
- (let ((key-8627 (car b-8626)))
- (if (eqv? key-8627 'lexical)
- (build-lexical-assignment-4265
- s-8587
- (syntax->datum id-8622)
- (cdr b-8626)
- (expand-4330 val-8623 r-8585 w-8586 mod-8588))
- (if (eqv? key-8627 'global)
- (build-global-assignment-4268
- s-8587
- n-8624
- (expand-4330 val-8623 r-8585 w-8586 mod-8588)
- id-mod-8625)
- (if (eqv? key-8627 'macro)
- (let ((p-8986 (cdr b-8626)))
+ (let ((key-8628 (car b-8627)))
+ (if (eqv? key-8628 'lexical)
+ (build-lexical-assignment-4266
+ s-8588
+ (syntax->datum id-8623)
+ (cdr b-8627)
+ (expand-4331 val-8624 r-8586 w-8587 mod-8589))
+ (if (eqv? key-8628 'global)
+ (build-global-assignment-4269
+ s-8588
+ n-8625
+ (expand-4331 val-8624 r-8586 w-8587 mod-8589)
+ id-mod-8626)
+ (if (eqv? key-8628 'macro)
+ (let ((p-8987 (cdr b-8627)))
(if (procedure-property
- p-8986
+ p-8987
'variable-transformer)
- (expand-4330
- (expand-macro-4333
- p-8986
- e-8584
- r-8585
- w-8586
- s-8587
+ (expand-4331
+ (expand-macro-4334
+ p-8987
+ e-8585
+ r-8586
+ w-8587
+ s-8588
#f
- mod-8588)
- r-8585
+ mod-8589)
+ r-8586
'(())
- mod-8588)
+ mod-8589)
(syntax-violation
'set!
"not a variable transformer"
- (wrap-4323 e-8584 w-8586 mod-8588)
- (wrap-4323 id-8622 w-8586 id-mod-8625))))
- (if (eqv? key-8627 'displaced-lexical)
+ (wrap-4324 e-8585 w-8587 mod-8589)
+ (wrap-4324 id-8623 w-8587 id-mod-8626))))
+ (if (eqv? key-8628 'displaced-lexical)
(syntax-violation
'set!
"identifier out of context"
- (wrap-4323 id-8622 w-8586 mod-8588))
+ (wrap-4324 id-8623 w-8587 mod-8589))
(syntax-violation
'set!
"bad set!"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-8584) s-8587 #f)
- (set-source-properties! e-8584 s-8587))
- e-8584)
- w-8586
- mod-8588))))))))))
- tmp-8590)
- (let ((tmp-9081
- ($sc-dispatch e-8584 '(_ (any . each-any) any))))
- (if tmp-9081
+ (if (if s-8588
+ (supports-source-properties?
+ e-8585)
+ #f)
+ (set-source-properties! e-8585 s-8588))
+ e-8585)
+ w-8587
+ mod-8589))))))))))
+ tmp-8591)
+ (let ((tmp-9082
+ ($sc-dispatch e-8585 '(_ (any . each-any) any))))
+ (if tmp-9082
(@apply
- (lambda (head-9085 tail-9086 val-9087)
+ (lambda (head-9086 tail-9087 val-9088)
(call-with-values
(lambda ()
- (syntax-type-4329
- head-9085
- r-8585
+ (syntax-type-4330
+ head-9086
+ r-8586
'(())
#f
#f
- mod-8588
+ mod-8589
#t))
- (lambda (type-9090
- value-9091
- formform-9092
- ee-9093
- ww-9094
- ss-9095
- modmod-9096)
- (if (eqv? type-9090 'module-ref)
- (let ((val-9102
- (expand-4330
- val-9087
- r-8585
- w-8586
- mod-8588)))
+ (lambda (type-9091
+ value-9092
+ formform-9093
+ ee-9094
+ ww-9095
+ ss-9096
+ modmod-9097)
+ (if (eqv? type-9091 'module-ref)
+ (let ((val-9103
+ (expand-4331
+ val-9088
+ r-8586
+ w-8587
+ mod-8589)))
(call-with-values
(lambda ()
- (value-9091
- (cons head-9085 tail-9086)
- r-8585
- w-8586))
- (lambda (e-9103 r-9104 w-9105 s*-9106 mod-9107)
- (let ((tmp-9109 (list e-9103)))
+ (value-9092
+ (cons head-9086 tail-9087)
+ r-8586
+ w-8587))
+ (lambda (e-9104 r-9105 w-9106 s*-9107 mod-9108)
+ (let ((tmp-9110 (list e-9104)))
(if (@apply
- (lambda (e-9111)
- (if (symbol? e-9111)
+ (lambda (e-9112)
+ (if (symbol? e-9112)
#t
- (if (if (vector? e-9111)
+ (if (if (vector? e-9112)
(if (= (vector-length
- e-9111)
+ e-9112)
4)
(eq? (vector-ref
- e-9111
+ e-9112
0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref e-9111 1))
+ (symbol? (vector-ref e-9112 1))
#f)))
- tmp-9109)
+ tmp-9110)
(@apply
- (lambda (e-9141)
- (build-global-assignment-4268
- s-8587
- (syntax->datum e-9141)
- val-9102
- mod-9107))
- tmp-9109)
+ (lambda (e-9142)
+ (build-global-assignment-4269
+ s-8588
+ (syntax->datum e-9142)
+ val-9103
+ mod-9108))
+ tmp-9110)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-9103))))))
- (build-application-4261
- s-8587
- (let ((e-9366
+ e-9104))))))
+ (build-application-4262
+ s-8588
+ (let ((e-9367
(list '#(syntax-object
setter
((top)
#(ribcage () () ())
#(ribcage
#(key)
- #((m-*-3553 top))
- #("l-*-3554"))
+ #((m-*-3554 top))
+ #("l-*-3555"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -9306,19 +9369,19 @@
(top)
(top)
(top))
- #("l-*-3546"
- "l-*-3547"
+ #("l-*-3547"
"l-*-3548"
"l-*-3549"
"l-*-3550"
"l-*-3551"
- "l-*-3552"))
+ "l-*-3552"
+ "l-*-3553"))
#(ribcage
#(head tail val)
#((top) (top) (top))
- #("l-*-3531"
- "l-*-3532"
- "l-*-3533"))
+ #("l-*-3532"
+ "l-*-3533"
+ "l-*-3534"))
#(ribcage () () ())
#(ribcage
#(e r w s mod)
@@ -9327,11 +9390,11 @@
(top)
(top)
(top))
- #("l-*-3500"
- "l-*-3501"
+ #("l-*-3501"
"l-*-3502"
"l-*-3503"
- "l-*-3504"))
+ "l-*-3504"
+ "l-*-3505"))
#(ribcage
(lambda-var-list
gen-var
@@ -9762,103 +9825,105 @@
"l-*-46"
"l-*-45")))
(hygiene guile))
- head-9085)))
+ head-9086)))
(call-with-values
(lambda ()
- (syntax-type-4329
- e-9366
- r-8585
- w-8586
- (source-annotation-4287 e-9366)
+ (syntax-type-4330
+ e-9367
+ r-8586
+ w-8587
+ (source-annotation-4288 e-9367)
#f
- mod-8588
+ mod-8589
#f))
- (lambda (type-9373
- value-9374
- form-9375
- e-9376
- w-9377
- s-9378
- mod-9379)
- (expand-expr-4331
- type-9373
- value-9374
- form-9375
- e-9376
- r-8585
- w-9377
- s-9378
- mod-9379))))
- (map (lambda (e-9383)
+ (lambda (type-9374
+ value-9375
+ form-9376
+ e-9377
+ w-9378
+ s-9379
+ mod-9380)
+ (expand-expr-4332
+ type-9374
+ value-9375
+ form-9376
+ e-9377
+ r-8586
+ w-9378
+ s-9379
+ mod-9380))))
+ (map (lambda (e-9384)
(call-with-values
(lambda ()
- (syntax-type-4329
- e-9383
- r-8585
- w-8586
- (source-annotation-4287 e-9383)
+ (syntax-type-4330
+ e-9384
+ r-8586
+ w-8587
+ (source-annotation-4288 e-9384)
#f
- mod-8588
+ mod-8589
#f))
- (lambda (type-9398
- value-9399
- form-9400
- e-9401
- w-9402
- s-9403
- mod-9404)
- (expand-expr-4331
- type-9398
- value-9399
- form-9400
- e-9401
- r-8585
- w-9402
- s-9403
- mod-9404))))
- (append tail-9086 (list val-9087))))))))
- tmp-9081)
+ (lambda (type-9399
+ value-9400
+ form-9401
+ e-9402
+ w-9403
+ s-9404
+ mod-9405)
+ (expand-expr-4332
+ type-9399
+ value-9400
+ form-9401
+ e-9402
+ r-8586
+ w-9403
+ s-9404
+ mod-9405))))
+ (append tail-9087 (list val-9088))))))))
+ tmp-9082)
(syntax-violation
'set!
"bad set!"
- (wrap-4323
+ (wrap-4324
(begin
- (if (if (pair? e-8584) s-8587 #f)
- (set-source-properties! e-8584 s-8587))
- e-8584)
- w-8586
- mod-8588))))))))
+ (if (if s-8588
+ (supports-source-properties? e-8585)
+ #f)
+ (set-source-properties! e-8585 s-8588))
+ e-8585)
+ w-8587
+ mod-8589))))))))
(module-define!
(current-module)
'@
(make-syntax-transformer
'@
'module-ref
- (lambda (e-9447 r-9448 w-9449)
- (let ((tmp-9451
- ($sc-dispatch e-9447 '(_ each-any any))))
- (if (if tmp-9451
+ (lambda (e-9448 r-9449 w-9450)
+ (let ((tmp-9452
+ ($sc-dispatch e-9448 '(_ each-any any))))
+ (if (if tmp-9452
(@apply
- (lambda (mod-9454 id-9455)
- (if (and-map id?-4294 mod-9454)
- (if (symbol? id-9455)
+ (lambda (mod-9455 id-9456)
+ (if (and-map id?-4295 mod-9455)
+ (if (symbol? id-9456)
#t
- (if (if (vector? id-9455)
- (if (= (vector-length id-9455) 4)
- (eq? (vector-ref id-9455 0) 'syntax-object)
+ (if (if (vector? id-9456)
+ (if (= (vector-length id-9456) 4)
+ (eq? (vector-ref id-9456 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-9455 1))
+ (symbol? (vector-ref id-9456 1))
#f))
#f))
- tmp-9451)
+ tmp-9452)
#f)
(@apply
- (lambda (mod-9495 id-9496)
+ (lambda (mod-9496 id-9497)
(values
- (syntax->datum id-9496)
- r-9448
- w-9449
+ (syntax->datum id-9497)
+ r-9449
+ w-9450
#f
(syntax->datum
(cons '#(syntax-object
@@ -9867,12 +9932,12 @@
#(ribcage
#(mod id)
#((top) (top))
- #("l-*-3595" "l-*-3596"))
+ #("l-*-3596" "l-*-3597"))
#(ribcage () () ())
#(ribcage
#(e r w)
#((top) (top) (top))
- #("l-*-3583" "l-*-3584" "l-*-3585"))
+ #("l-*-3584" "l-*-3585" "l-*-3586"))
#(ribcage
(lambda-var-list
gen-var
@@ -10301,64 +10366,64 @@
((top) (top) (top))
("l-*-47" "l-*-46" "l-*-45")))
(hygiene guile))
- mod-9495))))
- tmp-9451)
+ mod-9496))))
+ tmp-9452)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-9447))))))
- (global-extend-4292
+ e-9448))))))
+ (global-extend-4293
'module-ref
'@@
- (lambda (e-9588 r-9589 w-9590)
+ (lambda (e-9589 r-9590 w-9591)
(letrec*
- ((remodulate-9591
- (lambda (x-9626 mod-9627)
- (if (pair? x-9626)
- (cons (remodulate-9591 (car x-9626) mod-9627)
- (remodulate-9591 (cdr x-9626) mod-9627))
- (if (if (vector? x-9626)
- (if (= (vector-length x-9626) 4)
- (eq? (vector-ref x-9626 0) 'syntax-object)
+ ((remodulate-9592
+ (lambda (x-9627 mod-9628)
+ (if (pair? x-9627)
+ (cons (remodulate-9592 (car x-9627) mod-9628)
+ (remodulate-9592 (cdr x-9627) mod-9628))
+ (if (if (vector? x-9627)
+ (if (= (vector-length x-9627) 4)
+ (eq? (vector-ref x-9627 0) 'syntax-object)
#f)
#f)
- (let ((expression-9641
- (remodulate-9591 (vector-ref x-9626 1) mod-9627))
- (wrap-9642 (vector-ref x-9626 2)))
+ (let ((expression-9642
+ (remodulate-9592 (vector-ref x-9627 1) mod-9628))
+ (wrap-9643 (vector-ref x-9627 2)))
(vector
'syntax-object
- expression-9641
- wrap-9642
- mod-9627))
- (if (vector? x-9626)
- (let ((n-9650 (vector-length x-9626)))
- (let ((v-9651 (make-vector n-9650)))
+ expression-9642
+ wrap-9643
+ mod-9628))
+ (if (vector? x-9627)
+ (let ((n-9651 (vector-length x-9627)))
+ (let ((v-9652 (make-vector n-9651)))
(letrec*
- ((loop-9652
- (lambda (i-9699)
- (if (= i-9699 n-9650)
- v-9651
+ ((loop-9653
+ (lambda (i-9700)
+ (if (= i-9700 n-9651)
+ v-9652
(begin
(vector-set!
- v-9651
- i-9699
- (remodulate-9591
- (vector-ref x-9626 i-9699)
- mod-9627))
- (loop-9652 (#{1+}# i-9699)))))))
- (loop-9652 0))))
- x-9626))))))
- (let ((tmp-9593
- ($sc-dispatch e-9588 '(_ each-any any))))
- (if (if tmp-9593
+ v-9652
+ i-9700
+ (remodulate-9592
+ (vector-ref x-9627 i-9700)
+ mod-9628))
+ (loop-9653 (#{1+}# i-9700)))))))
+ (loop-9653 0))))
+ x-9627))))))
+ (let ((tmp-9594
+ ($sc-dispatch e-9589 '(_ each-any any))))
+ (if (if tmp-9594
(@apply
- (lambda (mod-9597 exp-9598)
- (and-map id?-4294 mod-9597))
- tmp-9593)
+ (lambda (mod-9598 exp-9599)
+ (and-map id?-4295 mod-9598))
+ tmp-9594)
#f)
(@apply
- (lambda (mod-9614 exp-9615)
- (let ((mod-9616
+ (lambda (mod-9615 exp-9616)
+ (let ((mod-9617
(syntax->datum
(cons '#(syntax-object
private
@@ -10366,15 +10431,15 @@
#(ribcage
#(mod exp)
#((top) (top))
- #("l-*-3633" "l-*-3634"))
+ #("l-*-3634" "l-*-3635"))
#(ribcage
(remodulate)
((top))
- ("l-*-3606"))
+ ("l-*-3607"))
#(ribcage
#(e r w)
#((top) (top) (top))
- #("l-*-3603" "l-*-3604" "l-*-3605"))
+ #("l-*-3604" "l-*-3605" "l-*-3606"))
#(ribcage
(lambda-var-list
gen-var
@@ -10803,85 +10868,87 @@
((top) (top) (top))
("l-*-47" "l-*-46" "l-*-45")))
(hygiene guile))
- mod-9614))))
+ mod-9615))))
(values
- (remodulate-9591 exp-9615 mod-9616)
- r-9589
- w-9590
- (source-annotation-4287 exp-9615)
- mod-9616)))
- tmp-9593)
+ (remodulate-9592 exp-9616 mod-9617)
+ r-9590
+ w-9591
+ (source-annotation-4288 exp-9616)
+ mod-9617)))
+ tmp-9594)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-9588))))))
- (global-extend-4292
+ e-9589))))))
+ (global-extend-4293
'core
'if
- (lambda (e-9800 r-9801 w-9802 s-9803 mod-9804)
- (let ((tmp-9806 ($sc-dispatch e-9800 '(_ any any))))
- (if tmp-9806
+ (lambda (e-9801 r-9802 w-9803 s-9804 mod-9805)
+ (let ((tmp-9807 ($sc-dispatch e-9801 '(_ any any))))
+ (if tmp-9807
(@apply
- (lambda (test-9810 then-9811)
- (build-conditional-4262
- s-9803
- (expand-4330 test-9810 r-9801 w-9802 mod-9804)
- (expand-4330 then-9811 r-9801 w-9802 mod-9804)
+ (lambda (test-9811 then-9812)
+ (build-conditional-4263
+ s-9804
+ (expand-4331 test-9811 r-9802 w-9803 mod-9805)
+ (expand-4331 then-9812 r-9802 w-9803 mod-9805)
(make-struct/no-tail
(vector-ref %expanded-vtables 0)
#f)))
- tmp-9806)
- (let ((tmp-10036
- ($sc-dispatch e-9800 '(_ any any any))))
- (if tmp-10036
+ tmp-9807)
+ (let ((tmp-10037
+ ($sc-dispatch e-9801 '(_ any any any))))
+ (if tmp-10037
(@apply
- (lambda (test-10040 then-10041 else-10042)
- (build-conditional-4262
- s-9803
- (expand-4330 test-10040 r-9801 w-9802 mod-9804)
- (expand-4330 then-10041 r-9801 w-9802 mod-9804)
- (expand-4330 else-10042 r-9801 w-9802 mod-9804)))
- tmp-10036)
+ (lambda (test-10041 then-10042 else-10043)
+ (build-conditional-4263
+ s-9804
+ (expand-4331 test-10041 r-9802 w-9803 mod-9805)
+ (expand-4331 then-10042 r-9802 w-9803 mod-9805)
+ (expand-4331 else-10043 r-9802 w-9803 mod-9805)))
+ tmp-10037)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-9800)))))))
- (global-extend-4292
+ e-9801)))))))
+ (global-extend-4293
'core
'with-fluids
- (lambda (e-10441 r-10442 w-10443 s-10444 mod-10445)
- (let ((tmp-10447
+ (lambda (e-10442 r-10443 w-10444 s-10445 mod-10446)
+ (let ((tmp-10448
($sc-dispatch
- e-10441
+ e-10442
'(_ #(each (any any)) any . each-any))))
- (if tmp-10447
+ (if tmp-10448
(@apply
- (lambda (fluid-10451 val-10452 b-10453 b*-10454)
- (build-dynlet-4263
- s-10444
- (map (lambda (x-10535)
- (expand-4330 x-10535 r-10442 w-10443 mod-10445))
- fluid-10451)
- (map (lambda (x-10605)
- (expand-4330 x-10605 r-10442 w-10443 mod-10445))
- val-10452)
- (expand-body-4334
- (cons b-10453 b*-10454)
- (wrap-4323
+ (lambda (fluid-10452 val-10453 b-10454 b*-10455)
+ (build-dynlet-4264
+ s-10445
+ (map (lambda (x-10536)
+ (expand-4331 x-10536 r-10443 w-10444 mod-10446))
+ fluid-10452)
+ (map (lambda (x-10606)
+ (expand-4331 x-10606 r-10443 w-10444 mod-10446))
+ val-10453)
+ (expand-body-4335
+ (cons b-10454 b*-10455)
+ (wrap-4324
(begin
- (if (if (pair? e-10441) s-10444 #f)
- (set-source-properties! e-10441 s-10444))
- e-10441)
- w-10443
- mod-10445)
- r-10442
- w-10443
- mod-10445)))
- tmp-10447)
+ (if (if s-10445
+ (supports-source-properties? e-10442)
+ #f)
+ (set-source-properties! e-10442 s-10445))
+ e-10442)
+ w-10444
+ mod-10446)
+ r-10443
+ w-10444
+ mod-10446)))
+ tmp-10448)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-10441)))))
+ e-10442)))))
(module-define!
(current-module)
'begin
@@ -10911,60 +10978,60 @@
'eval-when
'eval-when
'()))
- (global-extend-4292
+ (global-extend-4293
'core
'syntax-case
(letrec*
- ((convert-pattern-10973
- (lambda (pattern-12570 keys-12571)
+ ((convert-pattern-10974
+ (lambda (pattern-12571 keys-12572)
(letrec*
- ((cvt*-12572
- (lambda (p*-13196 n-13197 ids-13198)
- (if (not (pair? p*-13196))
- (cvt-12574 p*-13196 n-13197 ids-13198)
+ ((cvt*-12573
+ (lambda (p*-13197 n-13198 ids-13199)
+ (if (not (pair? p*-13197))
+ (cvt-12575 p*-13197 n-13198 ids-13199)
(call-with-values
(lambda ()
- (cvt*-12572 (cdr p*-13196) n-13197 ids-13198))
- (lambda (y-13201 ids-13202)
+ (cvt*-12573 (cdr p*-13197) n-13198 ids-13199))
+ (lambda (y-13202 ids-13203)
(call-with-values
(lambda ()
- (cvt-12574 (car p*-13196) n-13197 ids-13202))
- (lambda (x-13205 ids-13206)
+ (cvt-12575 (car p*-13197) n-13198 ids-13203))
+ (lambda (x-13206 ids-13207)
(values
- (cons x-13205 y-13201)
- ids-13206))))))))
- (v-reverse-12573
- (lambda (x-13207)
+ (cons x-13206 y-13202)
+ ids-13207))))))))
+ (v-reverse-12574
+ (lambda (x-13208)
(letrec*
- ((loop-13208
- (lambda (r-13288 x-13289)
- (if (not (pair? x-13289))
- (values r-13288 x-13289)
- (loop-13208
- (cons (car x-13289) r-13288)
- (cdr x-13289))))))
- (loop-13208 '() x-13207))))
- (cvt-12574
- (lambda (p-12577 n-12578 ids-12579)
- (if (if (symbol? p-12577)
+ ((loop-13209
+ (lambda (r-13289 x-13290)
+ (if (not (pair? x-13290))
+ (values r-13289 x-13290)
+ (loop-13209
+ (cons (car x-13290) r-13289)
+ (cdr x-13290))))))
+ (loop-13209 '() x-13208))))
+ (cvt-12575
+ (lambda (p-12578 n-12579 ids-12580)
+ (if (if (symbol? p-12578)
#t
- (if (if (vector? p-12577)
- (if (= (vector-length p-12577) 4)
- (eq? (vector-ref p-12577 0) 'syntax-object)
+ (if (if (vector? p-12578)
+ (if (= (vector-length p-12578) 4)
+ (eq? (vector-ref p-12578 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref p-12577 1))
+ (symbol? (vector-ref p-12578 1))
#f))
- (if (bound-id-member?-4322 p-12577 keys-12571)
- (values (vector 'free-id p-12577) ids-12579)
- (if (if (eq? (if (if (vector? p-12577)
- (if (= (vector-length p-12577) 4)
- (eq? (vector-ref p-12577 0)
+ (if (bound-id-member?-4323 p-12578 keys-12572)
+ (values (vector 'free-id p-12578) ids-12580)
+ (if (if (eq? (if (if (vector? p-12578)
+ (if (= (vector-length p-12578) 4)
+ (eq? (vector-ref p-12578 0)
'syntax-object)
#f)
#f)
- (vector-ref p-12577 1)
- p-12577)
+ (vector-ref p-12578 1)
+ p-12578)
(if (if (= (vector-length
'#(syntax-object
_
@@ -10973,20 +11040,20 @@
#(ribcage
#(p n ids)
#((top) (top) (top))
- #("l-*-3734"
- "l-*-3735"
- "l-*-3736"))
+ #("l-*-3735"
+ "l-*-3736"
+ "l-*-3737"))
#(ribcage
(cvt v-reverse cvt*)
((top) (top) (top))
- ("l-*-3707"
- "l-*-3705"
- "l-*-3703"))
+ ("l-*-3708"
+ "l-*-3706"
+ "l-*-3704"))
#(ribcage
#(pattern keys)
#((top) (top))
- #("l-*-3701"
- "l-*-3702"))
+ #("l-*-3702"
+ "l-*-3703"))
#(ribcage
(gen-syntax-case
gen-clause
@@ -10996,10 +11063,10 @@
(top)
(top)
(top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -11441,29 +11508,29 @@
#(ribcage
#(p n ids)
#((top) (top) (top))
- #("l-*-3734"
- "l-*-3735"
- "l-*-3736"))
+ #("l-*-3735"
+ "l-*-3736"
+ "l-*-3737"))
#(ribcage
(cvt v-reverse cvt*)
((top) (top) (top))
- ("l-*-3707"
- "l-*-3705"
- "l-*-3703"))
+ ("l-*-3708"
+ "l-*-3706"
+ "l-*-3704"))
#(ribcage
#(pattern keys)
#((top) (top))
- #("l-*-3701" "l-*-3702"))
+ #("l-*-3702" "l-*-3703"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -11892,8 +11959,8 @@
((top) (top) (top))
("l-*-47" "l-*-46" "l-*-45")))
(hygiene guile))))
- (eq? (id-var-name-4313 p-12577 '(()))
- (id-var-name-4313
+ (eq? (id-var-name-4314 p-12578 '(()))
+ (id-var-name-4314
'#(syntax-object
_
((top)
@@ -11901,29 +11968,29 @@
#(ribcage
#(p n ids)
#((top) (top) (top))
- #("l-*-3734"
- "l-*-3735"
- "l-*-3736"))
+ #("l-*-3735"
+ "l-*-3736"
+ "l-*-3737"))
#(ribcage
(cvt v-reverse cvt*)
((top) (top) (top))
- ("l-*-3707"
- "l-*-3705"
- "l-*-3703"))
+ ("l-*-3708"
+ "l-*-3706"
+ "l-*-3704"))
#(ribcage
#(pattern keys)
#((top) (top))
- #("l-*-3701" "l-*-3702"))
+ #("l-*-3702" "l-*-3703"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -12354,35 +12421,35 @@
(hygiene guile))
'(())))
#f)
- (values '_ ids-12579)
+ (values '_ ids-12580)
(values
'any
- (cons (cons p-12577 n-12578) ids-12579))))
- (let ((tmp-12899 ($sc-dispatch p-12577 '(any any))))
- (if (if tmp-12899
+ (cons (cons p-12578 n-12579) ids-12580))))
+ (let ((tmp-12900 ($sc-dispatch p-12578 '(any any))))
+ (if (if tmp-12900
(@apply
- (lambda (x-12903 dots-12904)
- (if (if (if (vector? dots-12904)
- (if (= (vector-length dots-12904)
+ (lambda (x-12904 dots-12905)
+ (if (if (if (vector? dots-12905)
+ (if (= (vector-length dots-12905)
4)
- (eq? (vector-ref dots-12904 0)
+ (eq? (vector-ref dots-12905 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref dots-12904 1))
+ (symbol? (vector-ref dots-12905 1))
#f)
- (if (eq? (if (if (vector? dots-12904)
+ (if (eq? (if (if (vector? dots-12905)
(if (= (vector-length
- dots-12904)
+ dots-12905)
4)
(eq? (vector-ref
- dots-12904
+ dots-12905
0)
'syntax-object)
#f)
#f)
- (vector-ref dots-12904 1)
- dots-12904)
+ (vector-ref dots-12905 1)
+ dots-12905)
(if (if (= (vector-length
'#(syntax-object
...
@@ -12398,7 +12465,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -12844,7 +12911,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -13275,10 +13342,10 @@
"l-*-46"
"l-*-45")))
(hygiene guile))))
- (eq? (id-var-name-4313
- dots-12904
+ (eq? (id-var-name-4314
+ dots-12905
'(()))
- (id-var-name-4313
+ (id-var-name-4314
'#(syntax-object
...
((top)
@@ -13287,7 +13354,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -13721,53 +13788,53 @@
'(())))
#f)
#f))
- tmp-12899)
+ tmp-12900)
#f)
(@apply
- (lambda (x-13004 dots-13005)
+ (lambda (x-13005 dots-13006)
(call-with-values
(lambda ()
- (cvt-12574
- x-13004
- (#{1+}# n-12578)
- ids-12579))
- (lambda (p-13006 ids-13007)
+ (cvt-12575
+ x-13005
+ (#{1+}# n-12579)
+ ids-12580))
+ (lambda (p-13007 ids-13008)
(values
- (if (eq? p-13006 'any)
+ (if (eq? p-13007 'any)
'each-any
- (vector 'each p-13006))
- ids-13007))))
- tmp-12899)
- (let ((tmp-13008
- ($sc-dispatch p-12577 '(any any . any))))
- (if (if tmp-13008
+ (vector 'each p-13007))
+ ids-13008))))
+ tmp-12900)
+ (let ((tmp-13009
+ ($sc-dispatch p-12578 '(any any . any))))
+ (if (if tmp-13009
(@apply
- (lambda (x-13012 dots-13013 ys-13014)
- (if (if (if (vector? dots-13013)
+ (lambda (x-13013 dots-13014 ys-13015)
+ (if (if (if (vector? dots-13014)
(if (= (vector-length
- dots-13013)
+ dots-13014)
4)
(eq? (vector-ref
- dots-13013
+ dots-13014
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref dots-13013 1))
+ (vector-ref dots-13014 1))
#f)
- (if (eq? (if (if (vector? dots-13013)
+ (if (eq? (if (if (vector? dots-13014)
(if (= (vector-length
- dots-13013)
+ dots-13014)
4)
(eq? (vector-ref
- dots-13013
+ dots-13014
0)
'syntax-object)
#f)
#f)
- (vector-ref dots-13013 1)
- dots-13013)
+ (vector-ref dots-13014 1)
+ dots-13014)
(if (if (= (vector-length
'#(syntax-object
...
@@ -13783,7 +13850,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -14229,7 +14296,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -14660,10 +14727,10 @@
"l-*-46"
"l-*-45")))
(hygiene guile))))
- (eq? (id-var-name-4313
- dots-13013
+ (eq? (id-var-name-4314
+ dots-13014
'(()))
- (id-var-name-4313
+ (id-var-name-4314
'#(syntax-object
...
((top)
@@ -14672,7 +14739,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -15106,97 +15173,97 @@
'(())))
#f)
#f))
- tmp-13008)
+ tmp-13009)
#f)
(@apply
- (lambda (x-13114 dots-13115 ys-13116)
+ (lambda (x-13115 dots-13116 ys-13117)
(call-with-values
(lambda ()
- (cvt*-12572
- ys-13116
- n-12578
- ids-12579))
- (lambda (ys-13119 ids-13120)
+ (cvt*-12573
+ ys-13117
+ n-12579
+ ids-12580))
+ (lambda (ys-13120 ids-13121)
(call-with-values
(lambda ()
- (cvt-12574
- x-13114
- (#{1+}# n-12578)
- ids-13120))
- (lambda (x-13121 ids-13122)
+ (cvt-12575
+ x-13115
+ (#{1+}# n-12579)
+ ids-13121))
+ (lambda (x-13122 ids-13123)
(call-with-values
(lambda ()
- (v-reverse-12573 ys-13119))
- (lambda (ys-13155 e-13156)
+ (v-reverse-12574 ys-13120))
+ (lambda (ys-13156 e-13157)
(values
(vector
'each+
- x-13121
- ys-13155
- e-13156)
- ids-13122))))))))
- tmp-13008)
- (let ((tmp-13157
- ($sc-dispatch p-12577 '(any . any))))
- (if tmp-13157
+ x-13122
+ ys-13156
+ e-13157)
+ ids-13123))))))))
+ tmp-13009)
+ (let ((tmp-13158
+ ($sc-dispatch p-12578 '(any . any))))
+ (if tmp-13158
(@apply
- (lambda (x-13161 y-13162)
+ (lambda (x-13162 y-13163)
(call-with-values
(lambda ()
- (cvt-12574
- y-13162
- n-12578
- ids-12579))
- (lambda (y-13163 ids-13164)
+ (cvt-12575
+ y-13163
+ n-12579
+ ids-12580))
+ (lambda (y-13164 ids-13165)
(call-with-values
(lambda ()
- (cvt-12574
- x-13161
- n-12578
- ids-13164))
- (lambda (x-13165 ids-13166)
+ (cvt-12575
+ x-13162
+ n-12579
+ ids-13165))
+ (lambda (x-13166 ids-13167)
(values
- (cons x-13165 y-13163)
- ids-13166))))))
- tmp-13157)
- (let ((tmp-13167
- ($sc-dispatch p-12577 '())))
- (if tmp-13167
+ (cons x-13166 y-13164)
+ ids-13167))))))
+ tmp-13158)
+ (let ((tmp-13168
+ ($sc-dispatch p-12578 '())))
+ (if tmp-13168
(@apply
- (lambda () (values '() ids-12579))
- tmp-13167)
- (let ((tmp-13171
+ (lambda () (values '() ids-12580))
+ tmp-13168)
+ (let ((tmp-13172
($sc-dispatch
- p-12577
+ p-12578
'#(vector each-any))))
- (if tmp-13171
+ (if tmp-13172
(@apply
- (lambda (x-13175)
+ (lambda (x-13176)
(call-with-values
(lambda ()
- (cvt-12574
- x-13175
- n-12578
- ids-12579))
- (lambda (p-13176 ids-13177)
+ (cvt-12575
+ x-13176
+ n-12579
+ ids-12580))
+ (lambda (p-13177 ids-13178)
(values
- (vector 'vector p-13176)
- ids-13177))))
- tmp-13171)
+ (vector 'vector p-13177)
+ ids-13178))))
+ tmp-13172)
(values
(vector
'atom
- (strip-4343 p-12577 '(())))
- ids-12579)))))))))))))))
- (cvt-12574 pattern-12570 0 '()))))
- (build-dispatch-call-10974
- (lambda (pvars-13290 exp-13291 y-13292 r-13293 mod-13294)
- (let ((ids-13295 (map car pvars-13290)))
+ (strip-4344 p-12578 '(())))
+ ids-12580)))))))))))))))
+ (cvt-12575 pattern-12571 0 '()))))
+ (build-dispatch-call-10975
+ (lambda (pvars-13291 exp-13292 y-13293 r-13294 mod-13295)
+ (let ((ids-13296 (map car pvars-13291)))
(begin
- (map cdr pvars-13290)
- (let ((labels-13297 (gen-labels-4297 ids-13295))
- (new-vars-13298 (map gen-var-4344 ids-13295)))
- (build-application-4261
+ (map cdr pvars-13291)
+ (let ((labels-13298 (gen-labels-4298 ids-13296))
+ (new-vars-13299 (map gen-var-4345 ids-13296)))
+ (build-application-4262
#f
(if (equal? (module-name (current-module)) '(guile))
(make-struct/no-tail
@@ -15209,73 +15276,73 @@
'(guile)
'apply
#f))
- (list (build-simple-lambda-4270
+ (list (build-simple-lambda-4271
#f
- (map syntax->datum ids-13295)
+ (map syntax->datum ids-13296)
#f
- new-vars-13298
+ new-vars-13299
'()
- (expand-4330
- exp-13291
- (extend-env-4288
- labels-13297
- (map (lambda (var-13621 level-13622)
+ (expand-4331
+ exp-13292
+ (extend-env-4289
+ labels-13298
+ (map (lambda (var-13622 level-13623)
(cons 'syntax
- (cons var-13621 level-13622)))
- new-vars-13298
- (map cdr pvars-13290))
- r-13293)
- (make-binding-wrap-4308
- ids-13295
- labels-13297
+ (cons var-13622 level-13623)))
+ new-vars-13299
+ (map cdr pvars-13291))
+ r-13294)
+ (make-binding-wrap-4309
+ ids-13296
+ labels-13298
'(()))
- mod-13294))
- y-13292)))))))
- (gen-clause-10975
- (lambda (x-11942
- keys-11943
- clauses-11944
- r-11945
- pat-11946
- fender-11947
- exp-11948
- mod-11949)
+ mod-13295))
+ y-13293)))))))
+ (gen-clause-10976
+ (lambda (x-11943
+ keys-11944
+ clauses-11945
+ r-11946
+ pat-11947
+ fender-11948
+ exp-11949
+ mod-11950)
(call-with-values
(lambda ()
- (convert-pattern-10973 pat-11946 keys-11943))
- (lambda (p-12104 pvars-12105)
- (if (not (distinct-bound-ids?-4321 (map car pvars-12105)))
+ (convert-pattern-10974 pat-11947 keys-11944))
+ (lambda (p-12105 pvars-12106)
+ (if (not (distinct-bound-ids?-4322 (map car pvars-12106)))
(syntax-violation
'syntax-case
"duplicate pattern variable"
- pat-11946)
+ pat-11947)
(if (not (and-map
- (lambda (x-12221)
- (not (let ((x-12225 (car x-12221)))
- (if (if (if (vector? x-12225)
+ (lambda (x-12222)
+ (not (let ((x-12226 (car x-12222)))
+ (if (if (if (vector? x-12226)
(if (= (vector-length
- x-12225)
+ x-12226)
4)
(eq? (vector-ref
- x-12225
+ x-12226
0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-12225 1))
+ (symbol? (vector-ref x-12226 1))
#f)
- (if (eq? (if (if (vector? x-12225)
+ (if (eq? (if (if (vector? x-12226)
(if (= (vector-length
- x-12225)
+ x-12226)
4)
(eq? (vector-ref
- x-12225
+ x-12226
0)
'syntax-object)
#f)
#f)
- (vector-ref x-12225 1)
- x-12225)
+ (vector-ref x-12226 1)
+ x-12226)
(if (if (= (vector-length
'#(syntax-object
...
@@ -15291,7 +15358,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -15737,7 +15804,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -16168,10 +16235,10 @@
"l-*-46"
"l-*-45")))
(hygiene guile))))
- (eq? (id-var-name-4313
- x-12225
+ (eq? (id-var-name-4314
+ x-12226
'(()))
- (id-var-name-4313
+ (id-var-name-4314
'#(syntax-object
...
((top)
@@ -16180,7 +16247,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -16614,42 +16681,42 @@
'(())))
#f)
#f))))
- pvars-12105))
+ pvars-12106))
(syntax-violation
'syntax-case
"misplaced ellipsis"
- pat-11946)
- (let ((y-12301
+ pat-11947)
+ (let ((y-12302
(gensym
(string-append (symbol->string 'tmp) "-"))))
- (build-application-4261
+ (build-application-4262
#f
- (let ((req-12444 (list 'tmp))
- (vars-12446 (list y-12301))
- (exp-12448
- (let ((y-12465
+ (let ((req-12445 (list 'tmp))
+ (vars-12447 (list y-12302))
+ (exp-12449
+ (let ((y-12466
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
#f
'tmp
- y-12301)))
- (let ((test-exp-12469
- (let ((tmp-12478
+ y-12302)))
+ (let ((test-exp-12470
+ (let ((tmp-12479
($sc-dispatch
- fender-11947
+ fender-11948
'#(atom #t))))
- (if tmp-12478
+ (if tmp-12479
(@apply
- (lambda () y-12465)
- tmp-12478)
- (let ((then-exp-12496
- (build-dispatch-call-10974
- pvars-12105
- fender-11947
- y-12465
- r-11945
- mod-11949))
- (else-exp-12497
+ (lambda () y-12466)
+ tmp-12479)
+ (let ((then-exp-12497
+ (build-dispatch-call-10975
+ pvars-12106
+ fender-11948
+ y-12466
+ r-11946
+ mod-11950))
+ (else-exp-12498
(make-struct/no-tail
(vector-ref
%expanded-vtables
@@ -16661,48 +16728,48 @@
%expanded-vtables
10)
#f
- y-12465
- then-exp-12496
- else-exp-12497)))))
- (then-exp-12470
- (build-dispatch-call-10974
- pvars-12105
- exp-11948
- y-12465
- r-11945
- mod-11949))
- (else-exp-12471
- (gen-syntax-case-10976
- x-11942
- keys-11943
- clauses-11944
- r-11945
- mod-11949)))
+ y-12466
+ then-exp-12497
+ else-exp-12498)))))
+ (then-exp-12471
+ (build-dispatch-call-10975
+ pvars-12106
+ exp-11949
+ y-12466
+ r-11946
+ mod-11950))
+ (else-exp-12472
+ (gen-syntax-case-10977
+ x-11943
+ keys-11944
+ clauses-11945
+ r-11946
+ mod-11950)))
(make-struct/no-tail
(vector-ref %expanded-vtables 10)
#f
- test-exp-12469
- then-exp-12470
- else-exp-12471)))))
- (let ((body-12453
+ test-exp-12470
+ then-exp-12471
+ else-exp-12472)))))
+ (let ((body-12454
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
#f
- req-12444
+ req-12445
#f
#f
#f
'()
- vars-12446
- exp-12448
+ vars-12447
+ exp-12449
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
#f
'()
- body-12453)))
- (list (if (eq? p-12104 'any)
- (let ((fun-exp-12519
+ body-12454)))
+ (list (if (eq? p-12105 'any)
+ (let ((fun-exp-12520
(if (equal?
(module-name (current-module))
'(guile))
@@ -16716,13 +16783,13 @@
'(guile)
'list
#f)))
- (arg-exps-12520 (list x-11942)))
+ (arg-exps-12521 (list x-11943)))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
#f
- fun-exp-12519
- arg-exps-12520))
- (let ((fun-exp-12543
+ fun-exp-12520
+ arg-exps-12521))
+ (let ((fun-exp-12544
(if (equal?
(module-name (current-module))
'(guile))
@@ -16736,27 +16803,27 @@
'(guile)
'$sc-dispatch
#f)))
- (arg-exps-12544
- (list x-11942
+ (arg-exps-12545
+ (list x-11943
(make-struct/no-tail
(vector-ref
%expanded-vtables
1)
#f
- p-12104))))
+ p-12105))))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
#f
- fun-exp-12543
- arg-exps-12544))))))))))))
- (gen-syntax-case-10976
- (lambda (x-11375
- keys-11376
- clauses-11377
- r-11378
- mod-11379)
- (if (null? clauses-11377)
- (let ((fun-exp-11384
+ fun-exp-12544
+ arg-exps-12545))))))))))))
+ (gen-syntax-case-10977
+ (lambda (x-11376
+ keys-11377
+ clauses-11378
+ r-11379
+ mod-11380)
+ (if (null? clauses-11378)
+ (let ((fun-exp-11385
(if (equal? (module-name (current-module)) '(guile))
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
@@ -16768,7 +16835,7 @@
'(guile)
'syntax-violation
#f)))
- (arg-exps-11385
+ (arg-exps-11386
(list (make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
@@ -16777,58 +16844,58 @@
(vector-ref %expanded-vtables 1)
#f
"source expression failed to match any pattern")
- x-11375)))
+ x-11376)))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
#f
- fun-exp-11384
- arg-exps-11385))
- (let ((tmp-11418 (car clauses-11377)))
- (let ((tmp-11419 ($sc-dispatch tmp-11418 '(any any))))
- (if tmp-11419
+ fun-exp-11385
+ arg-exps-11386))
+ (let ((tmp-11419 (car clauses-11378)))
+ (let ((tmp-11420 ($sc-dispatch tmp-11419 '(any any))))
+ (if tmp-11420
(@apply
- (lambda (pat-11421 exp-11422)
- (if (if (if (symbol? pat-11421)
+ (lambda (pat-11422 exp-11423)
+ (if (if (if (symbol? pat-11422)
#t
- (if (if (vector? pat-11421)
- (if (= (vector-length pat-11421) 4)
- (eq? (vector-ref pat-11421 0)
+ (if (if (vector? pat-11422)
+ (if (= (vector-length pat-11422) 4)
+ (eq? (vector-ref pat-11422 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref pat-11421 1))
+ (symbol? (vector-ref pat-11422 1))
#f))
(and-map
- (lambda (x-11449)
- (not (if (eq? (if (if (vector? pat-11421)
+ (lambda (x-11450)
+ (not (if (eq? (if (if (vector? pat-11422)
(if (= (vector-length
- pat-11421)
+ pat-11422)
4)
(eq? (vector-ref
- pat-11421
+ pat-11422
0)
'syntax-object)
#f)
#f)
- (vector-ref pat-11421 1)
- pat-11421)
- (if (if (vector? x-11449)
+ (vector-ref pat-11422 1)
+ pat-11422)
+ (if (if (vector? x-11450)
(if (= (vector-length
- x-11449)
+ x-11450)
4)
(eq? (vector-ref
- x-11449
+ x-11450
0)
'syntax-object)
#f)
#f)
- (vector-ref x-11449 1)
- x-11449))
- (eq? (id-var-name-4313
- pat-11421
+ (vector-ref x-11450 1)
+ x-11450))
+ (eq? (id-var-name-4314
+ pat-11422
'(()))
- (id-var-name-4313
- x-11449
+ (id-var-name-4314
+ x-11450
'(())))
#f)))
(cons '#(syntax-object
@@ -16837,26 +16904,26 @@
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3890" "l-*-3891"))
+ #("l-*-3891" "l-*-3892"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
#((top) (top) (top) (top) (top))
- #("l-*-3879"
- "l-*-3880"
+ #("l-*-3880"
"l-*-3881"
"l-*-3882"
- "l-*-3883"))
+ "l-*-3883"
+ "l-*-3884"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -17285,7 +17352,7 @@
((top) (top) (top))
("l-*-47" "l-*-46" "l-*-45")))
(hygiene guile))
- keys-11376))
+ keys-11377))
#f)
(if (if (eq? (if (if (= (vector-length
'#(syntax-object
@@ -17294,8 +17361,8 @@
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3890"
- "l-*-3891"))
+ #("l-*-3891"
+ "l-*-3892"))
#(ribcage () () ())
#(ribcage
#(x
@@ -17308,11 +17375,11 @@
(top)
(top)
(top))
- #("l-*-3879"
- "l-*-3880"
+ #("l-*-3880"
"l-*-3881"
"l-*-3882"
- "l-*-3883"))
+ "l-*-3883"
+ "l-*-3884"))
#(ribcage
(gen-syntax-case
gen-clause
@@ -17322,10 +17389,10 @@
(top)
(top)
(top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -17768,7 +17835,7 @@
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3890" "l-*-3891"))
+ #("l-*-3891" "l-*-3892"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
@@ -17777,21 +17844,21 @@
(top)
(top)
(top))
- #("l-*-3879"
- "l-*-3880"
+ #("l-*-3880"
"l-*-3881"
"l-*-3882"
- "l-*-3883"))
+ "l-*-3883"
+ "l-*-3884"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -18229,8 +18296,8 @@
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3890"
- "l-*-3891"))
+ #("l-*-3891"
+ "l-*-3892"))
#(ribcage () () ())
#(ribcage
#(x
@@ -18243,11 +18310,11 @@
(top)
(top)
(top))
- #("l-*-3879"
- "l-*-3880"
+ #("l-*-3880"
"l-*-3881"
"l-*-3882"
- "l-*-3883"))
+ "l-*-3883"
+ "l-*-3884"))
#(ribcage
(gen-syntax-case
gen-clause
@@ -18257,10 +18324,10 @@
(top)
(top)
(top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -18703,7 +18770,7 @@
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3890" "l-*-3891"))
+ #("l-*-3891" "l-*-3892"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
@@ -18712,21 +18779,21 @@
(top)
(top)
(top))
- #("l-*-3879"
- "l-*-3880"
+ #("l-*-3880"
"l-*-3881"
"l-*-3882"
- "l-*-3883"))
+ "l-*-3883"
+ "l-*-3884"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -19157,14 +19224,14 @@
"l-*-46"
"l-*-45")))
(hygiene guile))))
- (eq? (id-var-name-4313
+ (eq? (id-var-name-4314
'#(syntax-object
pad
((top)
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3890" "l-*-3891"))
+ #("l-*-3891" "l-*-3892"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
@@ -19173,21 +19240,21 @@
(top)
(top)
(top))
- #("l-*-3879"
- "l-*-3880"
+ #("l-*-3880"
"l-*-3881"
"l-*-3882"
- "l-*-3883"))
+ "l-*-3883"
+ "l-*-3884"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -19617,14 +19684,14 @@
("l-*-47" "l-*-46" "l-*-45")))
(hygiene guile))
'(()))
- (id-var-name-4313
+ (id-var-name-4314
'#(syntax-object
_
((top)
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3890" "l-*-3891"))
+ #("l-*-3891" "l-*-3892"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
@@ -19633,21 +19700,21 @@
(top)
(top)
(top))
- #("l-*-3879"
- "l-*-3880"
+ #("l-*-3880"
"l-*-3881"
"l-*-3882"
- "l-*-3883"))
+ "l-*-3883"
+ "l-*-3884"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3697"
- "l-*-3695"
- "l-*-3693"
- "l-*-3691"))
+ ("l-*-3698"
+ "l-*-3696"
+ "l-*-3694"
+ "l-*-3692"))
#(ribcage
(lambda-var-list
gen-var
@@ -20078,129 +20145,131 @@
(hygiene guile))
'(())))
#f)
- (expand-4330 exp-11422 r-11378 '(()) mod-11379)
- (let ((labels-11625
+ (expand-4331 exp-11423 r-11379 '(()) mod-11380)
+ (let ((labels-11626
(list (string-append
"l-"
- (session-id-4255)
+ (session-id-4256)
(symbol->string (gensym "-")))))
- (var-11626
- (let ((id-11664
- (if (if (vector? pat-11421)
+ (var-11627
+ (let ((id-11665
+ (if (if (vector? pat-11422)
(if (= (vector-length
- pat-11421)
+ pat-11422)
4)
(eq? (vector-ref
- pat-11421
+ pat-11422
0)
'syntax-object)
#f)
#f)
- (vector-ref pat-11421 1)
- pat-11421)))
+ (vector-ref pat-11422 1)
+ pat-11422)))
(gensym
(string-append
- (symbol->string id-11664)
+ (symbol->string id-11665)
"-")))))
- (build-application-4261
+ (build-application-4262
#f
- (build-simple-lambda-4270
+ (build-simple-lambda-4271
#f
- (list (syntax->datum pat-11421))
+ (list (syntax->datum pat-11422))
#f
- (list var-11626)
+ (list var-11627)
'()
- (expand-4330
- exp-11422
- (extend-env-4288
- labels-11625
+ (expand-4331
+ exp-11423
+ (extend-env-4289
+ labels-11626
(list (cons 'syntax
- (cons var-11626 0)))
- r-11378)
- (make-binding-wrap-4308
- (list pat-11421)
- labels-11625
+ (cons var-11627 0)))
+ r-11379)
+ (make-binding-wrap-4309
+ (list pat-11422)
+ labels-11626
'(()))
- mod-11379))
- (list x-11375))))
- (gen-clause-10975
- x-11375
- keys-11376
- (cdr clauses-11377)
- r-11378
- pat-11421
+ mod-11380))
+ (list x-11376))))
+ (gen-clause-10976
+ x-11376
+ keys-11377
+ (cdr clauses-11378)
+ r-11379
+ pat-11422
#t
- exp-11422
- mod-11379)))
- tmp-11419)
- (let ((tmp-11934
- ($sc-dispatch tmp-11418 '(any any any))))
- (if tmp-11934
+ exp-11423
+ mod-11380)))
+ tmp-11420)
+ (let ((tmp-11935
+ ($sc-dispatch tmp-11419 '(any any any))))
+ (if tmp-11935
(@apply
- (lambda (pat-11936 fender-11937 exp-11938)
- (gen-clause-10975
- x-11375
- keys-11376
- (cdr clauses-11377)
- r-11378
- pat-11936
- fender-11937
- exp-11938
- mod-11379))
- tmp-11934)
+ (lambda (pat-11937 fender-11938 exp-11939)
+ (gen-clause-10976
+ x-11376
+ keys-11377
+ (cdr clauses-11378)
+ r-11379
+ pat-11937
+ fender-11938
+ exp-11939
+ mod-11380))
+ tmp-11935)
(syntax-violation
'syntax-case
"invalid clause"
- (car clauses-11377)))))))))))
- (lambda (e-10977 r-10978 w-10979 s-10980 mod-10981)
- (let ((e-10982
- (wrap-4323
+ (car clauses-11378)))))))))))
+ (lambda (e-10978 r-10979 w-10980 s-10981 mod-10982)
+ (let ((e-10983
+ (wrap-4324
(begin
- (if (if (pair? e-10977) s-10980 #f)
- (set-source-properties! e-10977 s-10980))
- e-10977)
- w-10979
- mod-10981)))
- (let ((tmp-10984
+ (if (if s-10981
+ (supports-source-properties? e-10978)
+ #f)
+ (set-source-properties! e-10978 s-10981))
+ e-10978)
+ w-10980
+ mod-10982)))
+ (let ((tmp-10985
($sc-dispatch
- e-10982
+ e-10983
'(_ any each-any . each-any))))
- (if tmp-10984
+ (if tmp-10985
(@apply
- (lambda (val-11009 key-11010 m-11011)
+ (lambda (val-11010 key-11011 m-11012)
(if (and-map
- (lambda (x-11012)
- (if (if (symbol? x-11012)
+ (lambda (x-11013)
+ (if (if (symbol? x-11013)
#t
- (if (if (vector? x-11012)
- (if (= (vector-length x-11012) 4)
- (eq? (vector-ref x-11012 0)
+ (if (if (vector? x-11013)
+ (if (= (vector-length x-11013) 4)
+ (eq? (vector-ref x-11013 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-11012 1))
+ (symbol? (vector-ref x-11013 1))
#f))
- (not (if (if (if (vector? x-11012)
- (if (= (vector-length x-11012)
+ (not (if (if (if (vector? x-11013)
+ (if (= (vector-length x-11013)
4)
- (eq? (vector-ref x-11012 0)
+ (eq? (vector-ref x-11013 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-11012 1))
+ (symbol? (vector-ref x-11013 1))
#f)
- (if (eq? (if (if (vector? x-11012)
+ (if (eq? (if (if (vector? x-11013)
(if (= (vector-length
- x-11012)
+ x-11013)
4)
(eq? (vector-ref
- x-11012
+ x-11013
0)
'syntax-object)
#f)
#f)
- (vector-ref x-11012 1)
- x-11012)
+ (vector-ref x-11013 1)
+ x-11013)
(if (if (= (vector-length
'#(syntax-object
...
@@ -20216,7 +20285,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -20662,7 +20731,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -21093,8 +21162,8 @@
"l-*-46"
"l-*-45")))
(hygiene guile))))
- (eq? (id-var-name-4313 x-11012 '(()))
- (id-var-name-4313
+ (eq? (id-var-name-4314 x-11013 '(()))
+ (id-var-name-4314
'#(syntax-object
...
((top)
@@ -21103,7 +21172,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2266"))
+ #("l-*-2267"))
#(ribcage
(lambda-var-list
gen-var
@@ -21538,760 +21607,760 @@
#f)
#f))
#f))
- key-11010)
- (let ((x-11138
+ key-11011)
+ (let ((x-11139
(gensym
(string-append (symbol->string 'tmp) "-"))))
- (build-application-4261
- s-10980
- (let ((req-11268 (list 'tmp))
- (vars-11270 (list x-11138))
- (exp-11272
- (gen-syntax-case-10976
+ (build-application-4262
+ s-10981
+ (let ((req-11269 (list 'tmp))
+ (vars-11271 (list x-11139))
+ (exp-11273
+ (gen-syntax-case-10977
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
#f
'tmp
- x-11138)
- key-11010
- m-11011
- r-10978
- mod-10981)))
- (let ((body-11277
+ x-11139)
+ key-11011
+ m-11012
+ r-10979
+ mod-10982)))
+ (let ((body-11278
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
#f
- req-11268
+ req-11269
#f
#f
#f
'()
- vars-11270
- exp-11272
+ vars-11271
+ exp-11273
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
#f
'()
- body-11277)))
- (list (expand-4330
- val-11009
- r-10978
+ body-11278)))
+ (list (expand-4331
+ val-11010
+ r-10979
'(())
- mod-10981))))
+ mod-10982))))
(syntax-violation
'syntax-case
"invalid literals list"
- e-10982)))
- tmp-10984)
+ e-10983)))
+ tmp-10985)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-10982)))))))
+ e-10983)))))))
(set! macroexpand
(lambda*
- (x-13695
+ (x-13696
#:optional
- (m-13696 'e)
- (esew-13697 '(eval)))
- (expand-top-sequence-4326
- (list x-13695)
+ (m-13697 'e)
+ (esew-13698 '(eval)))
+ (expand-top-sequence-4327
+ (list x-13696)
'()
'((top))
#f
- m-13696
- esew-13697
+ m-13697
+ esew-13698
(cons 'hygiene (module-name (current-module))))))
(set! identifier?
- (lambda (x-13700)
- (if (if (vector? x-13700)
- (if (= (vector-length x-13700) 4)
- (eq? (vector-ref x-13700 0) 'syntax-object)
+ (lambda (x-13701)
+ (if (if (vector? x-13701)
+ (if (= (vector-length x-13701) 4)
+ (eq? (vector-ref x-13701 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-13700 1))
+ (symbol? (vector-ref x-13701 1))
#f)))
(set! datum->syntax
- (lambda (id-13725 datum-13726)
- (let ((wrap-13731 (vector-ref id-13725 2))
- (module-13732 (vector-ref id-13725 3)))
+ (lambda (id-13726 datum-13727)
+ (let ((wrap-13732 (vector-ref id-13726 2))
+ (module-13733 (vector-ref id-13726 3)))
(vector
'syntax-object
- datum-13726
- wrap-13731
- module-13732))))
+ datum-13727
+ wrap-13732
+ module-13733))))
(set! syntax->datum
- (lambda (x-13739) (strip-4343 x-13739 '(()))))
+ (lambda (x-13740) (strip-4344 x-13740 '(()))))
(set! syntax-source
- (lambda (x-13742)
- (source-annotation-4287 x-13742)))
+ (lambda (x-13743)
+ (source-annotation-4288 x-13743)))
(set! generate-temporaries
- (lambda (ls-13895)
+ (lambda (ls-13896)
(begin
- (if (not (list? ls-13895))
+ (if (not (list? ls-13896))
(syntax-violation
'generate-temporaries
"invalid argument"
- ls-13895))
- (let ((mod-13903
+ ls-13896))
+ (let ((mod-13904
(cons 'hygiene (module-name (current-module)))))
- (map (lambda (x-13904)
- (wrap-4323 (gensym "t-") '((top)) mod-13903))
- ls-13895)))))
+ (map (lambda (x-13905)
+ (wrap-4324 (gensym "t-") '((top)) mod-13904))
+ ls-13896)))))
(set! free-identifier=?
- (lambda (x-13908 y-13909)
+ (lambda (x-13909 y-13910)
(begin
- (if (not (if (if (vector? x-13908)
- (if (= (vector-length x-13908) 4)
- (eq? (vector-ref x-13908 0) 'syntax-object)
+ (if (not (if (if (vector? x-13909)
+ (if (= (vector-length x-13909) 4)
+ (eq? (vector-ref x-13909 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-13908 1))
+ (symbol? (vector-ref x-13909 1))
#f))
(syntax-violation
'free-identifier=?
"invalid argument"
- x-13908))
- (if (not (if (if (vector? y-13909)
- (if (= (vector-length y-13909) 4)
- (eq? (vector-ref y-13909 0) 'syntax-object)
+ x-13909))
+ (if (not (if (if (vector? y-13910)
+ (if (= (vector-length y-13910) 4)
+ (eq? (vector-ref y-13910 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref y-13909 1))
+ (symbol? (vector-ref y-13910 1))
#f))
(syntax-violation
'free-identifier=?
"invalid argument"
- y-13909))
- (if (eq? (if (if (vector? x-13908)
- (if (= (vector-length x-13908) 4)
- (eq? (vector-ref x-13908 0) 'syntax-object)
+ y-13910))
+ (if (eq? (if (if (vector? x-13909)
+ (if (= (vector-length x-13909) 4)
+ (eq? (vector-ref x-13909 0) 'syntax-object)
#f)
#f)
- (vector-ref x-13908 1)
- x-13908)
- (if (if (vector? y-13909)
- (if (= (vector-length y-13909) 4)
- (eq? (vector-ref y-13909 0) 'syntax-object)
+ (vector-ref x-13909 1)
+ x-13909)
+ (if (if (vector? y-13910)
+ (if (= (vector-length y-13910) 4)
+ (eq? (vector-ref y-13910 0) 'syntax-object)
#f)
#f)
- (vector-ref y-13909 1)
- y-13909))
- (eq? (id-var-name-4313 x-13908 '(()))
- (id-var-name-4313 y-13909 '(())))
+ (vector-ref y-13910 1)
+ y-13910))
+ (eq? (id-var-name-4314 x-13909 '(()))
+ (id-var-name-4314 y-13910 '(())))
#f))))
(set! bound-identifier=?
- (lambda (x-14059 y-14060)
+ (lambda (x-14060 y-14061)
(begin
- (if (not (if (if (vector? x-14059)
- (if (= (vector-length x-14059) 4)
- (eq? (vector-ref x-14059 0) 'syntax-object)
+ (if (not (if (if (vector? x-14060)
+ (if (= (vector-length x-14060) 4)
+ (eq? (vector-ref x-14060 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-14059 1))
+ (symbol? (vector-ref x-14060 1))
#f))
(syntax-violation
'bound-identifier=?
"invalid argument"
- x-14059))
- (if (not (if (if (vector? y-14060)
- (if (= (vector-length y-14060) 4)
- (eq? (vector-ref y-14060 0) 'syntax-object)
+ x-14060))
+ (if (not (if (if (vector? y-14061)
+ (if (= (vector-length y-14061) 4)
+ (eq? (vector-ref y-14061 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref y-14060 1))
+ (symbol? (vector-ref y-14061 1))
#f))
(syntax-violation
'bound-identifier=?
"invalid argument"
- y-14060))
- (if (if (if (vector? x-14059)
- (if (= (vector-length x-14059) 4)
- (eq? (vector-ref x-14059 0) 'syntax-object)
+ y-14061))
+ (if (if (if (vector? x-14060)
+ (if (= (vector-length x-14060) 4)
+ (eq? (vector-ref x-14060 0) 'syntax-object)
#f)
#f)
- (if (vector? y-14060)
- (if (= (vector-length y-14060) 4)
- (eq? (vector-ref y-14060 0) 'syntax-object)
+ (if (vector? y-14061)
+ (if (= (vector-length y-14061) 4)
+ (eq? (vector-ref y-14061 0) 'syntax-object)
#f)
#f)
#f)
- (if (eq? (vector-ref x-14059 1)
- (vector-ref y-14060 1))
- (same-marks?-4312
- (car (vector-ref x-14059 2))
- (car (vector-ref y-14060 2)))
+ (if (eq? (vector-ref x-14060 1)
+ (vector-ref y-14061 1))
+ (same-marks?-4313
+ (car (vector-ref x-14060 2))
+ (car (vector-ref y-14061 2)))
#f)
- (eq? x-14059 y-14060)))))
+ (eq? x-14060 y-14061)))))
(set! syntax-violation
(lambda*
- (who-14193
- message-14194
- form-14195
+ (who-14194
+ message-14195
+ form-14196
#:optional
- (subform-14196 #f))
+ (subform-14197 #f))
(begin
- (if (not (if (not who-14193)
- (not who-14193)
- (let ((t-14214 (string? who-14193)))
- (if t-14214 t-14214 (symbol? who-14193)))))
+ (if (not (if (not who-14194)
+ (not who-14194)
+ (let ((t-14215 (string? who-14194)))
+ (if t-14215 t-14215 (symbol? who-14194)))))
(syntax-violation
'syntax-violation
"invalid argument"
- who-14193))
- (if (not (string? message-14194))
+ who-14194))
+ (if (not (string? message-14195))
(syntax-violation
'syntax-violation
"invalid argument"
- message-14194))
+ message-14195))
(throw 'syntax-error
- who-14193
- message-14194
- (let ((t-14245 (source-annotation-4287 subform-14196)))
- (if t-14245
- t-14245
- (source-annotation-4287 form-14195)))
- (strip-4343 form-14195 '(()))
- (if subform-14196
- (strip-4343 subform-14196 '(()))
+ who-14194
+ message-14195
+ (let ((t-14246 (source-annotation-4288 subform-14197)))
+ (if t-14246
+ t-14246
+ (source-annotation-4288 form-14196)))
+ (strip-4344 form-14196 '(()))
+ (if subform-14197
+ (strip-4344 subform-14197 '(()))
#f)))))
(letrec*
- ((syntax-local-binding-14637
- (lambda (id-14770)
+ ((syntax-local-binding-14638
+ (lambda (id-14771)
(begin
- (if (not (if (if (vector? id-14770)
- (if (= (vector-length id-14770) 4)
- (eq? (vector-ref id-14770 0) 'syntax-object)
+ (if (not (if (if (vector? id-14771)
+ (if (= (vector-length id-14771) 4)
+ (eq? (vector-ref id-14771 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-14770 1))
+ (symbol? (vector-ref id-14771 1))
#f))
(syntax-violation
'syntax-local-binding
"invalid argument"
- id-14770))
- ((fluid-ref transformer-environment-4316)
- (lambda (e-14810
- r-14811
- w-14812
- s-14813
- rib-14814
- mod-14815)
+ id-14771))
+ ((fluid-ref transformer-environment-4317)
+ (lambda (e-14811
+ r-14812
+ w-14813
+ s-14814
+ rib-14815
+ mod-14816)
(call-with-values
(lambda ()
- (let ((id-14818 (vector-ref id-14770 1))
- (w-14819
- (let ((w-14830 (vector-ref id-14770 2)))
- (let ((ms-14831 (car w-14830))
- (s-14832 (cdr w-14830)))
- (if (if (pair? ms-14831)
- (eq? (car ms-14831) #f)
+ (let ((id-14819 (vector-ref id-14771 1))
+ (w-14820
+ (let ((w-14831 (vector-ref id-14771 2)))
+ (let ((ms-14832 (car w-14831))
+ (s-14833 (cdr w-14831)))
+ (if (if (pair? ms-14832)
+ (eq? (car ms-14832) #f)
#f)
- (cons (cdr ms-14831)
- (if rib-14814
- (cons rib-14814 (cdr s-14832))
- (cdr s-14832)))
- (cons ms-14831
- (if rib-14814
- (cons rib-14814 s-14832)
- s-14832))))))
- (mod-14821 (vector-ref id-14770 3)))
- (let ((n-14824 (id-var-name-4313 id-14818 w-14819)))
- (if (symbol? n-14824)
- (let ((mod-14838
- (if (if (vector? id-14818)
- (if (= (vector-length id-14818) 4)
- (eq? (vector-ref id-14818 0)
+ (cons (cdr ms-14832)
+ (if rib-14815
+ (cons rib-14815 (cdr s-14833))
+ (cdr s-14833)))
+ (cons ms-14832
+ (if rib-14815
+ (cons rib-14815 s-14833)
+ s-14833))))))
+ (mod-14822 (vector-ref id-14771 3)))
+ (let ((n-14825 (id-var-name-4314 id-14819 w-14820)))
+ (if (symbol? n-14825)
+ (let ((mod-14839
+ (if (if (vector? id-14819)
+ (if (= (vector-length id-14819) 4)
+ (eq? (vector-ref id-14819 0)
'syntax-object)
#f)
#f)
- (vector-ref id-14818 3)
- mod-14821)))
- (let ((b-14839
- (let ((t-14840
- (get-global-definition-hook-4257
- n-14824
- mod-14838)))
- (if t-14840 t-14840 '(global)))))
- (if (eq? (car b-14839) 'global)
- (values 'global n-14824 mod-14838)
+ (vector-ref id-14819 3)
+ mod-14822)))
+ (let ((b-14840
+ (let ((t-14841
+ (get-global-definition-hook-4258
+ n-14825
+ mod-14839)))
+ (if t-14841 t-14841 '(global)))))
+ (if (eq? (car b-14840) 'global)
+ (values 'global n-14825 mod-14839)
(values
- (car b-14839)
- (cdr b-14839)
- mod-14838))))
- (if (string? n-14824)
- (let ((mod-14866
- (if (if (vector? id-14818)
- (if (= (vector-length id-14818) 4)
- (eq? (vector-ref id-14818 0)
+ (car b-14840)
+ (cdr b-14840)
+ mod-14839))))
+ (if (string? n-14825)
+ (let ((mod-14867
+ (if (if (vector? id-14819)
+ (if (= (vector-length id-14819) 4)
+ (eq? (vector-ref id-14819 0)
'syntax-object)
#f)
#f)
- (vector-ref id-14818 3)
- mod-14821)))
- (let ((b-14867
- (let ((t-14868
- (assq-ref r-14811 n-14824)))
- (if t-14868
- t-14868
+ (vector-ref id-14819 3)
+ mod-14822)))
+ (let ((b-14868
+ (let ((t-14869
+ (assq-ref r-14812 n-14825)))
+ (if t-14869
+ t-14869
'(displaced-lexical)))))
(values
- (car b-14867)
- (cdr b-14867)
- mod-14866)))
+ (car b-14868)
+ (cdr b-14868)
+ mod-14867)))
(error "unexpected id-var-name"
- id-14818
- w-14819
- n-14824))))))
- (lambda (type-14881 value-14882 mod-14883)
- (if (eqv? type-14881 'lexical)
- (values 'lexical value-14882)
- (if (eqv? type-14881 'macro)
- (values 'macro value-14882)
- (if (eqv? type-14881 'syntax)
- (values 'pattern-variable value-14882)
- (if (eqv? type-14881 'displaced-lexical)
+ id-14819
+ w-14820
+ n-14825))))))
+ (lambda (type-14882 value-14883 mod-14884)
+ (if (eqv? type-14882 'lexical)
+ (values 'lexical value-14883)
+ (if (eqv? type-14882 'macro)
+ (values 'macro value-14883)
+ (if (eqv? type-14882 'syntax)
+ (values 'pattern-variable value-14883)
+ (if (eqv? type-14882 'displaced-lexical)
(values 'displaced-lexical #f)
- (if (eqv? type-14881 'global)
+ (if (eqv? type-14882 'global)
(values
'global
- (cons value-14882 (cdr mod-14883)))
+ (cons value-14883 (cdr mod-14884)))
(values 'other #f)))))))))))))
- (syntax-locally-bound-identifiers-14638
- (lambda (id-14905)
+ (syntax-locally-bound-identifiers-14639
+ (lambda (id-14906)
(begin
- (if (not (if (if (vector? id-14905)
- (if (= (vector-length id-14905) 4)
- (eq? (vector-ref id-14905 0) 'syntax-object)
+ (if (not (if (if (vector? id-14906)
+ (if (= (vector-length id-14906) 4)
+ (eq? (vector-ref id-14906 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-14905 1))
+ (symbol? (vector-ref id-14906 1))
#f))
(syntax-violation
'syntax-locally-bound-identifiers
"invalid argument"
- id-14905))
- (locally-bound-identifiers-4314
- (vector-ref id-14905 2)
- (vector-ref id-14905 3))))))
+ id-14906))
+ (locally-bound-identifiers-4315
+ (vector-ref id-14906 2)
+ (vector-ref id-14906 3))))))
(begin
(define!
'syntax-module
- (lambda (id-14640)
+ (lambda (id-14641)
(begin
- (if (not (if (if (vector? id-14640)
- (if (= (vector-length id-14640) 4)
- (eq? (vector-ref id-14640 0) 'syntax-object)
+ (if (not (if (if (vector? id-14641)
+ (if (= (vector-length id-14641) 4)
+ (eq? (vector-ref id-14641 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-14640 1))
+ (symbol? (vector-ref id-14641 1))
#f))
(syntax-violation
'syntax-module
"invalid argument"
- id-14640))
- (cdr (vector-ref id-14640 3)))))
+ id-14641))
+ (cdr (vector-ref id-14641 3)))))
(define!
'syntax-local-binding
- syntax-local-binding-14637)
+ syntax-local-binding-14638)
(define!
'syntax-locally-bound-identifiers
- syntax-locally-bound-identifiers-14638)))
+ syntax-locally-bound-identifiers-14639)))
(letrec*
- ((match-each-15012
- (lambda (e-15599 p-15600 w-15601 mod-15602)
- (if (pair? e-15599)
- (let ((first-15603
- (match-15018
- (car e-15599)
- p-15600
- w-15601
+ ((match-each-15013
+ (lambda (e-15600 p-15601 w-15602 mod-15603)
+ (if (pair? e-15600)
+ (let ((first-15604
+ (match-15019
+ (car e-15600)
+ p-15601
+ w-15602
'()
- mod-15602)))
- (if first-15603
- (let ((rest-15606
- (match-each-15012
- (cdr e-15599)
- p-15600
- w-15601
- mod-15602)))
- (if rest-15606 (cons first-15603 rest-15606) #f))
+ mod-15603)))
+ (if first-15604
+ (let ((rest-15607
+ (match-each-15013
+ (cdr e-15600)
+ p-15601
+ w-15602
+ mod-15603)))
+ (if rest-15607 (cons first-15604 rest-15607) #f))
#f))
- (if (null? e-15599)
+ (if (null? e-15600)
'()
- (if (if (vector? e-15599)
- (if (= (vector-length e-15599) 4)
- (eq? (vector-ref e-15599 0) 'syntax-object)
+ (if (if (vector? e-15600)
+ (if (= (vector-length e-15600) 4)
+ (eq? (vector-ref e-15600 0) 'syntax-object)
#f)
#f)
- (match-each-15012
- (vector-ref e-15599 1)
- p-15600
- (join-wraps-4310 w-15601 (vector-ref e-15599 2))
- (vector-ref e-15599 3))
+ (match-each-15013
+ (vector-ref e-15600 1)
+ p-15601
+ (join-wraps-4311 w-15602 (vector-ref e-15600 2))
+ (vector-ref e-15600 3))
#f)))))
- (match-each-any-15014
- (lambda (e-15634 w-15635 mod-15636)
- (if (pair? e-15634)
- (let ((l-15637
- (match-each-any-15014
- (cdr e-15634)
- w-15635
- mod-15636)))
- (if l-15637
- (cons (wrap-4323 (car e-15634) w-15635 mod-15636)
- l-15637)
+ (match-each-any-15015
+ (lambda (e-15635 w-15636 mod-15637)
+ (if (pair? e-15635)
+ (let ((l-15638
+ (match-each-any-15015
+ (cdr e-15635)
+ w-15636
+ mod-15637)))
+ (if l-15638
+ (cons (wrap-4324 (car e-15635) w-15636 mod-15637)
+ l-15638)
#f))
- (if (null? e-15634)
+ (if (null? e-15635)
'()
- (if (if (vector? e-15634)
- (if (= (vector-length e-15634) 4)
- (eq? (vector-ref e-15634 0) 'syntax-object)
+ (if (if (vector? e-15635)
+ (if (= (vector-length e-15635) 4)
+ (eq? (vector-ref e-15635 0) 'syntax-object)
#f)
#f)
- (match-each-any-15014
- (vector-ref e-15634 1)
- (join-wraps-4310 w-15635 (vector-ref e-15634 2))
- mod-15636)
+ (match-each-any-15015
+ (vector-ref e-15635 1)
+ (join-wraps-4311 w-15636 (vector-ref e-15635 2))
+ mod-15637)
#f)))))
- (match-empty-15015
- (lambda (p-15661 r-15662)
- (if (null? p-15661)
- r-15662
- (if (eq? p-15661 '_)
- r-15662
- (if (eq? p-15661 'any)
- (cons '() r-15662)
- (if (pair? p-15661)
- (match-empty-15015
- (car p-15661)
- (match-empty-15015 (cdr p-15661) r-15662))
- (if (eq? p-15661 'each-any)
- (cons '() r-15662)
- (let ((key-15663 (vector-ref p-15661 0)))
- (if (eqv? key-15663 'each)
- (match-empty-15015
- (vector-ref p-15661 1)
- r-15662)
- (if (eqv? key-15663 'each+)
- (match-empty-15015
- (vector-ref p-15661 1)
- (match-empty-15015
- (reverse (vector-ref p-15661 2))
- (match-empty-15015
- (vector-ref p-15661 3)
- r-15662)))
- (if (if (eqv? key-15663 'free-id)
+ (match-empty-15016
+ (lambda (p-15662 r-15663)
+ (if (null? p-15662)
+ r-15663
+ (if (eq? p-15662 '_)
+ r-15663
+ (if (eq? p-15662 'any)
+ (cons '() r-15663)
+ (if (pair? p-15662)
+ (match-empty-15016
+ (car p-15662)
+ (match-empty-15016 (cdr p-15662) r-15663))
+ (if (eq? p-15662 'each-any)
+ (cons '() r-15663)
+ (let ((key-15664 (vector-ref p-15662 0)))
+ (if (eqv? key-15664 'each)
+ (match-empty-15016
+ (vector-ref p-15662 1)
+ r-15663)
+ (if (eqv? key-15664 'each+)
+ (match-empty-15016
+ (vector-ref p-15662 1)
+ (match-empty-15016
+ (reverse (vector-ref p-15662 2))
+ (match-empty-15016
+ (vector-ref p-15662 3)
+ r-15663)))
+ (if (if (eqv? key-15664 'free-id)
#t
- (eqv? key-15663 'atom))
- r-15662
- (if (eqv? key-15663 'vector)
- (match-empty-15015
- (vector-ref p-15661 1)
- r-15662)))))))))))))
- (combine-15016
- (lambda (r*-15682 r-15683)
- (if (null? (car r*-15682))
- r-15683
- (cons (map car r*-15682)
- (combine-15016 (map cdr r*-15682) r-15683)))))
- (match*-15017
- (lambda (e-15047 p-15048 w-15049 r-15050 mod-15051)
- (if (null? p-15048)
- (if (null? e-15047) r-15050 #f)
- (if (pair? p-15048)
- (if (pair? e-15047)
- (match-15018
- (car e-15047)
- (car p-15048)
- w-15049
- (match-15018
- (cdr e-15047)
- (cdr p-15048)
- w-15049
- r-15050
- mod-15051)
- mod-15051)
+ (eqv? key-15664 'atom))
+ r-15663
+ (if (eqv? key-15664 'vector)
+ (match-empty-15016
+ (vector-ref p-15662 1)
+ r-15663)))))))))))))
+ (combine-15017
+ (lambda (r*-15683 r-15684)
+ (if (null? (car r*-15683))
+ r-15684
+ (cons (map car r*-15683)
+ (combine-15017 (map cdr r*-15683) r-15684)))))
+ (match*-15018
+ (lambda (e-15048 p-15049 w-15050 r-15051 mod-15052)
+ (if (null? p-15049)
+ (if (null? e-15048) r-15051 #f)
+ (if (pair? p-15049)
+ (if (pair? e-15048)
+ (match-15019
+ (car e-15048)
+ (car p-15049)
+ w-15050
+ (match-15019
+ (cdr e-15048)
+ (cdr p-15049)
+ w-15050
+ r-15051
+ mod-15052)
+ mod-15052)
#f)
- (if (eq? p-15048 'each-any)
- (let ((l-15056
- (match-each-any-15014 e-15047 w-15049 mod-15051)))
- (if l-15056 (cons l-15056 r-15050) #f))
- (let ((key-15061 (vector-ref p-15048 0)))
- (if (eqv? key-15061 'each)
- (if (null? e-15047)
- (match-empty-15015
- (vector-ref p-15048 1)
- r-15050)
- (let ((l-15068
- (match-each-15012
- e-15047
- (vector-ref p-15048 1)
- w-15049
- mod-15051)))
- (if l-15068
+ (if (eq? p-15049 'each-any)
+ (let ((l-15057
+ (match-each-any-15015 e-15048 w-15050 mod-15052)))
+ (if l-15057 (cons l-15057 r-15051) #f))
+ (let ((key-15062 (vector-ref p-15049 0)))
+ (if (eqv? key-15062 'each)
+ (if (null? e-15048)
+ (match-empty-15016
+ (vector-ref p-15049 1)
+ r-15051)
+ (let ((l-15069
+ (match-each-15013
+ e-15048
+ (vector-ref p-15049 1)
+ w-15050
+ mod-15052)))
+ (if l-15069
(letrec*
- ((collect-15071
- (lambda (l-15122)
- (if (null? (car l-15122))
- r-15050
- (cons (map car l-15122)
- (collect-15071
- (map cdr l-15122)))))))
- (collect-15071 l-15068))
+ ((collect-15072
+ (lambda (l-15123)
+ (if (null? (car l-15123))
+ r-15051
+ (cons (map car l-15123)
+ (collect-15072
+ (map cdr l-15123)))))))
+ (collect-15072 l-15069))
#f)))
- (if (eqv? key-15061 'each+)
+ (if (eqv? key-15062 'each+)
(call-with-values
(lambda ()
- (let ((x-pat-15131 (vector-ref p-15048 1))
- (y-pat-15132 (vector-ref p-15048 2))
- (z-pat-15133 (vector-ref p-15048 3)))
+ (let ((x-pat-15132 (vector-ref p-15049 1))
+ (y-pat-15133 (vector-ref p-15049 2))
+ (z-pat-15134 (vector-ref p-15049 3)))
(letrec*
- ((f-15137
- (lambda (e-15139 w-15140)
- (if (pair? e-15139)
+ ((f-15138
+ (lambda (e-15140 w-15141)
+ (if (pair? e-15140)
(call-with-values
(lambda ()
- (f-15137 (cdr e-15139) w-15140))
- (lambda (xr*-15141
- y-pat-15142
- r-15143)
- (if r-15143
- (if (null? y-pat-15142)
- (let ((xr-15144
- (match-15018
- (car e-15139)
- x-pat-15131
- w-15140
+ (f-15138 (cdr e-15140) w-15141))
+ (lambda (xr*-15142
+ y-pat-15143
+ r-15144)
+ (if r-15144
+ (if (null? y-pat-15143)
+ (let ((xr-15145
+ (match-15019
+ (car e-15140)
+ x-pat-15132
+ w-15141
'()
- mod-15051)))
- (if xr-15144
+ mod-15052)))
+ (if xr-15145
(values
- (cons xr-15144 xr*-15141)
- y-pat-15142
- r-15143)
+ (cons xr-15145 xr*-15142)
+ y-pat-15143
+ r-15144)
(values #f #f #f)))
(values
'()
- (cdr y-pat-15142)
- (match-15018
- (car e-15139)
- (car y-pat-15142)
- w-15140
- r-15143
- mod-15051)))
+ (cdr y-pat-15143)
+ (match-15019
+ (car e-15140)
+ (car y-pat-15143)
+ w-15141
+ r-15144
+ mod-15052)))
(values #f #f #f))))
- (if (if (vector? e-15139)
- (if (= (vector-length e-15139) 4)
- (eq? (vector-ref e-15139 0)
+ (if (if (vector? e-15140)
+ (if (= (vector-length e-15140) 4)
+ (eq? (vector-ref e-15140 0)
'syntax-object)
#f)
#f)
- (f-15137
- (vector-ref e-15139 1)
- (join-wraps-4310 w-15140 e-15139))
+ (f-15138
+ (vector-ref e-15140 1)
+ (join-wraps-4311 w-15141 e-15140))
(values
'()
- y-pat-15132
- (match-15018
- e-15139
- z-pat-15133
- w-15140
- r-15050
- mod-15051)))))))
- (f-15137 e-15047 w-15049))))
- (lambda (xr*-15170 y-pat-15171 r-15172)
- (if r-15172
- (if (null? y-pat-15171)
- (if (null? xr*-15170)
- (match-empty-15015
- (vector-ref p-15048 1)
- r-15172)
- (combine-15016 xr*-15170 r-15172))
+ y-pat-15133
+ (match-15019
+ e-15140
+ z-pat-15134
+ w-15141
+ r-15051
+ mod-15052)))))))
+ (f-15138 e-15048 w-15050))))
+ (lambda (xr*-15171 y-pat-15172 r-15173)
+ (if r-15173
+ (if (null? y-pat-15172)
+ (if (null? xr*-15171)
+ (match-empty-15016
+ (vector-ref p-15049 1)
+ r-15173)
+ (combine-15017 xr*-15171 r-15173))
#f)
#f)))
- (if (eqv? key-15061 'free-id)
- (if (if (symbol? e-15047)
+ (if (eqv? key-15062 'free-id)
+ (if (if (symbol? e-15048)
#t
- (if (if (vector? e-15047)
- (if (= (vector-length e-15047) 4)
- (eq? (vector-ref e-15047 0)
+ (if (if (vector? e-15048)
+ (if (= (vector-length e-15048) 4)
+ (eq? (vector-ref e-15048 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref e-15047 1))
+ (symbol? (vector-ref e-15048 1))
#f))
- (if (let ((i-15503
- (wrap-4323 e-15047 w-15049 mod-15051))
- (j-15504 (vector-ref p-15048 1)))
- (if (eq? (if (if (vector? i-15503)
+ (if (let ((i-15504
+ (wrap-4324 e-15048 w-15050 mod-15052))
+ (j-15505 (vector-ref p-15049 1)))
+ (if (eq? (if (if (vector? i-15504)
(if (= (vector-length
- i-15503)
+ i-15504)
4)
- (eq? (vector-ref i-15503 0)
+ (eq? (vector-ref i-15504 0)
'syntax-object)
#f)
#f)
- (vector-ref i-15503 1)
- i-15503)
- (if (if (vector? j-15504)
+ (vector-ref i-15504 1)
+ i-15504)
+ (if (if (vector? j-15505)
(if (= (vector-length
- j-15504)
+ j-15505)
4)
- (eq? (vector-ref j-15504 0)
+ (eq? (vector-ref j-15505 0)
'syntax-object)
#f)
#f)
- (vector-ref j-15504 1)
- j-15504))
- (eq? (id-var-name-4313 i-15503 '(()))
- (id-var-name-4313 j-15504 '(())))
+ (vector-ref j-15505 1)
+ j-15505))
+ (eq? (id-var-name-4314 i-15504 '(()))
+ (id-var-name-4314 j-15505 '(())))
#f))
- r-15050
+ r-15051
#f)
#f)
- (if (eqv? key-15061 'atom)
+ (if (eqv? key-15062 'atom)
(if (equal?
- (vector-ref p-15048 1)
- (strip-4343 e-15047 w-15049))
- r-15050
+ (vector-ref p-15049 1)
+ (strip-4344 e-15048 w-15050))
+ r-15051
#f)
- (if (eqv? key-15061 'vector)
- (if (vector? e-15047)
- (match-15018
- (vector->list e-15047)
- (vector-ref p-15048 1)
- w-15049
- r-15050
- mod-15051)
+ (if (eqv? key-15062 'vector)
+ (if (vector? e-15048)
+ (match-15019
+ (vector->list e-15048)
+ (vector-ref p-15049 1)
+ w-15050
+ r-15051
+ mod-15052)
#f))))))))))))
- (match-15018
- (lambda (e-15564 p-15565 w-15566 r-15567 mod-15568)
- (if (not r-15567)
+ (match-15019
+ (lambda (e-15565 p-15566 w-15567 r-15568 mod-15569)
+ (if (not r-15568)
#f
- (if (eq? p-15565 '_)
- r-15567
- (if (eq? p-15565 'any)
- (cons (wrap-4323 e-15564 w-15566 mod-15568)
- r-15567)
- (if (if (vector? e-15564)
- (if (= (vector-length e-15564) 4)
- (eq? (vector-ref e-15564 0) 'syntax-object)
+ (if (eq? p-15566 '_)
+ r-15568
+ (if (eq? p-15566 'any)
+ (cons (wrap-4324 e-15565 w-15567 mod-15569)
+ r-15568)
+ (if (if (vector? e-15565)
+ (if (= (vector-length e-15565) 4)
+ (eq? (vector-ref e-15565 0) 'syntax-object)
#f)
#f)
- (match*-15017
- (vector-ref e-15564 1)
- p-15565
- (join-wraps-4310 w-15566 (vector-ref e-15564 2))
- r-15567
- (vector-ref e-15564 3))
- (match*-15017
- e-15564
- p-15565
- w-15566
- r-15567
- mod-15568))))))))
+ (match*-15018
+ (vector-ref e-15565 1)
+ p-15566
+ (join-wraps-4311 w-15567 (vector-ref e-15565 2))
+ r-15568
+ (vector-ref e-15565 3))
+ (match*-15018
+ e-15565
+ p-15566
+ w-15567
+ r-15568
+ mod-15569))))))))
(set! $sc-dispatch
- (lambda (e-15019 p-15020)
- (if (eq? p-15020 'any)
- (list e-15019)
- (if (eq? p-15020 '_)
+ (lambda (e-15020 p-15021)
+ (if (eq? p-15021 'any)
+ (list e-15020)
+ (if (eq? p-15021 '_)
'()
- (if (if (vector? e-15019)
- (if (= (vector-length e-15019) 4)
- (eq? (vector-ref e-15019 0) 'syntax-object)
+ (if (if (vector? e-15020)
+ (if (= (vector-length e-15020) 4)
+ (eq? (vector-ref e-15020 0) 'syntax-object)
#f)
#f)
- (match*-15017
- (vector-ref e-15019 1)
- p-15020
- (vector-ref e-15019 2)
+ (match*-15018
+ (vector-ref e-15020 1)
+ p-15021
+ (vector-ref e-15020 2)
'()
- (vector-ref e-15019 3))
- (match*-15017 e-15019 p-15020 '(()) '() #f))))))))))
+ (vector-ref e-15020 3))
+ (match*-15018 e-15020 p-15021 '(()) '() #f))))))))))
(define with-syntax
(make-syntax-transformer
'with-syntax
'macro
- (lambda (x-28006)
- (let ((tmp-28008
- ($sc-dispatch x-28006 '(_ () any . each-any))))
- (if tmp-28008
+ (lambda (x-28007)
+ (let ((tmp-28009
+ ($sc-dispatch x-28007 '(_ () any . each-any))))
+ (if tmp-28009
(@apply
- (lambda (e1-28012 e2-28013)
+ (lambda (e1-28013 e2-28014)
(cons '#(syntax-object
let
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-27979" "l-*-27980"))
+ #("l-*-27980" "l-*-27981"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-27976")))
+ #(ribcage #(x) #((top)) #("l-*-27977")))
(hygiene guile))
- (cons '() (cons e1-28012 e2-28013))))
- tmp-28008)
- (let ((tmp-28014
+ (cons '() (cons e1-28013 e2-28014))))
+ tmp-28009)
+ (let ((tmp-28015
($sc-dispatch
- x-28006
+ x-28007
'(_ ((any any)) any . each-any))))
- (if tmp-28014
+ (if tmp-28015
(@apply
- (lambda (out-28018 in-28019 e1-28020 e2-28021)
+ (lambda (out-28019 in-28020 e1-28021 e2-28022)
(list '#(syntax-object
syntax-case
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-27985"
- "l-*-27986"
+ #("l-*-27986"
"l-*-27987"
- "l-*-27988"))
+ "l-*-27988"
+ "l-*-27989"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-27976")))
+ #(ribcage #(x) #((top)) #("l-*-27977")))
(hygiene guile))
- in-28019
+ in-28020
'()
- (list out-28018
+ (list out-28019
(cons '#(syntax-object
let
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-27985"
- "l-*-27986"
+ #("l-*-27986"
"l-*-27987"
- "l-*-27988"))
+ "l-*-27988"
+ "l-*-27989"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-27976")))
+ #("l-*-27977")))
(hygiene guile))
- (cons '() (cons e1-28020 e2-28021))))))
- tmp-28014)
- (let ((tmp-28022
+ (cons '() (cons e1-28021 e2-28022))))))
+ tmp-28015)
+ (let ((tmp-28023
($sc-dispatch
- x-28006
+ x-28007
'(_ #(each (any any)) any . each-any))))
- (if tmp-28022
+ (if tmp-28023
(@apply
- (lambda (out-28026 in-28027 e1-28028 e2-28029)
+ (lambda (out-28027 in-28028 e1-28029 e2-28030)
(list '#(syntax-object
syntax-case
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-27995"
- "l-*-27996"
+ #("l-*-27996"
"l-*-27997"
- "l-*-27998"))
+ "l-*-27998"
+ "l-*-27999"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-27976")))
+ #(ribcage #(x) #((top)) #("l-*-27977")))
(hygiene guile))
(cons '#(syntax-object
list
@@ -22299,66 +22368,66 @@
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-27995"
- "l-*-27996"
+ #("l-*-27996"
"l-*-27997"
- "l-*-27998"))
+ "l-*-27998"
+ "l-*-27999"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-27976")))
+ #(ribcage #(x) #((top)) #("l-*-27977")))
(hygiene guile))
- in-28027)
+ in-28028)
'()
- (list out-28026
+ (list out-28027
(cons '#(syntax-object
let
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-27995"
- "l-*-27996"
+ #("l-*-27996"
"l-*-27997"
- "l-*-27998"))
+ "l-*-27998"
+ "l-*-27999"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-27976")))
+ #("l-*-27977")))
(hygiene guile))
- (cons '() (cons e1-28028 e2-28029))))))
- tmp-28022)
+ (cons '() (cons e1-28029 e2-28030))))))
+ tmp-28023)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-28006))))))))))
+ x-28007))))))))))
(define syntax-rules
(make-syntax-transformer
'syntax-rules
'macro
- (lambda (x-28083)
- (let ((tmp-28085
+ (lambda (x-28084)
+ (let ((tmp-28086
($sc-dispatch
- x-28083
+ x-28084
'(_ each-any . #(each ((any . any) any))))))
- (if tmp-28085
+ (if tmp-28086
(@apply
- (lambda (k-28089
- keyword-28090
- pattern-28091
- template-28092)
+ (lambda (k-28090
+ keyword-28091
+ pattern-28092
+ template-28093)
(list '#(syntax-object
lambda
((top)
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
'(#(syntax-object
x
@@ -22366,12 +22435,12 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile)))
(vector
'(#(syntax-object
@@ -22380,12 +22449,12 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
.
#(syntax-object
@@ -22394,12 +22463,12 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile)))
(cons '#(syntax-object
patterns
@@ -22407,26 +22476,26 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
- pattern-28091))
+ pattern-28092))
(cons '#(syntax-object
syntax-case
((top)
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
(cons '#(syntax-object
x
@@ -22434,16 +22503,16 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
- (cons k-28089
- (map (lambda (tmp-28057-28093
- tmp-28056-28094)
+ (cons k-28090
+ (map (lambda (tmp-28058-28094
+ tmp-28057-28095)
(list (cons '#(syntax-object
dummy
((top)
@@ -22456,10 +22525,10 @@
(top)
(top)
(top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage
()
()
@@ -22467,9 +22536,9 @@
#(ribcage
#(x)
#((top))
- #("l-*-28043")))
+ #("l-*-28044")))
(hygiene guile))
- tmp-28056-28094)
+ tmp-28057-28095)
(list '#(syntax-object
syntax
((top)
@@ -22482,10 +22551,10 @@
(top)
(top)
(top))
- #("l-*-28046"
- "l-*-28047"
+ #("l-*-28047"
"l-*-28048"
- "l-*-28049"))
+ "l-*-28049"
+ "l-*-28050"))
#(ribcage
()
()
@@ -22493,45 +22562,45 @@
#(ribcage
#(x)
#((top))
- #("l-*-28043")))
+ #("l-*-28044")))
(hygiene guile))
- tmp-28057-28093)))
- template-28092
- pattern-28091))))))
- tmp-28085)
- (let ((tmp-28095
+ tmp-28058-28094)))
+ template-28093
+ pattern-28092))))))
+ tmp-28086)
+ (let ((tmp-28096
($sc-dispatch
- x-28083
+ x-28084
'(_ each-any any . #(each ((any . any) any))))))
- (if (if tmp-28095
+ (if (if tmp-28096
(@apply
- (lambda (k-28099
- docstring-28100
- keyword-28101
- pattern-28102
- template-28103)
- (string? (syntax->datum docstring-28100)))
- tmp-28095)
+ (lambda (k-28100
+ docstring-28101
+ keyword-28102
+ pattern-28103
+ template-28104)
+ (string? (syntax->datum docstring-28101)))
+ tmp-28096)
#f)
(@apply
- (lambda (k-28104
- docstring-28105
- keyword-28106
- pattern-28107
- template-28108)
+ (lambda (k-28105
+ docstring-28106
+ keyword-28107
+ pattern-28108
+ template-28109)
(list '#(syntax-object
lambda
((top)
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
'(#(syntax-object
x
@@ -22539,15 +22608,15 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile)))
- docstring-28105
+ docstring-28106
(vector
'(#(syntax-object
macro-type
@@ -22555,13 +22624,13 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
.
#(syntax-object
@@ -22570,13 +22639,13 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile)))
(cons '#(syntax-object
patterns
@@ -22584,28 +22653,28 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
- pattern-28107))
+ pattern-28108))
(cons '#(syntax-object
syntax-case
((top)
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28043")))
+ #(ribcage #(x) #((top)) #("l-*-28044")))
(hygiene guile))
(cons '#(syntax-object
x
@@ -22617,20 +22686,20 @@
pattern
template)
#((top) (top) (top) (top) (top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28043")))
+ #("l-*-28044")))
(hygiene guile))
- (cons k-28104
- (map (lambda (tmp-28082-28109
- tmp-28081-28110)
+ (cons k-28105
+ (map (lambda (tmp-28083-28110
+ tmp-28082-28111)
(list (cons '#(syntax-object
dummy
((top)
@@ -22645,11 +22714,11 @@
(top)
(top)
(top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage
()
()
@@ -22657,10 +22726,10 @@
#(ribcage
#(x)
#((top))
- #("l-*-28043")))
+ #("l-*-28044")))
(hygiene
guile))
- tmp-28081-28110)
+ tmp-28082-28111)
(list '#(syntax-object
syntax
((top)
@@ -22675,11 +22744,11 @@
(top)
(top)
(top))
- #("l-*-28069"
- "l-*-28070"
+ #("l-*-28070"
"l-*-28071"
"l-*-28072"
- "l-*-28073"))
+ "l-*-28073"
+ "l-*-28074"))
#(ribcage
()
()
@@ -22687,48 +22756,48 @@
#(ribcage
#(x)
#((top))
- #("l-*-28043")))
+ #("l-*-28044")))
(hygiene
guile))
- tmp-28082-28109)))
- template-28108
- pattern-28107))))))
- tmp-28095)
+ tmp-28083-28110)))
+ template-28109
+ pattern-28108))))))
+ tmp-28096)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-28083))))))))
+ x-28084))))))))
(define define-syntax-rule
(make-syntax-transformer
'define-syntax-rule
'macro
- (lambda (x-28147)
- (let ((tmp-28149
- ($sc-dispatch x-28147 '(_ (any . any) any))))
- (if tmp-28149
+ (lambda (x-28148)
+ (let ((tmp-28150
+ ($sc-dispatch x-28148 '(_ (any . any) any))))
+ (if tmp-28150
(@apply
- (lambda (name-28153 pattern-28154 template-28155)
+ (lambda (name-28154 pattern-28155 template-28156)
(list '#(syntax-object
define-syntax
((top)
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-28124" "l-*-28125" "l-*-28126"))
+ #("l-*-28125" "l-*-28126" "l-*-28127"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28121")))
+ #(ribcage #(x) #((top)) #("l-*-28122")))
(hygiene guile))
- name-28153
+ name-28154
(list '#(syntax-object
syntax-rules
((top)
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-28124" "l-*-28125" "l-*-28126"))
+ #("l-*-28125" "l-*-28126" "l-*-28127"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28121")))
+ #(ribcage #(x) #((top)) #("l-*-28122")))
(hygiene guile))
'()
(list (cons '#(syntax-object
@@ -22737,63 +22806,63 @@
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-28124"
- "l-*-28125"
- "l-*-28126"))
+ #("l-*-28125"
+ "l-*-28126"
+ "l-*-28127"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28121")))
+ #("l-*-28122")))
(hygiene guile))
- pattern-28154)
- template-28155))))
- tmp-28149)
- (let ((tmp-28156
- ($sc-dispatch x-28147 '(_ (any . any) any any))))
- (if (if tmp-28156
+ pattern-28155)
+ template-28156))))
+ tmp-28150)
+ (let ((tmp-28157
+ ($sc-dispatch x-28148 '(_ (any . any) any any))))
+ (if (if tmp-28157
(@apply
- (lambda (name-28160
- pattern-28161
- docstring-28162
- template-28163)
- (string? (syntax->datum docstring-28162)))
- tmp-28156)
+ (lambda (name-28161
+ pattern-28162
+ docstring-28163
+ template-28164)
+ (string? (syntax->datum docstring-28163)))
+ tmp-28157)
#f)
(@apply
- (lambda (name-28164
- pattern-28165
- docstring-28166
- template-28167)
+ (lambda (name-28165
+ pattern-28166
+ docstring-28167
+ template-28168)
(list '#(syntax-object
define-syntax
((top)
#(ribcage
#(name pattern docstring template)
#((top) (top) (top) (top))
- #("l-*-28139"
- "l-*-28140"
+ #("l-*-28140"
"l-*-28141"
- "l-*-28142"))
+ "l-*-28142"
+ "l-*-28143"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28121")))
+ #(ribcage #(x) #((top)) #("l-*-28122")))
(hygiene guile))
- name-28164
+ name-28165
(list '#(syntax-object
syntax-rules
((top)
#(ribcage
#(name pattern docstring template)
#((top) (top) (top) (top))
- #("l-*-28139"
- "l-*-28140"
+ #("l-*-28140"
"l-*-28141"
- "l-*-28142"))
+ "l-*-28142"
+ "l-*-28143"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28121")))
+ #(ribcage #(x) #((top)) #("l-*-28122")))
(hygiene guile))
'()
- docstring-28166
+ docstring-28167
(list (cons '#(syntax-object
_
((top)
@@ -22803,45 +22872,45 @@
docstring
template)
#((top) (top) (top) (top))
- #("l-*-28139"
- "l-*-28140"
+ #("l-*-28140"
"l-*-28141"
- "l-*-28142"))
+ "l-*-28142"
+ "l-*-28143"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28121")))
+ #("l-*-28122")))
(hygiene guile))
- pattern-28165)
- template-28167))))
- tmp-28156)
+ pattern-28166)
+ template-28168))))
+ tmp-28157)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-28147))))))))
+ x-28148))))))))
(define let*
(make-syntax-transformer
'let*
'macro
- (lambda (x-28216)
- (let ((tmp-28218
+ (lambda (x-28217)
+ (let ((tmp-28219
($sc-dispatch
- x-28216
+ x-28217
'(any #(each (any any)) any . each-any))))
- (if (if tmp-28218
+ (if (if tmp-28219
(@apply
- (lambda (let*-28222 x-28223 v-28224 e1-28225 e2-28226)
- (and-map identifier? x-28223))
- tmp-28218)
+ (lambda (let*-28223 x-28224 v-28225 e1-28226 e2-28227)
+ (and-map identifier? x-28224))
+ tmp-28219)
#f)
(@apply
- (lambda (let*-28227 x-28228 v-28229 e1-28230 e2-28231)
+ (lambda (let*-28228 x-28229 v-28230 e1-28231 e2-28232)
(letrec*
- ((f-28232
- (lambda (bindings-28235)
- (if (null? bindings-28235)
+ ((f-28233
+ (lambda (bindings-28236)
+ (if (null? bindings-28236)
(cons '#(syntax-object
let
((top)
@@ -22849,26 +22918,26 @@
#(ribcage
#(f bindings)
#((top) (top))
- #("l-*-28202" "l-*-28203"))
+ #("l-*-28203" "l-*-28204"))
#(ribcage
#(let* x v e1 e2)
#((top) (top) (top) (top) (top))
- #("l-*-28192"
- "l-*-28193"
+ #("l-*-28193"
"l-*-28194"
"l-*-28195"
- "l-*-28196"))
+ "l-*-28196"
+ "l-*-28197"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28178")))
+ #(ribcage #(x) #((top)) #("l-*-28179")))
(hygiene guile))
- (cons '() (cons e1-28230 e2-28231)))
- (let ((tmp-28236
- (list (f-28232 (cdr bindings-28235))
- (car bindings-28235))))
- (let ((tmp-28237 ($sc-dispatch tmp-28236 '(any any))))
- (if tmp-28237
+ (cons '() (cons e1-28231 e2-28232)))
+ (let ((tmp-28237
+ (list (f-28233 (cdr bindings-28236))
+ (car bindings-28236))))
+ (let ((tmp-28238 ($sc-dispatch tmp-28237 '(any any))))
+ (if tmp-28238
(@apply
- (lambda (body-28239 binding-28240)
+ (lambda (body-28240 binding-28241)
(list '#(syntax-object
let
((top)
@@ -22876,84 +22945,84 @@
#(ribcage
#(body binding)
#((top) (top))
- #("l-*-28212" "l-*-28213"))
+ #("l-*-28213" "l-*-28214"))
#(ribcage () () ())
#(ribcage
#(f bindings)
#((top) (top))
- #("l-*-28202" "l-*-28203"))
+ #("l-*-28203" "l-*-28204"))
#(ribcage
#(let* x v e1 e2)
#((top) (top) (top) (top) (top))
- #("l-*-28192"
- "l-*-28193"
+ #("l-*-28193"
"l-*-28194"
"l-*-28195"
- "l-*-28196"))
+ "l-*-28196"
+ "l-*-28197"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28178")))
+ #("l-*-28179")))
(hygiene guile))
- (list binding-28240)
- body-28239))
- tmp-28237)
+ (list binding-28241)
+ body-28240))
+ tmp-28238)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-28236))))))))
- (f-28232 (map list x-28228 v-28229))))
- tmp-28218)
+ tmp-28237))))))))
+ (f-28233 (map list x-28229 v-28230))))
+ tmp-28219)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-28216))))))
+ x-28217))))))
(define do
(make-syntax-transformer
'do
'macro
- (lambda (orig-x-28298)
- (let ((tmp-28300
+ (lambda (orig-x-28299)
+ (let ((tmp-28301
($sc-dispatch
- orig-x-28298
+ orig-x-28299
'(_ #(each (any any . any))
(any . each-any)
.
each-any))))
- (if tmp-28300
+ (if tmp-28301
(@apply
- (lambda (var-28304
- init-28305
- step-28306
- e0-28307
- e1-28308
- c-28309)
- (let ((tmp-28310
- (map (lambda (v-28313 s-28314)
- (let ((tmp-28316 ($sc-dispatch s-28314 '())))
- (if tmp-28316
- (@apply (lambda () v-28313) tmp-28316)
- (let ((tmp-28319
- ($sc-dispatch s-28314 '(any))))
- (if tmp-28319
+ (lambda (var-28305
+ init-28306
+ step-28307
+ e0-28308
+ e1-28309
+ c-28310)
+ (let ((tmp-28311
+ (map (lambda (v-28314 s-28315)
+ (let ((tmp-28317 ($sc-dispatch s-28315 '())))
+ (if tmp-28317
+ (@apply (lambda () v-28314) tmp-28317)
+ (let ((tmp-28320
+ ($sc-dispatch s-28315 '(any))))
+ (if tmp-28320
(@apply
- (lambda (e-28322) e-28322)
- tmp-28319)
+ (lambda (e-28323) e-28323)
+ tmp-28320)
(syntax-violation
'do
"bad step expression"
- orig-x-28298
- s-28314))))))
- var-28304
- step-28306)))
- (let ((tmp-28311 ($sc-dispatch tmp-28310 'each-any)))
- (if tmp-28311
+ orig-x-28299
+ s-28315))))))
+ var-28305
+ step-28307)))
+ (let ((tmp-28312 ($sc-dispatch tmp-28311 'each-any)))
+ (if tmp-28312
(@apply
- (lambda (step-28328)
- (let ((tmp-28330 ($sc-dispatch e1-28308 '())))
- (if tmp-28330
+ (lambda (step-28329)
+ (let ((tmp-28331 ($sc-dispatch e1-28309 '())))
+ (if tmp-28331
(@apply
(lambda ()
(list '#(syntax-object
@@ -22963,7 +23032,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -22972,17 +23041,17 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
'#(syntax-object
doloop
@@ -22991,7 +23060,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23000,19 +23069,19 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
- (map list var-28304 init-28305)
+ (map list var-28305 init-28306)
(list '#(syntax-object
if
((top)
@@ -23020,7 +23089,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23029,17 +23098,17 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
(list '#(syntax-object
not
@@ -23048,7 +23117,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var
init
@@ -23062,19 +23131,19 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
- e0-28307)
+ e0-28308)
(cons '#(syntax-object
begin
((top)
@@ -23082,7 +23151,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var
init
@@ -23096,20 +23165,20 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
(append
- c-28309
+ c-28310
(list (cons '#(syntax-object
doloop
((top)
@@ -23120,7 +23189,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var
init
@@ -23134,12 +23203,12 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage
()
()
@@ -23147,28 +23216,28 @@
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene
guile))
- step-28328)))))))
- tmp-28330)
- (let ((tmp-28334
- ($sc-dispatch e1-28308 '(any . each-any))))
- (if tmp-28334
+ step-28329)))))))
+ tmp-28331)
+ (let ((tmp-28335
+ ($sc-dispatch e1-28309 '(any . each-any))))
+ (if tmp-28335
(@apply
- (lambda (e1-28338 e2-28339)
+ (lambda (e1-28339 e2-28340)
(list '#(syntax-object
let
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-28275" "l-*-28276"))
+ #("l-*-28276" "l-*-28277"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23177,17 +23246,17 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
'#(syntax-object
doloop
@@ -23195,12 +23264,12 @@
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-28275" "l-*-28276"))
+ #("l-*-28276" "l-*-28277"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23209,32 +23278,32 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
- (map list var-28304 init-28305)
+ (map list var-28305 init-28306)
(list '#(syntax-object
if
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-28275"
- "l-*-28276"))
+ #("l-*-28276"
+ "l-*-28277"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23243,32 +23312,32 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
- e0-28307
+ e0-28308
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-28275"
- "l-*-28276"))
+ #("l-*-28276"
+ "l-*-28277"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var
init
@@ -23282,32 +23351,32 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
- (cons e1-28338 e2-28339))
+ (cons e1-28339 e2-28340))
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-28275"
- "l-*-28276"))
+ #("l-*-28276"
+ "l-*-28277"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var
init
@@ -23321,20 +23390,20 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene guile))
(append
- c-28309
+ c-28310
(list (cons '#(syntax-object
doloop
((top)
@@ -23343,8 +23412,8 @@
e2)
#((top)
(top))
- #("l-*-28275"
- "l-*-28276"))
+ #("l-*-28276"
+ "l-*-28277"))
#(ribcage
()
()
@@ -23352,7 +23421,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-28266"))
+ #("l-*-28267"))
#(ribcage
#(var
init
@@ -23366,12 +23435,12 @@
(top)
(top)
(top))
- #("l-*-28251"
- "l-*-28252"
+ #("l-*-28252"
"l-*-28253"
"l-*-28254"
"l-*-28255"
- "l-*-28256"))
+ "l-*-28256"
+ "l-*-28257"))
#(ribcage
()
()
@@ -23379,36 +23448,36 @@
#(ribcage
#(orig-x)
#((top))
- #("l-*-28248")))
+ #("l-*-28249")))
(hygiene
guile))
- step-28328)))))))
- tmp-28334)
+ step-28329)))))))
+ tmp-28335)
(syntax-violation
#f
"source expression failed to match any pattern"
- e1-28308))))))
- tmp-28311)
+ e1-28309))))))
+ tmp-28312)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-28310)))))
- tmp-28300)
+ tmp-28311)))))
+ tmp-28301)
(syntax-violation
#f
"source expression failed to match any pattern"
- orig-x-28298))))))
+ orig-x-28299))))))
(define quasiquote
(make-syntax-transformer
'quasiquote
'macro
(letrec*
- ((quasi-28619
- (lambda (p-28643 lev-28644)
- (let ((tmp-28646
+ ((quasi-28620
+ (lambda (p-28644 lev-28645)
+ (let ((tmp-28647
($sc-dispatch
- p-28643
+ p-28644
'(#(free-id
#(syntax-object
unquote
@@ -23417,7 +23486,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23426,28 +23495,28 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
any))))
- (if tmp-28646
+ (if tmp-28647
(@apply
- (lambda (p-28650)
- (if (= lev-28644 0)
+ (lambda (p-28651)
+ (if (= lev-28645 0)
(list '#(syntax-object
"value"
((top)
- #(ribcage #(p) #((top)) #("l-*-28375"))
+ #(ribcage #(p) #((top)) #("l-*-28376"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23456,25 +23525,25 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- p-28650)
- (quasicons-28621
+ p-28651)
+ (quasicons-28622
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-28375"))
+ #(ribcage #(p) #((top)) #("l-*-28376"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23483,23 +23552,23 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
#(syntax-object
unquote
((top)
- #(ribcage #(p) #((top)) #("l-*-28375"))
+ #(ribcage #(p) #((top)) #("l-*-28376"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23508,19 +23577,19 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
- (quasi-28619 (list p-28650) (#{1-}# lev-28644)))))
- tmp-28646)
- (let ((tmp-28653
+ (quasi-28620 (list p-28651) (#{1-}# lev-28645)))))
+ tmp-28647)
+ (let ((tmp-28654
($sc-dispatch
- p-28643
+ p-28644
'(#(free-id
#(syntax-object
quasiquote
@@ -23529,7 +23598,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23538,28 +23607,28 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
any))))
- (if tmp-28653
+ (if tmp-28654
(@apply
- (lambda (p-28657)
- (quasicons-28621
+ (lambda (p-28658)
+ (quasicons-28622
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-28378"))
+ #(ribcage #(p) #((top)) #("l-*-28379"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23568,23 +23637,23 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
#(syntax-object
quasiquote
((top)
- #(ribcage #(p) #((top)) #("l-*-28378"))
+ #(ribcage #(p) #((top)) #("l-*-28379"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23593,23 +23662,23 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
- (quasi-28619 (list p-28657) (#{1+}# lev-28644))))
- tmp-28653)
- (let ((tmp-28660 ($sc-dispatch p-28643 '(any . any))))
- (if tmp-28660
+ (quasi-28620 (list p-28658) (#{1+}# lev-28645))))
+ tmp-28654)
+ (let ((tmp-28661 ($sc-dispatch p-28644 '(any . any))))
+ (if tmp-28661
(@apply
- (lambda (p-28664 q-28665)
- (let ((tmp-28667
+ (lambda (p-28665 q-28666)
+ (let ((tmp-28668
($sc-dispatch
- p-28664
+ p-28665
'(#(free-id
#(syntax-object
unquote
@@ -23617,12 +23686,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28381" "l-*-28382"))
+ #("l-*-28382" "l-*-28383"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23637,40 +23706,40 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
.
each-any))))
- (if tmp-28667
+ (if tmp-28668
(@apply
- (lambda (p-28671)
- (if (= lev-28644 0)
- (quasilist*-28623
- (map (lambda (tmp-28389-28707)
+ (lambda (p-28672)
+ (if (= lev-28645 0)
+ (quasilist*-28624
+ (map (lambda (tmp-28390-28708)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-28387"))
+ #("l-*-28388"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28381"
- "l-*-28382"))
+ #("l-*-28382"
+ "l-*-28383"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371"
- "l-*-28372"))
+ #("l-*-28372"
+ "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23685,35 +23754,35 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- tmp-28389-28707))
- p-28671)
- (quasi-28619 q-28665 lev-28644))
- (quasicons-28621
- (quasicons-28621
+ tmp-28390-28708))
+ p-28672)
+ (quasi-28620 q-28666 lev-28645))
+ (quasicons-28622
+ (quasicons-28622
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-28387"))
+ #("l-*-28388"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28381" "l-*-28382"))
+ #("l-*-28382" "l-*-28383"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23728,13 +23797,13 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
#(syntax-object
unquote
@@ -23742,16 +23811,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-28387"))
+ #("l-*-28388"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28381" "l-*-28382"))
+ #("l-*-28382" "l-*-28383"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23766,22 +23835,22 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
- (quasi-28619
- p-28671
- (#{1-}# lev-28644)))
- (quasi-28619 q-28665 lev-28644))))
- tmp-28667)
- (let ((tmp-28712
+ (quasi-28620
+ p-28672
+ (#{1-}# lev-28645)))
+ (quasi-28620 q-28666 lev-28645))))
+ tmp-28668)
+ (let ((tmp-28713
($sc-dispatch
- p-28664
+ p-28665
'(#(free-id
#(syntax-object
unquote-splicing
@@ -23789,12 +23858,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28381" "l-*-28382"))
+ #("l-*-28382" "l-*-28383"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23809,40 +23878,40 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
.
each-any))))
- (if tmp-28712
+ (if tmp-28713
(@apply
- (lambda (p-28716)
- (if (= lev-28644 0)
- (quasiappend-28622
- (map (lambda (tmp-28394-28719)
+ (lambda (p-28717)
+ (if (= lev-28645 0)
+ (quasiappend-28623
+ (map (lambda (tmp-28395-28720)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-28392"))
+ #("l-*-28393"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28381"
- "l-*-28382"))
+ #("l-*-28382"
+ "l-*-28383"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371"
- "l-*-28372"))
+ #("l-*-28372"
+ "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23857,35 +23926,35 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- tmp-28394-28719))
- p-28716)
- (quasi-28619 q-28665 lev-28644))
- (quasicons-28621
- (quasicons-28621
+ tmp-28395-28720))
+ p-28717)
+ (quasi-28620 q-28666 lev-28645))
+ (quasicons-28622
+ (quasicons-28622
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-28392"))
+ #("l-*-28393"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28381" "l-*-28382"))
+ #("l-*-28382" "l-*-28383"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23900,13 +23969,13 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
#(syntax-object
unquote-splicing
@@ -23914,16 +23983,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-28392"))
+ #("l-*-28393"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28381" "l-*-28382"))
+ #("l-*-28382" "l-*-28383"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -23938,49 +24007,49 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
- (quasi-28619
- p-28716
- (#{1-}# lev-28644)))
- (quasi-28619 q-28665 lev-28644))))
- tmp-28712)
- (quasicons-28621
- (quasi-28619 p-28664 lev-28644)
- (quasi-28619 q-28665 lev-28644)))))))
- tmp-28660)
- (let ((tmp-28733
- ($sc-dispatch p-28643 '#(vector each-any))))
- (if tmp-28733
+ (quasi-28620
+ p-28717
+ (#{1-}# lev-28645)))
+ (quasi-28620 q-28666 lev-28645))))
+ tmp-28713)
+ (quasicons-28622
+ (quasi-28620 p-28665 lev-28645)
+ (quasi-28620 q-28666 lev-28645)))))))
+ tmp-28661)
+ (let ((tmp-28734
+ ($sc-dispatch p-28644 '#(vector each-any))))
+ (if tmp-28734
(@apply
- (lambda (x-28737)
- (let ((x-28740
- (vquasi-28620 x-28737 lev-28644)))
- (let ((tmp-28742
+ (lambda (x-28738)
+ (let ((x-28741
+ (vquasi-28621 x-28738 lev-28645)))
+ (let ((tmp-28743
($sc-dispatch
- x-28740
+ x-28741
'(#(atom "quote") each-any))))
- (if tmp-28742
+ (if tmp-28743
(@apply
- (lambda (x-28746)
+ (lambda (x-28747)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(x)
#((top))
- #("l-*-28493"))
+ #("l-*-28494"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28490"))
+ #("l-*-28491"))
#(ribcage
(emit quasivector
quasilist*
@@ -23995,36 +24064,36 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- (list->vector x-28746)))
- tmp-28742)
+ (list->vector x-28747)))
+ tmp-28743)
(letrec*
- ((f-28748
- (lambda (y-28760 k-28761)
- (let ((tmp-28763
+ ((f-28749
+ (lambda (y-28761 k-28762)
+ (let ((tmp-28764
($sc-dispatch
- y-28760
+ y-28761
'(#(atom "quote")
each-any))))
- (if tmp-28763
+ (if tmp-28764
(@apply
- (lambda (y-28766)
- (k-28761
- (map (lambda (tmp-28518-28767)
+ (lambda (y-28767)
+ (k-28762
+ (map (lambda (tmp-28519-28768)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(y)
#((top))
- #("l-*-28516"))
+ #("l-*-28517"))
#(ribcage
()
()
@@ -24036,13 +24105,13 @@
#((top)
(top)
(top))
- #("l-*-28498"
- "l-*-28499"
- "l-*-28500"))
+ #("l-*-28499"
+ "l-*-28500"
+ "l-*-28501"))
#(ribcage
#(_)
#((top))
- #("l-*-28496"))
+ #("l-*-28497"))
#(ribcage
()
()
@@ -24050,7 +24119,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-28490"))
+ #("l-*-28491"))
#(ribcage
(emit quasivector
quasilist*
@@ -24065,50 +24134,50 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene
guile))
- tmp-28518-28767))
- y-28766)))
- tmp-28763)
- (let ((tmp-28768
+ tmp-28519-28768))
+ y-28767)))
+ tmp-28764)
+ (let ((tmp-28769
($sc-dispatch
- y-28760
+ y-28761
'(#(atom "list")
.
each-any))))
- (if tmp-28768
+ (if tmp-28769
(@apply
- (lambda (y-28771)
- (k-28761 y-28771))
- tmp-28768)
- (let ((tmp-28772
+ (lambda (y-28772)
+ (k-28762 y-28772))
+ tmp-28769)
+ (let ((tmp-28773
($sc-dispatch
- y-28760
+ y-28761
'(#(atom "list*")
.
#(each+
any
(any)
())))))
- (if tmp-28772
+ (if tmp-28773
(@apply
- (lambda (y-28775
- z-28776)
- (f-28748
- z-28776
- (lambda (ls-28777)
- (k-28761
+ (lambda (y-28776
+ z-28777)
+ (f-28749
+ z-28777
+ (lambda (ls-28778)
+ (k-28762
(append
- y-28775
- ls-28777)))))
- tmp-28772)
+ y-28776
+ ls-28778)))))
+ tmp-28773)
(list '#(syntax-object
"list->vector"
((top)
@@ -24117,14 +24186,14 @@
()
())
#(ribcage
- #(t-28533)
- #((m-*-28534
+ #(t-28534)
+ #((m-*-28535
top))
- #("l-*-28537"))
+ #("l-*-28538"))
#(ribcage
#(else)
#((top))
- #("l-*-28531"))
+ #("l-*-28532"))
#(ribcage
()
()
@@ -24134,13 +24203,13 @@
#((top)
(top)
(top))
- #("l-*-28498"
- "l-*-28499"
- "l-*-28500"))
+ #("l-*-28499"
+ "l-*-28500"
+ "l-*-28501"))
#(ribcage
#(_)
#((top))
- #("l-*-28496"))
+ #("l-*-28497"))
#(ribcage
()
()
@@ -24148,7 +24217,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-28490"))
+ #("l-*-28491"))
#(ribcage
(emit quasivector
quasilist*
@@ -24163,26 +24232,26 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene
guile))
- x-28740))))))))))
- (f-28748
- x-28740
- (lambda (ls-28750)
- (let ((tmp-28752
+ x-28741))))))))))
+ (f-28749
+ x-28741
+ (lambda (ls-28751)
+ (let ((tmp-28753
($sc-dispatch
- ls-28750
+ ls-28751
'each-any)))
- (if tmp-28752
+ (if tmp-28753
(@apply
- (lambda (t-28506-28755)
+ (lambda (t-28507-28756)
(cons '#(syntax-object
"vector"
((top)
@@ -24191,10 +24260,10 @@
()
())
#(ribcage
- #(t-28506)
- #((m-*-28507
+ #(t-28507)
+ #((m-*-28508
top))
- #("l-*-28511"))
+ #("l-*-28512"))
#(ribcage
()
()
@@ -24210,11 +24279,11 @@
#(ribcage
#(ls)
#((top))
- #("l-*-28505"))
+ #("l-*-28506"))
#(ribcage
#(_)
#((top))
- #("l-*-28496"))
+ #("l-*-28497"))
#(ribcage
()
()
@@ -24222,7 +24291,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-28490"))
+ #("l-*-28491"))
#(ribcage
(emit quasivector
quasilist*
@@ -24237,30 +24306,30 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- t-28506-28755))
- tmp-28752)
+ t-28507-28756))
+ tmp-28753)
(syntax-violation
#f
"source expression failed to match any pattern"
- ls-28750))))))))))
- tmp-28733)
+ ls-28751))))))))))
+ tmp-28734)
(list '#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-28402"))
+ #(ribcage #(p) #((top)) #("l-*-28403"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28371" "l-*-28372"))
+ #("l-*-28372" "l-*-28373"))
#(ribcage
(emit quasivector
quasilist*
@@ -24275,24 +24344,24 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- p-28643)))))))))))
- (vquasi-28620
- (lambda (p-28805 lev-28806)
- (let ((tmp-28808 ($sc-dispatch p-28805 '(any . any))))
- (if tmp-28808
+ p-28644)))))))))))
+ (vquasi-28621
+ (lambda (p-28806 lev-28807)
+ (let ((tmp-28809 ($sc-dispatch p-28806 '(any . any))))
+ (if tmp-28809
(@apply
- (lambda (p-28812 q-28813)
- (let ((tmp-28815
+ (lambda (p-28813 q-28814)
+ (let ((tmp-28816
($sc-dispatch
- p-28812
+ p-28813
'(#(free-id
#(syntax-object
unquote
@@ -24300,12 +24369,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28410" "l-*-28411"))
+ #("l-*-28411" "l-*-28412"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406" "l-*-28407"))
+ #("l-*-28407" "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24320,38 +24389,38 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
.
each-any))))
- (if tmp-28815
+ (if tmp-28816
(@apply
- (lambda (p-28819)
- (if (= lev-28806 0)
- (quasilist*-28623
- (map (lambda (tmp-28418-28855)
+ (lambda (p-28820)
+ (if (= lev-28807 0)
+ (quasilist*-28624
+ (map (lambda (tmp-28419-28856)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-28416"))
+ #("l-*-28417"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28410" "l-*-28411"))
+ #("l-*-28411" "l-*-28412"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406" "l-*-28407"))
+ #("l-*-28407" "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24366,32 +24435,32 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- tmp-28418-28855))
- p-28819)
- (vquasi-28620 q-28813 lev-28806))
- (quasicons-28621
- (quasicons-28621
+ tmp-28419-28856))
+ p-28820)
+ (vquasi-28621 q-28814 lev-28807))
+ (quasicons-28622
+ (quasicons-28622
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-28416"))
+ #(ribcage #(p) #((top)) #("l-*-28417"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28410" "l-*-28411"))
+ #("l-*-28411" "l-*-28412"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406" "l-*-28407"))
+ #("l-*-28407" "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24406,27 +24475,27 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
#(syntax-object
unquote
((top)
- #(ribcage #(p) #((top)) #("l-*-28416"))
+ #(ribcage #(p) #((top)) #("l-*-28417"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28410" "l-*-28411"))
+ #("l-*-28411" "l-*-28412"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406" "l-*-28407"))
+ #("l-*-28407" "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24441,20 +24510,20 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
- (quasi-28619 p-28819 (#{1-}# lev-28806)))
- (vquasi-28620 q-28813 lev-28806))))
- tmp-28815)
- (let ((tmp-28862
+ (quasi-28620 p-28820 (#{1-}# lev-28807)))
+ (vquasi-28621 q-28814 lev-28807))))
+ tmp-28816)
+ (let ((tmp-28863
($sc-dispatch
- p-28812
+ p-28813
'(#(free-id
#(syntax-object
unquote-splicing
@@ -24462,12 +24531,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28410" "l-*-28411"))
+ #("l-*-28411" "l-*-28412"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406" "l-*-28407"))
+ #("l-*-28407" "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24482,40 +24551,40 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
.
each-any))))
- (if tmp-28862
+ (if tmp-28863
(@apply
- (lambda (p-28866)
- (if (= lev-28806 0)
- (quasiappend-28622
- (map (lambda (tmp-28423-28869)
+ (lambda (p-28867)
+ (if (= lev-28807 0)
+ (quasiappend-28623
+ (map (lambda (tmp-28424-28870)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-28421"))
+ #("l-*-28422"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28410"
- "l-*-28411"))
+ #("l-*-28411"
+ "l-*-28412"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406"
- "l-*-28407"))
+ #("l-*-28407"
+ "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24530,35 +24599,35 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- tmp-28423-28869))
- p-28866)
- (vquasi-28620 q-28813 lev-28806))
- (quasicons-28621
- (quasicons-28621
+ tmp-28424-28870))
+ p-28867)
+ (vquasi-28621 q-28814 lev-28807))
+ (quasicons-28622
+ (quasicons-28622
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-28421"))
+ #("l-*-28422"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28410" "l-*-28411"))
+ #("l-*-28411" "l-*-28412"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406" "l-*-28407"))
+ #("l-*-28407" "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24573,13 +24642,13 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
#(syntax-object
unquote-splicing
@@ -24587,16 +24656,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-28421"))
+ #("l-*-28422"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-28410" "l-*-28411"))
+ #("l-*-28411" "l-*-28412"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406" "l-*-28407"))
+ #("l-*-28407" "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24611,23 +24680,23 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile)))
- (quasi-28619 p-28866 (#{1-}# lev-28806)))
- (vquasi-28620 q-28813 lev-28806))))
- tmp-28862)
- (quasicons-28621
- (quasi-28619 p-28812 lev-28806)
- (vquasi-28620 q-28813 lev-28806)))))))
- tmp-28808)
- (let ((tmp-28887 ($sc-dispatch p-28805 '())))
- (if tmp-28887
+ (quasi-28620 p-28867 (#{1-}# lev-28807)))
+ (vquasi-28621 q-28814 lev-28807))))
+ tmp-28863)
+ (quasicons-28622
+ (quasi-28620 p-28813 lev-28807)
+ (vquasi-28621 q-28814 lev-28807)))))))
+ tmp-28809)
+ (let ((tmp-28888 ($sc-dispatch p-28806 '())))
+ (if tmp-28888
(@apply
(lambda ()
'(#(syntax-object
@@ -24637,7 +24706,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-28406" "l-*-28407"))
+ #("l-*-28407" "l-*-28408"))
#(ribcage
(emit quasivector
quasilist*
@@ -24646,61 +24715,61 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
()))
- tmp-28887)
+ tmp-28888)
(syntax-violation
#f
"source expression failed to match any pattern"
- p-28805)))))))
- (quasicons-28621
- (lambda (x-28900 y-28901)
- (let ((tmp-28902 (list x-28900 y-28901)))
- (let ((tmp-28903 ($sc-dispatch tmp-28902 '(any any))))
- (if tmp-28903
+ p-28806)))))))
+ (quasicons-28622
+ (lambda (x-28901 y-28902)
+ (let ((tmp-28903 (list x-28901 y-28902)))
+ (let ((tmp-28904 ($sc-dispatch tmp-28903 '(any any))))
+ (if tmp-28904
(@apply
- (lambda (x-28905 y-28906)
- (let ((tmp-28908
- ($sc-dispatch y-28906 '(#(atom "quote") any))))
- (if tmp-28908
+ (lambda (x-28906 y-28907)
+ (let ((tmp-28909
+ ($sc-dispatch y-28907 '(#(atom "quote") any))))
+ (if tmp-28909
(@apply
- (lambda (dy-28912)
- (let ((tmp-28914
+ (lambda (dy-28913)
+ (let ((tmp-28915
($sc-dispatch
- x-28905
+ x-28906
'(#(atom "quote") any))))
- (if tmp-28914
+ (if tmp-28915
(@apply
- (lambda (dx-28918)
+ (lambda (dx-28919)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(dx)
#((top))
- #("l-*-28445"))
+ #("l-*-28446"))
#(ribcage
#(dy)
#((top))
- #("l-*-28441"))
+ #("l-*-28442"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28435" "l-*-28436"))
+ #("l-*-28436" "l-*-28437"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28430" "l-*-28431"))
+ #("l-*-28431" "l-*-28432"))
#(ribcage
(emit quasivector
quasilist*
@@ -24715,39 +24784,39 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- (cons dx-28918 dy-28912)))
- tmp-28914)
- (if (null? dy-28912)
+ (cons dx-28919 dy-28913)))
+ tmp-28915)
+ (if (null? dy-28913)
(list '#(syntax-object
"list"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-28447"))
+ #("l-*-28448"))
#(ribcage
#(dy)
#((top))
- #("l-*-28441"))
+ #("l-*-28442"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28435" "l-*-28436"))
+ #("l-*-28436" "l-*-28437"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28430" "l-*-28431"))
+ #("l-*-28431" "l-*-28432"))
#(ribcage
(emit quasivector
quasilist*
@@ -24762,37 +24831,37 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- x-28905)
+ x-28906)
(list '#(syntax-object
"list*"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-28447"))
+ #("l-*-28448"))
#(ribcage
#(dy)
#((top))
- #("l-*-28441"))
+ #("l-*-28442"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28435" "l-*-28436"))
+ #("l-*-28436" "l-*-28437"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28430" "l-*-28431"))
+ #("l-*-28431" "l-*-28432"))
#(ribcage
(emit quasivector
quasilist*
@@ -24807,42 +24876,42 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- x-28905
- y-28906)))))
- tmp-28908)
- (let ((tmp-28923
+ x-28906
+ y-28907)))))
+ tmp-28909)
+ (let ((tmp-28924
($sc-dispatch
- y-28906
+ y-28907
'(#(atom "list") . any))))
- (if tmp-28923
+ (if tmp-28924
(@apply
- (lambda (stuff-28927)
+ (lambda (stuff-28928)
(cons '#(syntax-object
"list"
((top)
#(ribcage
#(stuff)
#((top))
- #("l-*-28450"))
+ #("l-*-28451"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28435" "l-*-28436"))
+ #("l-*-28436" "l-*-28437"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28430" "l-*-28431"))
+ #("l-*-28431" "l-*-28432"))
#(ribcage
(emit quasivector
quasilist*
@@ -24857,41 +24926,41 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- (cons x-28905 stuff-28927)))
- tmp-28923)
- (let ((tmp-28928
+ (cons x-28906 stuff-28928)))
+ tmp-28924)
+ (let ((tmp-28929
($sc-dispatch
- y-28906
+ y-28907
'(#(atom "list*") . any))))
- (if tmp-28928
+ (if tmp-28929
(@apply
- (lambda (stuff-28932)
+ (lambda (stuff-28933)
(cons '#(syntax-object
"list*"
((top)
#(ribcage
#(stuff)
#((top))
- #("l-*-28453"))
+ #("l-*-28454"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28435" "l-*-28436"))
+ #("l-*-28436" "l-*-28437"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28430" "l-*-28431"))
+ #("l-*-28431" "l-*-28432"))
#(ribcage
(emit quasivector
quasilist*
@@ -24906,34 +24975,34 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- (cons x-28905 stuff-28932)))
- tmp-28928)
+ (cons x-28906 stuff-28933)))
+ tmp-28929)
(list '#(syntax-object
"list*"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-28455"))
+ #("l-*-28456"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28435" "l-*-28436"))
+ #("l-*-28436" "l-*-28437"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28430" "l-*-28431"))
+ #("l-*-28431" "l-*-28432"))
#(ribcage
(emit quasivector
quasilist*
@@ -24948,29 +25017,29 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- x-28905
- y-28906))))))))
- tmp-28903)
+ x-28906
+ y-28907))))))))
+ tmp-28904)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-28902))))))
- (quasiappend-28622
- (lambda (x-28943 y-28944)
- (let ((tmp-28946
- ($sc-dispatch y-28944 '(#(atom "quote") ()))))
- (if tmp-28946
+ tmp-28903))))))
+ (quasiappend-28623
+ (lambda (x-28944 y-28945)
+ (let ((tmp-28947
+ ($sc-dispatch y-28945 '(#(atom "quote") ()))))
+ (if tmp-28947
(@apply
(lambda ()
- (if (null? x-28943)
+ (if (null? x-28944)
'(#(syntax-object
"quote"
((top)
@@ -24978,7 +25047,7 @@
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28459" "l-*-28460"))
+ #("l-*-28460" "l-*-28461"))
#(ribcage
(emit quasivector
quasilist*
@@ -24987,21 +25056,21 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
())
- (if (null? (cdr x-28943))
- (car x-28943)
- (let ((tmp-28951 ($sc-dispatch x-28943 'each-any)))
- (if tmp-28951
+ (if (null? (cdr x-28944))
+ (car x-28944)
+ (let ((tmp-28952 ($sc-dispatch x-28944 'each-any)))
+ (if tmp-28952
(@apply
- (lambda (p-28955)
+ (lambda (p-28956)
(cons '#(syntax-object
"append"
((top)
@@ -25009,12 +25078,12 @@
#(ribcage
#(p)
#((top))
- #("l-*-28467"))
+ #("l-*-28468"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28459" "l-*-28460"))
+ #("l-*-28460" "l-*-28461"))
#(ribcage
(emit quasivector
quasilist*
@@ -25029,29 +25098,29 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- p-28955))
- tmp-28951)
+ p-28956))
+ tmp-28952)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-28943))))))
- tmp-28946)
- (if (null? x-28943)
- y-28944
- (let ((tmp-28963 (list x-28943 y-28944)))
- (let ((tmp-28964
- ($sc-dispatch tmp-28963 '(each-any any))))
- (if tmp-28964
+ x-28944))))))
+ tmp-28947)
+ (if (null? x-28944)
+ y-28945
+ (let ((tmp-28964 (list x-28944 y-28945)))
+ (let ((tmp-28965
+ ($sc-dispatch tmp-28964 '(each-any any))))
+ (if tmp-28965
(@apply
- (lambda (p-28966 y-28967)
+ (lambda (p-28967 y-28968)
(cons '#(syntax-object
"append"
((top)
@@ -25059,13 +25128,13 @@
#(ribcage
#(p y)
#((top) (top))
- #("l-*-28476" "l-*-28477"))
- #(ribcage #(_) #((top)) #("l-*-28470"))
+ #("l-*-28477" "l-*-28478"))
+ #(ribcage #(_) #((top)) #("l-*-28471"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28459" "l-*-28460"))
+ #("l-*-28460" "l-*-28461"))
#(ribcage
(emit quasivector
quasilist*
@@ -25080,44 +25149,44 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- (append p-28966 (list y-28967))))
- tmp-28964)
+ (append p-28967 (list y-28968))))
+ tmp-28965)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-28963)))))))))
- (quasilist*-28623
- (lambda (x-28971 y-28972)
+ tmp-28964)))))))))
+ (quasilist*-28624
+ (lambda (x-28972 y-28973)
(letrec*
- ((f-28973
- (lambda (x-29062)
- (if (null? x-29062)
- y-28972
- (quasicons-28621
- (car x-29062)
- (f-28973 (cdr x-29062)))))))
- (f-28973 x-28971))))
- (emit-28625
- (lambda (x-29065)
- (let ((tmp-29067
- ($sc-dispatch x-29065 '(#(atom "quote") any))))
- (if tmp-29067
+ ((f-28974
+ (lambda (x-29063)
+ (if (null? x-29063)
+ y-28973
+ (quasicons-28622
+ (car x-29063)
+ (f-28974 (cdr x-29063)))))))
+ (f-28974 x-28972))))
+ (emit-28626
+ (lambda (x-29066)
+ (let ((tmp-29068
+ ($sc-dispatch x-29066 '(#(atom "quote") any))))
+ (if tmp-29068
(@apply
- (lambda (x-29071)
+ (lambda (x-29072)
(list '#(syntax-object
quote
((top)
- #(ribcage #(x) #((top)) #("l-*-28543"))
+ #(ribcage #(x) #((top)) #("l-*-28544"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-28540"))
+ #(ribcage #(x) #((top)) #("l-*-28541"))
#(ribcage
(emit quasivector
quasilist*
@@ -25126,45 +25195,45 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- x-29071))
- tmp-29067)
- (let ((tmp-29072
+ x-29072))
+ tmp-29068)
+ (let ((tmp-29073
($sc-dispatch
- x-29065
+ x-29066
'(#(atom "list") . each-any))))
- (if tmp-29072
+ (if tmp-29073
(@apply
- (lambda (x-29076)
- (let ((tmp-29077 (map emit-28625 x-29076)))
- (let ((tmp-29078 ($sc-dispatch tmp-29077 'each-any)))
- (if tmp-29078
+ (lambda (x-29077)
+ (let ((tmp-29078 (map emit-28626 x-29077)))
+ (let ((tmp-29079 ($sc-dispatch tmp-29078 'each-any)))
+ (if tmp-29079
(@apply
- (lambda (t-28548-29080)
+ (lambda (t-28549-29081)
(cons '#(syntax-object
list
((top)
#(ribcage () () ())
#(ribcage
- #(t-28548)
- #((m-*-28549 top))
- #("l-*-28553"))
+ #(t-28549)
+ #((m-*-28550 top))
+ #("l-*-28554"))
#(ribcage
#(x)
#((top))
- #("l-*-28546"))
+ #("l-*-28547"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28540"))
+ #("l-*-28541"))
#(ribcage
(emit quasivector
quasilist*
@@ -25179,70 +25248,70 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- t-28548-29080))
- tmp-29078)
+ t-28549-29081))
+ tmp-29079)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-29077)))))
- tmp-29072)
- (let ((tmp-29081
+ tmp-29078)))))
+ tmp-29073)
+ (let ((tmp-29082
($sc-dispatch
- x-29065
+ x-29066
'(#(atom "list*") . #(each+ any (any) ())))))
- (if tmp-29081
+ (if tmp-29082
(@apply
- (lambda (x-29085 y-29086)
+ (lambda (x-29086 y-29087)
(letrec*
- ((f-29087
- (lambda (x*-29090)
- (if (null? x*-29090)
- (emit-28625 y-29086)
- (let ((tmp-29091
- (list (emit-28625 (car x*-29090))
- (f-29087 (cdr x*-29090)))))
- (let ((tmp-29092
+ ((f-29088
+ (lambda (x*-29091)
+ (if (null? x*-29091)
+ (emit-28626 y-29087)
+ (let ((tmp-29092
+ (list (emit-28626 (car x*-29091))
+ (f-29088 (cdr x*-29091)))))
+ (let ((tmp-29093
($sc-dispatch
- tmp-29091
+ tmp-29092
'(any any))))
- (if tmp-29092
+ (if tmp-29093
(@apply
- (lambda (t-28568-29094
- t-28567-29095)
+ (lambda (t-28569-29095
+ t-28568-29096)
(list '#(syntax-object
cons
((top)
#(ribcage () () ())
#(ribcage
- #(t-28568 t-28567)
- #((m-*-28569 top)
- (m-*-28569 top))
- #("l-*-28573"
- "l-*-28574"))
+ #(t-28569 t-28568)
+ #((m-*-28570 top)
+ (m-*-28570 top))
+ #("l-*-28574"
+ "l-*-28575"))
#(ribcage () () ())
#(ribcage
#(f x*)
#((top) (top))
- #("l-*-28562"
- "l-*-28563"))
+ #("l-*-28563"
+ "l-*-28564"))
#(ribcage
#(x y)
#((top) (top))
- #("l-*-28558"
- "l-*-28559"))
+ #("l-*-28559"
+ "l-*-28560"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28540"))
+ #("l-*-28541"))
#(ribcage
(emit quasivector
quasilist*
@@ -25257,53 +25326,53 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- t-28568-29094
- t-28567-29095))
- tmp-29092)
+ t-28569-29095
+ t-28568-29096))
+ tmp-29093)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-29091))))))))
- (f-29087 x-29085)))
- tmp-29081)
- (let ((tmp-29096
+ tmp-29092))))))))
+ (f-29088 x-29086)))
+ tmp-29082)
+ (let ((tmp-29097
($sc-dispatch
- x-29065
+ x-29066
'(#(atom "append") . each-any))))
- (if tmp-29096
+ (if tmp-29097
(@apply
- (lambda (x-29100)
- (let ((tmp-29101 (map emit-28625 x-29100)))
- (let ((tmp-29102
- ($sc-dispatch tmp-29101 'each-any)))
- (if tmp-29102
+ (lambda (x-29101)
+ (let ((tmp-29102 (map emit-28626 x-29101)))
+ (let ((tmp-29103
+ ($sc-dispatch tmp-29102 'each-any)))
+ (if tmp-29103
(@apply
- (lambda (t-28580-29104)
+ (lambda (t-28581-29105)
(cons '#(syntax-object
append
((top)
#(ribcage () () ())
#(ribcage
- #(t-28580)
- #((m-*-28581 top))
- #("l-*-28585"))
+ #(t-28581)
+ #((m-*-28582 top))
+ #("l-*-28586"))
#(ribcage
#(x)
#((top))
- #("l-*-28578"))
+ #("l-*-28579"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28540"))
+ #("l-*-28541"))
#(ribcage
(emit quasivector
quasilist*
@@ -25318,53 +25387,53 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- t-28580-29104))
- tmp-29102)
+ t-28581-29105))
+ tmp-29103)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-29101)))))
- tmp-29096)
- (let ((tmp-29105
+ tmp-29102)))))
+ tmp-29097)
+ (let ((tmp-29106
($sc-dispatch
- x-29065
+ x-29066
'(#(atom "vector") . each-any))))
- (if tmp-29105
+ (if tmp-29106
(@apply
- (lambda (x-29109)
- (let ((tmp-29110 (map emit-28625 x-29109)))
- (let ((tmp-29111
+ (lambda (x-29110)
+ (let ((tmp-29111 (map emit-28626 x-29110)))
+ (let ((tmp-29112
($sc-dispatch
- tmp-29110
+ tmp-29111
'each-any)))
- (if tmp-29111
+ (if tmp-29112
(@apply
- (lambda (t-28592-29113)
+ (lambda (t-28593-29114)
(cons '#(syntax-object
vector
((top)
#(ribcage () () ())
#(ribcage
- #(t-28592)
- #((m-*-28593 top))
- #("l-*-28597"))
+ #(t-28593)
+ #((m-*-28594 top))
+ #("l-*-28598"))
#(ribcage
#(x)
#((top))
- #("l-*-28590"))
+ #("l-*-28591"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28540"))
+ #("l-*-28541"))
#(ribcage
(emit quasivector
quasilist*
@@ -25379,46 +25448,46 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- t-28592-29113))
- tmp-29111)
+ t-28593-29114))
+ tmp-29112)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-29110)))))
- tmp-29105)
- (let ((tmp-29114
+ tmp-29111)))))
+ tmp-29106)
+ (let ((tmp-29115
($sc-dispatch
- x-29065
+ x-29066
'(#(atom "list->vector") any))))
- (if tmp-29114
+ (if tmp-29115
(@apply
- (lambda (x-29118)
- (let ((tmp-29119 (emit-28625 x-29118)))
+ (lambda (x-29119)
+ (let ((tmp-29120 (emit-28626 x-29119)))
(list '#(syntax-object
list->vector
((top)
#(ribcage () () ())
#(ribcage
- #(t-28604)
- #((m-*-28605 top))
- #("l-*-28608"))
+ #(t-28605)
+ #((m-*-28606 top))
+ #("l-*-28609"))
#(ribcage
#(x)
#((top))
- #("l-*-28602"))
+ #("l-*-28603"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-28540"))
+ #("l-*-28541"))
#(ribcage
(emit quasivector
quasilist*
@@ -25433,183 +25502,183 @@
(top)
(top)
(top))
- ("l-*-28367"
- "l-*-28365"
- "l-*-28363"
- "l-*-28361"
- "l-*-28359"
- "l-*-28357"
- "l-*-28355")))
+ ("l-*-28368"
+ "l-*-28366"
+ "l-*-28364"
+ "l-*-28362"
+ "l-*-28360"
+ "l-*-28358"
+ "l-*-28356")))
(hygiene guile))
- tmp-29119)))
- tmp-29114)
- (let ((tmp-29122
+ tmp-29120)))
+ tmp-29115)
+ (let ((tmp-29123
($sc-dispatch
- x-29065
+ x-29066
'(#(atom "value") any))))
- (if tmp-29122
+ (if tmp-29123
(@apply
- (lambda (x-29126) x-29126)
- tmp-29122)
+ (lambda (x-29127) x-29127)
+ tmp-29123)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-29065))))))))))))))))))
- (lambda (x-28626)
- (let ((tmp-28628 ($sc-dispatch x-28626 '(_ any))))
- (if tmp-28628
+ x-29066))))))))))))))))))
+ (lambda (x-28627)
+ (let ((tmp-28629 ($sc-dispatch x-28627 '(_ any))))
+ (if tmp-28629
(@apply
- (lambda (e-28632)
- (emit-28625 (quasi-28619 e-28632 0)))
- tmp-28628)
+ (lambda (e-28633)
+ (emit-28626 (quasi-28620 e-28633 0)))
+ tmp-28629)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-28626)))))))
+ x-28627)))))))
(define include
(make-syntax-transformer
'include
'macro
- (lambda (x-29181)
+ (lambda (x-29182)
(letrec*
- ((read-file-29182
- (lambda (fn-29291 k-29292)
- (let ((p-29293 (open-input-file fn-29291)))
+ ((read-file-29183
+ (lambda (fn-29292 k-29293)
+ (let ((p-29294 (open-input-file fn-29292)))
(letrec*
- ((f-29294
- (lambda (x-29348 result-29349)
- (if (eof-object? x-29348)
+ ((f-29295
+ (lambda (x-29349 result-29350)
+ (if (eof-object? x-29349)
(begin
- (close-input-port p-29293)
- (reverse result-29349))
- (f-29294
- (read p-29293)
- (cons (datum->syntax k-29292 x-29348)
- result-29349))))))
- (f-29294 (read p-29293) '()))))))
- (let ((tmp-29184 ($sc-dispatch x-29181 '(any any))))
- (if tmp-29184
+ (close-input-port p-29294)
+ (reverse result-29350))
+ (f-29295
+ (read p-29294)
+ (cons (datum->syntax k-29293 x-29349)
+ result-29350))))))
+ (f-29295 (read p-29294) '()))))))
+ (let ((tmp-29185 ($sc-dispatch x-29182 '(any any))))
+ (if tmp-29185
(@apply
- (lambda (k-29188 filename-29189)
- (let ((fn-29190 (syntax->datum filename-29189)))
- (let ((tmp-29191
- (read-file-29182 fn-29190 filename-29189)))
- (let ((tmp-29192 ($sc-dispatch tmp-29191 'each-any)))
- (if tmp-29192
+ (lambda (k-29189 filename-29190)
+ (let ((fn-29191 (syntax->datum filename-29190)))
+ (let ((tmp-29192
+ (read-file-29183 fn-29191 filename-29190)))
+ (let ((tmp-29193 ($sc-dispatch tmp-29192 'each-any)))
+ (if tmp-29193
(@apply
- (lambda (exp-29210)
+ (lambda (exp-29211)
(cons '#(syntax-object
begin
((top)
#(ribcage () () ())
- #(ribcage #(exp) #((top)) #("l-*-29178"))
+ #(ribcage #(exp) #((top)) #("l-*-29179"))
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-29173"))
+ #(ribcage #(fn) #((top)) #("l-*-29174"))
#(ribcage
#(k filename)
#((top) (top))
- #("l-*-29169" "l-*-29170"))
+ #("l-*-29170" "l-*-29171"))
#(ribcage
(read-file)
((top))
- ("l-*-29153"))
- #(ribcage #(x) #((top)) #("l-*-29152")))
+ ("l-*-29154"))
+ #(ribcage #(x) #((top)) #("l-*-29153")))
(hygiene guile))
- exp-29210))
- tmp-29192)
+ exp-29211))
+ tmp-29193)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-29191))))))
- tmp-29184)
+ tmp-29192))))))
+ tmp-29185)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-29181)))))))
+ x-29182)))))))
(define include-from-path
(make-syntax-transformer
'include-from-path
'macro
- (lambda (x-29368)
- (let ((tmp-29370 ($sc-dispatch x-29368 '(any any))))
- (if tmp-29370
+ (lambda (x-29369)
+ (let ((tmp-29371 ($sc-dispatch x-29369 '(any any))))
+ (if tmp-29371
(@apply
- (lambda (k-29374 filename-29375)
- (let ((fn-29376 (syntax->datum filename-29375)))
- (let ((tmp-29377
+ (lambda (k-29375 filename-29376)
+ (let ((fn-29377 (syntax->datum filename-29376)))
+ (let ((tmp-29378
(datum->syntax
- filename-29375
- (let ((t-29380 (%search-load-path fn-29376)))
- (if t-29380
- t-29380
+ filename-29376
+ (let ((t-29381 (%search-load-path fn-29377)))
+ (if t-29381
+ t-29381
(syntax-violation
'include-from-path
"file not found in path"
- x-29368
- filename-29375))))))
+ x-29369
+ filename-29376))))))
(list '#(syntax-object
include
((top)
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-29362"))
+ #(ribcage #(fn) #((top)) #("l-*-29363"))
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-29358"))
+ #(ribcage #(fn) #((top)) #("l-*-29359"))
#(ribcage
#(k filename)
#((top) (top))
- #("l-*-29354" "l-*-29355"))
+ #("l-*-29355" "l-*-29356"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29351")))
+ #(ribcage #(x) #((top)) #("l-*-29352")))
(hygiene guile))
- tmp-29377))))
- tmp-29370)
+ tmp-29378))))
+ tmp-29371)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-29368))))))
+ x-29369))))))
(define unquote
(make-syntax-transformer
'unquote
'macro
- (lambda (x-29389)
+ (lambda (x-29390)
(syntax-violation
'unquote
"expression not valid outside of quasiquote"
- x-29389))))
+ x-29390))))
(define unquote-splicing
(make-syntax-transformer
'unquote-splicing
'macro
- (lambda (x-29392)
+ (lambda (x-29393)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
- x-29392))))
+ x-29393))))
(define case
(make-syntax-transformer
'case
'macro
- (lambda (x-29448)
- (let ((tmp-29450
- ($sc-dispatch x-29448 '(_ any any . each-any))))
- (if tmp-29450
+ (lambda (x-29449)
+ (let ((tmp-29451
+ ($sc-dispatch x-29449 '(_ any any . each-any))))
+ (if tmp-29451
(@apply
- (lambda (e-29454 m1-29455 m2-29456)
- (let ((tmp-29457
+ (lambda (e-29455 m1-29456 m2-29457)
+ (let ((tmp-29458
(letrec*
- ((f-29499
- (lambda (clause-29502 clauses-29503)
- (if (null? clauses-29503)
- (let ((tmp-29505
+ ((f-29500
+ (lambda (clause-29503 clauses-29504)
+ (if (null? clauses-29504)
+ (let ((tmp-29506
($sc-dispatch
- clause-29502
+ clause-29503
'(#(free-id
#(syntax-object
else
@@ -25618,89 +25687,89 @@
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile)))
any
.
each-any))))
- (if tmp-29505
+ (if tmp-29506
(@apply
- (lambda (e1-29509 e2-29510)
+ (lambda (e1-29510 e2-29511)
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-29416" "l-*-29417"))
+ #("l-*-29417" "l-*-29418"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
- (cons e1-29509 e2-29510)))
- tmp-29505)
- (let ((tmp-29511
+ (cons e1-29510 e2-29511)))
+ tmp-29506)
+ (let ((tmp-29512
($sc-dispatch
- clause-29502
+ clause-29503
'(each-any any . each-any))))
- (if tmp-29511
+ (if tmp-29512
(@apply
- (lambda (k-29515 e1-29516 e2-29517)
+ (lambda (k-29516 e1-29517 e2-29518)
(list '#(syntax-object
if
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-29422"
- "l-*-29423"
- "l-*-29424"))
+ #("l-*-29423"
+ "l-*-29424"
+ "l-*-29425"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
(list '#(syntax-object
memv
@@ -25710,9 +25779,9 @@
#((top)
(top)
(top))
- #("l-*-29422"
- "l-*-29423"
- "l-*-29424"))
+ #("l-*-29423"
+ "l-*-29424"
+ "l-*-29425"))
#(ribcage () () ())
#(ribcage
#(f
@@ -25721,22 +25790,22 @@
#((top)
(top)
(top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
'#(syntax-object
t
@@ -25746,9 +25815,9 @@
#((top)
(top)
(top))
- #("l-*-29422"
- "l-*-29423"
- "l-*-29424"))
+ #("l-*-29423"
+ "l-*-29424"
+ "l-*-29425"))
#(ribcage () () ())
#(ribcage
#(f
@@ -25757,22 +25826,22 @@
#((top)
(top)
(top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
(list '#(syntax-object
quote
@@ -25782,9 +25851,9 @@
#((top)
(top)
(top))
- #("l-*-29422"
- "l-*-29423"
- "l-*-29424"))
+ #("l-*-29423"
+ "l-*-29424"
+ "l-*-29425"))
#(ribcage
()
()
@@ -25796,17 +25865,17 @@
#((top)
(top)
(top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage
()
()
@@ -25814,10 +25883,10 @@
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene
guile))
- k-29515))
+ k-29516))
(cons '#(syntax-object
begin
((top)
@@ -25826,9 +25895,9 @@
#((top)
(top)
(top))
- #("l-*-29422"
- "l-*-29423"
- "l-*-29424"))
+ #("l-*-29423"
+ "l-*-29424"
+ "l-*-29425"))
#(ribcage () () ())
#(ribcage
#(f
@@ -25837,74 +25906,74 @@
#((top)
(top)
(top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
- (cons e1-29516
- e2-29517))))
- tmp-29511)
+ (cons e1-29517
+ e2-29518))))
+ tmp-29512)
(syntax-violation
'case
"bad clause"
- x-29448
- clause-29502)))))
- (let ((tmp-29525
- (f-29499
- (car clauses-29503)
- (cdr clauses-29503))))
- (let ((tmp-29528
+ x-29449
+ clause-29503)))))
+ (let ((tmp-29526
+ (f-29500
+ (car clauses-29504)
+ (cdr clauses-29504))))
+ (let ((tmp-29529
($sc-dispatch
- clause-29502
+ clause-29503
'(each-any any . each-any))))
- (if tmp-29528
+ (if tmp-29529
(@apply
- (lambda (k-29532 e1-29533 e2-29534)
+ (lambda (k-29533 e1-29534 e2-29535)
(list '#(syntax-object
if
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-29438"
- "l-*-29439"
- "l-*-29440"))
+ #("l-*-29439"
+ "l-*-29440"
+ "l-*-29441"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-29434"))
+ #("l-*-29435"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
(list '#(syntax-object
memv
@@ -25912,32 +25981,32 @@
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-29438"
- "l-*-29439"
- "l-*-29440"))
+ #("l-*-29439"
+ "l-*-29440"
+ "l-*-29441"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-29434"))
+ #("l-*-29435"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
'#(syntax-object
t
@@ -25945,32 +26014,32 @@
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-29438"
- "l-*-29439"
- "l-*-29440"))
+ #("l-*-29439"
+ "l-*-29440"
+ "l-*-29441"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-29434"))
+ #("l-*-29435"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
(list '#(syntax-object
quote
@@ -25980,9 +26049,9 @@
#((top)
(top)
(top))
- #("l-*-29438"
- "l-*-29439"
- "l-*-29440"))
+ #("l-*-29439"
+ "l-*-29440"
+ "l-*-29441"))
#(ribcage
()
()
@@ -25990,7 +26059,7 @@
#(ribcage
#(rest)
#((top))
- #("l-*-29434"))
+ #("l-*-29435"))
#(ribcage
()
()
@@ -26002,17 +26071,17 @@
#((top)
(top)
(top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage
()
()
@@ -26020,63 +26089,63 @@
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
- k-29532))
+ k-29533))
(cons '#(syntax-object
begin
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-29438"
- "l-*-29439"
- "l-*-29440"))
+ #("l-*-29439"
+ "l-*-29440"
+ "l-*-29441"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-29434"))
+ #("l-*-29435"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-29407"
- "l-*-29408"
- "l-*-29409"))
+ #("l-*-29408"
+ "l-*-29409"
+ "l-*-29410"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
- (cons e1-29533 e2-29534))
- tmp-29525))
- tmp-29528)
+ (cons e1-29534 e2-29535))
+ tmp-29526))
+ tmp-29529)
(syntax-violation
'case
"bad clause"
- x-29448
- clause-29502))))))))
- (f-29499 m1-29455 m2-29456))))
- (let ((body-29458 tmp-29457))
+ x-29449
+ clause-29503))))))))
+ (f-29500 m1-29456 m2-29457))))
+ (let ((body-29459 tmp-29458))
(list '#(syntax-object
let
((top)
#(ribcage () () ())
- #(ribcage #(body) #((top)) #("l-*-29405"))
+ #(ribcage #(body) #((top)) #("l-*-29406"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397" "l-*-29398" "l-*-29399"))
+ #("l-*-29398" "l-*-29399" "l-*-29400"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29394")))
+ #(ribcage #(x) #((top)) #("l-*-29395")))
(hygiene guile))
(list (list '#(syntax-object
t
@@ -26085,122 +26154,122 @@
#(ribcage
#(body)
#((top))
- #("l-*-29405"))
+ #("l-*-29406"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-29397"
- "l-*-29398"
- "l-*-29399"))
+ #("l-*-29398"
+ "l-*-29399"
+ "l-*-29400"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29394")))
+ #("l-*-29395")))
(hygiene guile))
- e-29454))
- body-29458))))
- tmp-29450)
+ e-29455))
+ body-29459))))
+ tmp-29451)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-29448))))))
+ x-29449))))))
(define make-variable-transformer
- (lambda (proc-29552)
- (if (procedure? proc-29552)
+ (lambda (proc-29553)
+ (if (procedure? proc-29553)
(letrec*
- ((trans-29553
- (lambda (x-29559) (proc-29552 x-29559))))
+ ((trans-29554
+ (lambda (x-29560) (proc-29553 x-29560))))
(begin
(set-procedure-property!
- trans-29553
+ trans-29554
'variable-transformer
#t)
- trans-29553))
+ trans-29554))
(error "variable transformer not a procedure"
- proc-29552))))
+ proc-29553))))
(define identifier-syntax
(make-syntax-transformer
'identifier-syntax
'macro
- (lambda (x-29591)
- (let ((tmp-29593 ($sc-dispatch x-29591 '(_ any))))
- (if tmp-29593
+ (lambda (x-29592)
+ (let ((tmp-29594 ($sc-dispatch x-29592 '(_ any))))
+ (if tmp-29594
(@apply
- (lambda (e-29597)
+ (lambda (e-29598)
(list '#(syntax-object
lambda
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
'(#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile)))
'#((#(syntax-object
macro-type
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
.
#(syntax-object
identifier-syntax
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))))
(list '#(syntax-object
syntax-case
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
'#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
'()
(list '#(syntax-object
id
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
'(#(syntax-object
identifier?
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
(#(syntax-object
syntax
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
#(syntax-object
id
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))))
(list '#(syntax-object
syntax
@@ -26208,34 +26277,34 @@
#(ribcage
#(e)
#((top))
- #("l-*-29566"))
+ #("l-*-29567"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
- e-29597))
+ e-29598))
(list '(#(syntax-object
_
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
#(syntax-object
...
((top)
- #(ribcage #(e) #((top)) #("l-*-29566"))
+ #(ribcage #(e) #((top)) #("l-*-29567"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile)))
(list '#(syntax-object
syntax
@@ -26243,26 +26312,26 @@
#(ribcage
#(e)
#((top))
- #("l-*-29566"))
+ #("l-*-29567"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
- (cons e-29597
+ (cons e-29598
'(#(syntax-object
x
((top)
#(ribcage
#(e)
#((top))
- #("l-*-29566"))
+ #("l-*-29567"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
#(syntax-object
...
@@ -26270,59 +26339,59 @@
#(ribcage
#(e)
#((top))
- #("l-*-29566"))
+ #("l-*-29567"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile)))))))))
- tmp-29593)
- (let ((tmp-29598
+ tmp-29594)
+ (let ((tmp-29599
($sc-dispatch
- x-29591
+ x-29592
'(_ (any any)
((#(free-id
#(syntax-object
set!
((top)
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile)))
any
any)
any)))))
- (if (if tmp-29598
+ (if (if tmp-29599
(@apply
- (lambda (id-29602
- exp1-29603
- var-29604
- val-29605
- exp2-29606)
- (if (identifier? id-29602)
- (identifier? var-29604)
+ (lambda (id-29603
+ exp1-29604
+ var-29605
+ val-29606
+ exp2-29607)
+ (if (identifier? id-29603)
+ (identifier? var-29605)
#f))
- tmp-29598)
+ tmp-29599)
#f)
(@apply
- (lambda (id-29607
- exp1-29608
- var-29609
- val-29610
- exp2-29611)
+ (lambda (id-29608
+ exp1-29609
+ var-29610
+ val-29611
+ exp2-29612)
(list '#(syntax-object
make-variable-transformer
((top)
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
(list '#(syntax-object
lambda
@@ -26330,13 +26399,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
'(#(syntax-object
x
@@ -26344,13 +26413,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile)))
'#((#(syntax-object
macro-type
@@ -26358,13 +26427,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))
.
#(syntax-object
@@ -26373,13 +26442,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29563")))
+ #(ribcage #(x) #((top)) #("l-*-29564")))
(hygiene guile))))
(list '#(syntax-object
syntax-case
@@ -26387,16 +26456,16 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
'#(syntax-object
x
@@ -26404,16 +26473,16 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
'(#(syntax-object
set!
@@ -26421,16 +26490,16 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile)))
(list (list '#(syntax-object
set!
@@ -26442,19 +26511,19 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
- var-29609
- val-29610)
+ var-29610
+ val-29611)
(list '#(syntax-object
syntax
((top)
@@ -26465,19 +26534,19 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
- exp2-29611))
- (list (cons id-29607
+ exp2-29612))
+ (list (cons id-29608
'(#(syntax-object
x
((top)
@@ -26488,16 +26557,16 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
#(syntax-object
...
@@ -26509,16 +26578,16 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))))
(list '#(syntax-object
syntax
@@ -26530,18 +26599,18 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
- (cons exp1-29608
+ (cons exp1-29609
'(#(syntax-object
x
((top)
@@ -26556,16 +26625,16 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
#(syntax-object
...
@@ -26581,18 +26650,18 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))))))
- (list id-29607
+ (list id-29608
(list '#(syntax-object
identifier?
((top)
@@ -26603,16 +26672,16 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
(list '#(syntax-object
syntax
@@ -26628,18 +26697,18 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
- id-29607))
+ id-29608))
(list '#(syntax-object
syntax
((top)
@@ -26650,69 +26719,69 @@
(top)
(top)
(top))
- #("l-*-29581"
- "l-*-29582"
+ #("l-*-29582"
"l-*-29583"
"l-*-29584"
- "l-*-29585"))
+ "l-*-29585"
+ "l-*-29586"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29563")))
+ #("l-*-29564")))
(hygiene guile))
- exp1-29608))))))
- tmp-29598)
+ exp1-29609))))))
+ tmp-29599)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-29591))))))))
+ x-29592))))))))
(define define*
(make-syntax-transformer
'define*
'macro
- (lambda (x-29643)
- (let ((tmp-29645
+ (lambda (x-29644)
+ (let ((tmp-29646
($sc-dispatch
- x-29643
+ x-29644
'(_ (any . any) any . each-any))))
- (if tmp-29645
+ (if tmp-29646
(@apply
- (lambda (id-29649 args-29650 b0-29651 b1-29652)
+ (lambda (id-29650 args-29651 b0-29652 b1-29653)
(list '#(syntax-object
define
((top)
#(ribcage
#(id args b0 b1)
#((top) (top) (top) (top))
- #("l-*-29625"
- "l-*-29626"
+ #("l-*-29626"
"l-*-29627"
- "l-*-29628"))
+ "l-*-29628"
+ "l-*-29629"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29622")))
+ #(ribcage #(x) #((top)) #("l-*-29623")))
(hygiene guile))
- id-29649
+ id-29650
(cons '#(syntax-object
lambda*
((top)
#(ribcage
#(id args b0 b1)
#((top) (top) (top) (top))
- #("l-*-29625"
- "l-*-29626"
+ #("l-*-29626"
"l-*-29627"
- "l-*-29628"))
+ "l-*-29628"
+ "l-*-29629"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29622")))
+ #(ribcage #(x) #((top)) #("l-*-29623")))
(hygiene guile))
- (cons args-29650 (cons b0-29651 b1-29652)))))
- tmp-29645)
- (let ((tmp-29653 ($sc-dispatch x-29643 '(_ any any))))
- (if (if tmp-29653
+ (cons args-29651 (cons b0-29652 b1-29653)))))
+ tmp-29646)
+ (let ((tmp-29654 ($sc-dispatch x-29644 '(_ any any))))
+ (if (if tmp-29654
(@apply
- (lambda (id-29657 val-29658)
+ (lambda (id-29658 val-29659)
(identifier?
'#(syntax-object
x
@@ -26720,29 +26789,29 @@
#(ribcage
#(id val)
#((top) (top))
- #("l-*-29635" "l-*-29636"))
+ #("l-*-29636" "l-*-29637"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29622")))
+ #(ribcage #(x) #((top)) #("l-*-29623")))
(hygiene guile))))
- tmp-29653)
+ tmp-29654)
#f)
(@apply
- (lambda (id-29659 val-29660)
+ (lambda (id-29660 val-29661)
(list '#(syntax-object
define
((top)
#(ribcage
#(id val)
#((top) (top))
- #("l-*-29639" "l-*-29640"))
+ #("l-*-29640" "l-*-29641"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29622")))
+ #(ribcage #(x) #((top)) #("l-*-29623")))
(hygiene guile))
- id-29659
- val-29660))
- tmp-29653)
+ id-29660
+ val-29661))
+ tmp-29654)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-29643))))))))
+ x-29644))))))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 729ae6ecb..429006920 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -301,7 +301,7 @@
(define (decorate-source e s)
- (if (and (pair? e) s)
+ (if (and s (supports-source-properties? e))
(set-source-properties! e s))
e)
@@ -461,14 +461,11 @@
(define source-annotation
(lambda (x)
- (cond
- ((syntax-object? x)
- (source-annotation (syntax-object-expression x)))
- ((pair? x) (let ((props (source-properties x)))
- (if (pair? props)
- props
- #f)))
- (else #f))))
+ (let ((props (source-properties
+ (if (syntax-object? x)
+ (syntax-object-expression x)
+ x))))
+ (and (pair? props) props))))
(define-syntax-rule (arg-check pred? e who)
(let ((x e))