summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-10-14 00:08:35 +0200
committerAndy Wingo <wingo@pobox.com>2009-10-23 15:10:25 +0200
commit8a4ca0ea3bd3e378fc63ef719ce828b7252b3985 (patch)
treeff71f102d96cc8f10f67618cf136aa35fc55a47f
parentc783b0827c5e5485209879b6cd329a7f095ecf9c (diff)
downloadguile-8a4ca0ea3bd3e378fc63ef719ce828b7252b3985.tar.gz
tree-il support for case-lambda
* module/language/tree-il.scm (<lambda>, <lambda-case>): Split lambda into the lambda itself, denoting the procedure, and lambda-case, denoting a particular arity case. Lambda-case is fairly featureful, and has not yet been fully tested. (<let-values>): Use a <lambda-case> as the binding expression. Seems to suit the purpose well. Adapt parsers, unparsers, traversal operators, etc. Sometimes in this first version we assume there are no optional args, rest args, or a predicate. * module/language/tree-il/analyze.scm (analyze-lexicals): Adapt for the new case-lambda regime. Fairly well commented. It actually simplifies things. (report-unused-variables): Update for new tree-il. * module/language/tree-il/compile-glil.scm: Adapt for the new tree-il. There are some first stabs here at proper case-lambda compilation, but they are untested as of yet. * module/language/tree-il/inline.scm (inline!): Rework so we can recurse on a single node; though these transformations are strictly reductive, so they should complete in bounded time. Simplify accordingly, and adapt to case-lambda. Oh, and we handle lambda->let in not just the nullary case. * module/ice-9/psyntax.scm (build-simple-lambda, build-case-lambda) (build-lambda-case): New constructors. The idea is that after syntax expansion, we shouldn't have to deal with improper lists any more. Build-simple-lambda is a shortcut for the common case. The others are not fully exercised yet. Adapt callers. (syntax): Add some debugging in the lambda case. I don't fully understand this, but in practice we don't seem to see rest args here. (lambda): Inline chi-lambda-clause, and adapt for build-simple-lambda. * module/ice-9/psyntax-pp.scm: Regenerated. * test-suite/tests/tree-il.test: Update tests for new tree-il lambda format, and to expect post-prelude labels for all glil programs.
-rw-r--r--module/ice-9/psyntax-pp.scm8228
-rw-r--r--module/ice-9/psyntax.scm191
-rw-r--r--module/language/tree-il.scm108
-rw-r--r--module/language/tree-il/analyze.scm204
-rw-r--r--module/language/tree-il/compile-glil.scm276
-rw-r--r--module/language/tree-il/inline.scm71
-rw-r--r--test-suite/tests/tree-il.test230
7 files changed, 4801 insertions, 4507 deletions
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index a50574489..f9d77f58e 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -2,18 +2,18 @@
(if #f #f)
(letrec ((#{and-map*\ 31}#
- (lambda (#{f\ 71}# #{first\ 70}# . #{rest\ 69}#)
+ (lambda (#{f\ 69}# #{first\ 70}# . #{rest\ 71}#)
(let ((#{t\ 72}# (null? #{first\ 70}#)))
(if #{t\ 72}#
#{t\ 72}#
- (if (null? #{rest\ 69}#)
+ (if (null? #{rest\ 71}#)
(letrec ((#{andmap\ 73}#
(lambda (#{first\ 74}#)
(let ((#{x\ 75}# (car #{first\ 74}#))
(#{first\ 76}# (cdr #{first\ 74}#)))
(if (null? #{first\ 76}#)
- (#{f\ 71}# #{x\ 75}#)
- (if (#{f\ 71}# #{x\ 75}#)
+ (#{f\ 69}# #{x\ 75}#)
+ (if (#{f\ 69}# #{x\ 75}#)
(#{andmap\ 73}# #{first\ 76}#)
#f))))))
(#{andmap\ 73}# #{first\ 70}#))
@@ -24,102 +24,102 @@
(#{first\ 82}# (cdr #{first\ 78}#))
(#{rest\ 83}# (map cdr #{rest\ 79}#)))
(if (null? #{first\ 82}#)
- (apply #{f\ 71}#
+ (apply #{f\ 69}#
(cons #{x\ 80}# #{xr\ 81}#))
- (if (apply #{f\ 71}#
+ (if (apply #{f\ 69}#
(cons #{x\ 80}# #{xr\ 81}#))
(#{andmap\ 77}#
#{first\ 82}#
#{rest\ 83}#)
#f))))))
- (#{andmap\ 77}# #{first\ 70}# #{rest\ 69}#))))))))
- (letrec ((#{lambda-var-list\ 177}#
- (lambda (#{vars\ 301}#)
- (letrec ((#{lvl\ 302}#
- (lambda (#{vars\ 303}# #{ls\ 304}# #{w\ 305}#)
- (if (pair? #{vars\ 303}#)
- (#{lvl\ 302}#
- (cdr #{vars\ 303}#)
- (cons (#{wrap\ 157}#
- (car #{vars\ 303}#)
- #{w\ 305}#
+ (#{andmap\ 77}# #{first\ 70}# #{rest\ 71}#))))))))
+ (letrec ((#{lambda-var-list\ 178}#
+ (lambda (#{vars\ 302}#)
+ (letrec ((#{lvl\ 303}#
+ (lambda (#{vars\ 304}# #{ls\ 305}# #{w\ 306}#)
+ (if (pair? #{vars\ 304}#)
+ (#{lvl\ 303}#
+ (cdr #{vars\ 304}#)
+ (cons (#{wrap\ 159}#
+ (car #{vars\ 304}#)
+ #{w\ 306}#
#f)
- #{ls\ 304}#)
- #{w\ 305}#)
- (if (#{id?\ 129}# #{vars\ 303}#)
- (cons (#{wrap\ 157}#
- #{vars\ 303}#
- #{w\ 305}#
+ #{ls\ 305}#)
+ #{w\ 306}#)
+ (if (#{id?\ 131}# #{vars\ 304}#)
+ (cons (#{wrap\ 159}#
+ #{vars\ 304}#
+ #{w\ 306}#
#f)
- #{ls\ 304}#)
- (if (null? #{vars\ 303}#)
- #{ls\ 304}#
- (if (#{syntax-object?\ 113}# #{vars\ 303}#)
- (#{lvl\ 302}#
- (#{syntax-object-expression\ 114}#
- #{vars\ 303}#)
- #{ls\ 304}#
- (#{join-wraps\ 148}#
- #{w\ 305}#
- (#{syntax-object-wrap\ 115}#
- #{vars\ 303}#)))
- (cons #{vars\ 303}# #{ls\ 304}#))))))))
- (#{lvl\ 302}#
- #{vars\ 301}#
+ #{ls\ 305}#)
+ (if (null? #{vars\ 304}#)
+ #{ls\ 305}#
+ (if (#{syntax-object?\ 115}# #{vars\ 304}#)
+ (#{lvl\ 303}#
+ (#{syntax-object-expression\ 116}#
+ #{vars\ 304}#)
+ #{ls\ 305}#
+ (#{join-wraps\ 150}#
+ #{w\ 306}#
+ (#{syntax-object-wrap\ 117}#
+ #{vars\ 304}#)))
+ (cons #{vars\ 304}# #{ls\ 305}#))))))))
+ (#{lvl\ 303}#
+ #{vars\ 302}#
'()
'(())))))
- (#{gen-var\ 176}#
- (lambda (#{id\ 306}#)
- (let ((#{id\ 307}#
- (if (#{syntax-object?\ 113}# #{id\ 306}#)
- (#{syntax-object-expression\ 114}# #{id\ 306}#)
- #{id\ 306}#)))
+ (#{gen-var\ 177}#
+ (lambda (#{id\ 307}#)
+ (let ((#{id\ 308}#
+ (if (#{syntax-object?\ 115}# #{id\ 307}#)
+ (#{syntax-object-expression\ 116}# #{id\ 307}#)
+ #{id\ 307}#)))
(gensym
- (string-append (symbol->string #{id\ 307}#) " ")))))
- (#{strip\ 175}#
- (lambda (#{x\ 308}# #{w\ 309}#)
+ (string-append (symbol->string #{id\ 308}#) " ")))))
+ (#{strip\ 176}#
+ (lambda (#{x\ 309}# #{w\ 310}#)
(if (memq 'top
- (#{wrap-marks\ 132}# #{w\ 309}#))
- #{x\ 308}#
- (letrec ((#{f\ 310}# (lambda (#{x\ 311}#)
- (if (#{syntax-object?\ 113}#
- #{x\ 311}#)
- (#{strip\ 175}#
- (#{syntax-object-expression\ 114}#
- #{x\ 311}#)
- (#{syntax-object-wrap\ 115}#
- #{x\ 311}#))
- (if (pair? #{x\ 311}#)
- (let ((#{a\ 312}# (#{f\ 310}# (car #{x\ 311}#)))
- (#{d\ 313}# (#{f\ 310}# (cdr #{x\ 311}#))))
- (if (if (eq? #{a\ 312}#
- (car #{x\ 311}#))
- (eq? #{d\ 313}#
- (cdr #{x\ 311}#))
+ (#{wrap-marks\ 134}# #{w\ 310}#))
+ #{x\ 309}#
+ (letrec ((#{f\ 311}# (lambda (#{x\ 312}#)
+ (if (#{syntax-object?\ 115}#
+ #{x\ 312}#)
+ (#{strip\ 176}#
+ (#{syntax-object-expression\ 116}#
+ #{x\ 312}#)
+ (#{syntax-object-wrap\ 117}#
+ #{x\ 312}#))
+ (if (pair? #{x\ 312}#)
+ (let ((#{a\ 313}# (#{f\ 311}# (car #{x\ 312}#)))
+ (#{d\ 314}# (#{f\ 311}# (cdr #{x\ 312}#))))
+ (if (if (eq? #{a\ 313}#
+ (car #{x\ 312}#))
+ (eq? #{d\ 314}#
+ (cdr #{x\ 312}#))
#f)
- #{x\ 311}#
- (cons #{a\ 312}# #{d\ 313}#)))
- (if (vector? #{x\ 311}#)
- (let ((#{old\ 314}#
+ #{x\ 312}#
+ (cons #{a\ 313}# #{d\ 314}#)))
+ (if (vector? #{x\ 312}#)
+ (let ((#{old\ 315}#
(vector->list
- #{x\ 311}#)))
- (let ((#{new\ 315}#
- (map #{f\ 310}#
- #{old\ 314}#)))
+ #{x\ 312}#)))
+ (let ((#{new\ 316}#
+ (map #{f\ 311}#
+ #{old\ 315}#)))
(if (#{and-map*\ 31}#
eq?
- #{old\ 314}#
- #{new\ 315}#)
- #{x\ 311}#
+ #{old\ 315}#
+ #{new\ 316}#)
+ #{x\ 312}#
(list->vector
- #{new\ 315}#))))
- #{x\ 311}#))))))
- (#{f\ 310}# #{x\ 308}#)))))
- (#{ellipsis?\ 174}#
- (lambda (#{x\ 316}#)
- (if (#{nonsymbol-id?\ 128}# #{x\ 316}#)
- (#{free-id=?\ 152}#
- #{x\ 316}#
+ #{new\ 316}#))))
+ #{x\ 312}#))))))
+ (#{f\ 311}# #{x\ 309}#)))))
+ (#{ellipsis?\ 175}#
+ (lambda (#{x\ 317}#)
+ (if (#{nonsymbol-id?\ 130}# #{x\ 317}#)
+ (#{free-id=?\ 154}#
+ #{x\ 317}#
'#(syntax-object
...
((top)
@@ -134,7 +134,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -216,7 +215,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -350,6 +351,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -462,6 +464,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure and-map*)
@@ -469,1369 +472,1222 @@
("i" "i")))
(hygiene guile)))
#f)))
- (#{chi-void\ 173}#
+ (#{chi-void\ 174}#
(lambda () (#{build-void\ 95}# #f)))
- (#{eval-local-transformer\ 172}#
- (lambda (#{expanded\ 317}# #{mod\ 318}#)
- (let ((#{p\ 319}# (#{local-eval-hook\ 91}#
- #{expanded\ 317}#
- #{mod\ 318}#)))
- (if (procedure? #{p\ 319}#)
- #{p\ 319}#
+ (#{eval-local-transformer\ 173}#
+ (lambda (#{expanded\ 318}# #{mod\ 319}#)
+ (let ((#{p\ 320}# (#{local-eval-hook\ 91}#
+ #{expanded\ 318}#
+ #{mod\ 319}#)))
+ (if (procedure? #{p\ 320}#)
+ #{p\ 320}#
(syntax-violation
#f
"nonprocedure transformer"
- #{p\ 319}#)))))
- (#{chi-local-syntax\ 171}#
- (lambda (#{rec?\ 320}#
- #{e\ 321}#
- #{r\ 322}#
- #{w\ 323}#
- #{s\ 324}#
- #{mod\ 325}#
- #{k\ 326}#)
- ((lambda (#{tmp\ 327}#)
- ((lambda (#{tmp\ 328}#)
- (if #{tmp\ 328}#
- (apply (lambda (#{_\ 329}#
- #{id\ 330}#
- #{val\ 331}#
- #{e1\ 332}#
- #{e2\ 333}#)
- (let ((#{ids\ 334}# #{id\ 330}#))
- (if (not (#{valid-bound-ids?\ 154}#
- #{ids\ 334}#))
+ #{p\ 320}#)))))
+ (#{chi-local-syntax\ 172}#
+ (lambda (#{rec?\ 321}#
+ #{e\ 322}#
+ #{r\ 323}#
+ #{w\ 324}#
+ #{s\ 325}#
+ #{mod\ 326}#
+ #{k\ 327}#)
+ ((lambda (#{tmp\ 328}#)
+ ((lambda (#{tmp\ 329}#)
+ (if #{tmp\ 329}#
+ (apply (lambda (#{_\ 330}#
+ #{id\ 331}#
+ #{val\ 332}#
+ #{e1\ 333}#
+ #{e2\ 334}#)
+ (let ((#{ids\ 335}# #{id\ 331}#))
+ (if (not (#{valid-bound-ids?\ 156}#
+ #{ids\ 335}#))
(syntax-violation
#f
"duplicate bound keyword"
- #{e\ 321}#)
- (let ((#{labels\ 336}#
- (#{gen-labels\ 135}#
- #{ids\ 334}#)))
- (let ((#{new-w\ 337}#
- (#{make-binding-wrap\ 146}#
- #{ids\ 334}#
- #{labels\ 336}#
- #{w\ 323}#)))
- (#{k\ 326}# (cons #{e1\ 332}#
- #{e2\ 333}#)
- (#{extend-env\ 123}#
- #{labels\ 336}#
- (let ((#{w\ 339}# (if #{rec?\ 320}#
- #{new-w\ 337}#
- #{w\ 323}#))
- (#{trans-r\ 340}#
- (#{macros-only-env\ 125}#
- #{r\ 322}#)))
- (map (lambda (#{x\ 341}#)
+ #{e\ 322}#)
+ (let ((#{labels\ 337}#
+ (#{gen-labels\ 137}#
+ #{ids\ 335}#)))
+ (let ((#{new-w\ 338}#
+ (#{make-binding-wrap\ 148}#
+ #{ids\ 335}#
+ #{labels\ 337}#
+ #{w\ 324}#)))
+ (#{k\ 327}# (cons #{e1\ 333}#
+ #{e2\ 334}#)
+ (#{extend-env\ 125}#
+ #{labels\ 337}#
+ (let ((#{w\ 340}# (if #{rec?\ 321}#
+ #{new-w\ 338}#
+ #{w\ 324}#))
+ (#{trans-r\ 341}#
+ (#{macros-only-env\ 127}#
+ #{r\ 323}#)))
+ (map (lambda (#{x\ 342}#)
(cons 'macro
- (#{eval-local-transformer\ 172}#
- (#{chi\ 165}#
- #{x\ 341}#
- #{trans-r\ 340}#
- #{w\ 339}#
- #{mod\ 325}#)
- #{mod\ 325}#)))
- #{val\ 331}#))
- #{r\ 322}#)
- #{new-w\ 337}#
- #{s\ 324}#
- #{mod\ 325}#))))))
- #{tmp\ 328}#)
- ((lambda (#{_\ 343}#)
+ (#{eval-local-transformer\ 173}#
+ (#{chi\ 167}#
+ #{x\ 342}#
+ #{trans-r\ 341}#
+ #{w\ 340}#
+ #{mod\ 326}#)
+ #{mod\ 326}#)))
+ #{val\ 332}#))
+ #{r\ 323}#)
+ #{new-w\ 338}#
+ #{s\ 325}#
+ #{mod\ 326}#))))))
+ #{tmp\ 329}#)
+ ((lambda (#{_\ 344}#)
(syntax-violation
#f
"bad local syntax definition"
- (#{source-wrap\ 158}#
- #{e\ 321}#
- #{w\ 323}#
- #{s\ 324}#
- #{mod\ 325}#)))
- #{tmp\ 327}#)))
+ (#{source-wrap\ 160}#
+ #{e\ 322}#
+ #{w\ 324}#
+ #{s\ 325}#
+ #{mod\ 326}#)))
+ #{tmp\ 328}#)))
($sc-dispatch
- #{tmp\ 327}#
+ #{tmp\ 328}#
'(any #(each (any any)) any . each-any))))
- #{e\ 321}#)))
- (#{chi-lambda-clause\ 170}#
- (lambda (#{e\ 344}#
- #{docstring\ 345}#
- #{c\ 346}#
+ #{e\ 322}#)))
+ (#{chi-body\ 171}#
+ (lambda (#{body\ 345}#
+ #{outer-form\ 346}#
#{r\ 347}#
#{w\ 348}#
- #{mod\ 349}#
- #{k\ 350}#)
- ((lambda (#{tmp\ 351}#)
- ((lambda (#{tmp\ 352}#)
- (if (if #{tmp\ 352}#
- (apply (lambda (#{args\ 353}#
- #{doc\ 354}#
- #{e1\ 355}#
- #{e2\ 356}#)
- (if (string? (syntax->datum #{doc\ 354}#))
- (not #{docstring\ 345}#)
- #f))
- #{tmp\ 352}#)
- #f)
- (apply (lambda (#{args\ 357}#
- #{doc\ 358}#
- #{e1\ 359}#
- #{e2\ 360}#)
- (#{chi-lambda-clause\ 170}#
- #{e\ 344}#
- #{doc\ 358}#
- (cons #{args\ 357}#
- (cons #{e1\ 359}# #{e2\ 360}#))
- #{r\ 347}#
- #{w\ 348}#
- #{mod\ 349}#
- #{k\ 350}#))
- #{tmp\ 352}#)
- ((lambda (#{tmp\ 362}#)
- (if #{tmp\ 362}#
- (apply (lambda (#{id\ 363}#
- #{e1\ 364}#
- #{e2\ 365}#)
- (let ((#{ids\ 366}# #{id\ 363}#))
- (if (not (#{valid-bound-ids?\ 154}#
- #{ids\ 366}#))
- (syntax-violation
- 'lambda
- "invalid parameter list"
- #{e\ 344}#)
- (let ((#{labels\ 368}#
- (#{gen-labels\ 135}#
- #{ids\ 366}#))
- (#{new-vars\ 369}#
- (map #{gen-var\ 176}#
- #{ids\ 366}#)))
- (#{k\ 350}# (map syntax->datum
- #{ids\ 366}#)
- #{new-vars\ 369}#
- (if #{docstring\ 345}#
- (syntax->datum
- #{docstring\ 345}#)
- #f)
- (#{chi-body\ 169}#
- (cons #{e1\ 364}#
- #{e2\ 365}#)
- #{e\ 344}#
- (#{extend-var-env\ 124}#
- #{labels\ 368}#
- #{new-vars\ 369}#
- #{r\ 347}#)
- (#{make-binding-wrap\ 146}#
- #{ids\ 366}#
- #{labels\ 368}#
- #{w\ 348}#)
- #{mod\ 349}#))))))
- #{tmp\ 362}#)
- ((lambda (#{tmp\ 371}#)
- (if #{tmp\ 371}#
- (apply (lambda (#{ids\ 372}#
- #{e1\ 373}#
- #{e2\ 374}#)
- (let ((#{old-ids\ 375}#
- (#{lambda-var-list\ 177}#
- #{ids\ 372}#)))
- (if (not (#{valid-bound-ids?\ 154}#
- #{old-ids\ 375}#))
- (syntax-violation
- 'lambda
- "invalid parameter list"
- #{e\ 344}#)
- (let ((#{labels\ 376}#
- (#{gen-labels\ 135}#
- #{old-ids\ 375}#))
- (#{new-vars\ 377}#
- (map #{gen-var\ 176}#
- #{old-ids\ 375}#)))
- (#{k\ 350}# (letrec ((#{f\ 378}# (lambda (#{ls1\ 379}#
- #{ls2\ 380}#)
- (if (null? #{ls1\ 379}#)
- (syntax->datum
- #{ls2\ 380}#)
- (#{f\ 378}# (cdr #{ls1\ 379}#)
- (cons (syntax->datum
- (car #{ls1\ 379}#))
- #{ls2\ 380}#))))))
- (#{f\ 378}# (cdr #{old-ids\ 375}#)
- (car #{old-ids\ 375}#)))
- (letrec ((#{f\ 381}# (lambda (#{ls1\ 382}#
- #{ls2\ 383}#)
- (if (null? #{ls1\ 382}#)
- #{ls2\ 383}#
- (#{f\ 381}# (cdr #{ls1\ 382}#)
- (cons (car #{ls1\ 382}#)
- #{ls2\ 383}#))))))
- (#{f\ 381}# (cdr #{new-vars\ 377}#)
- (car #{new-vars\ 377}#)))
- (if #{docstring\ 345}#
- (syntax->datum
- #{docstring\ 345}#)
- #f)
- (#{chi-body\ 169}#
- (cons #{e1\ 373}#
- #{e2\ 374}#)
- #{e\ 344}#
- (#{extend-var-env\ 124}#
- #{labels\ 376}#
- #{new-vars\ 377}#
- #{r\ 347}#)
- (#{make-binding-wrap\ 146}#
- #{old-ids\ 375}#
- #{labels\ 376}#
- #{w\ 348}#)
- #{mod\ 349}#))))))
- #{tmp\ 371}#)
- ((lambda (#{_\ 385}#)
- (syntax-violation
- 'lambda
- "bad lambda"
- #{e\ 344}#))
- #{tmp\ 351}#)))
- ($sc-dispatch
- #{tmp\ 351}#
- '(any any . each-any)))))
- ($sc-dispatch
- #{tmp\ 351}#
- '(each-any any . each-any)))))
- ($sc-dispatch
- #{tmp\ 351}#
- '(any any any . each-any))))
- #{c\ 346}#)))
- (#{chi-body\ 169}#
- (lambda (#{body\ 386}#
- #{outer-form\ 387}#
- #{r\ 388}#
- #{w\ 389}#
- #{mod\ 390}#)
- (let ((#{r\ 391}# (cons '("placeholder" placeholder)
- #{r\ 388}#)))
- (let ((#{ribcage\ 392}#
- (#{make-ribcage\ 136}#
+ #{mod\ 349}#)
+ (let ((#{r\ 350}# (cons '("placeholder" placeholder)
+ #{r\ 347}#)))
+ (let ((#{ribcage\ 351}#
+ (#{make-ribcage\ 138}#
'()
'()
'())))
- (let ((#{w\ 393}# (#{make-wrap\ 131}#
- (#{wrap-marks\ 132}# #{w\ 389}#)
- (cons #{ribcage\ 392}#
- (#{wrap-subst\ 133}#
- #{w\ 389}#)))))
- (letrec ((#{parse\ 394}#
- (lambda (#{body\ 395}#
- #{ids\ 396}#
- #{labels\ 397}#
- #{var-ids\ 398}#
- #{vars\ 399}#
- #{vals\ 400}#
- #{bindings\ 401}#)
- (if (null? #{body\ 395}#)
+ (let ((#{w\ 352}# (#{make-wrap\ 133}#
+ (#{wrap-marks\ 134}# #{w\ 348}#)
+ (cons #{ribcage\ 351}#
+ (#{wrap-subst\ 135}#
+ #{w\ 348}#)))))
+ (letrec ((#{parse\ 353}#
+ (lambda (#{body\ 354}#
+ #{ids\ 355}#
+ #{labels\ 356}#
+ #{var-ids\ 357}#
+ #{vars\ 358}#
+ #{vals\ 359}#
+ #{bindings\ 360}#)
+ (if (null? #{body\ 354}#)
(syntax-violation
#f
"no expressions in body"
- #{outer-form\ 387}#)
- (let ((#{e\ 403}# (cdar #{body\ 395}#))
- (#{er\ 404}# (caar #{body\ 395}#)))
+ #{outer-form\ 346}#)
+ (let ((#{e\ 362}# (cdar #{body\ 354}#))
+ (#{er\ 363}# (caar #{body\ 354}#)))
(call-with-values
(lambda ()
- (#{syntax-type\ 163}#
- #{e\ 403}#
- #{er\ 404}#
+ (#{syntax-type\ 165}#
+ #{e\ 362}#
+ #{er\ 363}#
'(())
- (#{source-annotation\ 120}#
- #{er\ 404}#)
- #{ribcage\ 392}#
- #{mod\ 390}#
+ (#{source-annotation\ 122}#
+ #{er\ 363}#)
+ #{ribcage\ 351}#
+ #{mod\ 349}#
#f))
- (lambda (#{type\ 405}#
- #{value\ 406}#
- #{e\ 407}#
- #{w\ 408}#
- #{s\ 409}#
- #{mod\ 410}#)
- (if (memv #{type\ 405}#
+ (lambda (#{type\ 364}#
+ #{value\ 365}#
+ #{e\ 366}#
+ #{w\ 367}#
+ #{s\ 368}#
+ #{mod\ 369}#)
+ (if (memv #{type\ 364}#
'(define-form))
- (let ((#{id\ 411}#
- (#{wrap\ 157}#
- #{value\ 406}#
- #{w\ 408}#
- #{mod\ 410}#))
- (#{label\ 412}#
- (#{gen-label\ 134}#)))
- (let ((#{var\ 413}#
- (#{gen-var\ 176}#
- #{id\ 411}#)))
+ (let ((#{id\ 370}#
+ (#{wrap\ 159}#
+ #{value\ 365}#
+ #{w\ 367}#
+ #{mod\ 369}#))
+ (#{label\ 371}#
+ (#{gen-label\ 136}#)))
+ (let ((#{var\ 372}#
+ (#{gen-var\ 177}#
+ #{id\ 370}#)))
(begin
- (#{extend-ribcage!\ 145}#
- #{ribcage\ 392}#
- #{id\ 411}#
- #{label\ 412}#)
- (#{parse\ 394}#
- (cdr #{body\ 395}#)
- (cons #{id\ 411}#
- #{ids\ 396}#)
- (cons #{label\ 412}#
- #{labels\ 397}#)
- (cons #{id\ 411}#
- #{var-ids\ 398}#)
- (cons #{var\ 413}#
- #{vars\ 399}#)
- (cons (cons #{er\ 404}#
- (#{wrap\ 157}#
- #{e\ 407}#
- #{w\ 408}#
- #{mod\ 410}#))
- #{vals\ 400}#)
+ (#{extend-ribcage!\ 147}#
+ #{ribcage\ 351}#
+ #{id\ 370}#
+ #{label\ 371}#)
+ (#{parse\ 353}#
+ (cdr #{body\ 354}#)
+ (cons #{id\ 370}#
+ #{ids\ 355}#)
+ (cons #{label\ 371}#
+ #{labels\ 356}#)
+ (cons #{id\ 370}#
+ #{var-ids\ 357}#)
+ (cons #{var\ 372}#
+ #{vars\ 358}#)
+ (cons (cons #{er\ 363}#
+ (#{wrap\ 159}#
+ #{e\ 366}#
+ #{w\ 367}#
+ #{mod\ 369}#))
+ #{vals\ 359}#)
(cons (cons 'lexical
- #{var\ 413}#)
- #{bindings\ 401}#)))))
- (if (memv #{type\ 405}#
+ #{var\ 372}#)
+ #{bindings\ 360}#)))))
+ (if (memv #{type\ 364}#
'(define-syntax-form))
- (let ((#{id\ 414}#
- (#{wrap\ 157}#
- #{value\ 406}#
- #{w\ 408}#
- #{mod\ 410}#))
- (#{label\ 415}#
- (#{gen-label\ 134}#)))
+ (let ((#{id\ 373}#
+ (#{wrap\ 159}#
+ #{value\ 365}#
+ #{w\ 367}#
+ #{mod\ 369}#))
+ (#{label\ 374}#
+ (#{gen-label\ 136}#)))
(begin
- (#{extend-ribcage!\ 145}#
- #{ribcage\ 392}#
- #{id\ 414}#
- #{label\ 415}#)
- (#{parse\ 394}#
- (cdr #{body\ 395}#)
- (cons #{id\ 414}#
- #{ids\ 396}#)
- (cons #{label\ 415}#
- #{labels\ 397}#)
- #{var-ids\ 398}#
- #{vars\ 399}#
- #{vals\ 400}#
+ (#{extend-ribcage!\ 147}#
+ #{ribcage\ 351}#
+ #{id\ 373}#
+ #{label\ 374}#)
+ (#{parse\ 353}#
+ (cdr #{body\ 354}#)
+ (cons #{id\ 373}#
+ #{ids\ 355}#)
+ (cons #{label\ 374}#
+ #{labels\ 356}#)
+ #{var-ids\ 357}#
+ #{vars\ 358}#
+ #{vals\ 359}#
(cons (cons 'macro
- (cons #{er\ 404}#
- (#{wrap\ 157}#
- #{e\ 407}#
- #{w\ 408}#
- #{mod\ 410}#)))
- #{bindings\ 401}#))))
- (if (memv #{type\ 405}#
+ (cons #{er\ 363}#
+ (#{wrap\ 159}#
+ #{e\ 366}#
+ #{w\ 367}#
+ #{mod\ 369}#)))
+ #{bindings\ 360}#))))
+ (if (memv #{type\ 364}#
'(begin-form))
- ((lambda (#{tmp\ 416}#)
- ((lambda (#{tmp\ 417}#)
- (if #{tmp\ 417}#
- (apply (lambda (#{_\ 418}#
- #{e1\ 419}#)
- (#{parse\ 394}#
- (letrec ((#{f\ 420}# (lambda (#{forms\ 421}#)
- (if (null? #{forms\ 421}#)
- (cdr #{body\ 395}#)
- (cons (cons #{er\ 404}#
- (#{wrap\ 157}#
- (car #{forms\ 421}#)
- #{w\ 408}#
- #{mod\ 410}#))
- (#{f\ 420}# (cdr #{forms\ 421}#)))))))
- (#{f\ 420}# #{e1\ 419}#))
- #{ids\ 396}#
- #{labels\ 397}#
- #{var-ids\ 398}#
- #{vars\ 399}#
- #{vals\ 400}#
- #{bindings\ 401}#))
- #{tmp\ 417}#)
+ ((lambda (#{tmp\ 375}#)
+ ((lambda (#{tmp\ 376}#)
+ (if #{tmp\ 376}#
+ (apply (lambda (#{_\ 377}#
+ #{e1\ 378}#)
+ (#{parse\ 353}#
+ (letrec ((#{f\ 379}# (lambda (#{forms\ 380}#)
+ (if (null? #{forms\ 380}#)
+ (cdr #{body\ 354}#)
+ (cons (cons #{er\ 363}#
+ (#{wrap\ 159}#
+ (car #{forms\ 380}#)
+ #{w\ 367}#
+ #{mod\ 369}#))
+ (#{f\ 379}# (cdr #{forms\ 380}#)))))))
+ (#{f\ 379}# #{e1\ 378}#))
+ #{ids\ 355}#
+ #{labels\ 356}#
+ #{var-ids\ 357}#
+ #{vars\ 358}#
+ #{vals\ 359}#
+ #{bindings\ 360}#))
+ #{tmp\ 376}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 416}#)))
+ #{tmp\ 375}#)))
($sc-dispatch
- #{tmp\ 416}#
+ #{tmp\ 375}#
'(any . each-any))))
- #{e\ 407}#)
- (if (memv #{type\ 405}#
+ #{e\ 366}#)
+ (if (memv #{type\ 364}#
'(local-syntax-form))
- (#{chi-local-syntax\ 171}#
- #{value\ 406}#
- #{e\ 407}#
- #{er\ 404}#
- #{w\ 408}#
- #{s\ 409}#
- #{mod\ 410}#
- (lambda (#{forms\ 423}#
- #{er\ 424}#
- #{w\ 425}#
- #{s\ 426}#
- #{mod\ 427}#)
- (#{parse\ 394}#
- (letrec ((#{f\ 428}# (lambda (#{forms\ 429}#)
- (if (null? #{forms\ 429}#)
- (cdr #{body\ 395}#)
- (cons (cons #{er\ 424}#
- (#{wrap\ 157}#
- (car #{forms\ 429}#)
- #{w\ 425}#
- #{mod\ 427}#))
- (#{f\ 428}# (cdr #{forms\ 429}#)))))))
- (#{f\ 428}# #{forms\ 423}#))
- #{ids\ 396}#
- #{labels\ 397}#
- #{var-ids\ 398}#
- #{vars\ 399}#
- #{vals\ 400}#
- #{bindings\ 401}#)))
- (if (null? #{ids\ 396}#)
- (#{build-sequence\ 108}#
+ (#{chi-local-syntax\ 172}#
+ #{value\ 365}#
+ #{e\ 366}#
+ #{er\ 363}#
+ #{w\ 367}#
+ #{s\ 368}#
+ #{mod\ 369}#
+ (lambda (#{forms\ 382}#
+ #{er\ 383}#
+ #{w\ 384}#
+ #{s\ 385}#
+ #{mod\ 386}#)
+ (#{parse\ 353}#
+ (letrec ((#{f\ 387}# (lambda (#{forms\ 388}#)
+ (if (null? #{forms\ 388}#)
+ (cdr #{body\ 354}#)
+ (cons (cons #{er\ 383}#
+ (#{wrap\ 159}#
+ (car #{forms\ 388}#)
+ #{w\ 384}#
+ #{mod\ 386}#))
+ (#{f\ 387}# (cdr #{forms\ 388}#)))))))
+ (#{f\ 387}# #{forms\ 382}#))
+ #{ids\ 355}#
+ #{labels\ 356}#
+ #{var-ids\ 357}#
+ #{vars\ 358}#
+ #{vals\ 359}#
+ #{bindings\ 360}#)))
+ (if (null? #{ids\ 355}#)
+ (#{build-sequence\ 110}#
#f
- (map (lambda (#{x\ 430}#)
- (#{chi\ 165}#
- (cdr #{x\ 430}#)
- (car #{x\ 430}#)
+ (map (lambda (#{x\ 389}#)
+ (#{chi\ 167}#
+ (cdr #{x\ 389}#)
+ (car #{x\ 389}#)
'(())
- #{mod\ 410}#))
- (cons (cons #{er\ 404}#
- (#{source-wrap\ 158}#
- #{e\ 407}#
- #{w\ 408}#
- #{s\ 409}#
- #{mod\ 410}#))
- (cdr #{body\ 395}#))))
+ #{mod\ 369}#))
+ (cons (cons #{er\ 363}#
+ (#{source-wrap\ 160}#
+ #{e\ 366}#
+ #{w\ 367}#
+ #{s\ 368}#
+ #{mod\ 369}#))
+ (cdr #{body\ 354}#))))
(begin
- (if (not (#{valid-bound-ids?\ 154}#
- #{ids\ 396}#))
+ (if (not (#{valid-bound-ids?\ 156}#
+ #{ids\ 355}#))
(syntax-violation
#f
"invalid or duplicate identifier in definition"
- #{outer-form\ 387}#))
- (letrec ((#{loop\ 431}#
- (lambda (#{bs\ 432}#
- #{er-cache\ 433}#
- #{r-cache\ 434}#)
- (if (not (null? #{bs\ 432}#))
- (let ((#{b\ 435}# (car #{bs\ 432}#)))
- (if (eq? (car #{b\ 435}#)
+ #{outer-form\ 346}#))
+ (letrec ((#{loop\ 390}#
+ (lambda (#{bs\ 391}#
+ #{er-cache\ 392}#
+ #{r-cache\ 393}#)
+ (if (not (null? #{bs\ 391}#))
+ (let ((#{b\ 394}# (car #{bs\ 391}#)))
+ (if (eq? (car #{b\ 394}#)
'macro)
- (let ((#{er\ 436}#
- (cadr #{b\ 435}#)))
- (let ((#{r-cache\ 437}#
- (if (eq? #{er\ 436}#
- #{er-cache\ 433}#)
- #{r-cache\ 434}#
- (#{macros-only-env\ 125}#
- #{er\ 436}#))))
+ (let ((#{er\ 395}#
+ (cadr #{b\ 394}#)))
+ (let ((#{r-cache\ 396}#
+ (if (eq? #{er\ 395}#
+ #{er-cache\ 392}#)
+ #{r-cache\ 393}#
+ (#{macros-only-env\ 127}#
+ #{er\ 395}#))))
(begin
(set-cdr!
- #{b\ 435}#
- (#{eval-local-transformer\ 172}#
- (#{chi\ 165}#
- (cddr #{b\ 435}#)
- #{r-cache\ 437}#
+ #{b\ 394}#
+ (#{eval-local-transformer\ 173}#
+ (#{chi\ 167}#
+ (cddr #{b\ 394}#)
+ #{r-cache\ 396}#
'(())
- #{mod\ 410}#)
- #{mod\ 410}#))
- (#{loop\ 431}#
- (cdr #{bs\ 432}#)
- #{er\ 436}#
- #{r-cache\ 437}#))))
- (#{loop\ 431}#
- (cdr #{bs\ 432}#)
- #{er-cache\ 433}#
- #{r-cache\ 434}#)))))))
- (#{loop\ 431}#
- #{bindings\ 401}#
+ #{mod\ 369}#)
+ #{mod\ 369}#))
+ (#{loop\ 390}#
+ (cdr #{bs\ 391}#)
+ #{er\ 395}#
+ #{r-cache\ 396}#))))
+ (#{loop\ 390}#
+ (cdr #{bs\ 391}#)
+ #{er-cache\ 392}#
+ #{r-cache\ 393}#)))))))
+ (#{loop\ 390}#
+ #{bindings\ 360}#
#f
#f))
(set-cdr!
- #{r\ 391}#
- (#{extend-env\ 123}#
- #{labels\ 397}#
- #{bindings\ 401}#
- (cdr #{r\ 391}#)))
- (#{build-letrec\ 111}#
+ #{r\ 350}#
+ (#{extend-env\ 125}#
+ #{labels\ 356}#
+ #{bindings\ 360}#
+ (cdr #{r\ 350}#)))
+ (#{build-letrec\ 113}#
#f
(map syntax->datum
- #{var-ids\ 398}#)
- #{vars\ 399}#
- (map (lambda (#{x\ 438}#)
- (#{chi\ 165}#
- (cdr #{x\ 438}#)
- (car #{x\ 438}#)
+ #{var-ids\ 357}#)
+ #{vars\ 358}#
+ (map (lambda (#{x\ 397}#)
+ (#{chi\ 167}#
+ (cdr #{x\ 397}#)
+ (car #{x\ 397}#)
'(())
- #{mod\ 410}#))
- #{vals\ 400}#)
- (#{build-sequence\ 108}#
+ #{mod\ 369}#))
+ #{vals\ 359}#)
+ (#{build-sequence\ 110}#
#f
- (map (lambda (#{x\ 439}#)
- (#{chi\ 165}#
- (cdr #{x\ 439}#)
- (car #{x\ 439}#)
+ (map (lambda (#{x\ 398}#)
+ (#{chi\ 167}#
+ (cdr #{x\ 398}#)
+ (car #{x\ 398}#)
'(())
- #{mod\ 410}#))
- (cons (cons #{er\ 404}#
- (#{source-wrap\ 158}#
- #{e\ 407}#
- #{w\ 408}#
- #{s\ 409}#
- #{mod\ 410}#))
- (cdr #{body\ 395}#))))))))))))))))))
- (#{parse\ 394}#
- (map (lambda (#{x\ 402}#)
- (cons #{r\ 391}#
- (#{wrap\ 157}#
- #{x\ 402}#
- #{w\ 393}#
- #{mod\ 390}#)))
- #{body\ 386}#)
+ #{mod\ 369}#))
+ (cons (cons #{er\ 363}#
+ (#{source-wrap\ 160}#
+ #{e\ 366}#
+ #{w\ 367}#
+ #{s\ 368}#
+ #{mod\ 369}#))
+ (cdr #{body\ 354}#))))))))))))))))))
+ (#{parse\ 353}#
+ (map (lambda (#{x\ 361}#)
+ (cons #{r\ 350}#
+ (#{wrap\ 159}#
+ #{x\ 361}#
+ #{w\ 352}#
+ #{mod\ 349}#)))
+ #{body\ 345}#)
'()
'()
'()
'()
'()
'())))))))
- (#{chi-macro\ 168}#
- (lambda (#{p\ 440}#
- #{e\ 441}#
- #{r\ 442}#
- #{w\ 443}#
- #{rib\ 444}#
- #{mod\ 445}#)
- (letrec ((#{rebuild-macro-output\ 446}#
- (lambda (#{x\ 447}# #{m\ 448}#)
- (if (pair? #{x\ 447}#)
- (cons (#{rebuild-macro-output\ 446}#
- (car #{x\ 447}#)
- #{m\ 448}#)
- (#{rebuild-macro-output\ 446}#
- (cdr #{x\ 447}#)
- #{m\ 448}#))
- (if (#{syntax-object?\ 113}# #{x\ 447}#)
- (let ((#{w\ 449}# (#{syntax-object-wrap\ 115}#
- #{x\ 447}#)))
- (let ((#{ms\ 450}#
- (#{wrap-marks\ 132}# #{w\ 449}#))
- (#{s\ 451}# (#{wrap-subst\ 133}#
- #{w\ 449}#)))
- (if (if (pair? #{ms\ 450}#)
- (eq? (car #{ms\ 450}#) #f)
+ (#{chi-macro\ 170}#
+ (lambda (#{p\ 399}#
+ #{e\ 400}#
+ #{r\ 401}#
+ #{w\ 402}#
+ #{rib\ 403}#
+ #{mod\ 404}#)
+ (letrec ((#{rebuild-macro-output\ 405}#
+ (lambda (#{x\ 406}# #{m\ 407}#)
+ (if (pair? #{x\ 406}#)
+ (cons (#{rebuild-macro-output\ 405}#
+ (car #{x\ 406}#)
+ #{m\ 407}#)
+ (#{rebuild-macro-output\ 405}#
+ (cdr #{x\ 406}#)
+ #{m\ 407}#))
+ (if (#{syntax-object?\ 115}# #{x\ 406}#)
+ (let ((#{w\ 408}# (#{syntax-object-wrap\ 117}#
+ #{x\ 406}#)))
+ (let ((#{ms\ 409}#
+ (#{wrap-marks\ 134}# #{w\ 408}#))
+ (#{s\ 410}# (#{wrap-subst\ 135}#
+ #{w\ 408}#)))
+ (if (if (pair? #{ms\ 409}#)
+ (eq? (car #{ms\ 409}#) #f)
#f)
- (#{make-syntax-object\ 112}#
- (#{syntax-object-expression\ 114}#
- #{x\ 447}#)
- (#{make-wrap\ 131}#
- (cdr #{ms\ 450}#)
- (if #{rib\ 444}#
- (cons #{rib\ 444}#
- (cdr #{s\ 451}#))
- (cdr #{s\ 451}#)))
- (#{syntax-object-module\ 116}#
- #{x\ 447}#))
- (#{make-syntax-object\ 112}#
- (#{syntax-object-expression\ 114}#
- #{x\ 447}#)
- (#{make-wrap\ 131}#
- (cons #{m\ 448}# #{ms\ 450}#)
- (if #{rib\ 444}#
- (cons #{rib\ 444}#
+ (#{make-syntax-object\ 114}#
+ (#{syntax-object-expression\ 116}#
+ #{x\ 406}#)
+ (#{make-wrap\ 133}#
+ (cdr #{ms\ 409}#)
+ (if #{rib\ 403}#
+ (cons #{rib\ 403}#
+ (cdr #{s\ 410}#))
+ (cdr #{s\ 410}#)))
+ (#{syntax-object-module\ 118}#
+ #{x\ 406}#))
+ (#{make-syntax-object\ 114}#
+ (#{syntax-object-expression\ 116}#
+ #{x\ 406}#)
+ (#{make-wrap\ 133}#
+ (cons #{m\ 407}# #{ms\ 409}#)
+ (if #{rib\ 403}#
+ (cons #{rib\ 403}#
(cons 'shift
- #{s\ 451}#))
- (cons (quote shift) #{s\ 451}#)))
- (let ((#{pmod\ 452}#
- (procedure-module #{p\ 440}#)))
- (if #{pmod\ 452}#
+ #{s\ 410}#))
+ (cons (quote shift) #{s\ 410}#)))
+ (let ((#{pmod\ 411}#
+ (procedure-module #{p\ 399}#)))
+ (if #{pmod\ 411}#
(cons 'hygiene
- (module-name #{pmod\ 452}#))
+ (module-name #{pmod\ 411}#))
'(hygiene guile)))))))
- (if (vector? #{x\ 447}#)
- (let ((#{n\ 453}# (vector-length
- #{x\ 447}#)))
- (let ((#{v\ 454}# (make-vector
- #{n\ 453}#)))
- (letrec ((#{loop\ 455}#
- (lambda (#{i\ 456}#)
+ (if (vector? #{x\ 406}#)
+ (let ((#{n\ 412}# (vector-length
+ #{x\ 406}#)))
+ (let ((#{v\ 413}# (make-vector
+ #{n\ 412}#)))
+ (letrec ((#{loop\ 414}#
+ (lambda (#{i\ 415}#)
(if (#{fx=\ 88}#
- #{i\ 456}#
- #{n\ 453}#)
+ #{i\ 415}#
+ #{n\ 412}#)
(begin
(if #f #f)
- #{v\ 454}#)
+ #{v\ 413}#)
(begin
(vector-set!
- #{v\ 454}#
- #{i\ 456}#
- (#{rebuild-macro-output\ 446}#
+ #{v\ 413}#
+ #{i\ 415}#
+ (#{rebuild-macro-output\ 405}#
(vector-ref
- #{x\ 447}#
- #{i\ 456}#)
- #{m\ 448}#))
- (#{loop\ 455}#
+ #{x\ 406}#
+ #{i\ 415}#)
+ #{m\ 407}#))
+ (#{loop\ 414}#
(#{fx+\ 86}#
- #{i\ 456}#
+ #{i\ 415}#
1)))))))
- (#{loop\ 455}# 0))))
- (if (symbol? #{x\ 447}#)
+ (#{loop\ 414}# 0))))
+ (if (symbol? #{x\ 406}#)
(syntax-violation
#f
"encountered raw symbol in macro output"
- (#{source-wrap\ 158}#
- #{e\ 441}#
- #{w\ 443}#
- (#{wrap-subst\ 133}# #{w\ 443}#)
- #{mod\ 445}#)
- #{x\ 447}#)
- #{x\ 447}#)))))))
- (#{rebuild-macro-output\ 446}#
- (#{p\ 440}# (#{wrap\ 157}#
- #{e\ 441}#
- (#{anti-mark\ 144}# #{w\ 443}#)
- #{mod\ 445}#))
+ (#{source-wrap\ 160}#
+ #{e\ 400}#
+ #{w\ 402}#
+ (#{wrap-subst\ 135}# #{w\ 402}#)
+ #{mod\ 404}#)
+ #{x\ 406}#)
+ #{x\ 406}#)))))))
+ (#{rebuild-macro-output\ 405}#
+ (#{p\ 399}# (#{wrap\ 159}#
+ #{e\ 400}#
+ (#{anti-mark\ 146}# #{w\ 402}#)
+ #{mod\ 404}#))
(string #\m)))))
- (#{chi-application\ 167}#
- (lambda (#{x\ 457}#
- #{e\ 458}#
- #{r\ 459}#
- #{w\ 460}#
- #{s\ 461}#
- #{mod\ 462}#)
- ((lambda (#{tmp\ 463}#)
- ((lambda (#{tmp\ 464}#)
- (if #{tmp\ 464}#
- (apply (lambda (#{e0\ 465}# #{e1\ 466}#)
+ (#{chi-application\ 169}#
+ (lambda (#{x\ 416}#
+ #{e\ 417}#
+ #{r\ 418}#
+ #{w\ 419}#
+ #{s\ 420}#
+ #{mod\ 421}#)
+ ((lambda (#{tmp\ 422}#)
+ ((lambda (#{tmp\ 423}#)
+ (if #{tmp\ 423}#
+ (apply (lambda (#{e0\ 424}# #{e1\ 425}#)
(#{build-application\ 96}#
- #{s\ 461}#
- #{x\ 457}#
- (map (lambda (#{e\ 467}#)
- (#{chi\ 165}#
- #{e\ 467}#
- #{r\ 459}#
- #{w\ 460}#
- #{mod\ 462}#))
- #{e1\ 466}#)))
- #{tmp\ 464}#)
+ #{s\ 420}#
+ #{x\ 416}#
+ (map (lambda (#{e\ 426}#)
+ (#{chi\ 167}#
+ #{e\ 426}#
+ #{r\ 418}#
+ #{w\ 419}#
+ #{mod\ 421}#))
+ #{e1\ 425}#)))
+ #{tmp\ 423}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 463}#)))
+ #{tmp\ 422}#)))
($sc-dispatch
- #{tmp\ 463}#
+ #{tmp\ 422}#
'(any . each-any))))
- #{e\ 458}#)))
- (#{chi-expr\ 166}#
- (lambda (#{type\ 469}#
- #{value\ 470}#
- #{e\ 471}#
- #{r\ 472}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#)
- (if (memv #{type\ 469}# (quote (lexical)))
+ #{e\ 417}#)))
+ (#{chi-expr\ 168}#
+ (lambda (#{type\ 428}#
+ #{value\ 429}#
+ #{e\ 430}#
+ #{r\ 431}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#)
+ (if (memv #{type\ 428}# (quote (lexical)))
(#{build-lexical-reference\ 98}#
'value
- #{s\ 474}#
- #{e\ 471}#
- #{value\ 470}#)
- (if (memv #{type\ 469}# (quote (core core-form)))
- (#{value\ 470}#
- #{e\ 471}#
- #{r\ 472}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#)
- (if (memv #{type\ 469}# (quote (module-ref)))
+ #{s\ 433}#
+ #{e\ 430}#
+ #{value\ 429}#)
+ (if (memv #{type\ 428}# (quote (core core-form)))
+ (#{value\ 429}#
+ #{e\ 430}#
+ #{r\ 431}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#)
+ (if (memv #{type\ 428}# (quote (module-ref)))
(call-with-values
- (lambda () (#{value\ 470}# #{e\ 471}#))
- (lambda (#{id\ 476}# #{mod\ 477}#)
+ (lambda () (#{value\ 429}# #{e\ 430}#))
+ (lambda (#{id\ 435}# #{mod\ 436}#)
(#{build-global-reference\ 101}#
- #{s\ 474}#
- #{id\ 476}#
- #{mod\ 477}#)))
- (if (memv #{type\ 469}# (quote (lexical-call)))
- (#{chi-application\ 167}#
+ #{s\ 433}#
+ #{id\ 435}#
+ #{mod\ 436}#)))
+ (if (memv #{type\ 428}# (quote (lexical-call)))
+ (#{chi-application\ 169}#
(#{build-lexical-reference\ 98}#
'fun
- (#{source-annotation\ 120}# (car #{e\ 471}#))
- (car #{e\ 471}#)
- #{value\ 470}#)
- #{e\ 471}#
- #{r\ 472}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#)
- (if (memv #{type\ 469}# (quote (global-call)))
- (#{chi-application\ 167}#
+ (#{source-annotation\ 122}# (car #{e\ 430}#))
+ (car #{e\ 430}#)
+ #{value\ 429}#)
+ #{e\ 430}#
+ #{r\ 431}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#)
+ (if (memv #{type\ 428}# (quote (global-call)))
+ (#{chi-application\ 169}#
(#{build-global-reference\ 101}#
- (#{source-annotation\ 120}# (car #{e\ 471}#))
- (if (#{syntax-object?\ 113}# #{value\ 470}#)
- (#{syntax-object-expression\ 114}#
- #{value\ 470}#)
- #{value\ 470}#)
- (if (#{syntax-object?\ 113}# #{value\ 470}#)
- (#{syntax-object-module\ 116}# #{value\ 470}#)
- #{mod\ 475}#))
- #{e\ 471}#
- #{r\ 472}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#)
- (if (memv #{type\ 469}# (quote (constant)))
- (#{build-data\ 107}#
- #{s\ 474}#
- (#{strip\ 175}#
- (#{source-wrap\ 158}#
- #{e\ 471}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#)
+ (#{source-annotation\ 122}# (car #{e\ 430}#))
+ (if (#{syntax-object?\ 115}# #{value\ 429}#)
+ (#{syntax-object-expression\ 116}#
+ #{value\ 429}#)
+ #{value\ 429}#)
+ (if (#{syntax-object?\ 115}# #{value\ 429}#)
+ (#{syntax-object-module\ 118}# #{value\ 429}#)
+ #{mod\ 434}#))
+ #{e\ 430}#
+ #{r\ 431}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#)
+ (if (memv #{type\ 428}# (quote (constant)))
+ (#{build-data\ 109}#
+ #{s\ 433}#
+ (#{strip\ 176}#
+ (#{source-wrap\ 160}#
+ #{e\ 430}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#)
'(())))
- (if (memv #{type\ 469}# (quote (global)))
+ (if (memv #{type\ 428}# (quote (global)))
(#{build-global-reference\ 101}#
- #{s\ 474}#
- #{value\ 470}#
- #{mod\ 475}#)
- (if (memv #{type\ 469}# (quote (call)))
- (#{chi-application\ 167}#
- (#{chi\ 165}#
- (car #{e\ 471}#)
- #{r\ 472}#
- #{w\ 473}#
- #{mod\ 475}#)
- #{e\ 471}#
- #{r\ 472}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#)
- (if (memv #{type\ 469}# (quote (begin-form)))
- ((lambda (#{tmp\ 478}#)
- ((lambda (#{tmp\ 479}#)
- (if #{tmp\ 479}#
- (apply (lambda (#{_\ 480}#
- #{e1\ 481}#
- #{e2\ 482}#)
- (#{chi-sequence\ 159}#
- (cons #{e1\ 481}#
- #{e2\ 482}#)
- #{r\ 472}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#))
- #{tmp\ 479}#)
+ #{s\ 433}#
+ #{value\ 429}#
+ #{mod\ 434}#)
+ (if (memv #{type\ 428}# (quote (call)))
+ (#{chi-application\ 169}#
+ (#{chi\ 167}#
+ (car #{e\ 430}#)
+ #{r\ 431}#
+ #{w\ 432}#
+ #{mod\ 434}#)
+ #{e\ 430}#
+ #{r\ 431}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#)
+ (if (memv #{type\ 428}# (quote (begin-form)))
+ ((lambda (#{tmp\ 437}#)
+ ((lambda (#{tmp\ 438}#)
+ (if #{tmp\ 438}#
+ (apply (lambda (#{_\ 439}#
+ #{e1\ 440}#
+ #{e2\ 441}#)
+ (#{chi-sequence\ 161}#
+ (cons #{e1\ 440}#
+ #{e2\ 441}#)
+ #{r\ 431}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#))
+ #{tmp\ 438}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 478}#)))
+ #{tmp\ 437}#)))
($sc-dispatch
- #{tmp\ 478}#
+ #{tmp\ 437}#
'(any any . each-any))))
- #{e\ 471}#)
- (if (memv #{type\ 469}#
+ #{e\ 430}#)
+ (if (memv #{type\ 428}#
'(local-syntax-form))
- (#{chi-local-syntax\ 171}#
- #{value\ 470}#
- #{e\ 471}#
- #{r\ 472}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#
- #{chi-sequence\ 159}#)
- (if (memv #{type\ 469}#
+ (#{chi-local-syntax\ 172}#
+ #{value\ 429}#
+ #{e\ 430}#
+ #{r\ 431}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#
+ #{chi-sequence\ 161}#)
+ (if (memv #{type\ 428}#
'(eval-when-form))
- ((lambda (#{tmp\ 484}#)
- ((lambda (#{tmp\ 485}#)
- (if #{tmp\ 485}#
- (apply (lambda (#{_\ 486}#
- #{x\ 487}#
- #{e1\ 488}#
- #{e2\ 489}#)
- (let ((#{when-list\ 490}#
- (#{chi-when-list\ 162}#
- #{e\ 471}#
- #{x\ 487}#
- #{w\ 473}#)))
+ ((lambda (#{tmp\ 443}#)
+ ((lambda (#{tmp\ 444}#)
+ (if #{tmp\ 444}#
+ (apply (lambda (#{_\ 445}#
+ #{x\ 446}#
+ #{e1\ 447}#
+ #{e2\ 448}#)
+ (let ((#{when-list\ 449}#
+ (#{chi-when-list\ 164}#
+ #{e\ 430}#
+ #{x\ 446}#
+ #{w\ 432}#)))
(if (memq 'eval
- #{when-list\ 490}#)
- (#{chi-sequence\ 159}#
- (cons #{e1\ 488}#
- #{e2\ 489}#)
- #{r\ 472}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#)
- (#{chi-void\ 173}#))))
- #{tmp\ 485}#)
+ #{when-list\ 449}#)
+ (#{chi-sequence\ 161}#
+ (cons #{e1\ 447}#
+ #{e2\ 448}#)
+ #{r\ 431}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#)
+ (#{chi-void\ 174}#))))
+ #{tmp\ 444}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 484}#)))
+ #{tmp\ 443}#)))
($sc-dispatch
- #{tmp\ 484}#
+ #{tmp\ 443}#
'(any each-any any . each-any))))
- #{e\ 471}#)
- (if (memv #{type\ 469}#
+ #{e\ 430}#)
+ (if (memv #{type\ 428}#
'(define-form
define-syntax-form))
(syntax-violation
#f
"definition in expression context"
- #{e\ 471}#
- (#{wrap\ 157}#
- #{value\ 470}#
- #{w\ 473}#
- #{mod\ 475}#))
- (if (memv #{type\ 469}#
+ #{e\ 430}#
+ (#{wrap\ 159}#
+ #{value\ 429}#
+ #{w\ 432}#
+ #{mod\ 434}#))
+ (if (memv #{type\ 428}#
'(syntax))
(syntax-violation
#f
"reference to pattern variable outside syntax form"
- (#{source-wrap\ 158}#
- #{e\ 471}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#))
- (if (memv #{type\ 469}#
+ (#{source-wrap\ 160}#
+ #{e\ 430}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#))
+ (if (memv #{type\ 428}#
'(displaced-lexical))
(syntax-violation
#f
"reference to identifier outside its scope"
- (#{source-wrap\ 158}#
- #{e\ 471}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#))
+ (#{source-wrap\ 160}#
+ #{e\ 430}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#))
(syntax-violation
#f
"unexpected syntax"
- (#{source-wrap\ 158}#
- #{e\ 471}#
- #{w\ 473}#
- #{s\ 474}#
- #{mod\ 475}#))))))))))))))))))
- (#{chi\ 165}#
- (lambda (#{e\ 493}# #{r\ 494}# #{w\ 495}# #{mod\ 496}#)
+ (#{source-wrap\ 160}#
+ #{e\ 430}#
+ #{w\ 432}#
+ #{s\ 433}#
+ #{mod\ 434}#))))))))))))))))))
+ (#{chi\ 167}#
+ (lambda (#{e\ 452}# #{r\ 453}# #{w\ 454}# #{mod\ 455}#)
(call-with-values
(lambda ()
- (#{syntax-type\ 163}#
- #{e\ 493}#
- #{r\ 494}#
- #{w\ 495}#
- (#{source-annotation\ 120}# #{e\ 493}#)
+ (#{syntax-type\ 165}#
+ #{e\ 452}#
+ #{r\ 453}#
+ #{w\ 454}#
+ (#{source-annotation\ 122}# #{e\ 452}#)
#f
- #{mod\ 496}#
+ #{mod\ 455}#
#f))
- (lambda (#{type\ 497}#
- #{value\ 498}#
- #{e\ 499}#
- #{w\ 500}#
- #{s\ 501}#
- #{mod\ 502}#)
- (#{chi-expr\ 166}#
- #{type\ 497}#
- #{value\ 498}#
- #{e\ 499}#
- #{r\ 494}#
- #{w\ 500}#
- #{s\ 501}#
- #{mod\ 502}#)))))
- (#{chi-top\ 164}#
- (lambda (#{e\ 503}#
- #{r\ 504}#
- #{w\ 505}#
- #{m\ 506}#
- #{esew\ 507}#
- #{mod\ 508}#)
+ (lambda (#{type\ 456}#
+ #{value\ 457}#
+ #{e\ 458}#
+ #{w\ 459}#
+ #{s\ 460}#
+ #{mod\ 461}#)
+ (#{chi-expr\ 168}#
+ #{type\ 456}#
+ #{value\ 457}#
+ #{e\ 458}#
+ #{r\ 453}#
+ #{w\ 459}#
+ #{s\ 460}#
+ #{mod\ 461}#)))))
+ (#{chi-top\ 166}#
+ (lambda (#{e\ 462}#
+ #{r\ 463}#
+ #{w\ 464}#
+ #{m\ 465}#
+ #{esew\ 466}#
+ #{mod\ 467}#)
(call-with-values
(lambda ()
- (#{syntax-type\ 163}#
- #{e\ 503}#
- #{r\ 504}#
- #{w\ 505}#
- (#{source-annotation\ 120}# #{e\ 503}#)
+ (#{syntax-type\ 165}#
+ #{e\ 462}#
+ #{r\ 463}#
+ #{w\ 464}#
+ (#{source-annotation\ 122}# #{e\ 462}#)
#f
- #{mod\ 508}#
+ #{mod\ 467}#
#f))
- (lambda (#{type\ 516}#
- #{value\ 517}#
- #{e\ 518}#
- #{w\ 519}#
- #{s\ 520}#
- #{mod\ 521}#)
- (if (memv #{type\ 516}# (quote (begin-form)))
- ((lambda (#{tmp\ 522}#)
- ((lambda (#{tmp\ 523}#)
- (if #{tmp\ 523}#
- (apply (lambda (#{_\ 524}#) (#{chi-void\ 173}#))
- #{tmp\ 523}#)
- ((lambda (#{tmp\ 525}#)
- (if #{tmp\ 525}#
- (apply (lambda (#{_\ 526}#
- #{e1\ 527}#
- #{e2\ 528}#)
- (#{chi-top-sequence\ 160}#
- (cons #{e1\ 527}# #{e2\ 528}#)
- #{r\ 504}#
- #{w\ 519}#
- #{s\ 520}#
- #{m\ 506}#
- #{esew\ 507}#
- #{mod\ 521}#))
- #{tmp\ 525}#)
+ (lambda (#{type\ 475}#
+ #{value\ 476}#
+ #{e\ 477}#
+ #{w\ 478}#
+ #{s\ 479}#
+ #{mod\ 480}#)
+ (if (memv #{type\ 475}# (quote (begin-form)))
+ ((lambda (#{tmp\ 481}#)
+ ((lambda (#{tmp\ 482}#)
+ (if #{tmp\ 482}#
+ (apply (lambda (#{_\ 483}#) (#{chi-void\ 174}#))
+ #{tmp\ 482}#)
+ ((lambda (#{tmp\ 484}#)
+ (if #{tmp\ 484}#
+ (apply (lambda (#{_\ 485}#
+ #{e1\ 486}#
+ #{e2\ 487}#)
+ (#{chi-top-sequence\ 162}#
+ (cons #{e1\ 486}# #{e2\ 487}#)
+ #{r\ 463}#
+ #{w\ 478}#
+ #{s\ 479}#
+ #{m\ 465}#
+ #{esew\ 466}#
+ #{mod\ 480}#))
+ #{tmp\ 484}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 522}#)))
+ #{tmp\ 481}#)))
($sc-dispatch
- #{tmp\ 522}#
+ #{tmp\ 481}#
'(any any . each-any)))))
- ($sc-dispatch #{tmp\ 522}# (quote (any)))))
- #{e\ 518}#)
- (if (memv #{type\ 516}# (quote (local-syntax-form)))
- (#{chi-local-syntax\ 171}#
- #{value\ 517}#
- #{e\ 518}#
- #{r\ 504}#
- #{w\ 519}#
- #{s\ 520}#
- #{mod\ 521}#
- (lambda (#{body\ 530}#
- #{r\ 531}#
- #{w\ 532}#
- #{s\ 533}#
- #{mod\ 534}#)
- (#{chi-top-sequence\ 160}#
- #{body\ 530}#
- #{r\ 531}#
- #{w\ 532}#
- #{s\ 533}#
- #{m\ 506}#
- #{esew\ 507}#
- #{mod\ 534}#)))
- (if (memv #{type\ 516}# (quote (eval-when-form)))
- ((lambda (#{tmp\ 535}#)
- ((lambda (#{tmp\ 536}#)
- (if #{tmp\ 536}#
- (apply (lambda (#{_\ 537}#
- #{x\ 538}#
- #{e1\ 539}#
- #{e2\ 540}#)
- (let ((#{when-list\ 541}#
- (#{chi-when-list\ 162}#
- #{e\ 518}#
- #{x\ 538}#
- #{w\ 519}#))
- (#{body\ 542}#
- (cons #{e1\ 539}#
- #{e2\ 540}#)))
- (if (eq? #{m\ 506}# (quote e))
+ ($sc-dispatch #{tmp\ 481}# (quote (any)))))
+ #{e\ 477}#)
+ (if (memv #{type\ 475}# (quote (local-syntax-form)))
+ (#{chi-local-syntax\ 172}#
+ #{value\ 476}#
+ #{e\ 477}#
+ #{r\ 463}#
+ #{w\ 478}#
+ #{s\ 479}#
+ #{mod\ 480}#
+ (lambda (#{body\ 489}#
+ #{r\ 490}#
+ #{w\ 491}#
+ #{s\ 492}#
+ #{mod\ 493}#)
+ (#{chi-top-sequence\ 162}#
+ #{body\ 489}#
+ #{r\ 490}#
+ #{w\ 491}#
+ #{s\ 492}#
+ #{m\ 465}#
+ #{esew\ 466}#
+ #{mod\ 493}#)))
+ (if (memv #{type\ 475}# (quote (eval-when-form)))
+ ((lambda (#{tmp\ 494}#)
+ ((lambda (#{tmp\ 495}#)
+ (if #{tmp\ 495}#
+ (apply (lambda (#{_\ 496}#
+ #{x\ 497}#
+ #{e1\ 498}#
+ #{e2\ 499}#)
+ (let ((#{when-list\ 500}#
+ (#{chi-when-list\ 164}#
+ #{e\ 477}#
+ #{x\ 497}#
+ #{w\ 478}#))
+ (#{body\ 501}#
+ (cons #{e1\ 498}#
+ #{e2\ 499}#)))
+ (if (eq? #{m\ 465}# (quote e))
(if (memq 'eval
- #{when-list\ 541}#)
- (#{chi-top-sequence\ 160}#
- #{body\ 542}#
- #{r\ 504}#
- #{w\ 519}#
- #{s\ 520}#
+ #{when-list\ 500}#)
+ (#{chi-top-sequence\ 162}#
+ #{body\ 501}#
+ #{r\ 463}#
+ #{w\ 478}#
+ #{s\ 479}#
'e
'(eval)
- #{mod\ 521}#)
- (#{chi-void\ 173}#))
+ #{mod\ 480}#)
+ (#{chi-void\ 174}#))
(if (memq 'load
- #{when-list\ 541}#)
- (if (let ((#{t\ 545}# (memq 'compile
- #{when-list\ 541}#)))
- (if #{t\ 545}#
- #{t\ 545}#
- (if (eq? #{m\ 506}#
+ #{when-list\ 500}#)
+ (if (let ((#{t\ 504}# (memq 'compile
+ #{when-list\ 500}#)))
+ (if #{t\ 504}#
+ #{t\ 504}#
+ (if (eq? #{m\ 465}#
'c&e)
(memq 'eval
- #{when-list\ 541}#)
+ #{when-list\ 500}#)
#f)))
- (#{chi-top-sequence\ 160}#
- #{body\ 542}#
- #{r\ 504}#
- #{w\ 519}#
- #{s\ 520}#
+ (#{chi-top-sequence\ 162}#
+ #{body\ 501}#
+ #{r\ 463}#
+ #{w\ 478}#
+ #{s\ 479}#
'c&e
'(compile load)
- #{mod\ 521}#)
- (if (memq #{m\ 506}#
+ #{mod\ 480}#)
+ (if (memq #{m\ 465}#
'(c c&e))
- (#{chi-top-sequence\ 160}#
- #{body\ 542}#
- #{r\ 504}#
- #{w\ 519}#
- #{s\ 520}#
+ (#{chi-top-sequence\ 162}#
+ #{body\ 501}#
+ #{r\ 463}#
+ #{w\ 478}#
+ #{s\ 479}#
'c
'(load)
- #{mod\ 521}#)
- (#{chi-void\ 173}#)))
- (if (let ((#{t\ 546}# (memq 'compile
- #{when-list\ 541}#)))
- (if #{t\ 546}#
- #{t\ 546}#
- (if (eq? #{m\ 506}#
+ #{mod\ 480}#)
+ (#{chi-void\ 174}#)))
+ (if (let ((#{t\ 505}# (memq 'compile
+ #{when-list\ 500}#)))
+ (if #{t\ 505}#
+ #{t\ 505}#
+ (if (eq? #{m\ 465}#
'c&e)
(memq 'eval
- #{when-list\ 541}#)
+ #{when-list\ 500}#)
#f)))
(begin
(#{top-level-eval-hook\ 90}#
- (#{chi-top-sequence\ 160}#
- #{body\ 542}#
- #{r\ 504}#
- #{w\ 519}#
- #{s\ 520}#
+ (#{chi-top-sequence\ 162}#
+ #{body\ 501}#
+ #{r\ 463}#
+ #{w\ 478}#
+ #{s\ 479}#
'e
'(eval)
- #{mod\ 521}#)
- #{mod\ 521}#)
- (#{chi-void\ 173}#))
- (#{chi-void\ 173}#))))))
- #{tmp\ 536}#)
+ #{mod\ 480}#)
+ #{mod\ 480}#)
+ (#{chi-void\ 174}#))
+ (#{chi-void\ 174}#))))))
+ #{tmp\ 495}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 535}#)))
+ #{tmp\ 494}#)))
($sc-dispatch
- #{tmp\ 535}#
+ #{tmp\ 494}#
'(any each-any any . each-any))))
- #{e\ 518}#)
- (if (memv #{type\ 516}# (quote (define-syntax-form)))
- (let ((#{n\ 547}# (#{id-var-name\ 151}#
- #{value\ 517}#
- #{w\ 519}#))
- (#{r\ 548}# (#{macros-only-env\ 125}#
- #{r\ 504}#)))
- (if (memv #{m\ 506}# (quote (c)))
- (if (memq (quote compile) #{esew\ 507}#)
- (let ((#{e\ 549}# (#{chi-install-global\ 161}#
- #{n\ 547}#
- (#{chi\ 165}#
- #{e\ 518}#
- #{r\ 548}#
- #{w\ 519}#
- #{mod\ 521}#))))
+ #{e\ 477}#)
+ (if (memv #{type\ 475}# (quote (define-syntax-form)))
+ (let ((#{n\ 506}# (#{id-var-name\ 153}#
+ #{value\ 476}#
+ #{w\ 478}#))
+ (#{r\ 507}# (#{macros-only-env\ 127}#
+ #{r\ 463}#)))
+ (if (memv #{m\ 465}# (quote (c)))
+ (if (memq (quote compile) #{esew\ 466}#)
+ (let ((#{e\ 508}# (#{chi-install-global\ 163}#
+ #{n\ 506}#
+ (#{chi\ 167}#
+ #{e\ 477}#
+ #{r\ 507}#
+ #{w\ 478}#
+ #{mod\ 480}#))))
(begin
(#{top-level-eval-hook\ 90}#
- #{e\ 549}#
- #{mod\ 521}#)
- (if (memq (quote load) #{esew\ 507}#)
- #{e\ 549}#
- (#{chi-void\ 173}#))))
- (if (memq (quote load) #{esew\ 507}#)
- (#{chi-install-global\ 161}#
- #{n\ 547}#
- (#{chi\ 165}#
- #{e\ 518}#
- #{r\ 548}#
- #{w\ 519}#
- #{mod\ 521}#))
- (#{chi-void\ 173}#)))
- (if (memv #{m\ 506}# (quote (c&e)))
- (let ((#{e\ 550}# (#{chi-install-global\ 161}#
- #{n\ 547}#
- (#{chi\ 165}#
- #{e\ 518}#
- #{r\ 548}#
- #{w\ 519}#
- #{mod\ 521}#))))
+ #{e\ 508}#
+ #{mod\ 480}#)
+ (if (memq (quote load) #{esew\ 466}#)
+ #{e\ 508}#
+ (#{chi-void\ 174}#))))
+ (if (memq (quote load) #{esew\ 466}#)
+ (#{chi-install-global\ 163}#
+ #{n\ 506}#
+ (#{chi\ 167}#
+ #{e\ 477}#
+ #{r\ 507}#
+ #{w\ 478}#
+ #{mod\ 480}#))
+ (#{chi-void\ 174}#)))
+ (if (memv #{m\ 465}# (quote (c&e)))
+ (let ((#{e\ 509}# (#{chi-install-global\ 163}#
+ #{n\ 506}#
+ (#{chi\ 167}#
+ #{e\ 477}#
+ #{r\ 507}#
+ #{w\ 478}#
+ #{mod\ 480}#))))
(begin
(#{top-level-eval-hook\ 90}#
- #{e\ 550}#
- #{mod\ 521}#)
- #{e\ 550}#))
+ #{e\ 509}#
+ #{mod\ 480}#)
+ #{e\ 509}#))
(begin
- (if (memq (quote eval) #{esew\ 507}#)
+ (if (memq (quote eval) #{esew\ 466}#)
(#{top-level-eval-hook\ 90}#
- (#{chi-install-global\ 161}#
- #{n\ 547}#
- (#{chi\ 165}#
- #{e\ 518}#
- #{r\ 548}#
- #{w\ 519}#
- #{mod\ 521}#))
- #{mod\ 521}#))
- (#{chi-void\ 173}#)))))
- (if (memv #{type\ 516}# (quote (define-form)))
- (let ((#{n\ 551}# (#{id-var-name\ 151}#
- #{value\ 517}#
- #{w\ 519}#)))
- (let ((#{type\ 552}#
- (#{binding-type\ 121}#
- (#{lookup\ 126}#
- #{n\ 551}#
- #{r\ 504}#
- #{mod\ 521}#))))
- (if (memv #{type\ 552}#
+ (#{chi-install-global\ 163}#
+ #{n\ 506}#
+ (#{chi\ 167}#
+ #{e\ 477}#
+ #{r\ 507}#
+ #{w\ 478}#
+ #{mod\ 480}#))
+ #{mod\ 480}#))
+ (#{chi-void\ 174}#)))))
+ (if (memv #{type\ 475}# (quote (define-form)))
+ (let ((#{n\ 510}# (#{id-var-name\ 153}#
+ #{value\ 476}#
+ #{w\ 478}#)))
+ (let ((#{type\ 511}#
+ (#{binding-type\ 123}#
+ (#{lookup\ 128}#
+ #{n\ 510}#
+ #{r\ 463}#
+ #{mod\ 480}#))))
+ (if (memv #{type\ 511}#
'(global core macro module-ref))
(begin
(if (if (not (module-local-variable
(current-module)
- #{n\ 551}#))
+ #{n\ 510}#))
(current-module)
#f)
- (let ((#{old\ 553}#
+ (let ((#{old\ 512}#
(module-variable
(current-module)
- #{n\ 551}#)))
+ #{n\ 510}#)))
(module-define!
(current-module)
- #{n\ 551}#
- (if (variable? #{old\ 553}#)
- (variable-ref #{old\ 553}#)
+ #{n\ 510}#
+ (if (variable? #{old\ 512}#)
+ (variable-ref #{old\ 512}#)
#f))))
- (let ((#{x\ 554}# (#{build-global-definition\ 104}#
- #{s\ 520}#
- #{n\ 551}#
- (#{chi\ 165}#
- #{e\ 518}#
- #{r\ 504}#
- #{w\ 519}#
- #{mod\ 521}#))))
+ (let ((#{x\ 513}# (#{build-global-definition\ 104}#
+ #{s\ 479}#
+ #{n\ 510}#
+ (#{chi\ 167}#
+ #{e\ 477}#
+ #{r\ 463}#
+ #{w\ 478}#
+ #{mod\ 480}#))))
(begin
- (if (eq? #{m\ 506}# (quote c&e))
+ (if (eq? #{m\ 465}# (quote c&e))
(#{top-level-eval-hook\ 90}#
- #{x\ 554}#
- #{mod\ 521}#))
- #{x\ 554}#)))
- (if (memv #{type\ 552}#
+ #{x\ 513}#
+ #{mod\ 480}#))
+ #{x\ 513}#)))
+ (if (memv #{type\ 511}#
'(displaced-lexical))
(syntax-violation
#f
"identifier out of context"
- #{e\ 518}#
- (#{wrap\ 157}#
- #{value\ 517}#
- #{w\ 519}#
- #{mod\ 521}#))
+ #{e\ 477}#
+ (#{wrap\ 159}#
+ #{value\ 476}#
+ #{w\ 478}#
+ #{mod\ 480}#))
(syntax-violation
#f
"cannot define keyword at top level"
- #{e\ 518}#
- (#{wrap\ 157}#
- #{value\ 517}#
- #{w\ 519}#
- #{mod\ 521}#))))))
- (let ((#{x\ 555}# (#{chi-expr\ 166}#
- #{type\ 516}#
- #{value\ 517}#
- #{e\ 518}#
- #{r\ 504}#
- #{w\ 519}#
- #{s\ 520}#
- #{mod\ 521}#)))
+ #{e\ 477}#
+ (#{wrap\ 159}#
+ #{value\ 476}#
+ #{w\ 478}#
+ #{mod\ 480}#))))))
+ (let ((#{x\ 514}# (#{chi-expr\ 168}#
+ #{type\ 475}#
+ #{value\ 476}#
+ #{e\ 477}#
+ #{r\ 463}#
+ #{w\ 478}#
+ #{s\ 479}#
+ #{mod\ 480}#)))
(begin
- (if (eq? #{m\ 506}# (quote c&e))
+ (if (eq? #{m\ 465}# (quote c&e))
(#{top-level-eval-hook\ 90}#
- #{x\ 555}#
- #{mod\ 521}#))
- #{x\ 555}#)))))))))))
- (#{syntax-type\ 163}#
- (lambda (#{e\ 556}#
- #{r\ 557}#
- #{w\ 558}#
- #{s\ 559}#
- #{rib\ 560}#
- #{mod\ 561}#
- #{for-car?\ 562}#)
- (if (symbol? #{e\ 556}#)
- (let ((#{n\ 563}# (#{id-var-name\ 151}#
- #{e\ 556}#
- #{w\ 558}#)))
- (let ((#{b\ 564}# (#{lookup\ 126}#
- #{n\ 563}#
- #{r\ 557}#
- #{mod\ 561}#)))
- (let ((#{type\ 565}#
- (#{binding-type\ 121}# #{b\ 564}#)))
- (if (memv #{type\ 565}# (quote (lexical)))
+ #{x\ 514}#
+ #{mod\ 480}#))
+ #{x\ 514}#)))))))))))
+ (#{syntax-type\ 165}#
+ (lambda (#{e\ 515}#
+ #{r\ 516}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{rib\ 519}#
+ #{mod\ 520}#
+ #{for-car?\ 521}#)
+ (if (symbol? #{e\ 515}#)
+ (let ((#{n\ 522}# (#{id-var-name\ 153}#
+ #{e\ 515}#
+ #{w\ 517}#)))
+ (let ((#{b\ 523}# (#{lookup\ 128}#
+ #{n\ 522}#
+ #{r\ 516}#
+ #{mod\ 520}#)))
+ (let ((#{type\ 524}#
+ (#{binding-type\ 123}# #{b\ 523}#)))
+ (if (memv #{type\ 524}# (quote (lexical)))
(values
- #{type\ 565}#
- (#{binding-value\ 122}# #{b\ 564}#)
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (if (memv #{type\ 565}# (quote (global)))
+ #{type\ 524}#
+ (#{binding-value\ 124}# #{b\ 523}#)
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (if (memv #{type\ 524}# (quote (global)))
(values
- #{type\ 565}#
- #{n\ 563}#
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (if (memv #{type\ 565}# (quote (macro)))
- (if #{for-car?\ 562}#
+ #{type\ 524}#
+ #{n\ 522}#
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (if (memv #{type\ 524}# (quote (macro)))
+ (if #{for-car?\ 521}#
(values
- #{type\ 565}#
- (#{binding-value\ 122}# #{b\ 564}#)
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (#{syntax-type\ 163}#
- (#{chi-macro\ 168}#
- (#{binding-value\ 122}# #{b\ 564}#)
- #{e\ 556}#
- #{r\ 557}#
- #{w\ 558}#
- #{rib\ 560}#
- #{mod\ 561}#)
- #{r\ 557}#
+ #{type\ 524}#
+ (#{binding-value\ 124}# #{b\ 523}#)
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (#{syntax-type\ 165}#
+ (#{chi-macro\ 170}#
+ (#{binding-value\ 124}# #{b\ 523}#)
+ #{e\ 515}#
+ #{r\ 516}#
+ #{w\ 517}#
+ #{rib\ 519}#
+ #{mod\ 520}#)
+ #{r\ 516}#
'(())
- #{s\ 559}#
- #{rib\ 560}#
- #{mod\ 561}#
+ #{s\ 518}#
+ #{rib\ 519}#
+ #{mod\ 520}#
#f))
(values
- #{type\ 565}#
- (#{binding-value\ 122}# #{b\ 564}#)
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)))))))
- (if (pair? #{e\ 556}#)
- (let ((#{first\ 566}# (car #{e\ 556}#)))
+ #{type\ 524}#
+ (#{binding-value\ 124}# #{b\ 523}#)
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)))))))
+ (if (pair? #{e\ 515}#)
+ (let ((#{first\ 525}# (car #{e\ 515}#)))
(call-with-values
(lambda ()
- (#{syntax-type\ 163}#
- #{first\ 566}#
- #{r\ 557}#
- #{w\ 558}#
- #{s\ 559}#
- #{rib\ 560}#
- #{mod\ 561}#
+ (#{syntax-type\ 165}#
+ #{first\ 525}#
+ #{r\ 516}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{rib\ 519}#
+ #{mod\ 520}#
#t))
- (lambda (#{ftype\ 567}#
- #{fval\ 568}#
- #{fe\ 569}#
- #{fw\ 570}#
- #{fs\ 571}#
- #{fmod\ 572}#)
- (if (memv #{ftype\ 567}# (quote (lexical)))
+ (lambda (#{ftype\ 526}#
+ #{fval\ 527}#
+ #{fe\ 528}#
+ #{fw\ 529}#
+ #{fs\ 530}#
+ #{fmod\ 531}#)
+ (if (memv #{ftype\ 526}# (quote (lexical)))
(values
'lexical-call
- #{fval\ 568}#
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (if (memv #{ftype\ 567}# (quote (global)))
+ #{fval\ 527}#
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (if (memv #{ftype\ 526}# (quote (global)))
(values
'global-call
- (#{make-syntax-object\ 112}#
- #{fval\ 568}#
- #{w\ 558}#
- #{fmod\ 572}#)
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (if (memv #{ftype\ 567}# (quote (macro)))
- (#{syntax-type\ 163}#
- (#{chi-macro\ 168}#
- #{fval\ 568}#
- #{e\ 556}#
- #{r\ 557}#
- #{w\ 558}#
- #{rib\ 560}#
- #{mod\ 561}#)
- #{r\ 557}#
+ (#{make-syntax-object\ 114}#
+ #{fval\ 527}#
+ #{w\ 517}#
+ #{fmod\ 531}#)
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (if (memv #{ftype\ 526}# (quote (macro)))
+ (#{syntax-type\ 165}#
+ (#{chi-macro\ 170}#
+ #{fval\ 527}#
+ #{e\ 515}#
+ #{r\ 516}#
+ #{w\ 517}#
+ #{rib\ 519}#
+ #{mod\ 520}#)
+ #{r\ 516}#
'(())
- #{s\ 559}#
- #{rib\ 560}#
- #{mod\ 561}#
- #{for-car?\ 562}#)
- (if (memv #{ftype\ 567}# (quote (module-ref)))
+ #{s\ 518}#
+ #{rib\ 519}#
+ #{mod\ 520}#
+ #{for-car?\ 521}#)
+ (if (memv #{ftype\ 526}# (quote (module-ref)))
(call-with-values
- (lambda () (#{fval\ 568}# #{e\ 556}#))
- (lambda (#{sym\ 573}# #{mod\ 574}#)
- (#{syntax-type\ 163}#
- #{sym\ 573}#
- #{r\ 557}#
- #{w\ 558}#
- #{s\ 559}#
- #{rib\ 560}#
- #{mod\ 574}#
- #{for-car?\ 562}#)))
- (if (memv #{ftype\ 567}# (quote (core)))
+ (lambda () (#{fval\ 527}# #{e\ 515}#))
+ (lambda (#{sym\ 532}# #{mod\ 533}#)
+ (#{syntax-type\ 165}#
+ #{sym\ 532}#
+ #{r\ 516}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{rib\ 519}#
+ #{mod\ 533}#
+ #{for-car?\ 521}#)))
+ (if (memv #{ftype\ 526}# (quote (core)))
(values
'core-form
- #{fval\ 568}#
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (if (memv #{ftype\ 567}#
+ #{fval\ 527}#
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (if (memv #{ftype\ 526}#
'(local-syntax))
(values
'local-syntax-form
- #{fval\ 568}#
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (if (memv #{ftype\ 567}# (quote (begin)))
+ #{fval\ 527}#
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (if (memv #{ftype\ 526}# (quote (begin)))
(values
'begin-form
#f
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (if (memv #{ftype\ 567}#
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (if (memv #{ftype\ 526}#
'(eval-when))
(values
'eval-when-form
#f
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
- (if (memv #{ftype\ 567}#
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
+ (if (memv #{ftype\ 526}#
'(define))
- ((lambda (#{tmp\ 575}#)
- ((lambda (#{tmp\ 576}#)
- (if (if #{tmp\ 576}#
- (apply (lambda (#{_\ 577}#
- #{name\ 578}#
- #{val\ 579}#)
- (#{id?\ 129}#
- #{name\ 578}#))
- #{tmp\ 576}#)
+ ((lambda (#{tmp\ 534}#)
+ ((lambda (#{tmp\ 535}#)
+ (if (if #{tmp\ 535}#
+ (apply (lambda (#{_\ 536}#
+ #{name\ 537}#
+ #{val\ 538}#)
+ (#{id?\ 131}#
+ #{name\ 537}#))
+ #{tmp\ 535}#)
#f)
- (apply (lambda (#{_\ 580}#
- #{name\ 581}#
- #{val\ 582}#)
+ (apply (lambda (#{_\ 539}#
+ #{name\ 540}#
+ #{val\ 541}#)
(values
'define-form
- #{name\ 581}#
- #{val\ 582}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#))
- #{tmp\ 576}#)
- ((lambda (#{tmp\ 583}#)
- (if (if #{tmp\ 583}#
- (apply (lambda (#{_\ 584}#
- #{name\ 585}#
- #{args\ 586}#
- #{e1\ 587}#
- #{e2\ 588}#)
- (if (#{id?\ 129}#
- #{name\ 585}#)
- (#{valid-bound-ids?\ 154}#
- (#{lambda-var-list\ 177}#
- #{args\ 586}#))
+ #{name\ 540}#
+ #{val\ 541}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#))
+ #{tmp\ 535}#)
+ ((lambda (#{tmp\ 542}#)
+ (if (if #{tmp\ 542}#
+ (apply (lambda (#{_\ 543}#
+ #{name\ 544}#
+ #{args\ 545}#
+ #{e1\ 546}#
+ #{e2\ 547}#)
+ (if (#{id?\ 131}#
+ #{name\ 544}#)
+ (#{valid-bound-ids?\ 156}#
+ (#{lambda-var-list\ 178}#
+ #{args\ 545}#))
#f))
- #{tmp\ 583}#)
+ #{tmp\ 542}#)
#f)
- (apply (lambda (#{_\ 589}#
- #{name\ 590}#
- #{args\ 591}#
- #{e1\ 592}#
- #{e2\ 593}#)
+ (apply (lambda (#{_\ 548}#
+ #{name\ 549}#
+ #{args\ 550}#
+ #{e1\ 551}#
+ #{e2\ 552}#)
(values
'define-form
- (#{wrap\ 157}#
- #{name\ 590}#
- #{w\ 558}#
- #{mod\ 561}#)
+ (#{wrap\ 159}#
+ #{name\ 549}#
+ #{w\ 517}#
+ #{mod\ 520}#)
(#{decorate-source\ 94}#
(cons '#(syntax-object
lambda
@@ -1929,7 +1785,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -2011,7 +1866,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -2145,6 +2002,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -2257,6 +2115,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -2267,33 +2126,33 @@
"i")))
(hygiene
guile))
- (#{wrap\ 157}#
- (cons #{args\ 591}#
- (cons #{e1\ 592}#
- #{e2\ 593}#))
- #{w\ 558}#
- #{mod\ 561}#))
- #{s\ 559}#)
+ (#{wrap\ 159}#
+ (cons #{args\ 550}#
+ (cons #{e1\ 551}#
+ #{e2\ 552}#))
+ #{w\ 517}#
+ #{mod\ 520}#))
+ #{s\ 518}#)
'(())
- #{s\ 559}#
- #{mod\ 561}#))
- #{tmp\ 583}#)
- ((lambda (#{tmp\ 595}#)
- (if (if #{tmp\ 595}#
- (apply (lambda (#{_\ 596}#
- #{name\ 597}#)
- (#{id?\ 129}#
- #{name\ 597}#))
- #{tmp\ 595}#)
+ #{s\ 518}#
+ #{mod\ 520}#))
+ #{tmp\ 542}#)
+ ((lambda (#{tmp\ 554}#)
+ (if (if #{tmp\ 554}#
+ (apply (lambda (#{_\ 555}#
+ #{name\ 556}#)
+ (#{id?\ 131}#
+ #{name\ 556}#))
+ #{tmp\ 554}#)
#f)
- (apply (lambda (#{_\ 598}#
- #{name\ 599}#)
+ (apply (lambda (#{_\ 557}#
+ #{name\ 558}#)
(values
'define-form
- (#{wrap\ 157}#
- #{name\ 599}#
- #{w\ 558}#
- #{mod\ 561}#)
+ (#{wrap\ 159}#
+ #{name\ 558}#
+ #{w\ 517}#
+ #{mod\ 520}#)
'(#(syntax-object
if
((top)
@@ -2381,7 +2240,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -2463,7 +2321,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -2597,6 +2457,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -2709,6 +2570,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -2806,7 +2668,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -2888,7 +2749,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -3022,6 +2885,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -3134,6 +2998,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -3231,7 +3096,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -3313,7 +3177,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -3447,6 +3313,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -3559,6 +3426,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -3570,102 +3438,102 @@
(hygiene
guile)))
'(())
- #{s\ 559}#
- #{mod\ 561}#))
- #{tmp\ 595}#)
+ #{s\ 518}#
+ #{mod\ 520}#))
+ #{tmp\ 554}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 575}#)))
+ #{tmp\ 534}#)))
($sc-dispatch
- #{tmp\ 575}#
+ #{tmp\ 534}#
'(any any)))))
($sc-dispatch
- #{tmp\ 575}#
+ #{tmp\ 534}#
'(any (any . any)
any
.
each-any)))))
($sc-dispatch
- #{tmp\ 575}#
+ #{tmp\ 534}#
'(any any any))))
- #{e\ 556}#)
- (if (memv #{ftype\ 567}#
+ #{e\ 515}#)
+ (if (memv #{ftype\ 526}#
'(define-syntax))
- ((lambda (#{tmp\ 600}#)
- ((lambda (#{tmp\ 601}#)
- (if (if #{tmp\ 601}#
- (apply (lambda (#{_\ 602}#
- #{name\ 603}#
- #{val\ 604}#)
- (#{id?\ 129}#
- #{name\ 603}#))
- #{tmp\ 601}#)
+ ((lambda (#{tmp\ 559}#)
+ ((lambda (#{tmp\ 560}#)
+ (if (if #{tmp\ 560}#
+ (apply (lambda (#{_\ 561}#
+ #{name\ 562}#
+ #{val\ 563}#)
+ (#{id?\ 131}#
+ #{name\ 562}#))
+ #{tmp\ 560}#)
#f)
- (apply (lambda (#{_\ 605}#
- #{name\ 606}#
- #{val\ 607}#)
+ (apply (lambda (#{_\ 564}#
+ #{name\ 565}#
+ #{val\ 566}#)
(values
'define-syntax-form
- #{name\ 606}#
- #{val\ 607}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#))
- #{tmp\ 601}#)
+ #{name\ 565}#
+ #{val\ 566}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#))
+ #{tmp\ 560}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 600}#)))
+ #{tmp\ 559}#)))
($sc-dispatch
- #{tmp\ 600}#
+ #{tmp\ 559}#
'(any any any))))
- #{e\ 556}#)
+ #{e\ 515}#)
(values
'call
#f
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#))))))))))))))
- (if (#{syntax-object?\ 113}# #{e\ 556}#)
- (#{syntax-type\ 163}#
- (#{syntax-object-expression\ 114}# #{e\ 556}#)
- #{r\ 557}#
- (#{join-wraps\ 148}#
- #{w\ 558}#
- (#{syntax-object-wrap\ 115}# #{e\ 556}#))
- #{s\ 559}#
- #{rib\ 560}#
- (let ((#{t\ 608}# (#{syntax-object-module\ 116}#
- #{e\ 556}#)))
- (if #{t\ 608}# #{t\ 608}# #{mod\ 561}#))
- #{for-car?\ 562}#)
- (if (self-evaluating? #{e\ 556}#)
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#))))))))))))))
+ (if (#{syntax-object?\ 115}# #{e\ 515}#)
+ (#{syntax-type\ 165}#
+ (#{syntax-object-expression\ 116}# #{e\ 515}#)
+ #{r\ 516}#
+ (#{join-wraps\ 150}#
+ #{w\ 517}#
+ (#{syntax-object-wrap\ 117}# #{e\ 515}#))
+ #{s\ 518}#
+ #{rib\ 519}#
+ (let ((#{t\ 567}# (#{syntax-object-module\ 118}#
+ #{e\ 515}#)))
+ (if #{t\ 567}# #{t\ 567}# #{mod\ 520}#))
+ #{for-car?\ 521}#)
+ (if (self-evaluating? #{e\ 515}#)
(values
'constant
#f
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)
(values
'other
#f
- #{e\ 556}#
- #{w\ 558}#
- #{s\ 559}#
- #{mod\ 561}#)))))))
- (#{chi-when-list\ 162}#
- (lambda (#{e\ 609}# #{when-list\ 610}# #{w\ 611}#)
- (letrec ((#{f\ 612}# (lambda (#{when-list\ 613}#
- #{situations\ 614}#)
- (if (null? #{when-list\ 613}#)
- #{situations\ 614}#
- (#{f\ 612}# (cdr #{when-list\ 613}#)
- (cons (let ((#{x\ 615}# (car #{when-list\ 613}#)))
- (if (#{free-id=?\ 152}#
- #{x\ 615}#
+ #{e\ 515}#
+ #{w\ 517}#
+ #{s\ 518}#
+ #{mod\ 520}#)))))))
+ (#{chi-when-list\ 164}#
+ (lambda (#{e\ 568}# #{when-list\ 569}# #{w\ 570}#)
+ (letrec ((#{f\ 571}# (lambda (#{when-list\ 572}#
+ #{situations\ 573}#)
+ (if (null? #{when-list\ 572}#)
+ #{situations\ 573}#
+ (#{f\ 571}# (cdr #{when-list\ 572}#)
+ (cons (let ((#{x\ 574}# (car #{when-list\ 572}#)))
+ (if (#{free-id=?\ 154}#
+ #{x\ 574}#
'#(syntax-object
compile
((top)
@@ -3721,7 +3589,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -3803,7 +3670,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -3937,6 +3806,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -4049,6 +3919,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -4060,8 +3931,8 @@
(hygiene
guile)))
'compile
- (if (#{free-id=?\ 152}#
- #{x\ 615}#
+ (if (#{free-id=?\ 154}#
+ #{x\ 574}#
'#(syntax-object
load
((top)
@@ -4117,7 +3988,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -4199,7 +4069,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -4333,6 +4205,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -4445,6 +4318,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -4456,8 +4330,8 @@
(hygiene
guile)))
'load
- (if (#{free-id=?\ 152}#
- #{x\ 615}#
+ (if (#{free-id=?\ 154}#
+ #{x\ 574}#
'#(syntax-object
eval
((top)
@@ -4513,7 +4387,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -4595,7 +4468,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -4729,6 +4604,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -4841,6 +4717,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -4855,1072 +4732,1168 @@
(syntax-violation
'eval-when
"invalid situation"
- #{e\ 609}#
- (#{wrap\ 157}#
- #{x\ 615}#
- #{w\ 611}#
+ #{e\ 568}#
+ (#{wrap\ 159}#
+ #{x\ 574}#
+ #{w\ 570}#
#f))))))
- #{situations\ 614}#))))))
- (#{f\ 612}# #{when-list\ 610}# (quote ())))))
- (#{chi-install-global\ 161}#
- (lambda (#{name\ 616}# #{e\ 617}#)
+ #{situations\ 573}#))))))
+ (#{f\ 571}# #{when-list\ 569}# (quote ())))))
+ (#{chi-install-global\ 163}#
+ (lambda (#{name\ 575}# #{e\ 576}#)
(#{build-global-definition\ 104}#
#f
- #{name\ 616}#
- (if (let ((#{v\ 618}# (module-variable
+ #{name\ 575}#
+ (if (let ((#{v\ 577}# (module-variable
(current-module)
- #{name\ 616}#)))
- (if #{v\ 618}#
- (if (variable-bound? #{v\ 618}#)
- (if (macro? (variable-ref #{v\ 618}#))
- (not (eq? (macro-type (variable-ref #{v\ 618}#))
+ #{name\ 575}#)))
+ (if #{v\ 577}#
+ (if (variable-bound? #{v\ 577}#)
+ (if (macro? (variable-ref #{v\ 577}#))
+ (not (eq? (macro-type (variable-ref #{v\ 577}#))
'syncase-macro))
#f)
#f)
#f))
(#{build-application\ 96}#
#f
- (#{build-primref\ 106}#
+ (#{build-primref\ 108}#
#f
'make-extended-syncase-macro)
(list (#{build-application\ 96}#
#f
- (#{build-primref\ 106}# #f (quote module-ref))
+ (#{build-primref\ 108}# #f (quote module-ref))
(list (#{build-application\ 96}#
#f
- (#{build-primref\ 106}#
+ (#{build-primref\ 108}#
#f
'current-module)
'())
- (#{build-data\ 107}# #f #{name\ 616}#)))
- (#{build-data\ 107}# #f (quote macro))
- #{e\ 617}#))
+ (#{build-data\ 109}# #f #{name\ 575}#)))
+ (#{build-data\ 109}# #f (quote macro))
+ #{e\ 576}#))
(#{build-application\ 96}#
#f
- (#{build-primref\ 106}#
+ (#{build-primref\ 108}#
#f
'make-syncase-macro)
- (list (#{build-data\ 107}# #f (quote macro))
- #{e\ 617}#))))))
- (#{chi-top-sequence\ 160}#
- (lambda (#{body\ 619}#
- #{r\ 620}#
- #{w\ 621}#
- #{s\ 622}#
- #{m\ 623}#
- #{esew\ 624}#
- #{mod\ 625}#)
- (#{build-sequence\ 108}#
- #{s\ 622}#
- (letrec ((#{dobody\ 626}#
- (lambda (#{body\ 627}#
- #{r\ 628}#
- #{w\ 629}#
- #{m\ 630}#
- #{esew\ 631}#
- #{mod\ 632}#)
- (if (null? #{body\ 627}#)
+ (list (#{build-data\ 109}# #f (quote macro))
+ #{e\ 576}#))))))
+ (#{chi-top-sequence\ 162}#
+ (lambda (#{body\ 578}#
+ #{r\ 579}#
+ #{w\ 580}#
+ #{s\ 581}#
+ #{m\ 582}#
+ #{esew\ 583}#
+ #{mod\ 584}#)
+ (#{build-sequence\ 110}#
+ #{s\ 581}#
+ (letrec ((#{dobody\ 585}#
+ (lambda (#{body\ 586}#
+ #{r\ 587}#
+ #{w\ 588}#
+ #{m\ 589}#
+ #{esew\ 590}#
+ #{mod\ 591}#)
+ (if (null? #{body\ 586}#)
'()
- (let ((#{first\ 633}#
- (#{chi-top\ 164}#
- (car #{body\ 627}#)
- #{r\ 628}#
- #{w\ 629}#
- #{m\ 630}#
- #{esew\ 631}#
- #{mod\ 632}#)))
- (cons #{first\ 633}#
- (#{dobody\ 626}#
- (cdr #{body\ 627}#)
- #{r\ 628}#
- #{w\ 629}#
- #{m\ 630}#
- #{esew\ 631}#
- #{mod\ 632}#)))))))
- (#{dobody\ 626}#
- #{body\ 619}#
- #{r\ 620}#
- #{w\ 621}#
- #{m\ 623}#
- #{esew\ 624}#
- #{mod\ 625}#)))))
- (#{chi-sequence\ 159}#
- (lambda (#{body\ 634}#
- #{r\ 635}#
- #{w\ 636}#
- #{s\ 637}#
- #{mod\ 638}#)
- (#{build-sequence\ 108}#
- #{s\ 637}#
- (letrec ((#{dobody\ 639}#
- (lambda (#{body\ 640}#
- #{r\ 641}#
- #{w\ 642}#
- #{mod\ 643}#)
- (if (null? #{body\ 640}#)
+ (let ((#{first\ 592}#
+ (#{chi-top\ 166}#
+ (car #{body\ 586}#)
+ #{r\ 587}#
+ #{w\ 588}#
+ #{m\ 589}#
+ #{esew\ 590}#
+ #{mod\ 591}#)))
+ (cons #{first\ 592}#
+ (#{dobody\ 585}#
+ (cdr #{body\ 586}#)
+ #{r\ 587}#
+ #{w\ 588}#
+ #{m\ 589}#
+ #{esew\ 590}#
+ #{mod\ 591}#)))))))
+ (#{dobody\ 585}#
+ #{body\ 578}#
+ #{r\ 579}#
+ #{w\ 580}#
+ #{m\ 582}#
+ #{esew\ 583}#
+ #{mod\ 584}#)))))
+ (#{chi-sequence\ 161}#
+ (lambda (#{body\ 593}#
+ #{r\ 594}#
+ #{w\ 595}#
+ #{s\ 596}#
+ #{mod\ 597}#)
+ (#{build-sequence\ 110}#
+ #{s\ 596}#
+ (letrec ((#{dobody\ 598}#
+ (lambda (#{body\ 599}#
+ #{r\ 600}#
+ #{w\ 601}#
+ #{mod\ 602}#)
+ (if (null? #{body\ 599}#)
'()
- (let ((#{first\ 644}#
- (#{chi\ 165}#
- (car #{body\ 640}#)
- #{r\ 641}#
- #{w\ 642}#
- #{mod\ 643}#)))
- (cons #{first\ 644}#
- (#{dobody\ 639}#
- (cdr #{body\ 640}#)
- #{r\ 641}#
- #{w\ 642}#
- #{mod\ 643}#)))))))
- (#{dobody\ 639}#
- #{body\ 634}#
- #{r\ 635}#
- #{w\ 636}#
- #{mod\ 638}#)))))
- (#{source-wrap\ 158}#
- (lambda (#{x\ 645}#
- #{w\ 646}#
- #{s\ 647}#
- #{defmod\ 648}#)
- (#{wrap\ 157}#
- (#{decorate-source\ 94}# #{x\ 645}# #{s\ 647}#)
- #{w\ 646}#
- #{defmod\ 648}#)))
- (#{wrap\ 157}#
- (lambda (#{x\ 649}# #{w\ 650}# #{defmod\ 651}#)
- (if (if (null? (#{wrap-marks\ 132}# #{w\ 650}#))
- (null? (#{wrap-subst\ 133}# #{w\ 650}#))
+ (let ((#{first\ 603}#
+ (#{chi\ 167}#
+ (car #{body\ 599}#)
+ #{r\ 600}#
+ #{w\ 601}#
+ #{mod\ 602}#)))
+ (cons #{first\ 603}#
+ (#{dobody\ 598}#
+ (cdr #{body\ 599}#)
+ #{r\ 600}#
+ #{w\ 601}#
+ #{mod\ 602}#)))))))
+ (#{dobody\ 598}#
+ #{body\ 593}#
+ #{r\ 594}#
+ #{w\ 595}#
+ #{mod\ 597}#)))))
+ (#{source-wrap\ 160}#
+ (lambda (#{x\ 604}#
+ #{w\ 605}#
+ #{s\ 606}#
+ #{defmod\ 607}#)
+ (#{wrap\ 159}#
+ (#{decorate-source\ 94}# #{x\ 604}# #{s\ 606}#)
+ #{w\ 605}#
+ #{defmod\ 607}#)))
+ (#{wrap\ 159}#
+ (lambda (#{x\ 608}# #{w\ 609}# #{defmod\ 610}#)
+ (if (if (null? (#{wrap-marks\ 134}# #{w\ 609}#))
+ (null? (#{wrap-subst\ 135}# #{w\ 609}#))
#f)
- #{x\ 649}#
- (if (#{syntax-object?\ 113}# #{x\ 649}#)
- (#{make-syntax-object\ 112}#
- (#{syntax-object-expression\ 114}# #{x\ 649}#)
- (#{join-wraps\ 148}#
- #{w\ 650}#
- (#{syntax-object-wrap\ 115}# #{x\ 649}#))
- (#{syntax-object-module\ 116}# #{x\ 649}#))
- (if (null? #{x\ 649}#)
- #{x\ 649}#
- (#{make-syntax-object\ 112}#
- #{x\ 649}#
- #{w\ 650}#
- #{defmod\ 651}#))))))
- (#{bound-id-member?\ 156}#
- (lambda (#{x\ 652}# #{list\ 653}#)
- (if (not (null? #{list\ 653}#))
- (let ((#{t\ 654}# (#{bound-id=?\ 153}#
- #{x\ 652}#
- (car #{list\ 653}#))))
- (if #{t\ 654}#
- #{t\ 654}#
- (#{bound-id-member?\ 156}#
- #{x\ 652}#
- (cdr #{list\ 653}#))))
+ #{x\ 608}#
+ (if (#{syntax-object?\ 115}# #{x\ 608}#)
+ (#{make-syntax-object\ 114}#
+ (#{syntax-object-expression\ 116}# #{x\ 608}#)
+ (#{join-wraps\ 150}#
+ #{w\ 609}#
+ (#{syntax-object-wrap\ 117}# #{x\ 608}#))
+ (#{syntax-object-module\ 118}# #{x\ 608}#))
+ (if (null? #{x\ 608}#)
+ #{x\ 608}#
+ (#{make-syntax-object\ 114}#
+ #{x\ 608}#
+ #{w\ 609}#
+ #{defmod\ 610}#))))))
+ (#{bound-id-member?\ 158}#
+ (lambda (#{x\ 611}# #{list\ 612}#)
+ (if (not (null? #{list\ 612}#))
+ (let ((#{t\ 613}# (#{bound-id=?\ 155}#
+ #{x\ 611}#
+ (car #{list\ 612}#))))
+ (if #{t\ 613}#
+ #{t\ 613}#
+ (#{bound-id-member?\ 158}#
+ #{x\ 611}#
+ (cdr #{list\ 612}#))))
#f)))
- (#{distinct-bound-ids?\ 155}#
- (lambda (#{ids\ 655}#)
- (letrec ((#{distinct?\ 656}#
- (lambda (#{ids\ 657}#)
- (let ((#{t\ 658}# (null? #{ids\ 657}#)))
- (if #{t\ 658}#
- #{t\ 658}#
- (if (not (#{bound-id-member?\ 156}#
- (car #{ids\ 657}#)
- (cdr #{ids\ 657}#)))
- (#{distinct?\ 656}# (cdr #{ids\ 657}#))
+ (#{distinct-bound-ids?\ 157}#
+ (lambda (#{ids\ 614}#)
+ (letrec ((#{distinct?\ 615}#
+ (lambda (#{ids\ 616}#)
+ (let ((#{t\ 617}# (null? #{ids\ 616}#)))
+ (if #{t\ 617}#
+ #{t\ 617}#
+ (if (not (#{bound-id-member?\ 158}#
+ (car #{ids\ 616}#)
+ (cdr #{ids\ 616}#)))
+ (#{distinct?\ 615}# (cdr #{ids\ 616}#))
#f))))))
- (#{distinct?\ 656}# #{ids\ 655}#))))
- (#{valid-bound-ids?\ 154}#
- (lambda (#{ids\ 659}#)
- (if (letrec ((#{all-ids?\ 660}#
- (lambda (#{ids\ 661}#)
- (let ((#{t\ 662}# (null? #{ids\ 661}#)))
- (if #{t\ 662}#
- #{t\ 662}#
- (if (#{id?\ 129}# (car #{ids\ 661}#))
- (#{all-ids?\ 660}# (cdr #{ids\ 661}#))
+ (#{distinct?\ 615}# #{ids\ 614}#))))
+ (#{valid-bound-ids?\ 156}#
+ (lambda (#{ids\ 618}#)
+ (if (letrec ((#{all-ids?\ 619}#
+ (lambda (#{ids\ 620}#)
+ (let ((#{t\ 621}# (null? #{ids\ 620}#)))
+ (if #{t\ 621}#
+ #{t\ 621}#
+ (if (#{id?\ 131}# (car #{ids\ 620}#))
+ (#{all-ids?\ 619}# (cdr #{ids\ 620}#))
#f))))))
- (#{all-ids?\ 660}# #{ids\ 659}#))
- (#{distinct-bound-ids?\ 155}# #{ids\ 659}#)
+ (#{all-ids?\ 619}# #{ids\ 618}#))
+ (#{distinct-bound-ids?\ 157}# #{ids\ 618}#)
#f)))
- (#{bound-id=?\ 153}#
- (lambda (#{i\ 663}# #{j\ 664}#)
- (if (if (#{syntax-object?\ 113}# #{i\ 663}#)
- (#{syntax-object?\ 113}# #{j\ 664}#)
+ (#{bound-id=?\ 155}#
+ (lambda (#{i\ 622}# #{j\ 623}#)
+ (if (if (#{syntax-object?\ 115}# #{i\ 622}#)
+ (#{syntax-object?\ 115}# #{j\ 623}#)
#f)
- (if (eq? (#{syntax-object-expression\ 114}# #{i\ 663}#)
- (#{syntax-object-expression\ 114}# #{j\ 664}#))
- (#{same-marks?\ 150}#
- (#{wrap-marks\ 132}#
- (#{syntax-object-wrap\ 115}# #{i\ 663}#))
- (#{wrap-marks\ 132}#
- (#{syntax-object-wrap\ 115}# #{j\ 664}#)))
+ (if (eq? (#{syntax-object-expression\ 116}# #{i\ 622}#)
+ (#{syntax-object-expression\ 116}# #{j\ 623}#))
+ (#{same-marks?\ 152}#
+ (#{wrap-marks\ 134}#
+ (#{syntax-object-wrap\ 117}# #{i\ 622}#))
+ (#{wrap-marks\ 134}#
+ (#{syntax-object-wrap\ 117}# #{j\ 623}#)))
#f)
- (eq? #{i\ 663}# #{j\ 664}#))))
- (#{free-id=?\ 152}#
- (lambda (#{i\ 665}# #{j\ 666}#)
- (if (eq? (let ((#{x\ 667}# #{i\ 665}#))
- (if (#{syntax-object?\ 113}# #{x\ 667}#)
- (#{syntax-object-expression\ 114}# #{x\ 667}#)
- #{x\ 667}#))
- (let ((#{x\ 668}# #{j\ 666}#))
- (if (#{syntax-object?\ 113}# #{x\ 668}#)
- (#{syntax-object-expression\ 114}# #{x\ 668}#)
- #{x\ 668}#)))
- (eq? (#{id-var-name\ 151}# #{i\ 665}# (quote (())))
- (#{id-var-name\ 151}# #{j\ 666}# (quote (()))))
+ (eq? #{i\ 622}# #{j\ 623}#))))
+ (#{free-id=?\ 154}#
+ (lambda (#{i\ 624}# #{j\ 625}#)
+ (if (eq? (let ((#{x\ 626}# #{i\ 624}#))
+ (if (#{syntax-object?\ 115}# #{x\ 626}#)
+ (#{syntax-object-expression\ 116}# #{x\ 626}#)
+ #{x\ 626}#))
+ (let ((#{x\ 627}# #{j\ 625}#))
+ (if (#{syntax-object?\ 115}# #{x\ 627}#)
+ (#{syntax-object-expression\ 116}# #{x\ 627}#)
+ #{x\ 627}#)))
+ (eq? (#{id-var-name\ 153}# #{i\ 624}# (quote (())))
+ (#{id-var-name\ 153}# #{j\ 625}# (quote (()))))
#f)))
- (#{id-var-name\ 151}#
- (lambda (#{id\ 669}# #{w\ 670}#)
- (letrec ((#{search-vector-rib\ 673}#
- (lambda (#{sym\ 679}#
- #{subst\ 680}#
- #{marks\ 681}#
- #{symnames\ 682}#
- #{ribcage\ 683}#)
- (let ((#{n\ 684}# (vector-length
- #{symnames\ 682}#)))
- (letrec ((#{f\ 685}# (lambda (#{i\ 686}#)
+ (#{id-var-name\ 153}#
+ (lambda (#{id\ 628}# #{w\ 629}#)
+ (letrec ((#{search-vector-rib\ 632}#
+ (lambda (#{sym\ 638}#
+ #{subst\ 639}#
+ #{marks\ 640}#
+ #{symnames\ 641}#
+ #{ribcage\ 642}#)
+ (let ((#{n\ 643}# (vector-length
+ #{symnames\ 641}#)))
+ (letrec ((#{f\ 644}# (lambda (#{i\ 645}#)
(if (#{fx=\ 88}#
- #{i\ 686}#
- #{n\ 684}#)
- (#{search\ 671}#
- #{sym\ 679}#
- (cdr #{subst\ 680}#)
- #{marks\ 681}#)
+ #{i\ 645}#
+ #{n\ 643}#)
+ (#{search\ 630}#
+ #{sym\ 638}#
+ (cdr #{subst\ 639}#)
+ #{marks\ 640}#)
(if (if (eq? (vector-ref
- #{symnames\ 682}#
- #{i\ 686}#)
- #{sym\ 679}#)
- (#{same-marks?\ 150}#
- #{marks\ 681}#
+ #{symnames\ 641}#
+ #{i\ 645}#)
+ #{sym\ 638}#)
+ (#{same-marks?\ 152}#
+ #{marks\ 640}#
(vector-ref
- (#{ribcage-marks\ 139}#
- #{ribcage\ 683}#)
- #{i\ 686}#))
+ (#{ribcage-marks\ 141}#
+ #{ribcage\ 642}#)
+ #{i\ 645}#))
#f)
(values
(vector-ref
- (#{ribcage-labels\ 140}#
- #{ribcage\ 683}#)
- #{i\ 686}#)
- #{marks\ 681}#)
- (#{f\ 685}# (#{fx+\ 86}#
- #{i\ 686}#
+ (#{ribcage-labels\ 142}#
+ #{ribcage\ 642}#)
+ #{i\ 645}#)
+ #{marks\ 640}#)
+ (#{f\ 644}# (#{fx+\ 86}#
+ #{i\ 645}#
1)))))))
- (#{f\ 685}# 0)))))
- (#{search-list-rib\ 672}#
- (lambda (#{sym\ 687}#
- #{subst\ 688}#
- #{marks\ 689}#
- #{symnames\ 690}#
- #{ribcage\ 691}#)
- (letrec ((#{f\ 692}# (lambda (#{symnames\ 693}#
- #{i\ 694}#)
- (if (null? #{symnames\ 693}#)
- (#{search\ 671}#
- #{sym\ 687}#
- (cdr #{subst\ 688}#)
- #{marks\ 689}#)
- (if (if (eq? (car #{symnames\ 693}#)
- #{sym\ 687}#)
- (#{same-marks?\ 150}#
- #{marks\ 689}#
+ (#{f\ 644}# 0)))))
+ (#{search-list-rib\ 631}#
+ (lambda (#{sym\ 646}#
+ #{subst\ 647}#
+ #{marks\ 648}#
+ #{symnames\ 649}#
+ #{ribcage\ 650}#)
+ (letrec ((#{f\ 651}# (lambda (#{symnames\ 652}#
+ #{i\ 653}#)
+ (if (null? #{symnames\ 652}#)
+ (#{search\ 630}#
+ #{sym\ 646}#
+ (cdr #{subst\ 647}#)
+ #{marks\ 648}#)
+ (if (if (eq? (car #{symnames\ 652}#)
+ #{sym\ 646}#)
+ (#{same-marks?\ 152}#
+ #{marks\ 648}#
(list-ref
- (#{ribcage-marks\ 139}#
- #{ribcage\ 691}#)
- #{i\ 694}#))
+ (#{ribcage-marks\ 141}#
+ #{ribcage\ 650}#)
+ #{i\ 653}#))
#f)
(values
(list-ref
- (#{ribcage-labels\ 140}#
- #{ribcage\ 691}#)
- #{i\ 694}#)
- #{marks\ 689}#)
- (#{f\ 692}# (cdr #{symnames\ 693}#)
+ (#{ribcage-labels\ 142}#
+ #{ribcage\ 650}#)
+ #{i\ 653}#)
+ #{marks\ 648}#)
+ (#{f\ 651}# (cdr #{symnames\ 652}#)
(#{fx+\ 86}#
- #{i\ 694}#
+ #{i\ 653}#
1)))))))
- (#{f\ 692}# #{symnames\ 690}# 0))))
- (#{search\ 671}#
- (lambda (#{sym\ 695}# #{subst\ 696}# #{marks\ 697}#)
- (if (null? #{subst\ 696}#)
- (values #f #{marks\ 697}#)
- (let ((#{fst\ 698}# (car #{subst\ 696}#)))
- (if (eq? #{fst\ 698}# (quote shift))
- (#{search\ 671}#
- #{sym\ 695}#
- (cdr #{subst\ 696}#)
- (cdr #{marks\ 697}#))
- (let ((#{symnames\ 699}#
- (#{ribcage-symnames\ 138}#
- #{fst\ 698}#)))
- (if (vector? #{symnames\ 699}#)
- (#{search-vector-rib\ 673}#
- #{sym\ 695}#
- #{subst\ 696}#
- #{marks\ 697}#
- #{symnames\ 699}#
- #{fst\ 698}#)
- (#{search-list-rib\ 672}#
- #{sym\ 695}#
- #{subst\ 696}#
- #{marks\ 697}#
- #{symnames\ 699}#
- #{fst\ 698}#)))))))))
- (if (symbol? #{id\ 669}#)
- (let ((#{t\ 700}# (call-with-values
+ (#{f\ 651}# #{symnames\ 649}# 0))))
+ (#{search\ 630}#
+ (lambda (#{sym\ 654}# #{subst\ 655}# #{marks\ 656}#)
+ (if (null? #{subst\ 655}#)
+ (values #f #{marks\ 656}#)
+ (let ((#{fst\ 657}# (car #{subst\ 655}#)))
+ (if (eq? #{fst\ 657}# (quote shift))
+ (#{search\ 630}#
+ #{sym\ 654}#
+ (cdr #{subst\ 655}#)
+ (cdr #{marks\ 656}#))
+ (let ((#{symnames\ 658}#
+ (#{ribcage-symnames\ 140}#
+ #{fst\ 657}#)))
+ (if (vector? #{symnames\ 658}#)
+ (#{search-vector-rib\ 632}#
+ #{sym\ 654}#
+ #{subst\ 655}#
+ #{marks\ 656}#
+ #{symnames\ 658}#
+ #{fst\ 657}#)
+ (#{search-list-rib\ 631}#
+ #{sym\ 654}#
+ #{subst\ 655}#
+ #{marks\ 656}#
+ #{symnames\ 658}#
+ #{fst\ 657}#)))))))))
+ (if (symbol? #{id\ 628}#)
+ (let ((#{t\ 659}# (call-with-values
(lambda ()
- (#{search\ 671}#
- #{id\ 669}#
- (#{wrap-subst\ 133}# #{w\ 670}#)
- (#{wrap-marks\ 132}# #{w\ 670}#)))
- (lambda (#{x\ 702}# . #{ignore\ 701}#)
- #{x\ 702}#))))
- (if #{t\ 700}# #{t\ 700}# #{id\ 669}#))
- (if (#{syntax-object?\ 113}# #{id\ 669}#)
- (let ((#{id\ 703}#
- (#{syntax-object-expression\ 114}# #{id\ 669}#))
- (#{w1\ 704}#
- (#{syntax-object-wrap\ 115}# #{id\ 669}#)))
- (let ((#{marks\ 705}#
- (#{join-marks\ 149}#
- (#{wrap-marks\ 132}# #{w\ 670}#)
- (#{wrap-marks\ 132}# #{w1\ 704}#))))
+ (#{search\ 630}#
+ #{id\ 628}#
+ (#{wrap-subst\ 135}# #{w\ 629}#)
+ (#{wrap-marks\ 134}# #{w\ 629}#)))
+ (lambda (#{x\ 660}# . #{ignore\ 661}#)
+ #{x\ 660}#))))
+ (if #{t\ 659}# #{t\ 659}# #{id\ 628}#))
+ (if (#{syntax-object?\ 115}# #{id\ 628}#)
+ (let ((#{id\ 662}#
+ (#{syntax-object-expression\ 116}# #{id\ 628}#))
+ (#{w1\ 663}#
+ (#{syntax-object-wrap\ 117}# #{id\ 628}#)))
+ (let ((#{marks\ 664}#
+ (#{join-marks\ 151}#
+ (#{wrap-marks\ 134}# #{w\ 629}#)
+ (#{wrap-marks\ 134}# #{w1\ 663}#))))
(call-with-values
(lambda ()
- (#{search\ 671}#
- #{id\ 703}#
- (#{wrap-subst\ 133}# #{w\ 670}#)
- #{marks\ 705}#))
- (lambda (#{new-id\ 706}# #{marks\ 707}#)
- (let ((#{t\ 708}# #{new-id\ 706}#))
- (if #{t\ 708}#
- #{t\ 708}#
- (let ((#{t\ 709}# (call-with-values
+ (#{search\ 630}#
+ #{id\ 662}#
+ (#{wrap-subst\ 135}# #{w\ 629}#)
+ #{marks\ 664}#))
+ (lambda (#{new-id\ 665}# #{marks\ 666}#)
+ (let ((#{t\ 667}# #{new-id\ 665}#))
+ (if #{t\ 667}#
+ #{t\ 667}#
+ (let ((#{t\ 668}# (call-with-values
(lambda ()
- (#{search\ 671}#
- #{id\ 703}#
- (#{wrap-subst\ 133}#
- #{w1\ 704}#)
- #{marks\ 707}#))
- (lambda (#{x\ 711}#
+ (#{search\ 630}#
+ #{id\ 662}#
+ (#{wrap-subst\ 135}#
+ #{w1\ 663}#)
+ #{marks\ 666}#))
+ (lambda (#{x\ 669}#
.
- #{ignore\ 710}#)
- #{x\ 711}#))))
- (if #{t\ 709}#
- #{t\ 709}#
- #{id\ 703}#))))))))
+ #{ignore\ 670}#)
+ #{x\ 669}#))))
+ (if #{t\ 668}#
+ #{t\ 668}#
+ #{id\ 662}#))))))))
(syntax-violation
'id-var-name
"invalid id"
- #{id\ 669}#))))))
- (#{same-marks?\ 150}#
- (lambda (#{x\ 712}# #{y\ 713}#)
- (let ((#{t\ 714}# (eq? #{x\ 712}# #{y\ 713}#)))
- (if #{t\ 714}#
- #{t\ 714}#
- (if (not (null? #{x\ 712}#))
- (if (not (null? #{y\ 713}#))
- (if (eq? (car #{x\ 712}#) (car #{y\ 713}#))
- (#{same-marks?\ 150}#
- (cdr #{x\ 712}#)
- (cdr #{y\ 713}#))
+ #{id\ 628}#))))))
+ (#{same-marks?\ 152}#
+ (lambda (#{x\ 671}# #{y\ 672}#)
+ (let ((#{t\ 673}# (eq? #{x\ 671}# #{y\ 672}#)))
+ (if #{t\ 673}#
+ #{t\ 673}#
+ (if (not (null? #{x\ 671}#))
+ (if (not (null? #{y\ 672}#))
+ (if (eq? (car #{x\ 671}#) (car #{y\ 672}#))
+ (#{same-marks?\ 152}#
+ (cdr #{x\ 671}#)
+ (cdr #{y\ 672}#))
#f)
#f)
#f)))))
- (#{join-marks\ 149}#
- (lambda (#{m1\ 715}# #{m2\ 716}#)
- (#{smart-append\ 147}# #{m1\ 715}# #{m2\ 716}#)))
- (#{join-wraps\ 148}#
- (lambda (#{w1\ 717}# #{w2\ 718}#)
- (let ((#{m1\ 719}# (#{wrap-marks\ 132}# #{w1\ 717}#))
- (#{s1\ 720}# (#{wrap-subst\ 133}# #{w1\ 717}#)))
- (if (null? #{m1\ 719}#)
- (if (null? #{s1\ 720}#)
- #{w2\ 718}#
- (#{make-wrap\ 131}#
- (#{wrap-marks\ 132}# #{w2\ 718}#)
- (#{smart-append\ 147}#
- #{s1\ 720}#
- (#{wrap-subst\ 133}# #{w2\ 718}#))))
- (#{make-wrap\ 131}#
- (#{smart-append\ 147}#
- #{m1\ 719}#
- (#{wrap-marks\ 132}# #{w2\ 718}#))
- (#{smart-append\ 147}#
- #{s1\ 720}#
- (#{wrap-subst\ 133}# #{w2\ 718}#)))))))
- (#{smart-append\ 147}#
- (lambda (#{m1\ 721}# #{m2\ 722}#)
- (if (null? #{m2\ 722}#)
- #{m1\ 721}#
- (append #{m1\ 721}# #{m2\ 722}#))))
- (#{make-binding-wrap\ 146}#
- (lambda (#{ids\ 723}# #{labels\ 724}# #{w\ 725}#)
- (if (null? #{ids\ 723}#)
- #{w\ 725}#
- (#{make-wrap\ 131}#
- (#{wrap-marks\ 132}# #{w\ 725}#)
- (cons (let ((#{labelvec\ 726}#
- (list->vector #{labels\ 724}#)))
- (let ((#{n\ 727}# (vector-length
- #{labelvec\ 726}#)))
- (let ((#{symnamevec\ 728}#
- (make-vector #{n\ 727}#))
- (#{marksvec\ 729}#
- (make-vector #{n\ 727}#)))
+ (#{join-marks\ 151}#
+ (lambda (#{m1\ 674}# #{m2\ 675}#)
+ (#{smart-append\ 149}# #{m1\ 674}# #{m2\ 675}#)))
+ (#{join-wraps\ 150}#
+ (lambda (#{w1\ 676}# #{w2\ 677}#)
+ (let ((#{m1\ 678}# (#{wrap-marks\ 134}# #{w1\ 676}#))
+ (#{s1\ 679}# (#{wrap-subst\ 135}# #{w1\ 676}#)))
+ (if (null? #{m1\ 678}#)
+ (if (null? #{s1\ 679}#)
+ #{w2\ 677}#
+ (#{make-wrap\ 133}#
+ (#{wrap-marks\ 134}# #{w2\ 677}#)
+ (#{smart-append\ 149}#
+ #{s1\ 679}#
+ (#{wrap-subst\ 135}# #{w2\ 677}#))))
+ (#{make-wrap\ 133}#
+ (#{smart-append\ 149}#
+ #{m1\ 678}#
+ (#{wrap-marks\ 134}# #{w2\ 677}#))
+ (#{smart-append\ 149}#
+ #{s1\ 679}#
+ (#{wrap-subst\ 135}# #{w2\ 677}#)))))))
+ (#{smart-append\ 149}#
+ (lambda (#{m1\ 680}# #{m2\ 681}#)
+ (if (null? #{m2\ 681}#)
+ #{m1\ 680}#
+ (append #{m1\ 680}# #{m2\ 681}#))))
+ (#{make-binding-wrap\ 148}#
+ (lambda (#{ids\ 682}# #{labels\ 683}# #{w\ 684}#)
+ (if (null? #{ids\ 682}#)
+ #{w\ 684}#
+ (#{make-wrap\ 133}#
+ (#{wrap-marks\ 134}# #{w\ 684}#)
+ (cons (let ((#{labelvec\ 685}#
+ (list->vector #{labels\ 683}#)))
+ (let ((#{n\ 686}# (vector-length
+ #{labelvec\ 685}#)))
+ (let ((#{symnamevec\ 687}#
+ (make-vector #{n\ 686}#))
+ (#{marksvec\ 688}#
+ (make-vector #{n\ 686}#)))
(begin
- (letrec ((#{f\ 730}# (lambda (#{ids\ 731}#
- #{i\ 732}#)
- (if (not (null? #{ids\ 731}#))
+ (letrec ((#{f\ 689}# (lambda (#{ids\ 690}#
+ #{i\ 691}#)
+ (if (not (null? #{ids\ 690}#))
(call-with-values
(lambda ()
- (#{id-sym-name&marks\ 130}#
- (car #{ids\ 731}#)
- #{w\ 725}#))
- (lambda (#{symname\ 733}#
- #{marks\ 734}#)
+ (#{id-sym-name&marks\ 132}#
+ (car #{ids\ 690}#)
+ #{w\ 684}#))
+ (lambda (#{symname\ 692}#
+ #{marks\ 693}#)
(begin
(vector-set!
- #{symnamevec\ 728}#
- #{i\ 732}#
- #{symname\ 733}#)
+ #{symnamevec\ 687}#
+ #{i\ 691}#
+ #{symname\ 692}#)
(vector-set!
- #{marksvec\ 729}#
- #{i\ 732}#
- #{marks\ 734}#)
- (#{f\ 730}# (cdr #{ids\ 731}#)
+ #{marksvec\ 688}#
+ #{i\ 691}#
+ #{marks\ 693}#)
+ (#{f\ 689}# (cdr #{ids\ 690}#)
(#{fx+\ 86}#
- #{i\ 732}#
+ #{i\ 691}#
1)))))))))
- (#{f\ 730}# #{ids\ 723}# 0))
- (#{make-ribcage\ 136}#
- #{symnamevec\ 728}#
- #{marksvec\ 729}#
- #{labelvec\ 726}#)))))
- (#{wrap-subst\ 133}# #{w\ 725}#))))))
- (#{extend-ribcage!\ 145}#
- (lambda (#{ribcage\ 735}# #{id\ 736}# #{label\ 737}#)
+ (#{f\ 689}# #{ids\ 682}# 0))
+ (#{make-ribcage\ 138}#
+ #{symnamevec\ 687}#
+ #{marksvec\ 688}#
+ #{labelvec\ 685}#)))))
+ (#{wrap-subst\ 135}# #{w\ 684}#))))))
+ (#{extend-ribcage!\ 147}#
+ (lambda (#{ribcage\ 694}# #{id\ 695}# #{label\ 696}#)
(begin
- (#{set-ribcage-symnames!\ 141}#
- #{ribcage\ 735}#
- (cons (#{syntax-object-expression\ 114}# #{id\ 736}#)
- (#{ribcage-symnames\ 138}# #{ribcage\ 735}#)))
- (#{set-ribcage-marks!\ 142}#
- #{ribcage\ 735}#
- (cons (#{wrap-marks\ 132}#
- (#{syntax-object-wrap\ 115}# #{id\ 736}#))
- (#{ribcage-marks\ 139}# #{ribcage\ 735}#)))
- (#{set-ribcage-labels!\ 143}#
- #{ribcage\ 735}#
- (cons #{label\ 737}#
- (#{ribcage-labels\ 140}# #{ribcage\ 735}#))))))
- (#{anti-mark\ 144}#
- (lambda (#{w\ 738}#)
- (#{make-wrap\ 131}#
- (cons #f (#{wrap-marks\ 132}# #{w\ 738}#))
+ (#{set-ribcage-symnames!\ 143}#
+ #{ribcage\ 694}#
+ (cons (#{syntax-object-expression\ 116}# #{id\ 695}#)
+ (#{ribcage-symnames\ 140}# #{ribcage\ 694}#)))
+ (#{set-ribcage-marks!\ 144}#
+ #{ribcage\ 694}#
+ (cons (#{wrap-marks\ 134}#
+ (#{syntax-object-wrap\ 117}# #{id\ 695}#))
+ (#{ribcage-marks\ 141}# #{ribcage\ 694}#)))
+ (#{set-ribcage-labels!\ 145}#
+ #{ribcage\ 694}#
+ (cons #{label\ 696}#
+ (#{ribcage-labels\ 142}# #{ribcage\ 694}#))))))
+ (#{anti-mark\ 146}#
+ (lambda (#{w\ 697}#)
+ (#{make-wrap\ 133}#
+ (cons #f (#{wrap-marks\ 134}# #{w\ 697}#))
(cons 'shift
- (#{wrap-subst\ 133}# #{w\ 738}#)))))
- (#{set-ribcage-labels!\ 143}#
- (lambda (#{x\ 739}# #{update\ 740}#)
- (vector-set! #{x\ 739}# 3 #{update\ 740}#)))
- (#{set-ribcage-marks!\ 142}#
- (lambda (#{x\ 741}# #{update\ 742}#)
- (vector-set! #{x\ 741}# 2 #{update\ 742}#)))
- (#{set-ribcage-symnames!\ 141}#
- (lambda (#{x\ 743}# #{update\ 744}#)
- (vector-set! #{x\ 743}# 1 #{update\ 744}#)))
- (#{ribcage-labels\ 140}#
- (lambda (#{x\ 745}#) (vector-ref #{x\ 745}# 3)))
- (#{ribcage-marks\ 139}#
- (lambda (#{x\ 746}#) (vector-ref #{x\ 746}# 2)))
- (#{ribcage-symnames\ 138}#
- (lambda (#{x\ 747}#) (vector-ref #{x\ 747}# 1)))
- (#{ribcage?\ 137}#
- (lambda (#{x\ 748}#)
- (if (vector? #{x\ 748}#)
- (if (= (vector-length #{x\ 748}#) 4)
- (eq? (vector-ref #{x\ 748}# 0) (quote ribcage))
+ (#{wrap-subst\ 135}# #{w\ 697}#)))))
+ (#{set-ribcage-labels!\ 145}#
+ (lambda (#{x\ 698}# #{update\ 699}#)
+ (vector-set! #{x\ 698}# 3 #{update\ 699}#)))
+ (#{set-ribcage-marks!\ 144}#
+ (lambda (#{x\ 700}# #{update\ 701}#)
+ (vector-set! #{x\ 700}# 2 #{update\ 701}#)))
+ (#{set-ribcage-symnames!\ 143}#
+ (lambda (#{x\ 702}# #{update\ 703}#)
+ (vector-set! #{x\ 702}# 1 #{update\ 703}#)))
+ (#{ribcage-labels\ 142}#
+ (lambda (#{x\ 704}#) (vector-ref #{x\ 704}# 3)))
+ (#{ribcage-marks\ 141}#
+ (lambda (#{x\ 705}#) (vector-ref #{x\ 705}# 2)))
+ (#{ribcage-symnames\ 140}#
+ (lambda (#{x\ 706}#) (vector-ref #{x\ 706}# 1)))
+ (#{ribcage?\ 139}#
+ (lambda (#{x\ 707}#)
+ (if (vector? #{x\ 707}#)
+ (if (= (vector-length #{x\ 707}#) 4)
+ (eq? (vector-ref #{x\ 707}# 0) (quote ribcage))
#f)
#f)))
- (#{make-ribcage\ 136}#
- (lambda (#{symnames\ 749}#
- #{marks\ 750}#
- #{labels\ 751}#)
+ (#{make-ribcage\ 138}#
+ (lambda (#{symnames\ 708}#
+ #{marks\ 709}#
+ #{labels\ 710}#)
(vector
'ribcage
- #{symnames\ 749}#
- #{marks\ 750}#
- #{labels\ 751}#)))
- (#{gen-labels\ 135}#
- (lambda (#{ls\ 752}#)
- (if (null? #{ls\ 752}#)
+ #{symnames\ 708}#
+ #{marks\ 709}#
+ #{labels\ 710}#)))
+ (#{gen-labels\ 137}#
+ (lambda (#{ls\ 711}#)
+ (if (null? #{ls\ 711}#)
'()
- (cons (#{gen-label\ 134}#)
- (#{gen-labels\ 135}# (cdr #{ls\ 752}#))))))
- (#{gen-label\ 134}# (lambda () (string #\i)))
- (#{wrap-subst\ 133}# cdr)
- (#{wrap-marks\ 132}# car)
- (#{make-wrap\ 131}# cons)
- (#{id-sym-name&marks\ 130}#
- (lambda (#{x\ 753}# #{w\ 754}#)
- (if (#{syntax-object?\ 113}# #{x\ 753}#)
+ (cons (#{gen-label\ 136}#)
+ (#{gen-labels\ 137}# (cdr #{ls\ 711}#))))))
+ (#{gen-label\ 136}# (lambda () (string #\i)))
+ (#{wrap-subst\ 135}# cdr)
+ (#{wrap-marks\ 134}# car)
+ (#{make-wrap\ 133}# cons)
+ (#{id-sym-name&marks\ 132}#
+ (lambda (#{x\ 712}# #{w\ 713}#)
+ (if (#{syntax-object?\ 115}# #{x\ 712}#)
(values
- (#{syntax-object-expression\ 114}# #{x\ 753}#)
- (#{join-marks\ 149}#
- (#{wrap-marks\ 132}# #{w\ 754}#)
- (#{wrap-marks\ 132}#
- (#{syntax-object-wrap\ 115}# #{x\ 753}#))))
+ (#{syntax-object-expression\ 116}# #{x\ 712}#)
+ (#{join-marks\ 151}#
+ (#{wrap-marks\ 134}# #{w\ 713}#)
+ (#{wrap-marks\ 134}#
+ (#{syntax-object-wrap\ 117}# #{x\ 712}#))))
(values
- #{x\ 753}#
- (#{wrap-marks\ 132}# #{w\ 754}#)))))
- (#{id?\ 129}#
- (lambda (#{x\ 755}#)
- (if (symbol? #{x\ 755}#)
+ #{x\ 712}#
+ (#{wrap-marks\ 134}# #{w\ 713}#)))))
+ (#{id?\ 131}#
+ (lambda (#{x\ 714}#)
+ (if (symbol? #{x\ 714}#)
#t
- (if (#{syntax-object?\ 113}# #{x\ 755}#)
+ (if (#{syntax-object?\ 115}# #{x\ 714}#)
(symbol?
- (#{syntax-object-expression\ 114}# #{x\ 755}#))
+ (#{syntax-object-expression\ 116}# #{x\ 714}#))
#f))))
- (#{nonsymbol-id?\ 128}#
- (lambda (#{x\ 756}#)
- (if (#{syntax-object?\ 113}# #{x\ 756}#)
+ (#{nonsymbol-id?\ 130}#
+ (lambda (#{x\ 715}#)
+ (if (#{syntax-object?\ 115}# #{x\ 715}#)
(symbol?
- (#{syntax-object-expression\ 114}# #{x\ 756}#))
+ (#{syntax-object-expression\ 116}# #{x\ 715}#))
#f)))
- (#{global-extend\ 127}#
- (lambda (#{type\ 757}# #{sym\ 758}# #{val\ 759}#)
+ (#{global-extend\ 129}#
+ (lambda (#{type\ 716}# #{sym\ 717}# #{val\ 718}#)
(#{put-global-definition-hook\ 92}#
- #{sym\ 758}#
- #{type\ 757}#
- #{val\ 759}#)))
- (#{lookup\ 126}#
- (lambda (#{x\ 760}# #{r\ 761}# #{mod\ 762}#)
- (let ((#{t\ 763}# (assq #{x\ 760}# #{r\ 761}#)))
- (if #{t\ 763}#
- (cdr #{t\ 763}#)
- (if (symbol? #{x\ 760}#)
- (let ((#{t\ 764}# (#{get-global-definition-hook\ 93}#
- #{x\ 760}#
- #{mod\ 762}#)))
- (if #{t\ 764}# #{t\ 764}# (quote (global))))
+ #{sym\ 717}#
+ #{type\ 716}#
+ #{val\ 718}#)))
+ (#{lookup\ 128}#
+ (lambda (#{x\ 719}# #{r\ 720}# #{mod\ 721}#)
+ (let ((#{t\ 722}# (assq #{x\ 719}# #{r\ 720}#)))
+ (if #{t\ 722}#
+ (cdr #{t\ 722}#)
+ (if (symbol? #{x\ 719}#)
+ (let ((#{t\ 723}# (#{get-global-definition-hook\ 93}#
+ #{x\ 719}#
+ #{mod\ 721}#)))
+ (if #{t\ 723}# #{t\ 723}# (quote (global))))
'(displaced-lexical))))))
- (#{macros-only-env\ 125}#
- (lambda (#{r\ 765}#)
- (if (null? #{r\ 765}#)
+ (#{macros-only-env\ 127}#
+ (lambda (#{r\ 724}#)
+ (if (null? #{r\ 724}#)
'()
- (let ((#{a\ 766}# (car #{r\ 765}#)))
- (if (eq? (cadr #{a\ 766}#) (quote macro))
- (cons #{a\ 766}#
- (#{macros-only-env\ 125}# (cdr #{r\ 765}#)))
- (#{macros-only-env\ 125}# (cdr #{r\ 765}#)))))))
- (#{extend-var-env\ 124}#
- (lambda (#{labels\ 767}# #{vars\ 768}# #{r\ 769}#)
- (if (null? #{labels\ 767}#)
- #{r\ 769}#
- (#{extend-var-env\ 124}#
- (cdr #{labels\ 767}#)
- (cdr #{vars\ 768}#)
- (cons (cons (car #{labels\ 767}#)
- (cons (quote lexical) (car #{vars\ 768}#)))
- #{r\ 769}#)))))
- (#{extend-env\ 123}#
- (lambda (#{labels\ 770}# #{bindings\ 771}# #{r\ 772}#)
- (if (null? #{labels\ 770}#)
- #{r\ 772}#
- (#{extend-env\ 123}#
- (cdr #{labels\ 770}#)
- (cdr #{bindings\ 771}#)
- (cons (cons (car #{labels\ 770}#)
- (car #{bindings\ 771}#))
- #{r\ 772}#)))))
- (#{binding-value\ 122}# cdr)
- (#{binding-type\ 121}# car)
- (#{source-annotation\ 120}#
- (lambda (#{x\ 773}#)
- (if (#{syntax-object?\ 113}# #{x\ 773}#)
- (#{source-annotation\ 120}#
- (#{syntax-object-expression\ 114}# #{x\ 773}#))
- (if (pair? #{x\ 773}#)
- (let ((#{props\ 774}# (source-properties #{x\ 773}#)))
- (if (pair? #{props\ 774}#) #{props\ 774}# #f))
+ (let ((#{a\ 725}# (car #{r\ 724}#)))
+ (if (eq? (cadr #{a\ 725}#) (quote macro))
+ (cons #{a\ 725}#
+ (#{macros-only-env\ 127}# (cdr #{r\ 724}#)))
+ (#{macros-only-env\ 127}# (cdr #{r\ 724}#)))))))
+ (#{extend-var-env\ 126}#
+ (lambda (#{labels\ 726}# #{vars\ 727}# #{r\ 728}#)
+ (if (null? #{labels\ 726}#)
+ #{r\ 728}#
+ (#{extend-var-env\ 126}#
+ (cdr #{labels\ 726}#)
+ (cdr #{vars\ 727}#)
+ (cons (cons (car #{labels\ 726}#)
+ (cons (quote lexical) (car #{vars\ 727}#)))
+ #{r\ 728}#)))))
+ (#{extend-env\ 125}#
+ (lambda (#{labels\ 729}# #{bindings\ 730}# #{r\ 731}#)
+ (if (null? #{labels\ 729}#)
+ #{r\ 731}#
+ (#{extend-env\ 125}#
+ (cdr #{labels\ 729}#)
+ (cdr #{bindings\ 730}#)
+ (cons (cons (car #{labels\ 729}#)
+ (car #{bindings\ 730}#))
+ #{r\ 731}#)))))
+ (#{binding-value\ 124}# cdr)
+ (#{binding-type\ 123}# car)
+ (#{source-annotation\ 122}#
+ (lambda (#{x\ 732}#)
+ (if (#{syntax-object?\ 115}# #{x\ 732}#)
+ (#{source-annotation\ 122}#
+ (#{syntax-object-expression\ 116}# #{x\ 732}#))
+ (if (pair? #{x\ 732}#)
+ (let ((#{props\ 733}# (source-properties #{x\ 732}#)))
+ (if (pair? #{props\ 733}#) #{props\ 733}# #f))
#f))))
- (#{set-syntax-object-module!\ 119}#
- (lambda (#{x\ 775}# #{update\ 776}#)
- (vector-set! #{x\ 775}# 3 #{update\ 776}#)))
- (#{set-syntax-object-wrap!\ 118}#
- (lambda (#{x\ 777}# #{update\ 778}#)
- (vector-set! #{x\ 777}# 2 #{update\ 778}#)))
- (#{set-syntax-object-expression!\ 117}#
- (lambda (#{x\ 779}# #{update\ 780}#)
- (vector-set! #{x\ 779}# 1 #{update\ 780}#)))
- (#{syntax-object-module\ 116}#
- (lambda (#{x\ 781}#) (vector-ref #{x\ 781}# 3)))
- (#{syntax-object-wrap\ 115}#
- (lambda (#{x\ 782}#) (vector-ref #{x\ 782}# 2)))
- (#{syntax-object-expression\ 114}#
- (lambda (#{x\ 783}#) (vector-ref #{x\ 783}# 1)))
- (#{syntax-object?\ 113}#
- (lambda (#{x\ 784}#)
- (if (vector? #{x\ 784}#)
- (if (= (vector-length #{x\ 784}#) 4)
- (eq? (vector-ref #{x\ 784}# 0)
+ (#{set-syntax-object-module!\ 121}#
+ (lambda (#{x\ 734}# #{update\ 735}#)
+ (vector-set! #{x\ 734}# 3 #{update\ 735}#)))
+ (#{set-syntax-object-wrap!\ 120}#
+ (lambda (#{x\ 736}# #{update\ 737}#)
+ (vector-set! #{x\ 736}# 2 #{update\ 737}#)))
+ (#{set-syntax-object-expression!\ 119}#
+ (lambda (#{x\ 738}# #{update\ 739}#)
+ (vector-set! #{x\ 738}# 1 #{update\ 739}#)))
+ (#{syntax-object-module\ 118}#
+ (lambda (#{x\ 740}#) (vector-ref #{x\ 740}# 3)))
+ (#{syntax-object-wrap\ 117}#
+ (lambda (#{x\ 741}#) (vector-ref #{x\ 741}# 2)))
+ (#{syntax-object-expression\ 116}#
+ (lambda (#{x\ 742}#) (vector-ref #{x\ 742}# 1)))
+ (#{syntax-object?\ 115}#
+ (lambda (#{x\ 743}#)
+ (if (vector? #{x\ 743}#)
+ (if (= (vector-length #{x\ 743}#) 4)
+ (eq? (vector-ref #{x\ 743}# 0)
'syntax-object)
#f)
#f)))
- (#{make-syntax-object\ 112}#
- (lambda (#{expression\ 785}#
- #{wrap\ 786}#
- #{module\ 787}#)
+ (#{make-syntax-object\ 114}#
+ (lambda (#{expression\ 744}#
+ #{wrap\ 745}#
+ #{module\ 746}#)
(vector
'syntax-object
- #{expression\ 785}#
- #{wrap\ 786}#
- #{module\ 787}#)))
- (#{build-letrec\ 111}#
- (lambda (#{src\ 788}#
- #{ids\ 789}#
- #{vars\ 790}#
- #{val-exps\ 791}#
- #{body-exp\ 792}#)
- (if (null? #{vars\ 790}#)
- #{body-exp\ 792}#
- (let ((#{atom-key\ 793}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 793}# (quote (c)))
+ #{expression\ 744}#
+ #{wrap\ 745}#
+ #{module\ 746}#)))
+ (#{build-letrec\ 113}#
+ (lambda (#{src\ 747}#
+ #{ids\ 748}#
+ #{vars\ 749}#
+ #{val-exps\ 750}#
+ #{body-exp\ 751}#)
+ (if (null? #{vars\ 749}#)
+ #{body-exp\ 751}#
+ (let ((#{atom-key\ 752}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 752}# (quote (c)))
(begin
(for-each
#{maybe-name-value!\ 103}#
- #{ids\ 789}#
- #{val-exps\ 791}#)
+ #{ids\ 748}#
+ #{val-exps\ 750}#)
((@ (language tree-il) make-letrec)
- #{src\ 788}#
- #{ids\ 789}#
- #{vars\ 790}#
- #{val-exps\ 791}#
- #{body-exp\ 792}#))
+ #{src\ 747}#
+ #{ids\ 748}#
+ #{vars\ 749}#
+ #{val-exps\ 750}#
+ #{body-exp\ 751}#))
(#{decorate-source\ 94}#
(list 'letrec
- (map list #{vars\ 790}# #{val-exps\ 791}#)
- #{body-exp\ 792}#)
- #{src\ 788}#))))))
- (#{build-named-let\ 110}#
- (lambda (#{src\ 794}#
- #{ids\ 795}#
- #{vars\ 796}#
- #{val-exps\ 797}#
- #{body-exp\ 798}#)
- (let ((#{f\ 799}# (car #{vars\ 796}#))
- (#{f-name\ 800}# (car #{ids\ 795}#))
- (#{vars\ 801}# (cdr #{vars\ 796}#))
- (#{ids\ 802}# (cdr #{ids\ 795}#)))
- (let ((#{atom-key\ 803}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 803}# (quote (c)))
- (let ((#{proc\ 804}#
- (#{build-lambda\ 105}#
- #{src\ 794}#
- #{ids\ 802}#
- #{vars\ 801}#
+ (map list #{vars\ 749}# #{val-exps\ 750}#)
+ #{body-exp\ 751}#)
+ #{src\ 747}#))))))
+ (#{build-named-let\ 112}#
+ (lambda (#{src\ 753}#
+ #{ids\ 754}#
+ #{vars\ 755}#
+ #{val-exps\ 756}#
+ #{body-exp\ 757}#)
+ (let ((#{f\ 758}# (car #{vars\ 755}#))
+ (#{f-name\ 759}# (car #{ids\ 754}#))
+ (#{vars\ 760}# (cdr #{vars\ 755}#))
+ (#{ids\ 761}# (cdr #{ids\ 754}#)))
+ (let ((#{atom-key\ 762}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 762}# (quote (c)))
+ (let ((#{proc\ 763}#
+ (#{build-simple-lambda\ 105}#
+ #{src\ 753}#
+ #{ids\ 761}#
#f
- #{body-exp\ 798}#)))
+ #{vars\ 760}#
+ #f
+ #{body-exp\ 757}#)))
(begin
(#{maybe-name-value!\ 103}#
- #{f-name\ 800}#
- #{proc\ 804}#)
+ #{f-name\ 759}#
+ #{proc\ 763}#)
(for-each
#{maybe-name-value!\ 103}#
- #{ids\ 802}#
- #{val-exps\ 797}#)
+ #{ids\ 761}#
+ #{val-exps\ 756}#)
((@ (language tree-il) make-letrec)
- #{src\ 794}#
- (list #{f-name\ 800}#)
- (list #{f\ 799}#)
- (list #{proc\ 804}#)
+ #{src\ 753}#
+ (list #{f-name\ 759}#)
+ (list #{f\ 758}#)
+ (list #{proc\ 763}#)
(#{build-application\ 96}#
- #{src\ 794}#
+ #{src\ 753}#
(#{build-lexical-reference\ 98}#
'fun
- #{src\ 794}#
- #{f-name\ 800}#
- #{f\ 799}#)
- #{val-exps\ 797}#))))
+ #{src\ 753}#
+ #{f-name\ 759}#
+ #{f\ 758}#)
+ #{val-exps\ 756}#))))
(#{decorate-source\ 94}#
(list 'let
- #{f\ 799}#
- (map list #{vars\ 801}# #{val-exps\ 797}#)
- #{body-exp\ 798}#)
- #{src\ 794}#))))))
- (#{build-let\ 109}#
- (lambda (#{src\ 805}#
- #{ids\ 806}#
- #{vars\ 807}#
- #{val-exps\ 808}#
- #{body-exp\ 809}#)
- (if (null? #{vars\ 807}#)
- #{body-exp\ 809}#
- (let ((#{atom-key\ 810}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 810}# (quote (c)))
+ #{f\ 758}#
+ (map list #{vars\ 760}# #{val-exps\ 756}#)
+ #{body-exp\ 757}#)
+ #{src\ 753}#))))))
+ (#{build-let\ 111}#
+ (lambda (#{src\ 764}#
+ #{ids\ 765}#
+ #{vars\ 766}#
+ #{val-exps\ 767}#
+ #{body-exp\ 768}#)
+ (if (null? #{vars\ 766}#)
+ #{body-exp\ 768}#
+ (let ((#{atom-key\ 769}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 769}# (quote (c)))
(begin
(for-each
#{maybe-name-value!\ 103}#
- #{ids\ 806}#
- #{val-exps\ 808}#)
+ #{ids\ 765}#
+ #{val-exps\ 767}#)
((@ (language tree-il) make-let)
- #{src\ 805}#
- #{ids\ 806}#
- #{vars\ 807}#
- #{val-exps\ 808}#
- #{body-exp\ 809}#))
+ #{src\ 764}#
+ #{ids\ 765}#
+ #{vars\ 766}#
+ #{val-exps\ 767}#
+ #{body-exp\ 768}#))
(#{decorate-source\ 94}#
(list 'let
- (map list #{vars\ 807}# #{val-exps\ 808}#)
- #{body-exp\ 809}#)
- #{src\ 805}#))))))
- (#{build-sequence\ 108}#
- (lambda (#{src\ 811}# #{exps\ 812}#)
- (if (null? (cdr #{exps\ 812}#))
- (car #{exps\ 812}#)
- (let ((#{atom-key\ 813}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 813}# (quote (c)))
+ (map list #{vars\ 766}# #{val-exps\ 767}#)
+ #{body-exp\ 768}#)
+ #{src\ 764}#))))))
+ (#{build-sequence\ 110}#
+ (lambda (#{src\ 770}# #{exps\ 771}#)
+ (if (null? (cdr #{exps\ 771}#))
+ (car #{exps\ 771}#)
+ (let ((#{atom-key\ 772}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 772}# (quote (c)))
((@ (language tree-il) make-sequence)
- #{src\ 811}#
- #{exps\ 812}#)
+ #{src\ 770}#
+ #{exps\ 771}#)
(#{decorate-source\ 94}#
- (cons (quote begin) #{exps\ 812}#)
- #{src\ 811}#))))))
- (#{build-data\ 107}#
- (lambda (#{src\ 814}# #{exp\ 815}#)
- (let ((#{atom-key\ 816}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 816}# (quote (c)))
+ (cons (quote begin) #{exps\ 771}#)
+ #{src\ 770}#))))))
+ (#{build-data\ 109}#
+ (lambda (#{src\ 773}# #{exp\ 774}#)
+ (let ((#{atom-key\ 775}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 775}# (quote (c)))
((@ (language tree-il) make-const)
- #{src\ 814}#
- #{exp\ 815}#)
+ #{src\ 773}#
+ #{exp\ 774}#)
(#{decorate-source\ 94}#
- (if (if (self-evaluating? #{exp\ 815}#)
- (not (vector? #{exp\ 815}#))
+ (if (if (self-evaluating? #{exp\ 774}#)
+ (not (vector? #{exp\ 774}#))
#f)
- #{exp\ 815}#
- (list (quote quote) #{exp\ 815}#))
- #{src\ 814}#)))))
- (#{build-primref\ 106}#
- (lambda (#{src\ 817}# #{name\ 818}#)
+ #{exp\ 774}#
+ (list (quote quote) #{exp\ 774}#))
+ #{src\ 773}#)))))
+ (#{build-primref\ 108}#
+ (lambda (#{src\ 776}# #{name\ 777}#)
(if (equal?
(module-name (current-module))
'(guile))
- (let ((#{atom-key\ 819}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 819}# (quote (c)))
+ (let ((#{atom-key\ 778}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 778}# (quote (c)))
((@ (language tree-il) make-toplevel-ref)
- #{src\ 817}#
- #{name\ 818}#)
+ #{src\ 776}#
+ #{name\ 777}#)
(#{decorate-source\ 94}#
- #{name\ 818}#
- #{src\ 817}#)))
- (let ((#{atom-key\ 820}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 820}# (quote (c)))
+ #{name\ 777}#
+ #{src\ 776}#)))
+ (let ((#{atom-key\ 779}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 779}# (quote (c)))
((@ (language tree-il) make-module-ref)
- #{src\ 817}#
+ #{src\ 776}#
'(guile)
- #{name\ 818}#
+ #{name\ 777}#
#f)
(#{decorate-source\ 94}#
- (list (quote @@) (quote (guile)) #{name\ 818}#)
- #{src\ 817}#))))))
- (#{build-lambda\ 105}#
- (lambda (#{src\ 821}#
- #{ids\ 822}#
- #{vars\ 823}#
- #{docstring\ 824}#
- #{exp\ 825}#)
- (let ((#{atom-key\ 826}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 826}# (quote (c)))
+ (list (quote @@) (quote (guile)) #{name\ 777}#)
+ #{src\ 776}#))))))
+ (#{build-lambda-case\ 107}#
+ (lambda (#{src\ 780}#
+ #{req\ 781}#
+ #{opt\ 782}#
+ #{rest\ 783}#
+ #{kw\ 784}#
+ #{vars\ 785}#
+ #{predicate\ 786}#
+ #{body\ 787}#
+ #{else-case\ 788}#)
+ (let ((#{atom-key\ 789}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 789}# (quote (c)))
+ ((@ (language tree-il) make-lambda-case)
+ #{src\ 780}#
+ #{req\ 781}#
+ #{opt\ 782}#
+ #{rest\ 783}#
+ #{kw\ 784}#
+ #{vars\ 785}#
+ #{predicate\ 786}#
+ #{body\ 787}#
+ #{else-case\ 788}#)
+ (let ((#{nkw\ 790}#
+ (map (lambda (#{x\ 791}#)
+ (list 'list
+ (car #{x\ 791}#)
+ (letrec ((#{lp\ 792}#
+ (lambda (#{vars\ 793}#
+ #{i\ 794}#)
+ (if (null? #{vars\ 793}#)
+ (error "bad kwarg"
+ #{x\ 791}#)
+ (if (eq? (cadr #{x\ 791}#)
+ (car #{vars\ 793}#))
+ #{i\ 794}#
+ (#{lp\ 792}#
+ (cdr #{vars\ 793}#)
+ (1+ #{i\ 794}#)))))))
+ (#{lp\ 792}# #{vars\ 785}# 0))
+ (list 'lambda
+ '()
+ (caddr #{x\ 791}#))))
+ #{kw\ 784}#)))
+ (#{decorate-source\ 94}#
+ (cons (list (cons '(@@ (ice-9 optargs)
+ parse-lambda-case)
+ (cons (list 'list
+ (length #{req\ 781}#)
+ (length #{opt\ 782}#)
+ (if #{rest\ 783}# #t #f)
+ #{nkw\ 790}#
+ (if #{predicate\ 786}#
+ (error "not yet implemented")
+ #f))
+ '(%%args)))
+ '=>
+ (list 'lambda
+ #{vars\ 785}#
+ #{body\ 787}#))
+ (let ((#{t\ 795}# #{else-case\ 788}#))
+ (if #{t\ 795}#
+ #{t\ 795}#
+ '((%%args
+ (error "wrong number of arguments"
+ %%args))))))
+ #{src\ 780}#))))))
+ (#{build-case-lambda\ 106}#
+ (lambda (#{src\ 796}# #{docstring\ 797}# #{body\ 798}#)
+ (let ((#{atom-key\ 799}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 799}# (quote (c)))
((@ (language tree-il) make-lambda)
- #{src\ 821}#
- #{ids\ 822}#
- #{vars\ 823}#
- (if #{docstring\ 824}#
- (list (cons (quote documentation) #{docstring\ 824}#))
+ #{src\ 796}#
+ (if #{docstring\ 797}#
+ (list (cons (quote documentation) #{docstring\ 797}#))
'())
- #{exp\ 825}#)
+ #{body\ 798}#)
+ (#{decorate-source\ 94}#
+ (cons 'lambda
+ (cons '%%args
+ (append
+ (if #{docstring\ 797}#
+ (list #{docstring\ 797}#)
+ '())
+ (list (cons (quote cond) #{body\ 798}#)))))
+ #{src\ 796}#)))))
+ (#{build-simple-lambda\ 105}#
+ (lambda (#{src\ 800}#
+ #{req\ 801}#
+ #{rest\ 802}#
+ #{vars\ 803}#
+ #{docstring\ 804}#
+ #{exp\ 805}#)
+ (let ((#{atom-key\ 806}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 806}# (quote (c)))
+ ((@ (language tree-il) make-lambda)
+ #{src\ 800}#
+ (if #{docstring\ 804}#
+ (list (cons (quote documentation) #{docstring\ 804}#))
+ '())
+ ((@ (language tree-il) make-lambda-case)
+ #{src\ 800}#
+ #{req\ 801}#
+ #f
+ #{rest\ 802}#
+ #f
+ #{vars\ 803}#
+ #f
+ #{exp\ 805}#
+ #f))
(#{decorate-source\ 94}#
(cons 'lambda
- (cons #{vars\ 823}#
+ (cons (if #{rest\ 802}#
+ (apply cons* #{vars\ 803}#)
+ #{vars\ 803}#)
(append
- (if #{docstring\ 824}#
- (list #{docstring\ 824}#)
+ (if #{docstring\ 804}#
+ (list #{docstring\ 804}#)
'())
- (list #{exp\ 825}#))))
- #{src\ 821}#)))))
+ (list #{exp\ 805}#))))
+ #{src\ 800}#)))))
(#{build-global-definition\ 104}#
- (lambda (#{source\ 827}# #{var\ 828}# #{exp\ 829}#)
- (let ((#{atom-key\ 830}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 830}# (quote (c)))
+ (lambda (#{source\ 807}# #{var\ 808}# #{exp\ 809}#)
+ (let ((#{atom-key\ 810}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 810}# (quote (c)))
(begin
(#{maybe-name-value!\ 103}#
- #{var\ 828}#
- #{exp\ 829}#)
+ #{var\ 808}#
+ #{exp\ 809}#)
((@ (language tree-il) make-toplevel-define)
- #{source\ 827}#
- #{var\ 828}#
- #{exp\ 829}#))
+ #{source\ 807}#
+ #{var\ 808}#
+ #{exp\ 809}#))
(#{decorate-source\ 94}#
- (list (quote define) #{var\ 828}# #{exp\ 829}#)
- #{source\ 827}#)))))
+ (list (quote define) #{var\ 808}# #{exp\ 809}#)
+ #{source\ 807}#)))))
(#{maybe-name-value!\ 103}#
- (lambda (#{name\ 831}# #{val\ 832}#)
- (if ((@ (language tree-il) lambda?) #{val\ 832}#)
- (let ((#{meta\ 833}#
- ((@ (language tree-il) lambda-meta) #{val\ 832}#)))
- (if (not (assq (quote name) #{meta\ 833}#))
+ (lambda (#{name\ 811}# #{val\ 812}#)
+ (if ((@ (language tree-il) lambda?) #{val\ 812}#)
+ (let ((#{meta\ 813}#
+ ((@ (language tree-il) lambda-meta) #{val\ 812}#)))
+ (if (not (assq (quote name) #{meta\ 813}#))
((setter (@ (language tree-il) lambda-meta))
- #{val\ 832}#
- (acons (quote name) #{name\ 831}# #{meta\ 833}#)))))))
+ #{val\ 812}#
+ (acons (quote name) #{name\ 811}# #{meta\ 813}#)))))))
(#{build-global-assignment\ 102}#
- (lambda (#{source\ 834}#
- #{var\ 835}#
- #{exp\ 836}#
- #{mod\ 837}#)
+ (lambda (#{source\ 814}#
+ #{var\ 815}#
+ #{exp\ 816}#
+ #{mod\ 817}#)
(#{analyze-variable\ 100}#
- #{mod\ 837}#
- #{var\ 835}#
- (lambda (#{mod\ 838}# #{var\ 839}# #{public?\ 840}#)
- (let ((#{atom-key\ 841}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 841}# (quote (c)))
+ #{mod\ 817}#
+ #{var\ 815}#
+ (lambda (#{mod\ 818}# #{var\ 819}# #{public?\ 820}#)
+ (let ((#{atom-key\ 821}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 821}# (quote (c)))
((@ (language tree-il) make-module-set)
- #{source\ 834}#
- #{mod\ 838}#
- #{var\ 839}#
- #{public?\ 840}#
- #{exp\ 836}#)
+ #{source\ 814}#
+ #{mod\ 818}#
+ #{var\ 819}#
+ #{public?\ 820}#
+ #{exp\ 816}#)
(#{decorate-source\ 94}#
(list 'set!
- (list (if #{public?\ 840}# (quote @) (quote @@))
- #{mod\ 838}#
- #{var\ 839}#)
- #{exp\ 836}#)
- #{source\ 834}#))))
- (lambda (#{var\ 842}#)
- (let ((#{atom-key\ 843}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 843}# (quote (c)))
+ (list (if #{public?\ 820}# (quote @) (quote @@))
+ #{mod\ 818}#
+ #{var\ 819}#)
+ #{exp\ 816}#)
+ #{source\ 814}#))))
+ (lambda (#{var\ 822}#)
+ (let ((#{atom-key\ 823}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 823}# (quote (c)))
((@ (language tree-il) make-toplevel-set)
- #{source\ 834}#
- #{var\ 842}#
- #{exp\ 836}#)
+ #{source\ 814}#
+ #{var\ 822}#
+ #{exp\ 816}#)
(#{decorate-source\ 94}#
- (list (quote set!) #{var\ 842}# #{exp\ 836}#)
- #{source\ 834}#)))))))
+ (list (quote set!) #{var\ 822}# #{exp\ 816}#)
+ #{source\ 814}#)))))))
(#{build-global-reference\ 101}#
- (lambda (#{source\ 844}# #{var\ 845}# #{mod\ 846}#)
+ (lambda (#{source\ 824}# #{var\ 825}# #{mod\ 826}#)
(#{analyze-variable\ 100}#
- #{mod\ 846}#
- #{var\ 845}#
- (lambda (#{mod\ 847}# #{var\ 848}# #{public?\ 849}#)
- (let ((#{atom-key\ 850}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 850}# (quote (c)))
+ #{mod\ 826}#
+ #{var\ 825}#
+ (lambda (#{mod\ 827}# #{var\ 828}# #{public?\ 829}#)
+ (let ((#{atom-key\ 830}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 830}# (quote (c)))
((@ (language tree-il) make-module-ref)
- #{source\ 844}#
- #{mod\ 847}#
- #{var\ 848}#
- #{public?\ 849}#)
+ #{source\ 824}#
+ #{mod\ 827}#
+ #{var\ 828}#
+ #{public?\ 829}#)
(#{decorate-source\ 94}#
- (list (if #{public?\ 849}# (quote @) (quote @@))
- #{mod\ 847}#
- #{var\ 848}#)
- #{source\ 844}#))))
- (lambda (#{var\ 851}#)
- (let ((#{atom-key\ 852}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 852}# (quote (c)))
+ (list (if #{public?\ 829}# (quote @) (quote @@))
+ #{mod\ 827}#
+ #{var\ 828}#)
+ #{source\ 824}#))))
+ (lambda (#{var\ 831}#)
+ (let ((#{atom-key\ 832}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 832}# (quote (c)))
((@ (language tree-il) make-toplevel-ref)
- #{source\ 844}#
- #{var\ 851}#)
+ #{source\ 824}#
+ #{var\ 831}#)
(#{decorate-source\ 94}#
- #{var\ 851}#
- #{source\ 844}#)))))))
+ #{var\ 831}#
+ #{source\ 824}#)))))))
(#{analyze-variable\ 100}#
- (lambda (#{mod\ 853}#
- #{var\ 854}#
- #{modref-cont\ 855}#
- #{bare-cont\ 856}#)
- (if (not #{mod\ 853}#)
- (#{bare-cont\ 856}# #{var\ 854}#)
- (let ((#{kind\ 857}# (car #{mod\ 853}#))
- (#{mod\ 858}# (cdr #{mod\ 853}#)))
- (if (memv #{kind\ 857}# (quote (public)))
- (#{modref-cont\ 855}#
- #{mod\ 858}#
- #{var\ 854}#
+ (lambda (#{mod\ 833}#
+ #{var\ 834}#
+ #{modref-cont\ 835}#
+ #{bare-cont\ 836}#)
+ (if (not #{mod\ 833}#)
+ (#{bare-cont\ 836}# #{var\ 834}#)
+ (let ((#{kind\ 837}# (car #{mod\ 833}#))
+ (#{mod\ 838}# (cdr #{mod\ 833}#)))
+ (if (memv #{kind\ 837}# (quote (public)))
+ (#{modref-cont\ 835}#
+ #{mod\ 838}#
+ #{var\ 834}#
#t)
- (if (memv #{kind\ 857}# (quote (private)))
+ (if (memv #{kind\ 837}# (quote (private)))
(if (not (equal?
- #{mod\ 858}#
+ #{mod\ 838}#
(module-name (current-module))))
- (#{modref-cont\ 855}#
- #{mod\ 858}#
- #{var\ 854}#
+ (#{modref-cont\ 835}#
+ #{mod\ 838}#
+ #{var\ 834}#
#f)
- (#{bare-cont\ 856}# #{var\ 854}#))
- (if (memv #{kind\ 857}# (quote (bare)))
- (#{bare-cont\ 856}# #{var\ 854}#)
- (if (memv #{kind\ 857}# (quote (hygiene)))
+ (#{bare-cont\ 836}# #{var\ 834}#))
+ (if (memv #{kind\ 837}# (quote (bare)))
+ (#{bare-cont\ 836}# #{var\ 834}#)
+ (if (memv #{kind\ 837}# (quote (hygiene)))
(if (if (not (equal?
- #{mod\ 858}#
+ #{mod\ 838}#
(module-name (current-module))))
(module-variable
- (resolve-module #{mod\ 858}#)
- #{var\ 854}#)
+ (resolve-module #{mod\ 838}#)
+ #{var\ 834}#)
#f)
- (#{modref-cont\ 855}#
- #{mod\ 858}#
- #{var\ 854}#
+ (#{modref-cont\ 835}#
+ #{mod\ 838}#
+ #{var\ 834}#
#f)
- (#{bare-cont\ 856}# #{var\ 854}#))
+ (#{bare-cont\ 836}# #{var\ 834}#))
(syntax-violation
#f
"bad module kind"
- #{var\ 854}#
- #{mod\ 858}#)))))))))
+ #{var\ 834}#
+ #{mod\ 838}#)))))))))
(#{build-lexical-assignment\ 99}#
- (lambda (#{source\ 859}#
- #{name\ 860}#
- #{var\ 861}#
- #{exp\ 862}#)
- (let ((#{atom-key\ 863}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 863}# (quote (c)))
+ (lambda (#{source\ 839}#
+ #{name\ 840}#
+ #{var\ 841}#
+ #{exp\ 842}#)
+ (let ((#{atom-key\ 843}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 843}# (quote (c)))
((@ (language tree-il) make-lexical-set)
- #{source\ 859}#
- #{name\ 860}#
- #{var\ 861}#
- #{exp\ 862}#)
+ #{source\ 839}#
+ #{name\ 840}#
+ #{var\ 841}#
+ #{exp\ 842}#)
(#{decorate-source\ 94}#
- (list (quote set!) #{var\ 861}# #{exp\ 862}#)
- #{source\ 859}#)))))
+ (list (quote set!) #{var\ 841}# #{exp\ 842}#)
+ #{source\ 839}#)))))
(#{build-lexical-reference\ 98}#
- (lambda (#{type\ 864}#
- #{source\ 865}#
- #{name\ 866}#
- #{var\ 867}#)
- (let ((#{atom-key\ 868}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 868}# (quote (c)))
+ (lambda (#{type\ 844}#
+ #{source\ 845}#
+ #{name\ 846}#
+ #{var\ 847}#)
+ (let ((#{atom-key\ 848}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 848}# (quote (c)))
((@ (language tree-il) make-lexical-ref)
- #{source\ 865}#
- #{name\ 866}#
- #{var\ 867}#)
+ #{source\ 845}#
+ #{name\ 846}#
+ #{var\ 847}#)
(#{decorate-source\ 94}#
- #{var\ 867}#
- #{source\ 865}#)))))
+ #{var\ 847}#
+ #{source\ 845}#)))))
(#{build-conditional\ 97}#
- (lambda (#{source\ 869}#
- #{test-exp\ 870}#
- #{then-exp\ 871}#
- #{else-exp\ 872}#)
- (let ((#{atom-key\ 873}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 873}# (quote (c)))
+ (lambda (#{source\ 849}#
+ #{test-exp\ 850}#
+ #{then-exp\ 851}#
+ #{else-exp\ 852}#)
+ (let ((#{atom-key\ 853}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 853}# (quote (c)))
((@ (language tree-il) make-conditional)
- #{source\ 869}#
- #{test-exp\ 870}#
- #{then-exp\ 871}#
- #{else-exp\ 872}#)
+ #{source\ 849}#
+ #{test-exp\ 850}#
+ #{then-exp\ 851}#
+ #{else-exp\ 852}#)
(#{decorate-source\ 94}#
- (if (equal? #{else-exp\ 872}# (quote (if #f #f)))
+ (if (equal? #{else-exp\ 852}# (quote (if #f #f)))
(list 'if
- #{test-exp\ 870}#
- #{then-exp\ 871}#)
+ #{test-exp\ 850}#
+ #{then-exp\ 851}#)
(list 'if
- #{test-exp\ 870}#
- #{then-exp\ 871}#
- #{else-exp\ 872}#))
- #{source\ 869}#)))))
+ #{test-exp\ 850}#
+ #{then-exp\ 851}#
+ #{else-exp\ 852}#))
+ #{source\ 849}#)))))
(#{build-application\ 96}#
- (lambda (#{source\ 874}#
- #{fun-exp\ 875}#
- #{arg-exps\ 876}#)
- (let ((#{atom-key\ 877}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 877}# (quote (c)))
+ (lambda (#{source\ 854}#
+ #{fun-exp\ 855}#
+ #{arg-exps\ 856}#)
+ (let ((#{atom-key\ 857}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 857}# (quote (c)))
((@ (language tree-il) make-application)
- #{source\ 874}#
- #{fun-exp\ 875}#
- #{arg-exps\ 876}#)
+ #{source\ 854}#
+ #{fun-exp\ 855}#
+ #{arg-exps\ 856}#)
(#{decorate-source\ 94}#
- (cons #{fun-exp\ 875}# #{arg-exps\ 876}#)
- #{source\ 874}#)))))
+ (cons #{fun-exp\ 855}# #{arg-exps\ 856}#)
+ #{source\ 854}#)))))
(#{build-void\ 95}#
- (lambda (#{source\ 878}#)
- (let ((#{atom-key\ 879}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 879}# (quote (c)))
+ (lambda (#{source\ 858}#)
+ (let ((#{atom-key\ 859}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 859}# (quote (c)))
((@ (language tree-il) make-void)
- #{source\ 878}#)
+ #{source\ 858}#)
(#{decorate-source\ 94}#
'(if #f #f)
- #{source\ 878}#)))))
+ #{source\ 858}#)))))
(#{decorate-source\ 94}#
- (lambda (#{e\ 880}# #{s\ 881}#)
+ (lambda (#{e\ 860}# #{s\ 861}#)
(begin
- (if (if (pair? #{e\ 880}#) #{s\ 881}# #f)
- (set-source-properties! #{e\ 880}# #{s\ 881}#))
- #{e\ 880}#)))
+ (if (if (pair? #{e\ 860}#) #{s\ 861}# #f)
+ (set-source-properties! #{e\ 860}# #{s\ 861}#))
+ #{e\ 860}#)))
(#{get-global-definition-hook\ 93}#
- (lambda (#{symbol\ 882}# #{module\ 883}#)
+ (lambda (#{symbol\ 862}# #{module\ 863}#)
(begin
- (if (if (not #{module\ 883}#) (current-module) #f)
+ (if (if (not #{module\ 863}#) (current-module) #f)
(warn "module system is booted, we should have a module"
- #{symbol\ 882}#))
- (let ((#{v\ 884}# (module-variable
- (if #{module\ 883}#
- (resolve-module (cdr #{module\ 883}#))
+ #{symbol\ 862}#))
+ (let ((#{v\ 864}# (module-variable
+ (if #{module\ 863}#
+ (resolve-module (cdr #{module\ 863}#))
(current-module))
- #{symbol\ 882}#)))
- (if #{v\ 884}#
- (if (variable-bound? #{v\ 884}#)
- (let ((#{val\ 885}# (variable-ref #{v\ 884}#)))
- (if (macro? #{val\ 885}#)
- (if (syncase-macro-type #{val\ 885}#)
- (cons (syncase-macro-type #{val\ 885}#)
- (syncase-macro-binding #{val\ 885}#))
+ #{symbol\ 862}#)))
+ (if #{v\ 864}#
+ (if (variable-bound? #{v\ 864}#)
+ (let ((#{val\ 865}# (variable-ref #{v\ 864}#)))
+ (if (macro? #{val\ 865}#)
+ (if (syncase-macro-type #{val\ 865}#)
+ (cons (syncase-macro-type #{val\ 865}#)
+ (syncase-macro-binding #{val\ 865}#))
#f)
#f))
#f)
#f)))))
(#{put-global-definition-hook\ 92}#
- (lambda (#{symbol\ 886}# #{type\ 887}# #{val\ 888}#)
- (let ((#{existing\ 889}#
- (let ((#{v\ 890}# (module-variable
+ (lambda (#{symbol\ 866}# #{type\ 867}# #{val\ 868}#)
+ (let ((#{existing\ 869}#
+ (let ((#{v\ 870}# (module-variable
(current-module)
- #{symbol\ 886}#)))
- (if #{v\ 890}#
- (if (variable-bound? #{v\ 890}#)
- (let ((#{val\ 891}# (variable-ref #{v\ 890}#)))
- (if (macro? #{val\ 891}#)
- (if (not (syncase-macro-type #{val\ 891}#))
- #{val\ 891}#
+ #{symbol\ 866}#)))
+ (if #{v\ 870}#
+ (if (variable-bound? #{v\ 870}#)
+ (let ((#{val\ 871}# (variable-ref #{v\ 870}#)))
+ (if (macro? #{val\ 871}#)
+ (if (not (syncase-macro-type #{val\ 871}#))
+ #{val\ 871}#
#f)
#f))
#f)
#f))))
(module-define!
(current-module)
- #{symbol\ 886}#
- (if #{existing\ 889}#
+ #{symbol\ 866}#
+ (if #{existing\ 869}#
(make-extended-syncase-macro
- #{existing\ 889}#
- #{type\ 887}#
- #{val\ 888}#)
- (make-syncase-macro #{type\ 887}# #{val\ 888}#))))))
+ #{existing\ 869}#
+ #{type\ 867}#
+ #{val\ 868}#)
+ (make-syncase-macro #{type\ 867}# #{val\ 868}#))))))
(#{local-eval-hook\ 91}#
- (lambda (#{x\ 892}# #{mod\ 893}#)
+ (lambda (#{x\ 872}# #{mod\ 873}#)
(primitive-eval
(list #{noexpand\ 84}#
- (let ((#{atom-key\ 894}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 894}# (quote (c)))
+ (let ((#{atom-key\ 874}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 874}# (quote (c)))
((@ (language tree-il) tree-il->scheme)
- #{x\ 892}#)
- #{x\ 892}#))))))
+ #{x\ 872}#)
+ #{x\ 872}#))))))
(#{top-level-eval-hook\ 90}#
- (lambda (#{x\ 895}# #{mod\ 896}#)
+ (lambda (#{x\ 875}# #{mod\ 876}#)
(primitive-eval
(list #{noexpand\ 84}#
- (let ((#{atom-key\ 897}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 897}# (quote (c)))
+ (let ((#{atom-key\ 877}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 877}# (quote (c)))
((@ (language tree-il) tree-il->scheme)
- #{x\ 895}#)
- #{x\ 895}#))))))
+ #{x\ 875}#)
+ #{x\ 875}#))))))
(#{fx<\ 89}# <)
(#{fx=\ 88}# =)
(#{fx-\ 87}# -)
@@ -5928,872 +5901,1009 @@
(#{*mode*\ 85}# (make-fluid))
(#{noexpand\ 84}# "noexpand"))
(begin
- (#{global-extend\ 127}#
+ (#{global-extend\ 129}#
'local-syntax
'letrec-syntax
#t)
- (#{global-extend\ 127}#
+ (#{global-extend\ 129}#
'local-syntax
'let-syntax
#f)
- (#{global-extend\ 127}#
+ (#{global-extend\ 129}#
'core
'fluid-let-syntax
- (lambda (#{e\ 898}#
- #{r\ 899}#
- #{w\ 900}#
- #{s\ 901}#
- #{mod\ 902}#)
- ((lambda (#{tmp\ 903}#)
- ((lambda (#{tmp\ 904}#)
- (if (if #{tmp\ 904}#
- (apply (lambda (#{_\ 905}#
- #{var\ 906}#
- #{val\ 907}#
- #{e1\ 908}#
- #{e2\ 909}#)
- (#{valid-bound-ids?\ 154}# #{var\ 906}#))
- #{tmp\ 904}#)
+ (lambda (#{e\ 878}#
+ #{r\ 879}#
+ #{w\ 880}#
+ #{s\ 881}#
+ #{mod\ 882}#)
+ ((lambda (#{tmp\ 883}#)
+ ((lambda (#{tmp\ 884}#)
+ (if (if #{tmp\ 884}#
+ (apply (lambda (#{_\ 885}#
+ #{var\ 886}#
+ #{val\ 887}#
+ #{e1\ 888}#
+ #{e2\ 889}#)
+ (#{valid-bound-ids?\ 156}# #{var\ 886}#))
+ #{tmp\ 884}#)
#f)
- (apply (lambda (#{_\ 911}#
- #{var\ 912}#
- #{val\ 913}#
- #{e1\ 914}#
- #{e2\ 915}#)
- (let ((#{names\ 916}#
- (map (lambda (#{x\ 917}#)
- (#{id-var-name\ 151}#
- #{x\ 917}#
- #{w\ 900}#))
- #{var\ 912}#)))
+ (apply (lambda (#{_\ 891}#
+ #{var\ 892}#
+ #{val\ 893}#
+ #{e1\ 894}#
+ #{e2\ 895}#)
+ (let ((#{names\ 896}#
+ (map (lambda (#{x\ 897}#)
+ (#{id-var-name\ 153}#
+ #{x\ 897}#
+ #{w\ 880}#))
+ #{var\ 892}#)))
(begin
(for-each
- (lambda (#{id\ 919}# #{n\ 920}#)
- (let ((#{atom-key\ 921}#
- (#{binding-type\ 121}#
- (#{lookup\ 126}#
- #{n\ 920}#
- #{r\ 899}#
- #{mod\ 902}#))))
- (if (memv #{atom-key\ 921}#
+ (lambda (#{id\ 899}# #{n\ 900}#)
+ (let ((#{atom-key\ 901}#
+ (#{binding-type\ 123}#
+ (#{lookup\ 128}#
+ #{n\ 900}#
+ #{r\ 879}#
+ #{mod\ 882}#))))
+ (if (memv #{atom-key\ 901}#
'(displaced-lexical))
(syntax-violation
'fluid-let-syntax
"identifier out of context"
- #{e\ 898}#
- (#{source-wrap\ 158}#
- #{id\ 919}#
- #{w\ 900}#
- #{s\ 901}#
- #{mod\ 902}#)))))
- #{var\ 912}#
- #{names\ 916}#)
- (#{chi-body\ 169}#
- (cons #{e1\ 914}# #{e2\ 915}#)
- (#{source-wrap\ 158}#
- #{e\ 898}#
- #{w\ 900}#
- #{s\ 901}#
- #{mod\ 902}#)
- (#{extend-env\ 123}#
- #{names\ 916}#
- (let ((#{trans-r\ 924}#
- (#{macros-only-env\ 125}#
- #{r\ 899}#)))
- (map (lambda (#{x\ 925}#)
+ #{e\ 878}#
+ (#{source-wrap\ 160}#
+ #{id\ 899}#
+ #{w\ 880}#
+ #{s\ 881}#
+ #{mod\ 882}#)))))
+ #{var\ 892}#
+ #{names\ 896}#)
+ (#{chi-body\ 171}#
+ (cons #{e1\ 894}# #{e2\ 895}#)
+ (#{source-wrap\ 160}#
+ #{e\ 878}#
+ #{w\ 880}#
+ #{s\ 881}#
+ #{mod\ 882}#)
+ (#{extend-env\ 125}#
+ #{names\ 896}#
+ (let ((#{trans-r\ 904}#
+ (#{macros-only-env\ 127}#
+ #{r\ 879}#)))
+ (map (lambda (#{x\ 905}#)
(cons 'macro
- (#{eval-local-transformer\ 172}#
- (#{chi\ 165}#
- #{x\ 925}#
- #{trans-r\ 924}#
- #{w\ 900}#
- #{mod\ 902}#)
- #{mod\ 902}#)))
- #{val\ 913}#))
- #{r\ 899}#)
- #{w\ 900}#
- #{mod\ 902}#))))
- #{tmp\ 904}#)
- ((lambda (#{_\ 927}#)
+ (#{eval-local-transformer\ 173}#
+ (#{chi\ 167}#
+ #{x\ 905}#
+ #{trans-r\ 904}#
+ #{w\ 880}#
+ #{mod\ 882}#)
+ #{mod\ 882}#)))
+ #{val\ 893}#))
+ #{r\ 879}#)
+ #{w\ 880}#
+ #{mod\ 882}#))))
+ #{tmp\ 884}#)
+ ((lambda (#{_\ 907}#)
(syntax-violation
'fluid-let-syntax
"bad syntax"
- (#{source-wrap\ 158}#
- #{e\ 898}#
- #{w\ 900}#
- #{s\ 901}#
- #{mod\ 902}#)))
- #{tmp\ 903}#)))
+ (#{source-wrap\ 160}#
+ #{e\ 878}#
+ #{w\ 880}#
+ #{s\ 881}#
+ #{mod\ 882}#)))
+ #{tmp\ 883}#)))
($sc-dispatch
- #{tmp\ 903}#
+ #{tmp\ 883}#
'(any #(each (any any)) any . each-any))))
- #{e\ 898}#)))
- (#{global-extend\ 127}#
+ #{e\ 878}#)))
+ (#{global-extend\ 129}#
'core
'quote
- (lambda (#{e\ 928}#
- #{r\ 929}#
- #{w\ 930}#
- #{s\ 931}#
- #{mod\ 932}#)
- ((lambda (#{tmp\ 933}#)
- ((lambda (#{tmp\ 934}#)
- (if #{tmp\ 934}#
- (apply (lambda (#{_\ 935}# #{e\ 936}#)
- (#{build-data\ 107}#
- #{s\ 931}#
- (#{strip\ 175}# #{e\ 936}# #{w\ 930}#)))
- #{tmp\ 934}#)
- ((lambda (#{_\ 937}#)
+ (lambda (#{e\ 908}#
+ #{r\ 909}#
+ #{w\ 910}#
+ #{s\ 911}#
+ #{mod\ 912}#)
+ ((lambda (#{tmp\ 913}#)
+ ((lambda (#{tmp\ 914}#)
+ (if #{tmp\ 914}#
+ (apply (lambda (#{_\ 915}# #{e\ 916}#)
+ (#{build-data\ 109}#
+ #{s\ 911}#
+ (#{strip\ 176}# #{e\ 916}# #{w\ 910}#)))
+ #{tmp\ 914}#)
+ ((lambda (#{_\ 917}#)
(syntax-violation
'quote
"bad syntax"
- (#{source-wrap\ 158}#
- #{e\ 928}#
- #{w\ 930}#
- #{s\ 931}#
- #{mod\ 932}#)))
- #{tmp\ 933}#)))
- ($sc-dispatch #{tmp\ 933}# (quote (any any)))))
- #{e\ 928}#)))
- (#{global-extend\ 127}#
+ (#{source-wrap\ 160}#
+ #{e\ 908}#
+ #{w\ 910}#
+ #{s\ 911}#
+ #{mod\ 912}#)))
+ #{tmp\ 913}#)))
+ ($sc-dispatch #{tmp\ 913}# (quote (any any)))))
+ #{e\ 908}#)))
+ (#{global-extend\ 129}#
'core
'syntax
- (letrec ((#{regen\ 945}#
- (lambda (#{x\ 946}#)
- (let ((#{atom-key\ 947}# (car #{x\ 946}#)))
- (if (memv #{atom-key\ 947}# (quote (ref)))
+ (letrec ((#{regen\ 925}#
+ (lambda (#{x\ 926}#)
+ (let ((#{atom-key\ 927}# (car #{x\ 926}#)))
+ (if (memv #{atom-key\ 927}# (quote (ref)))
(#{build-lexical-reference\ 98}#
'value
#f
- (cadr #{x\ 946}#)
- (cadr #{x\ 946}#))
- (if (memv #{atom-key\ 947}# (quote (primitive)))
- (#{build-primref\ 106}# #f (cadr #{x\ 946}#))
- (if (memv #{atom-key\ 947}# (quote (quote)))
- (#{build-data\ 107}# #f (cadr #{x\ 946}#))
- (if (memv #{atom-key\ 947}# (quote (lambda)))
- (#{build-lambda\ 105}#
- #f
- (cadr #{x\ 946}#)
- (cadr #{x\ 946}#)
- #f
- (#{regen\ 945}# (caddr #{x\ 946}#)))
+ (cadr #{x\ 926}#)
+ (cadr #{x\ 926}#))
+ (if (memv #{atom-key\ 927}# (quote (primitive)))
+ (#{build-primref\ 108}# #f (cadr #{x\ 926}#))
+ (if (memv #{atom-key\ 927}# (quote (quote)))
+ (#{build-data\ 109}# #f (cadr #{x\ 926}#))
+ (if (memv #{atom-key\ 927}# (quote (lambda)))
+ (if (list? (cadr #{x\ 926}#))
+ (#{build-simple-lambda\ 105}#
+ #f
+ (cadr #{x\ 926}#)
+ #f
+ (cadr #{x\ 926}#)
+ #f
+ (#{regen\ 925}# (caddr #{x\ 926}#)))
+ (error "how did we get here" #{x\ 926}#))
(#{build-application\ 96}#
#f
- (#{build-primref\ 106}# #f (car #{x\ 946}#))
- (map #{regen\ 945}# (cdr #{x\ 946}#))))))))))
- (#{gen-vector\ 944}#
- (lambda (#{x\ 948}#)
- (if (eq? (car #{x\ 948}#) (quote list))
- (cons (quote vector) (cdr #{x\ 948}#))
- (if (eq? (car #{x\ 948}#) (quote quote))
+ (#{build-primref\ 108}# #f (car #{x\ 926}#))
+ (map #{regen\ 925}# (cdr #{x\ 926}#))))))))))
+ (#{gen-vector\ 924}#
+ (lambda (#{x\ 928}#)
+ (if (eq? (car #{x\ 928}#) (quote list))
+ (cons (quote vector) (cdr #{x\ 928}#))
+ (if (eq? (car #{x\ 928}#) (quote quote))
(list 'quote
- (list->vector (cadr #{x\ 948}#)))
- (list (quote list->vector) #{x\ 948}#)))))
- (#{gen-append\ 943}#
- (lambda (#{x\ 949}# #{y\ 950}#)
- (if (equal? #{y\ 950}# (quote (quote ())))
- #{x\ 949}#
- (list (quote append) #{x\ 949}# #{y\ 950}#))))
- (#{gen-cons\ 942}#
- (lambda (#{x\ 951}# #{y\ 952}#)
- (let ((#{atom-key\ 953}# (car #{y\ 952}#)))
- (if (memv #{atom-key\ 953}# (quote (quote)))
- (if (eq? (car #{x\ 951}#) (quote quote))
+ (list->vector (cadr #{x\ 928}#)))
+ (list (quote list->vector) #{x\ 928}#)))))
+ (#{gen-append\ 923}#
+ (lambda (#{x\ 929}# #{y\ 930}#)
+ (if (equal? #{y\ 930}# (quote (quote ())))
+ #{x\ 929}#
+ (list (quote append) #{x\ 929}# #{y\ 930}#))))
+ (#{gen-cons\ 922}#
+ (lambda (#{x\ 931}# #{y\ 932}#)
+ (let ((#{atom-key\ 933}# (car #{y\ 932}#)))
+ (if (memv #{atom-key\ 933}# (quote (quote)))
+ (if (eq? (car #{x\ 931}#) (quote quote))
(list 'quote
- (cons (cadr #{x\ 951}#) (cadr #{y\ 952}#)))
- (if (eq? (cadr #{y\ 952}#) (quote ()))
- (list (quote list) #{x\ 951}#)
- (list (quote cons) #{x\ 951}# #{y\ 952}#)))
- (if (memv #{atom-key\ 953}# (quote (list)))
+ (cons (cadr #{x\ 931}#) (cadr #{y\ 932}#)))
+ (if (eq? (cadr #{y\ 932}#) (quote ()))
+ (list (quote list) #{x\ 931}#)
+ (list (quote cons) #{x\ 931}# #{y\ 932}#)))
+ (if (memv #{atom-key\ 933}# (quote (list)))
(cons 'list
- (cons #{x\ 951}# (cdr #{y\ 952}#)))
- (list (quote cons) #{x\ 951}# #{y\ 952}#))))))
- (#{gen-map\ 941}#
- (lambda (#{e\ 954}# #{map-env\ 955}#)
- (let ((#{formals\ 956}# (map cdr #{map-env\ 955}#))
- (#{actuals\ 957}#
- (map (lambda (#{x\ 958}#)
- (list (quote ref) (car #{x\ 958}#)))
- #{map-env\ 955}#)))
- (if (eq? (car #{e\ 954}#) (quote ref))
- (car #{actuals\ 957}#)
+ (cons #{x\ 931}# (cdr #{y\ 932}#)))
+ (list (quote cons) #{x\ 931}# #{y\ 932}#))))))
+ (#{gen-map\ 921}#
+ (lambda (#{e\ 934}# #{map-env\ 935}#)
+ (let ((#{formals\ 936}# (map cdr #{map-env\ 935}#))
+ (#{actuals\ 937}#
+ (map (lambda (#{x\ 938}#)
+ (list (quote ref) (car #{x\ 938}#)))
+ #{map-env\ 935}#)))
+ (if (eq? (car #{e\ 934}#) (quote ref))
+ (car #{actuals\ 937}#)
(if (and-map
- (lambda (#{x\ 959}#)
- (if (eq? (car #{x\ 959}#) (quote ref))
- (memq (cadr #{x\ 959}#) #{formals\ 956}#)
+ (lambda (#{x\ 939}#)
+ (if (eq? (car #{x\ 939}#) (quote ref))
+ (memq (cadr #{x\ 939}#) #{formals\ 936}#)
#f))
- (cdr #{e\ 954}#))
+ (cdr #{e\ 934}#))
(cons 'map
(cons (list 'primitive
- (car #{e\ 954}#))
- (map (let ((#{r\ 960}# (map cons
- #{formals\ 956}#
- #{actuals\ 957}#)))
- (lambda (#{x\ 961}#)
- (cdr (assq (cadr #{x\ 961}#)
- #{r\ 960}#))))
- (cdr #{e\ 954}#))))
+ (car #{e\ 934}#))
+ (map (let ((#{r\ 940}# (map cons
+ #{formals\ 936}#
+ #{actuals\ 937}#)))
+ (lambda (#{x\ 941}#)
+ (cdr (assq (cadr #{x\ 941}#)
+ #{r\ 940}#))))
+ (cdr #{e\ 934}#))))
(cons 'map
(cons (list 'lambda
- #{formals\ 956}#
- #{e\ 954}#)
- #{actuals\ 957}#)))))))
- (#{gen-mappend\ 940}#
- (lambda (#{e\ 962}# #{map-env\ 963}#)
+ #{formals\ 936}#
+ #{e\ 934}#)
+ #{actuals\ 937}#)))))))
+ (#{gen-mappend\ 920}#
+ (lambda (#{e\ 942}# #{map-env\ 943}#)
(list 'apply
'(primitive append)
- (#{gen-map\ 941}# #{e\ 962}# #{map-env\ 963}#))))
- (#{gen-ref\ 939}#
- (lambda (#{src\ 964}#
- #{var\ 965}#
- #{level\ 966}#
- #{maps\ 967}#)
- (if (#{fx=\ 88}# #{level\ 966}# 0)
- (values #{var\ 965}# #{maps\ 967}#)
- (if (null? #{maps\ 967}#)
+ (#{gen-map\ 921}# #{e\ 942}# #{map-env\ 943}#))))
+ (#{gen-ref\ 919}#
+ (lambda (#{src\ 944}#
+ #{var\ 945}#
+ #{level\ 946}#
+ #{maps\ 947}#)
+ (if (#{fx=\ 88}# #{level\ 946}# 0)
+ (values #{var\ 945}# #{maps\ 947}#)
+ (if (null? #{maps\ 947}#)
(syntax-violation
'syntax
"missing ellipsis"
- #{src\ 964}#)
+ #{src\ 944}#)
(call-with-values
(lambda ()
- (#{gen-ref\ 939}#
- #{src\ 964}#
- #{var\ 965}#
- (#{fx-\ 87}# #{level\ 966}# 1)
- (cdr #{maps\ 967}#)))
- (lambda (#{outer-var\ 968}# #{outer-maps\ 969}#)
- (let ((#{b\ 970}# (assq #{outer-var\ 968}#
- (car #{maps\ 967}#))))
- (if #{b\ 970}#
- (values (cdr #{b\ 970}#) #{maps\ 967}#)
- (let ((#{inner-var\ 971}#
- (#{gen-var\ 176}# (quote tmp))))
+ (#{gen-ref\ 919}#
+ #{src\ 944}#
+ #{var\ 945}#
+ (#{fx-\ 87}# #{level\ 946}# 1)
+ (cdr #{maps\ 947}#)))
+ (lambda (#{outer-var\ 948}# #{outer-maps\ 949}#)
+ (let ((#{b\ 950}# (assq #{outer-var\ 948}#
+ (car #{maps\ 947}#))))
+ (if #{b\ 950}#
+ (values (cdr #{b\ 950}#) #{maps\ 947}#)
+ (let ((#{inner-var\ 951}#
+ (#{gen-var\ 177}# (quote tmp))))
(values
- #{inner-var\ 971}#
- (cons (cons (cons #{outer-var\ 968}#
- #{inner-var\ 971}#)
- (car #{maps\ 967}#))
- #{outer-maps\ 969}#)))))))))))
- (#{gen-syntax\ 938}#
- (lambda (#{src\ 972}#
- #{e\ 973}#
- #{r\ 974}#
- #{maps\ 975}#
- #{ellipsis?\ 976}#
- #{mod\ 977}#)
- (if (#{id?\ 129}# #{e\ 973}#)
- (let ((#{label\ 978}#
- (#{id-var-name\ 151}# #{e\ 973}# (quote (())))))
- (let ((#{b\ 979}# (#{lookup\ 126}#
- #{label\ 978}#
- #{r\ 974}#
- #{mod\ 977}#)))
- (if (eq? (#{binding-type\ 121}# #{b\ 979}#)
+ #{inner-var\ 951}#
+ (cons (cons (cons #{outer-var\ 948}#
+ #{inner-var\ 951}#)
+ (car #{maps\ 947}#))
+ #{outer-maps\ 949}#)))))))))))
+ (#{gen-syntax\ 918}#
+ (lambda (#{src\ 952}#
+ #{e\ 953}#
+ #{r\ 954}#
+ #{maps\ 955}#
+ #{ellipsis?\ 956}#
+ #{mod\ 957}#)
+ (if (#{id?\ 131}# #{e\ 953}#)
+ (let ((#{label\ 958}#
+ (#{id-var-name\ 153}# #{e\ 953}# (quote (())))))
+ (let ((#{b\ 959}# (#{lookup\ 128}#
+ #{label\ 958}#
+ #{r\ 954}#
+ #{mod\ 957}#)))
+ (if (eq? (#{binding-type\ 123}# #{b\ 959}#)
'syntax)
(call-with-values
(lambda ()
- (let ((#{var.lev\ 980}#
- (#{binding-value\ 122}# #{b\ 979}#)))
- (#{gen-ref\ 939}#
- #{src\ 972}#
- (car #{var.lev\ 980}#)
- (cdr #{var.lev\ 980}#)
- #{maps\ 975}#)))
- (lambda (#{var\ 981}# #{maps\ 982}#)
+ (let ((#{var.lev\ 960}#
+ (#{binding-value\ 124}# #{b\ 959}#)))
+ (#{gen-ref\ 919}#
+ #{src\ 952}#
+ (car #{var.lev\ 960}#)
+ (cdr #{var.lev\ 960}#)
+ #{maps\ 955}#)))
+ (lambda (#{var\ 961}# #{maps\ 962}#)
(values
- (list (quote ref) #{var\ 981}#)
- #{maps\ 982}#)))
- (if (#{ellipsis?\ 976}# #{e\ 973}#)
+ (list (quote ref) #{var\ 961}#)
+ #{maps\ 962}#)))
+ (if (#{ellipsis?\ 956}# #{e\ 953}#)
(syntax-violation
'syntax
"misplaced ellipsis"
- #{src\ 972}#)
+ #{src\ 952}#)
(values
- (list (quote quote) #{e\ 973}#)
- #{maps\ 975}#)))))
- ((lambda (#{tmp\ 983}#)
- ((lambda (#{tmp\ 984}#)
- (if (if #{tmp\ 984}#
- (apply (lambda (#{dots\ 985}# #{e\ 986}#)
- (#{ellipsis?\ 976}# #{dots\ 985}#))
- #{tmp\ 984}#)
+ (list (quote quote) #{e\ 953}#)
+ #{maps\ 955}#)))))
+ ((lambda (#{tmp\ 963}#)
+ ((lambda (#{tmp\ 964}#)
+ (if (if #{tmp\ 964}#
+ (apply (lambda (#{dots\ 965}# #{e\ 966}#)
+ (#{ellipsis?\ 956}# #{dots\ 965}#))
+ #{tmp\ 964}#)
#f)
- (apply (lambda (#{dots\ 987}# #{e\ 988}#)
- (#{gen-syntax\ 938}#
- #{src\ 972}#
- #{e\ 988}#
- #{r\ 974}#
- #{maps\ 975}#
- (lambda (#{x\ 989}#) #f)
- #{mod\ 977}#))
- #{tmp\ 984}#)
- ((lambda (#{tmp\ 990}#)
- (if (if #{tmp\ 990}#
- (apply (lambda (#{x\ 991}#
- #{dots\ 992}#
- #{y\ 993}#)
- (#{ellipsis?\ 976}#
- #{dots\ 992}#))
- #{tmp\ 990}#)
+ (apply (lambda (#{dots\ 967}# #{e\ 968}#)
+ (#{gen-syntax\ 918}#
+ #{src\ 952}#
+ #{e\ 968}#
+ #{r\ 954}#
+ #{maps\ 955}#
+ (lambda (#{x\ 969}#) #f)
+ #{mod\ 957}#))
+ #{tmp\ 964}#)
+ ((lambda (#{tmp\ 970}#)
+ (if (if #{tmp\ 970}#
+ (apply (lambda (#{x\ 971}#
+ #{dots\ 972}#
+ #{y\ 973}#)
+ (#{ellipsis?\ 956}#
+ #{dots\ 972}#))
+ #{tmp\ 970}#)
#f)
- (apply (lambda (#{x\ 994}#
- #{dots\ 995}#
- #{y\ 996}#)
- (letrec ((#{f\ 997}# (lambda (#{y\ 998}#
- #{k\ 999}#)
- ((lambda (#{tmp\ 1003}#)
- ((lambda (#{tmp\ 1004}#)
- (if (if #{tmp\ 1004}#
- (apply (lambda (#{dots\ 1005}#
- #{y\ 1006}#)
- (#{ellipsis?\ 976}#
- #{dots\ 1005}#))
- #{tmp\ 1004}#)
+ (apply (lambda (#{x\ 974}#
+ #{dots\ 975}#
+ #{y\ 976}#)
+ (letrec ((#{f\ 977}# (lambda (#{y\ 978}#
+ #{k\ 979}#)
+ ((lambda (#{tmp\ 983}#)
+ ((lambda (#{tmp\ 984}#)
+ (if (if #{tmp\ 984}#
+ (apply (lambda (#{dots\ 985}#
+ #{y\ 986}#)
+ (#{ellipsis?\ 956}#
+ #{dots\ 985}#))
+ #{tmp\ 984}#)
#f)
- (apply (lambda (#{dots\ 1007}#
- #{y\ 1008}#)
- (#{f\ 997}# #{y\ 1008}#
- (lambda (#{maps\ 1009}#)
+ (apply (lambda (#{dots\ 987}#
+ #{y\ 988}#)
+ (#{f\ 977}# #{y\ 988}#
+ (lambda (#{maps\ 989}#)
(call-with-values
(lambda ()
- (#{k\ 999}# (cons '()
- #{maps\ 1009}#)))
- (lambda (#{x\ 1010}#
- #{maps\ 1011}#)
- (if (null? (car #{maps\ 1011}#))
+ (#{k\ 979}# (cons '()
+ #{maps\ 989}#)))
+ (lambda (#{x\ 990}#
+ #{maps\ 991}#)
+ (if (null? (car #{maps\ 991}#))
(syntax-violation
'syntax
"extra ellipsis"
- #{src\ 972}#)
+ #{src\ 952}#)
(values
- (#{gen-mappend\ 940}#
- #{x\ 1010}#
- (car #{maps\ 1011}#))
- (cdr #{maps\ 1011}#))))))))
- #{tmp\ 1004}#)
- ((lambda (#{_\ 1012}#)
+ (#{gen-mappend\ 920}#
+ #{x\ 990}#
+ (car #{maps\ 991}#))
+ (cdr #{maps\ 991}#))))))))
+ #{tmp\ 984}#)
+ ((lambda (#{_\ 992}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 938}#
- #{src\ 972}#
- #{y\ 998}#
- #{r\ 974}#
- #{maps\ 975}#
- #{ellipsis?\ 976}#
- #{mod\ 977}#))
- (lambda (#{y\ 1013}#
- #{maps\ 1014}#)
+ (#{gen-syntax\ 918}#
+ #{src\ 952}#
+ #{y\ 978}#
+ #{r\ 954}#
+ #{maps\ 955}#
+ #{ellipsis?\ 956}#
+ #{mod\ 957}#))
+ (lambda (#{y\ 993}#
+ #{maps\ 994}#)
(call-with-values
(lambda ()
- (#{k\ 999}# #{maps\ 1014}#))
- (lambda (#{x\ 1015}#
- #{maps\ 1016}#)
+ (#{k\ 979}# #{maps\ 994}#))
+ (lambda (#{x\ 995}#
+ #{maps\ 996}#)
(values
- (#{gen-append\ 943}#
- #{x\ 1015}#
- #{y\ 1013}#)
- #{maps\ 1016}#))))))
- #{tmp\ 1003}#)))
+ (#{gen-append\ 923}#
+ #{x\ 995}#
+ #{y\ 993}#)
+ #{maps\ 996}#))))))
+ #{tmp\ 983}#)))
($sc-dispatch
- #{tmp\ 1003}#
+ #{tmp\ 983}#
'(any .
any))))
- #{y\ 998}#))))
- (#{f\ 997}# #{y\ 996}#
- (lambda (#{maps\ 1000}#)
+ #{y\ 978}#))))
+ (#{f\ 977}# #{y\ 976}#
+ (lambda (#{maps\ 980}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 938}#
- #{src\ 972}#
- #{x\ 994}#
- #{r\ 974}#
+ (#{gen-syntax\ 918}#
+ #{src\ 952}#
+ #{x\ 974}#
+ #{r\ 954}#
(cons '()
- #{maps\ 1000}#)
- #{ellipsis?\ 976}#
- #{mod\ 977}#))
- (lambda (#{x\ 1001}#
- #{maps\ 1002}#)
- (if (null? (car #{maps\ 1002}#))
+ #{maps\ 980}#)
+ #{ellipsis?\ 956}#
+ #{mod\ 957}#))
+ (lambda (#{x\ 981}#
+ #{maps\ 982}#)
+ (if (null? (car #{maps\ 982}#))
(syntax-violation
'syntax
"extra ellipsis"
- #{src\ 972}#)
+ #{src\ 952}#)
(values
- (#{gen-map\ 941}#
- #{x\ 1001}#
- (car #{maps\ 1002}#))
- (cdr #{maps\ 1002}#)))))))))
- #{tmp\ 990}#)
- ((lambda (#{tmp\ 1017}#)
- (if #{tmp\ 1017}#
- (apply (lambda (#{x\ 1018}#
- #{y\ 1019}#)
+ (#{gen-map\ 921}#
+ #{x\ 981}#
+ (car #{maps\ 982}#))
+ (cdr #{maps\ 982}#)))))))))
+ #{tmp\ 970}#)
+ ((lambda (#{tmp\ 997}#)
+ (if #{tmp\ 997}#
+ (apply (lambda (#{x\ 998}# #{y\ 999}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 938}#
- #{src\ 972}#
- #{x\ 1018}#
- #{r\ 974}#
- #{maps\ 975}#
- #{ellipsis?\ 976}#
- #{mod\ 977}#))
- (lambda (#{x\ 1020}#
- #{maps\ 1021}#)
+ (#{gen-syntax\ 918}#
+ #{src\ 952}#
+ #{x\ 998}#
+ #{r\ 954}#
+ #{maps\ 955}#
+ #{ellipsis?\ 956}#
+ #{mod\ 957}#))
+ (lambda (#{x\ 1000}#
+ #{maps\ 1001}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 938}#
- #{src\ 972}#
- #{y\ 1019}#
- #{r\ 974}#
- #{maps\ 1021}#
- #{ellipsis?\ 976}#
- #{mod\ 977}#))
- (lambda (#{y\ 1022}#
- #{maps\ 1023}#)
+ (#{gen-syntax\ 918}#
+ #{src\ 952}#
+ #{y\ 999}#
+ #{r\ 954}#
+ #{maps\ 1001}#
+ #{ellipsis?\ 956}#
+ #{mod\ 957}#))
+ (lambda (#{y\ 1002}#
+ #{maps\ 1003}#)
(values
- (#{gen-cons\ 942}#
- #{x\ 1020}#
- #{y\ 1022}#)
- #{maps\ 1023}#))))))
- #{tmp\ 1017}#)
- ((lambda (#{tmp\ 1024}#)
- (if #{tmp\ 1024}#
- (apply (lambda (#{e1\ 1025}#
- #{e2\ 1026}#)
+ (#{gen-cons\ 922}#
+ #{x\ 1000}#
+ #{y\ 1002}#)
+ #{maps\ 1003}#))))))
+ #{tmp\ 997}#)
+ ((lambda (#{tmp\ 1004}#)
+ (if #{tmp\ 1004}#
+ (apply (lambda (#{e1\ 1005}#
+ #{e2\ 1006}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 938}#
- #{src\ 972}#
- (cons #{e1\ 1025}#
- #{e2\ 1026}#)
- #{r\ 974}#
- #{maps\ 975}#
- #{ellipsis?\ 976}#
- #{mod\ 977}#))
- (lambda (#{e\ 1028}#
- #{maps\ 1029}#)
+ (#{gen-syntax\ 918}#
+ #{src\ 952}#
+ (cons #{e1\ 1005}#
+ #{e2\ 1006}#)
+ #{r\ 954}#
+ #{maps\ 955}#
+ #{ellipsis?\ 956}#
+ #{mod\ 957}#))
+ (lambda (#{e\ 1008}#
+ #{maps\ 1009}#)
(values
- (#{gen-vector\ 944}#
- #{e\ 1028}#)
- #{maps\ 1029}#))))
- #{tmp\ 1024}#)
- ((lambda (#{_\ 1030}#)
+ (#{gen-vector\ 924}#
+ #{e\ 1008}#)
+ #{maps\ 1009}#))))
+ #{tmp\ 1004}#)
+ ((lambda (#{_\ 1010}#)
(values
(list 'quote
- #{e\ 973}#)
- #{maps\ 975}#))
- #{tmp\ 983}#)))
+ #{e\ 953}#)
+ #{maps\ 955}#))
+ #{tmp\ 963}#)))
($sc-dispatch
- #{tmp\ 983}#
+ #{tmp\ 963}#
'#(vector (any . each-any))))))
($sc-dispatch
- #{tmp\ 983}#
+ #{tmp\ 963}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 983}#
+ #{tmp\ 963}#
'(any any . any)))))
- ($sc-dispatch #{tmp\ 983}# (quote (any any)))))
- #{e\ 973}#)))))
- (lambda (#{e\ 1031}#
- #{r\ 1032}#
- #{w\ 1033}#
- #{s\ 1034}#
- #{mod\ 1035}#)
- (let ((#{e\ 1036}#
- (#{source-wrap\ 158}#
- #{e\ 1031}#
- #{w\ 1033}#
- #{s\ 1034}#
- #{mod\ 1035}#)))
- ((lambda (#{tmp\ 1037}#)
- ((lambda (#{tmp\ 1038}#)
- (if #{tmp\ 1038}#
- (apply (lambda (#{_\ 1039}# #{x\ 1040}#)
+ ($sc-dispatch #{tmp\ 963}# (quote (any any)))))
+ #{e\ 953}#)))))
+ (lambda (#{e\ 1011}#
+ #{r\ 1012}#
+ #{w\ 1013}#
+ #{s\ 1014}#
+ #{mod\ 1015}#)
+ (let ((#{e\ 1016}#
+ (#{source-wrap\ 160}#
+ #{e\ 1011}#
+ #{w\ 1013}#
+ #{s\ 1014}#
+ #{mod\ 1015}#)))
+ ((lambda (#{tmp\ 1017}#)
+ ((lambda (#{tmp\ 1018}#)
+ (if #{tmp\ 1018}#
+ (apply (lambda (#{_\ 1019}# #{x\ 1020}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 938}#
- #{e\ 1036}#
- #{x\ 1040}#
- #{r\ 1032}#
+ (#{gen-syntax\ 918}#
+ #{e\ 1016}#
+ #{x\ 1020}#
+ #{r\ 1012}#
'()
- #{ellipsis?\ 174}#
- #{mod\ 1035}#))
- (lambda (#{e\ 1041}# #{maps\ 1042}#)
- (#{regen\ 945}# #{e\ 1041}#))))
- #{tmp\ 1038}#)
- ((lambda (#{_\ 1043}#)
+ #{ellipsis?\ 175}#
+ #{mod\ 1015}#))
+ (lambda (#{e\ 1021}# #{maps\ 1022}#)
+ (#{regen\ 925}# #{e\ 1021}#))))
+ #{tmp\ 1018}#)
+ ((lambda (#{_\ 1023}#)
(syntax-violation
'syntax
"bad `syntax' form"
- #{e\ 1036}#))
- #{tmp\ 1037}#)))
- ($sc-dispatch #{tmp\ 1037}# (quote (any any)))))
- #{e\ 1036}#)))))
- (#{global-extend\ 127}#
+ #{e\ 1016}#))
+ #{tmp\ 1017}#)))
+ ($sc-dispatch #{tmp\ 1017}# (quote (any any)))))
+ #{e\ 1016}#)))))
+ (#{global-extend\ 129}#
'core
'lambda
- (lambda (#{e\ 1044}#
- #{r\ 1045}#
- #{w\ 1046}#
- #{s\ 1047}#
- #{mod\ 1048}#)
- ((lambda (#{tmp\ 1049}#)
- ((lambda (#{tmp\ 1050}#)
- (if #{tmp\ 1050}#
- (apply (lambda (#{_\ 1051}# #{c\ 1052}#)
- (#{chi-lambda-clause\ 170}#
- (#{source-wrap\ 158}#
- #{e\ 1044}#
- #{w\ 1046}#
- #{s\ 1047}#
- #{mod\ 1048}#)
- #f
- #{c\ 1052}#
- #{r\ 1045}#
- #{w\ 1046}#
- #{mod\ 1048}#
- (lambda (#{names\ 1053}#
- #{vars\ 1054}#
- #{docstring\ 1055}#
- #{body\ 1056}#)
- (#{build-lambda\ 105}#
- #{s\ 1047}#
- #{names\ 1053}#
- #{vars\ 1054}#
- #{docstring\ 1055}#
- #{body\ 1056}#))))
- #{tmp\ 1050}#)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- #{tmp\ 1049}#)))
- ($sc-dispatch #{tmp\ 1049}# (quote (any . any)))))
- #{e\ 1044}#)))
- (#{global-extend\ 127}#
+ (lambda (#{e\ 1024}#
+ #{r\ 1025}#
+ #{w\ 1026}#
+ #{s\ 1027}#
+ #{mod\ 1028}#)
+ (letrec ((#{docstring&body\ 1029}#
+ (lambda (#{ids\ 1030}#
+ #{vars\ 1031}#
+ #{labels\ 1032}#
+ #{c\ 1033}#)
+ ((lambda (#{tmp\ 1034}#)
+ ((lambda (#{tmp\ 1035}#)
+ (if (if #{tmp\ 1035}#
+ (apply (lambda (#{docstring\ 1036}#
+ #{e1\ 1037}#
+ #{e2\ 1038}#)
+ (string?
+ (syntax->datum
+ #{docstring\ 1036}#)))
+ #{tmp\ 1035}#)
+ #f)
+ (apply (lambda (#{docstring\ 1039}#
+ #{e1\ 1040}#
+ #{e2\ 1041}#)
+ (values
+ (syntax->datum #{docstring\ 1039}#)
+ (#{chi-body\ 171}#
+ (cons #{e1\ 1040}# #{e2\ 1041}#)
+ (#{source-wrap\ 160}#
+ #{e\ 1024}#
+ #{w\ 1026}#
+ #{s\ 1027}#
+ #{mod\ 1028}#)
+ (#{extend-var-env\ 126}#
+ #{labels\ 1032}#
+ #{vars\ 1031}#
+ #{r\ 1025}#)
+ (#{make-binding-wrap\ 148}#
+ #{ids\ 1030}#
+ #{labels\ 1032}#
+ #{w\ 1026}#)
+ #{mod\ 1028}#)))
+ #{tmp\ 1035}#)
+ ((lambda (#{tmp\ 1043}#)
+ (if #{tmp\ 1043}#
+ (apply (lambda (#{e1\ 1044}# #{e2\ 1045}#)
+ (values
+ #f
+ (#{chi-body\ 171}#
+ (cons #{e1\ 1044}#
+ #{e2\ 1045}#)
+ (#{source-wrap\ 160}#
+ #{e\ 1024}#
+ #{w\ 1026}#
+ #{s\ 1027}#
+ #{mod\ 1028}#)
+ (#{extend-var-env\ 126}#
+ #{labels\ 1032}#
+ #{vars\ 1031}#
+ #{r\ 1025}#)
+ (#{make-binding-wrap\ 148}#
+ #{ids\ 1030}#
+ #{labels\ 1032}#
+ #{w\ 1026}#)
+ #{mod\ 1028}#)))
+ #{tmp\ 1043}#)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ #{tmp\ 1034}#)))
+ ($sc-dispatch
+ #{tmp\ 1034}#
+ '(any . each-any)))))
+ ($sc-dispatch
+ #{tmp\ 1034}#
+ '(any any . each-any))))
+ #{c\ 1033}#))))
+ ((lambda (#{tmp\ 1047}#)
+ ((lambda (#{tmp\ 1048}#)
+ (if #{tmp\ 1048}#
+ (apply (lambda (#{_\ 1049}#
+ #{id\ 1050}#
+ #{e1\ 1051}#
+ #{e2\ 1052}#)
+ (let ((#{ids\ 1053}# #{id\ 1050}#))
+ (if (not (#{valid-bound-ids?\ 156}#
+ #{ids\ 1053}#))
+ (syntax-violation
+ 'lambda
+ "invalid parameter list"
+ #{e\ 1024}#)
+ (let ((#{vars\ 1055}#
+ (map #{gen-var\ 177}# #{ids\ 1053}#))
+ (#{labels\ 1056}#
+ (#{gen-labels\ 137}# #{ids\ 1053}#)))
+ (call-with-values
+ (lambda ()
+ (#{docstring&body\ 1029}#
+ #{ids\ 1053}#
+ #{vars\ 1055}#
+ #{labels\ 1056}#
+ (cons #{e1\ 1051}# #{e2\ 1052}#)))
+ (lambda (#{docstring\ 1058}#
+ #{body\ 1059}#)
+ (#{build-simple-lambda\ 105}#
+ #{s\ 1027}#
+ (map syntax->datum #{ids\ 1053}#)
+ #f
+ #{vars\ 1055}#
+ #{docstring\ 1058}#
+ #{body\ 1059}#)))))))
+ #{tmp\ 1048}#)
+ ((lambda (#{tmp\ 1060}#)
+ (if #{tmp\ 1060}#
+ (apply (lambda (#{_\ 1061}#
+ #{ids\ 1062}#
+ #{e1\ 1063}#
+ #{e2\ 1064}#)
+ (let ((#{rids\ 1065}#
+ (#{lambda-var-list\ 178}#
+ #{ids\ 1062}#)))
+ (if (not (#{valid-bound-ids?\ 156}#
+ #{rids\ 1065}#))
+ (syntax-violation
+ 'lambda
+ "invalid parameter list"
+ #{e\ 1024}#)
+ (let ((#{req\ 1066}#
+ (reverse (cdr #{rids\ 1065}#))))
+ (let ((#{rest\ 1067}#
+ (car #{rids\ 1065}#)))
+ (let ((#{rrids\ 1068}#
+ (reverse #{rids\ 1065}#)))
+ (let ((#{vars\ 1069}#
+ (map #{gen-var\ 177}#
+ #{rrids\ 1068}#)))
+ (let ((#{labels\ 1070}#
+ (#{gen-labels\ 137}#
+ #{rrids\ 1068}#)))
+ (call-with-values
+ (lambda ()
+ (#{docstring&body\ 1029}#
+ #{rrids\ 1068}#
+ #{vars\ 1069}#
+ #{labels\ 1070}#
+ (cons #{e1\ 1063}#
+ #{e2\ 1064}#)))
+ (lambda (#{docstring\ 1072}#
+ #{body\ 1073}#)
+ (#{build-simple-lambda\ 105}#
+ #{s\ 1027}#
+ (map syntax->datum
+ #{req\ 1066}#)
+ (syntax->datum
+ #{rest\ 1067}#)
+ #{vars\ 1069}#
+ #{docstring\ 1072}#
+ #{body\ 1073}#)))))))))))
+ #{tmp\ 1060}#)
+ ((lambda (#{_\ 1074}#)
+ (syntax-violation
+ 'lambda
+ "bad lambda"
+ #{e\ 1024}#))
+ #{tmp\ 1047}#)))
+ ($sc-dispatch
+ #{tmp\ 1047}#
+ '(any any any . each-any)))))
+ ($sc-dispatch
+ #{tmp\ 1047}#
+ '(any each-any any . each-any))))
+ #{e\ 1024}#))))
+ (#{global-extend\ 129}#
'core
'let
- (letrec ((#{chi-let\ 1057}#
- (lambda (#{e\ 1058}#
- #{r\ 1059}#
- #{w\ 1060}#
- #{s\ 1061}#
- #{mod\ 1062}#
- #{constructor\ 1063}#
- #{ids\ 1064}#
- #{vals\ 1065}#
- #{exps\ 1066}#)
- (if (not (#{valid-bound-ids?\ 154}# #{ids\ 1064}#))
+ (letrec ((#{chi-let\ 1075}#
+ (lambda (#{e\ 1076}#
+ #{r\ 1077}#
+ #{w\ 1078}#
+ #{s\ 1079}#
+ #{mod\ 1080}#
+ #{constructor\ 1081}#
+ #{ids\ 1082}#
+ #{vals\ 1083}#
+ #{exps\ 1084}#)
+ (if (not (#{valid-bound-ids?\ 156}# #{ids\ 1082}#))
(syntax-violation
'let
"duplicate bound variable"
- #{e\ 1058}#)
- (let ((#{labels\ 1067}#
- (#{gen-labels\ 135}# #{ids\ 1064}#))
- (#{new-vars\ 1068}#
- (map #{gen-var\ 176}# #{ids\ 1064}#)))
- (let ((#{nw\ 1069}#
- (#{make-binding-wrap\ 146}#
- #{ids\ 1064}#
- #{labels\ 1067}#
- #{w\ 1060}#))
- (#{nr\ 1070}#
- (#{extend-var-env\ 124}#
- #{labels\ 1067}#
- #{new-vars\ 1068}#
- #{r\ 1059}#)))
- (#{constructor\ 1063}#
- #{s\ 1061}#
- (map syntax->datum #{ids\ 1064}#)
- #{new-vars\ 1068}#
- (map (lambda (#{x\ 1071}#)
- (#{chi\ 165}#
- #{x\ 1071}#
- #{r\ 1059}#
- #{w\ 1060}#
- #{mod\ 1062}#))
- #{vals\ 1065}#)
- (#{chi-body\ 169}#
- #{exps\ 1066}#
- (#{source-wrap\ 158}#
- #{e\ 1058}#
- #{nw\ 1069}#
- #{s\ 1061}#
- #{mod\ 1062}#)
- #{nr\ 1070}#
- #{nw\ 1069}#
- #{mod\ 1062}#))))))))
- (lambda (#{e\ 1072}#
- #{r\ 1073}#
- #{w\ 1074}#
- #{s\ 1075}#
- #{mod\ 1076}#)
- ((lambda (#{tmp\ 1077}#)
- ((lambda (#{tmp\ 1078}#)
- (if (if #{tmp\ 1078}#
- (apply (lambda (#{_\ 1079}#
- #{id\ 1080}#
- #{val\ 1081}#
- #{e1\ 1082}#
- #{e2\ 1083}#)
- (and-map #{id?\ 129}# #{id\ 1080}#))
- #{tmp\ 1078}#)
+ #{e\ 1076}#)
+ (let ((#{labels\ 1085}#
+ (#{gen-labels\ 137}# #{ids\ 1082}#))
+ (#{new-vars\ 1086}#
+ (map #{gen-var\ 177}# #{ids\ 1082}#)))
+ (let ((#{nw\ 1087}#
+ (#{make-binding-wrap\ 148}#
+ #{ids\ 1082}#
+ #{labels\ 1085}#
+ #{w\ 1078}#))
+ (#{nr\ 1088}#
+ (#{extend-var-env\ 126}#
+ #{labels\ 1085}#
+ #{new-vars\ 1086}#
+ #{r\ 1077}#)))
+ (#{constructor\ 1081}#
+ #{s\ 1079}#
+ (map syntax->datum #{ids\ 1082}#)
+ #{new-vars\ 1086}#
+ (map (lambda (#{x\ 1089}#)
+ (#{chi\ 167}#
+ #{x\ 1089}#
+ #{r\ 1077}#
+ #{w\ 1078}#
+ #{mod\ 1080}#))
+ #{vals\ 1083}#)
+ (#{chi-body\ 171}#
+ #{exps\ 1084}#
+ (#{source-wrap\ 160}#
+ #{e\ 1076}#
+ #{nw\ 1087}#
+ #{s\ 1079}#
+ #{mod\ 1080}#)
+ #{nr\ 1088}#
+ #{nw\ 1087}#
+ #{mod\ 1080}#))))))))
+ (lambda (#{e\ 1090}#
+ #{r\ 1091}#
+ #{w\ 1092}#
+ #{s\ 1093}#
+ #{mod\ 1094}#)
+ ((lambda (#{tmp\ 1095}#)
+ ((lambda (#{tmp\ 1096}#)
+ (if (if #{tmp\ 1096}#
+ (apply (lambda (#{_\ 1097}#
+ #{id\ 1098}#
+ #{val\ 1099}#
+ #{e1\ 1100}#
+ #{e2\ 1101}#)
+ (and-map #{id?\ 131}# #{id\ 1098}#))
+ #{tmp\ 1096}#)
#f)
- (apply (lambda (#{_\ 1085}#
- #{id\ 1086}#
- #{val\ 1087}#
- #{e1\ 1088}#
- #{e2\ 1089}#)
- (#{chi-let\ 1057}#
- #{e\ 1072}#
- #{r\ 1073}#
- #{w\ 1074}#
- #{s\ 1075}#
- #{mod\ 1076}#
- #{build-let\ 109}#
- #{id\ 1086}#
- #{val\ 1087}#
- (cons #{e1\ 1088}# #{e2\ 1089}#)))
- #{tmp\ 1078}#)
- ((lambda (#{tmp\ 1093}#)
- (if (if #{tmp\ 1093}#
- (apply (lambda (#{_\ 1094}#
- #{f\ 1095}#
- #{id\ 1096}#
- #{val\ 1097}#
- #{e1\ 1098}#
- #{e2\ 1099}#)
- (if (#{id?\ 129}# #{f\ 1095}#)
- (and-map #{id?\ 129}# #{id\ 1096}#)
+ (apply (lambda (#{_\ 1103}#
+ #{id\ 1104}#
+ #{val\ 1105}#
+ #{e1\ 1106}#
+ #{e2\ 1107}#)
+ (#{chi-let\ 1075}#
+ #{e\ 1090}#
+ #{r\ 1091}#
+ #{w\ 1092}#
+ #{s\ 1093}#
+ #{mod\ 1094}#
+ #{build-let\ 111}#
+ #{id\ 1104}#
+ #{val\ 1105}#
+ (cons #{e1\ 1106}# #{e2\ 1107}#)))
+ #{tmp\ 1096}#)
+ ((lambda (#{tmp\ 1111}#)
+ (if (if #{tmp\ 1111}#
+ (apply (lambda (#{_\ 1112}#
+ #{f\ 1113}#
+ #{id\ 1114}#
+ #{val\ 1115}#
+ #{e1\ 1116}#
+ #{e2\ 1117}#)
+ (if (#{id?\ 131}# #{f\ 1113}#)
+ (and-map #{id?\ 131}# #{id\ 1114}#)
#f))
- #{tmp\ 1093}#)
+ #{tmp\ 1111}#)
#f)
- (apply (lambda (#{_\ 1101}#
- #{f\ 1102}#
- #{id\ 1103}#
- #{val\ 1104}#
- #{e1\ 1105}#
- #{e2\ 1106}#)
- (#{chi-let\ 1057}#
- #{e\ 1072}#
- #{r\ 1073}#
- #{w\ 1074}#
- #{s\ 1075}#
- #{mod\ 1076}#
- #{build-named-let\ 110}#
- (cons #{f\ 1102}# #{id\ 1103}#)
- #{val\ 1104}#
- (cons #{e1\ 1105}# #{e2\ 1106}#)))
- #{tmp\ 1093}#)
- ((lambda (#{_\ 1110}#)
+ (apply (lambda (#{_\ 1119}#
+ #{f\ 1120}#
+ #{id\ 1121}#
+ #{val\ 1122}#
+ #{e1\ 1123}#
+ #{e2\ 1124}#)
+ (#{chi-let\ 1075}#
+ #{e\ 1090}#
+ #{r\ 1091}#
+ #{w\ 1092}#
+ #{s\ 1093}#
+ #{mod\ 1094}#
+ #{build-named-let\ 112}#
+ (cons #{f\ 1120}# #{id\ 1121}#)
+ #{val\ 1122}#
+ (cons #{e1\ 1123}# #{e2\ 1124}#)))
+ #{tmp\ 1111}#)
+ ((lambda (#{_\ 1128}#)
(syntax-violation
'let
"bad let"
- (#{source-wrap\ 158}#
- #{e\ 1072}#
- #{w\ 1074}#
- #{s\ 1075}#
- #{mod\ 1076}#)))
- #{tmp\ 1077}#)))
+ (#{source-wrap\ 160}#
+ #{e\ 1090}#
+ #{w\ 1092}#
+ #{s\ 1093}#
+ #{mod\ 1094}#)))
+ #{tmp\ 1095}#)))
($sc-dispatch
- #{tmp\ 1077}#
+ #{tmp\ 1095}#
'(any any #(each (any any)) any . each-any)))))
($sc-dispatch
- #{tmp\ 1077}#
+ #{tmp\ 1095}#
'(any #(each (any any)) any . each-any))))
- #{e\ 1072}#))))
- (#{global-extend\ 127}#
+ #{e\ 1090}#))))
+ (#{global-extend\ 129}#
'core
'letrec
- (lambda (#{e\ 1111}#
- #{r\ 1112}#
- #{w\ 1113}#
- #{s\ 1114}#
- #{mod\ 1115}#)
- ((lambda (#{tmp\ 1116}#)
- ((lambda (#{tmp\ 1117}#)
- (if (if #{tmp\ 1117}#
- (apply (lambda (#{_\ 1118}#
- #{id\ 1119}#
- #{val\ 1120}#
- #{e1\ 1121}#
- #{e2\ 1122}#)
- (and-map #{id?\ 129}# #{id\ 1119}#))
- #{tmp\ 1117}#)
+ (lambda (#{e\ 1129}#
+ #{r\ 1130}#
+ #{w\ 1131}#
+ #{s\ 1132}#
+ #{mod\ 1133}#)
+ ((lambda (#{tmp\ 1134}#)
+ ((lambda (#{tmp\ 1135}#)
+ (if (if #{tmp\ 1135}#
+ (apply (lambda (#{_\ 1136}#
+ #{id\ 1137}#
+ #{val\ 1138}#
+ #{e1\ 1139}#
+ #{e2\ 1140}#)
+ (and-map #{id?\ 131}# #{id\ 1137}#))
+ #{tmp\ 1135}#)
#f)
- (apply (lambda (#{_\ 1124}#
- #{id\ 1125}#
- #{val\ 1126}#
- #{e1\ 1127}#
- #{e2\ 1128}#)
- (let ((#{ids\ 1129}# #{id\ 1125}#))
- (if (not (#{valid-bound-ids?\ 154}#
- #{ids\ 1129}#))
+ (apply (lambda (#{_\ 1142}#
+ #{id\ 1143}#
+ #{val\ 1144}#
+ #{e1\ 1145}#
+ #{e2\ 1146}#)
+ (let ((#{ids\ 1147}# #{id\ 1143}#))
+ (if (not (#{valid-bound-ids?\ 156}#
+ #{ids\ 1147}#))
(syntax-violation
'letrec
"duplicate bound variable"
- #{e\ 1111}#)
- (let ((#{labels\ 1131}#
- (#{gen-labels\ 135}# #{ids\ 1129}#))
- (#{new-vars\ 1132}#
- (map #{gen-var\ 176}# #{ids\ 1129}#)))
- (let ((#{w\ 1133}#
- (#{make-binding-wrap\ 146}#
- #{ids\ 1129}#
- #{labels\ 1131}#
- #{w\ 1113}#))
- (#{r\ 1134}#
- (#{extend-var-env\ 124}#
- #{labels\ 1131}#
- #{new-vars\ 1132}#
- #{r\ 1112}#)))
- (#{build-letrec\ 111}#
- #{s\ 1114}#
- (map syntax->datum #{ids\ 1129}#)
- #{new-vars\ 1132}#
- (map (lambda (#{x\ 1135}#)
- (#{chi\ 165}#
- #{x\ 1135}#
- #{r\ 1134}#
- #{w\ 1133}#
- #{mod\ 1115}#))
- #{val\ 1126}#)
- (#{chi-body\ 169}#
- (cons #{e1\ 1127}# #{e2\ 1128}#)
- (#{source-wrap\ 158}#
- #{e\ 1111}#
- #{w\ 1133}#
- #{s\ 1114}#
- #{mod\ 1115}#)
- #{r\ 1134}#
- #{w\ 1133}#
- #{mod\ 1115}#)))))))
- #{tmp\ 1117}#)
- ((lambda (#{_\ 1138}#)
+ #{e\ 1129}#)
+ (let ((#{labels\ 1149}#
+ (#{gen-labels\ 137}# #{ids\ 1147}#))
+ (#{new-vars\ 1150}#
+ (map #{gen-var\ 177}# #{ids\ 1147}#)))
+ (let ((#{w\ 1151}#
+ (#{make-binding-wrap\ 148}#
+ #{ids\ 1147}#
+ #{labels\ 1149}#
+ #{w\ 1131}#))
+ (#{r\ 1152}#
+ (#{extend-var-env\ 126}#
+ #{labels\ 1149}#
+ #{new-vars\ 1150}#
+ #{r\ 1130}#)))
+ (#{build-letrec\ 113}#
+ #{s\ 1132}#
+ (map syntax->datum #{ids\ 1147}#)
+ #{new-vars\ 1150}#
+ (map (lambda (#{x\ 1153}#)
+ (#{chi\ 167}#
+ #{x\ 1153}#
+ #{r\ 1152}#
+ #{w\ 1151}#
+ #{mod\ 1133}#))
+ #{val\ 1144}#)
+ (#{chi-body\ 171}#
+ (cons #{e1\ 1145}# #{e2\ 1146}#)
+ (#{source-wrap\ 160}#
+ #{e\ 1129}#
+ #{w\ 1151}#
+ #{s\ 1132}#
+ #{mod\ 1133}#)
+ #{r\ 1152}#
+ #{w\ 1151}#
+ #{mod\ 1133}#)))))))
+ #{tmp\ 1135}#)
+ ((lambda (#{_\ 1156}#)
(syntax-violation
'letrec
"bad letrec"
- (#{source-wrap\ 158}#
- #{e\ 1111}#
- #{w\ 1113}#
- #{s\ 1114}#
- #{mod\ 1115}#)))
- #{tmp\ 1116}#)))
+ (#{source-wrap\ 160}#
+ #{e\ 1129}#
+ #{w\ 1131}#
+ #{s\ 1132}#
+ #{mod\ 1133}#)))
+ #{tmp\ 1134}#)))
($sc-dispatch
- #{tmp\ 1116}#
+ #{tmp\ 1134}#
'(any #(each (any any)) any . each-any))))
- #{e\ 1111}#)))
- (#{global-extend\ 127}#
+ #{e\ 1129}#)))
+ (#{global-extend\ 129}#
'core
'set!
- (lambda (#{e\ 1139}#
- #{r\ 1140}#
- #{w\ 1141}#
- #{s\ 1142}#
- #{mod\ 1143}#)
- ((lambda (#{tmp\ 1144}#)
- ((lambda (#{tmp\ 1145}#)
- (if (if #{tmp\ 1145}#
- (apply (lambda (#{_\ 1146}# #{id\ 1147}# #{val\ 1148}#)
- (#{id?\ 129}# #{id\ 1147}#))
- #{tmp\ 1145}#)
+ (lambda (#{e\ 1157}#
+ #{r\ 1158}#
+ #{w\ 1159}#
+ #{s\ 1160}#
+ #{mod\ 1161}#)
+ ((lambda (#{tmp\ 1162}#)
+ ((lambda (#{tmp\ 1163}#)
+ (if (if #{tmp\ 1163}#
+ (apply (lambda (#{_\ 1164}# #{id\ 1165}# #{val\ 1166}#)
+ (#{id?\ 131}# #{id\ 1165}#))
+ #{tmp\ 1163}#)
#f)
- (apply (lambda (#{_\ 1149}# #{id\ 1150}# #{val\ 1151}#)
- (let ((#{val\ 1152}#
- (#{chi\ 165}#
- #{val\ 1151}#
- #{r\ 1140}#
- #{w\ 1141}#
- #{mod\ 1143}#))
- (#{n\ 1153}#
- (#{id-var-name\ 151}#
- #{id\ 1150}#
- #{w\ 1141}#)))
- (let ((#{b\ 1154}#
- (#{lookup\ 126}#
- #{n\ 1153}#
- #{r\ 1140}#
- #{mod\ 1143}#)))
- (let ((#{atom-key\ 1155}#
- (#{binding-type\ 121}# #{b\ 1154}#)))
- (if (memv #{atom-key\ 1155}#
+ (apply (lambda (#{_\ 1167}# #{id\ 1168}# #{val\ 1169}#)
+ (let ((#{val\ 1170}#
+ (#{chi\ 167}#
+ #{val\ 1169}#
+ #{r\ 1158}#
+ #{w\ 1159}#
+ #{mod\ 1161}#))
+ (#{n\ 1171}#
+ (#{id-var-name\ 153}#
+ #{id\ 1168}#
+ #{w\ 1159}#)))
+ (let ((#{b\ 1172}#
+ (#{lookup\ 128}#
+ #{n\ 1171}#
+ #{r\ 1158}#
+ #{mod\ 1161}#)))
+ (let ((#{atom-key\ 1173}#
+ (#{binding-type\ 123}# #{b\ 1172}#)))
+ (if (memv #{atom-key\ 1173}#
'(lexical))
(#{build-lexical-assignment\ 99}#
- #{s\ 1142}#
- (syntax->datum #{id\ 1150}#)
- (#{binding-value\ 122}# #{b\ 1154}#)
- #{val\ 1152}#)
- (if (memv #{atom-key\ 1155}#
+ #{s\ 1160}#
+ (syntax->datum #{id\ 1168}#)
+ (#{binding-value\ 124}# #{b\ 1172}#)
+ #{val\ 1170}#)
+ (if (memv #{atom-key\ 1173}#
'(global))
(#{build-global-assignment\ 102}#
- #{s\ 1142}#
- #{n\ 1153}#
- #{val\ 1152}#
- #{mod\ 1143}#)
- (if (memv #{atom-key\ 1155}#
+ #{s\ 1160}#
+ #{n\ 1171}#
+ #{val\ 1170}#
+ #{mod\ 1161}#)
+ (if (memv #{atom-key\ 1173}#
'(displaced-lexical))
(syntax-violation
'set!
"identifier out of context"
- (#{wrap\ 157}#
- #{id\ 1150}#
- #{w\ 1141}#
- #{mod\ 1143}#))
+ (#{wrap\ 159}#
+ #{id\ 1168}#
+ #{w\ 1159}#
+ #{mod\ 1161}#))
(syntax-violation
'set!
"bad set!"
- (#{source-wrap\ 158}#
- #{e\ 1139}#
- #{w\ 1141}#
- #{s\ 1142}#
- #{mod\ 1143}#)))))))))
- #{tmp\ 1145}#)
- ((lambda (#{tmp\ 1156}#)
- (if #{tmp\ 1156}#
- (apply (lambda (#{_\ 1157}#
- #{head\ 1158}#
- #{tail\ 1159}#
- #{val\ 1160}#)
+ (#{source-wrap\ 160}#
+ #{e\ 1157}#
+ #{w\ 1159}#
+ #{s\ 1160}#
+ #{mod\ 1161}#)))))))))
+ #{tmp\ 1163}#)
+ ((lambda (#{tmp\ 1174}#)
+ (if #{tmp\ 1174}#
+ (apply (lambda (#{_\ 1175}#
+ #{head\ 1176}#
+ #{tail\ 1177}#
+ #{val\ 1178}#)
(call-with-values
(lambda ()
- (#{syntax-type\ 163}#
- #{head\ 1158}#
- #{r\ 1140}#
+ (#{syntax-type\ 165}#
+ #{head\ 1176}#
+ #{r\ 1158}#
'(())
#f
#f
- #{mod\ 1143}#
+ #{mod\ 1161}#
#t))
- (lambda (#{type\ 1161}#
- #{value\ 1162}#
- #{ee\ 1163}#
- #{ww\ 1164}#
- #{ss\ 1165}#
- #{modmod\ 1166}#)
- (if (memv #{type\ 1161}#
+ (lambda (#{type\ 1179}#
+ #{value\ 1180}#
+ #{ee\ 1181}#
+ #{ww\ 1182}#
+ #{ss\ 1183}#
+ #{modmod\ 1184}#)
+ (if (memv #{type\ 1179}#
'(module-ref))
- (let ((#{val\ 1167}#
- (#{chi\ 165}#
- #{val\ 1160}#
- #{r\ 1140}#
- #{w\ 1141}#
- #{mod\ 1143}#)))
+ (let ((#{val\ 1185}#
+ (#{chi\ 167}#
+ #{val\ 1178}#
+ #{r\ 1158}#
+ #{w\ 1159}#
+ #{mod\ 1161}#)))
(call-with-values
(lambda ()
- (#{value\ 1162}#
- (cons #{head\ 1158}#
- #{tail\ 1159}#)))
- (lambda (#{id\ 1169}# #{mod\ 1170}#)
+ (#{value\ 1180}#
+ (cons #{head\ 1176}#
+ #{tail\ 1177}#)))
+ (lambda (#{id\ 1187}# #{mod\ 1188}#)
(#{build-global-assignment\ 102}#
- #{s\ 1142}#
- #{id\ 1169}#
- #{val\ 1167}#
- #{mod\ 1170}#))))
+ #{s\ 1160}#
+ #{id\ 1187}#
+ #{val\ 1185}#
+ #{mod\ 1188}#))))
(#{build-application\ 96}#
- #{s\ 1142}#
- (#{chi\ 165}#
+ #{s\ 1160}#
+ (#{chi\ 167}#
(list '#(syntax-object
setter
((top)
@@ -6842,7 +6952,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -6924,7 +7033,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -7058,6 +7169,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -7170,6 +7282,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -7177,53 +7290,53 @@
((top) (top))
("i" "i")))
(hygiene guile))
- #{head\ 1158}#)
- #{r\ 1140}#
- #{w\ 1141}#
- #{mod\ 1143}#)
- (map (lambda (#{e\ 1171}#)
- (#{chi\ 165}#
- #{e\ 1171}#
- #{r\ 1140}#
- #{w\ 1141}#
- #{mod\ 1143}#))
+ #{head\ 1176}#)
+ #{r\ 1158}#
+ #{w\ 1159}#
+ #{mod\ 1161}#)
+ (map (lambda (#{e\ 1189}#)
+ (#{chi\ 167}#
+ #{e\ 1189}#
+ #{r\ 1158}#
+ #{w\ 1159}#
+ #{mod\ 1161}#))
(append
- #{tail\ 1159}#
- (list #{val\ 1160}#))))))))
- #{tmp\ 1156}#)
- ((lambda (#{_\ 1173}#)
+ #{tail\ 1177}#
+ (list #{val\ 1178}#))))))))
+ #{tmp\ 1174}#)
+ ((lambda (#{_\ 1191}#)
(syntax-violation
'set!
"bad set!"
- (#{source-wrap\ 158}#
- #{e\ 1139}#
- #{w\ 1141}#
- #{s\ 1142}#
- #{mod\ 1143}#)))
- #{tmp\ 1144}#)))
+ (#{source-wrap\ 160}#
+ #{e\ 1157}#
+ #{w\ 1159}#
+ #{s\ 1160}#
+ #{mod\ 1161}#)))
+ #{tmp\ 1162}#)))
($sc-dispatch
- #{tmp\ 1144}#
+ #{tmp\ 1162}#
'(any (any . each-any) any)))))
($sc-dispatch
- #{tmp\ 1144}#
+ #{tmp\ 1162}#
'(any any any))))
- #{e\ 1139}#)))
- (#{global-extend\ 127}#
+ #{e\ 1157}#)))
+ (#{global-extend\ 129}#
'module-ref
'@
- (lambda (#{e\ 1174}#)
- ((lambda (#{tmp\ 1175}#)
- ((lambda (#{tmp\ 1176}#)
- (if (if #{tmp\ 1176}#
- (apply (lambda (#{_\ 1177}# #{mod\ 1178}# #{id\ 1179}#)
- (if (and-map #{id?\ 129}# #{mod\ 1178}#)
- (#{id?\ 129}# #{id\ 1179}#)
+ (lambda (#{e\ 1192}#)
+ ((lambda (#{tmp\ 1193}#)
+ ((lambda (#{tmp\ 1194}#)
+ (if (if #{tmp\ 1194}#
+ (apply (lambda (#{_\ 1195}# #{mod\ 1196}# #{id\ 1197}#)
+ (if (and-map #{id?\ 131}# #{mod\ 1196}#)
+ (#{id?\ 131}# #{id\ 1197}#)
#f))
- #{tmp\ 1176}#)
+ #{tmp\ 1194}#)
#f)
- (apply (lambda (#{_\ 1181}# #{mod\ 1182}# #{id\ 1183}#)
+ (apply (lambda (#{_\ 1199}# #{mod\ 1200}# #{id\ 1201}#)
(values
- (syntax->datum #{id\ 1183}#)
+ (syntax->datum #{id\ 1201}#)
(syntax->datum
(cons '#(syntax-object
public
@@ -7242,7 +7355,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -7324,7 +7436,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -7458,6 +7572,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -7570,38 +7685,39 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure and-map*)
((top) (top))
("i" "i")))
(hygiene guile))
- #{mod\ 1182}#))))
- #{tmp\ 1176}#)
+ #{mod\ 1200}#))))
+ #{tmp\ 1194}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1175}#)))
+ #{tmp\ 1193}#)))
($sc-dispatch
- #{tmp\ 1175}#
+ #{tmp\ 1193}#
'(any each-any any))))
- #{e\ 1174}#)))
- (#{global-extend\ 127}#
+ #{e\ 1192}#)))
+ (#{global-extend\ 129}#
'module-ref
'@@
- (lambda (#{e\ 1185}#)
- ((lambda (#{tmp\ 1186}#)
- ((lambda (#{tmp\ 1187}#)
- (if (if #{tmp\ 1187}#
- (apply (lambda (#{_\ 1188}# #{mod\ 1189}# #{id\ 1190}#)
- (if (and-map #{id?\ 129}# #{mod\ 1189}#)
- (#{id?\ 129}# #{id\ 1190}#)
+ (lambda (#{e\ 1203}#)
+ ((lambda (#{tmp\ 1204}#)
+ ((lambda (#{tmp\ 1205}#)
+ (if (if #{tmp\ 1205}#
+ (apply (lambda (#{_\ 1206}# #{mod\ 1207}# #{id\ 1208}#)
+ (if (and-map #{id?\ 131}# #{mod\ 1207}#)
+ (#{id?\ 131}# #{id\ 1208}#)
#f))
- #{tmp\ 1187}#)
+ #{tmp\ 1205}#)
#f)
- (apply (lambda (#{_\ 1192}# #{mod\ 1193}# #{id\ 1194}#)
+ (apply (lambda (#{_\ 1210}# #{mod\ 1211}# #{id\ 1212}#)
(values
- (syntax->datum #{id\ 1194}#)
+ (syntax->datum #{id\ 1212}#)
(syntax->datum
(cons '#(syntax-object
private
@@ -7620,7 +7736,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -7702,7 +7817,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -7836,6 +7953,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -7948,129 +8066,130 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure and-map*)
((top) (top))
("i" "i")))
(hygiene guile))
- #{mod\ 1193}#))))
- #{tmp\ 1187}#)
+ #{mod\ 1211}#))))
+ #{tmp\ 1205}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1186}#)))
+ #{tmp\ 1204}#)))
($sc-dispatch
- #{tmp\ 1186}#
+ #{tmp\ 1204}#
'(any each-any any))))
- #{e\ 1185}#)))
- (#{global-extend\ 127}#
+ #{e\ 1203}#)))
+ (#{global-extend\ 129}#
'core
'if
- (lambda (#{e\ 1196}#
- #{r\ 1197}#
- #{w\ 1198}#
- #{s\ 1199}#
- #{mod\ 1200}#)
- ((lambda (#{tmp\ 1201}#)
- ((lambda (#{tmp\ 1202}#)
- (if #{tmp\ 1202}#
- (apply (lambda (#{_\ 1203}# #{test\ 1204}# #{then\ 1205}#)
+ (lambda (#{e\ 1214}#
+ #{r\ 1215}#
+ #{w\ 1216}#
+ #{s\ 1217}#
+ #{mod\ 1218}#)
+ ((lambda (#{tmp\ 1219}#)
+ ((lambda (#{tmp\ 1220}#)
+ (if #{tmp\ 1220}#
+ (apply (lambda (#{_\ 1221}# #{test\ 1222}# #{then\ 1223}#)
(#{build-conditional\ 97}#
- #{s\ 1199}#
- (#{chi\ 165}#
- #{test\ 1204}#
- #{r\ 1197}#
- #{w\ 1198}#
- #{mod\ 1200}#)
- (#{chi\ 165}#
- #{then\ 1205}#
- #{r\ 1197}#
- #{w\ 1198}#
- #{mod\ 1200}#)
+ #{s\ 1217}#
+ (#{chi\ 167}#
+ #{test\ 1222}#
+ #{r\ 1215}#
+ #{w\ 1216}#
+ #{mod\ 1218}#)
+ (#{chi\ 167}#
+ #{then\ 1223}#
+ #{r\ 1215}#
+ #{w\ 1216}#
+ #{mod\ 1218}#)
(#{build-void\ 95}# #f)))
- #{tmp\ 1202}#)
- ((lambda (#{tmp\ 1206}#)
- (if #{tmp\ 1206}#
- (apply (lambda (#{_\ 1207}#
- #{test\ 1208}#
- #{then\ 1209}#
- #{else\ 1210}#)
+ #{tmp\ 1220}#)
+ ((lambda (#{tmp\ 1224}#)
+ (if #{tmp\ 1224}#
+ (apply (lambda (#{_\ 1225}#
+ #{test\ 1226}#
+ #{then\ 1227}#
+ #{else\ 1228}#)
(#{build-conditional\ 97}#
- #{s\ 1199}#
- (#{chi\ 165}#
- #{test\ 1208}#
- #{r\ 1197}#
- #{w\ 1198}#
- #{mod\ 1200}#)
- (#{chi\ 165}#
- #{then\ 1209}#
- #{r\ 1197}#
- #{w\ 1198}#
- #{mod\ 1200}#)
- (#{chi\ 165}#
- #{else\ 1210}#
- #{r\ 1197}#
- #{w\ 1198}#
- #{mod\ 1200}#)))
- #{tmp\ 1206}#)
+ #{s\ 1217}#
+ (#{chi\ 167}#
+ #{test\ 1226}#
+ #{r\ 1215}#
+ #{w\ 1216}#
+ #{mod\ 1218}#)
+ (#{chi\ 167}#
+ #{then\ 1227}#
+ #{r\ 1215}#
+ #{w\ 1216}#
+ #{mod\ 1218}#)
+ (#{chi\ 167}#
+ #{else\ 1228}#
+ #{r\ 1215}#
+ #{w\ 1216}#
+ #{mod\ 1218}#)))
+ #{tmp\ 1224}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1201}#)))
+ #{tmp\ 1219}#)))
($sc-dispatch
- #{tmp\ 1201}#
+ #{tmp\ 1219}#
'(any any any any)))))
($sc-dispatch
- #{tmp\ 1201}#
+ #{tmp\ 1219}#
'(any any any))))
- #{e\ 1196}#)))
- (#{global-extend\ 127}#
+ #{e\ 1214}#)))
+ (#{global-extend\ 129}#
'begin
'begin
'())
- (#{global-extend\ 127}#
+ (#{global-extend\ 129}#
'define
'define
'())
- (#{global-extend\ 127}#
+ (#{global-extend\ 129}#
'define-syntax
'define-syntax
'())
- (#{global-extend\ 127}#
+ (#{global-extend\ 129}#
'eval-when
'eval-when
'())
- (#{global-extend\ 127}#
+ (#{global-extend\ 129}#
'core
'syntax-case
- (letrec ((#{gen-syntax-case\ 1214}#
- (lambda (#{x\ 1215}#
- #{keys\ 1216}#
- #{clauses\ 1217}#
- #{r\ 1218}#
- #{mod\ 1219}#)
- (if (null? #{clauses\ 1217}#)
+ (letrec ((#{gen-syntax-case\ 1232}#
+ (lambda (#{x\ 1233}#
+ #{keys\ 1234}#
+ #{clauses\ 1235}#
+ #{r\ 1236}#
+ #{mod\ 1237}#)
+ (if (null? #{clauses\ 1235}#)
(#{build-application\ 96}#
#f
- (#{build-primref\ 106}#
+ (#{build-primref\ 108}#
#f
'syntax-violation)
- (list (#{build-data\ 107}# #f #f)
- (#{build-data\ 107}#
+ (list (#{build-data\ 109}# #f #f)
+ (#{build-data\ 109}#
#f
"source expression failed to match any pattern")
- #{x\ 1215}#))
- ((lambda (#{tmp\ 1220}#)
- ((lambda (#{tmp\ 1221}#)
- (if #{tmp\ 1221}#
- (apply (lambda (#{pat\ 1222}# #{exp\ 1223}#)
- (if (if (#{id?\ 129}# #{pat\ 1222}#)
+ #{x\ 1233}#))
+ ((lambda (#{tmp\ 1238}#)
+ ((lambda (#{tmp\ 1239}#)
+ (if #{tmp\ 1239}#
+ (apply (lambda (#{pat\ 1240}# #{exp\ 1241}#)
+ (if (if (#{id?\ 131}# #{pat\ 1240}#)
(and-map
- (lambda (#{x\ 1224}#)
- (not (#{free-id=?\ 152}#
- #{pat\ 1222}#
- #{x\ 1224}#)))
+ (lambda (#{x\ 1242}#)
+ (not (#{free-id=?\ 154}#
+ #{pat\ 1240}#
+ #{x\ 1242}#)))
(cons '#(syntax-object
...
((top)
@@ -8113,7 +8232,6 @@
chi-void
eval-local-transformer
chi-local-syntax
- chi-lambda-clause
chi-body
chi-macro
chi-application
@@ -8195,7 +8313,9 @@
build-sequence
build-data
build-primref
- build-lambda
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
build-global-definition
maybe-name-value!
build-global-assignment
@@ -8329,6 +8449,7 @@
(top)
(top)
(top)
+ (top)
(top))
("i"
"i"
@@ -8441,6 +8562,7 @@
"i"
"i"
"i"
+ "i"
"i"))
#(ribcage
(define-structure
@@ -8448,730 +8570,734 @@
((top) (top))
("i" "i")))
(hygiene guile))
- #{keys\ 1216}#))
+ #{keys\ 1234}#))
#f)
- (let ((#{labels\ 1225}#
- (list (#{gen-label\ 134}#)))
- (#{var\ 1226}#
- (#{gen-var\ 176}#
- #{pat\ 1222}#)))
+ (let ((#{labels\ 1243}#
+ (list (#{gen-label\ 136}#)))
+ (#{var\ 1244}#
+ (#{gen-var\ 177}#
+ #{pat\ 1240}#)))
(#{build-application\ 96}#
#f
- (#{build-lambda\ 105}#
+ (#{build-simple-lambda\ 105}#
#f
(list (syntax->datum
- #{pat\ 1222}#))
- (list #{var\ 1226}#)
+ #{pat\ 1240}#))
#f
- (#{chi\ 165}#
- #{exp\ 1223}#
- (#{extend-env\ 123}#
- #{labels\ 1225}#
+ (list #{var\ 1244}#)
+ #f
+ (#{chi\ 167}#
+ #{exp\ 1241}#
+ (#{extend-env\ 125}#
+ #{labels\ 1243}#
(list (cons 'syntax
- (cons #{var\ 1226}#
+ (cons #{var\ 1244}#
0)))
- #{r\ 1218}#)
- (#{make-binding-wrap\ 146}#
- (list #{pat\ 1222}#)
- #{labels\ 1225}#
+ #{r\ 1236}#)
+ (#{make-binding-wrap\ 148}#
+ (list #{pat\ 1240}#)
+ #{labels\ 1243}#
'(()))
- #{mod\ 1219}#))
- (list #{x\ 1215}#)))
- (#{gen-clause\ 1213}#
- #{x\ 1215}#
- #{keys\ 1216}#
- (cdr #{clauses\ 1217}#)
- #{r\ 1218}#
- #{pat\ 1222}#
+ #{mod\ 1237}#))
+ (list #{x\ 1233}#)))
+ (#{gen-clause\ 1231}#
+ #{x\ 1233}#
+ #{keys\ 1234}#
+ (cdr #{clauses\ 1235}#)
+ #{r\ 1236}#
+ #{pat\ 1240}#
#t
- #{exp\ 1223}#
- #{mod\ 1219}#)))
- #{tmp\ 1221}#)
- ((lambda (#{tmp\ 1227}#)
- (if #{tmp\ 1227}#
- (apply (lambda (#{pat\ 1228}#
- #{fender\ 1229}#
- #{exp\ 1230}#)
- (#{gen-clause\ 1213}#
- #{x\ 1215}#
- #{keys\ 1216}#
- (cdr #{clauses\ 1217}#)
- #{r\ 1218}#
- #{pat\ 1228}#
- #{fender\ 1229}#
- #{exp\ 1230}#
- #{mod\ 1219}#))
- #{tmp\ 1227}#)
- ((lambda (#{_\ 1231}#)
+ #{exp\ 1241}#
+ #{mod\ 1237}#)))
+ #{tmp\ 1239}#)
+ ((lambda (#{tmp\ 1245}#)
+ (if #{tmp\ 1245}#
+ (apply (lambda (#{pat\ 1246}#
+ #{fender\ 1247}#
+ #{exp\ 1248}#)
+ (#{gen-clause\ 1231}#
+ #{x\ 1233}#
+ #{keys\ 1234}#
+ (cdr #{clauses\ 1235}#)
+ #{r\ 1236}#
+ #{pat\ 1246}#
+ #{fender\ 1247}#
+ #{exp\ 1248}#
+ #{mod\ 1237}#))
+ #{tmp\ 1245}#)
+ ((lambda (#{_\ 1249}#)
(syntax-violation
'syntax-case
"invalid clause"
- (car #{clauses\ 1217}#)))
- #{tmp\ 1220}#)))
+ (car #{clauses\ 1235}#)))
+ #{tmp\ 1238}#)))
($sc-dispatch
- #{tmp\ 1220}#
+ #{tmp\ 1238}#
'(any any any)))))
- ($sc-dispatch #{tmp\ 1220}# (quote (any any)))))
- (car #{clauses\ 1217}#)))))
- (#{gen-clause\ 1213}#
- (lambda (#{x\ 1232}#
- #{keys\ 1233}#
- #{clauses\ 1234}#
- #{r\ 1235}#
- #{pat\ 1236}#
- #{fender\ 1237}#
- #{exp\ 1238}#
- #{mod\ 1239}#)
+ ($sc-dispatch #{tmp\ 1238}# (quote (any any)))))
+ (car #{clauses\ 1235}#)))))
+ (#{gen-clause\ 1231}#
+ (lambda (#{x\ 1250}#
+ #{keys\ 1251}#
+ #{clauses\ 1252}#
+ #{r\ 1253}#
+ #{pat\ 1254}#
+ #{fender\ 1255}#
+ #{exp\ 1256}#
+ #{mod\ 1257}#)
(call-with-values
(lambda ()
- (#{convert-pattern\ 1211}#
- #{pat\ 1236}#
- #{keys\ 1233}#))
- (lambda (#{p\ 1240}# #{pvars\ 1241}#)
- (if (not (#{distinct-bound-ids?\ 155}#
- (map car #{pvars\ 1241}#)))
+ (#{convert-pattern\ 1229}#
+ #{pat\ 1254}#
+ #{keys\ 1251}#))
+ (lambda (#{p\ 1258}# #{pvars\ 1259}#)
+ (if (not (#{distinct-bound-ids?\ 157}#
+ (map car #{pvars\ 1259}#)))
(syntax-violation
'syntax-case
"duplicate pattern variable"
- #{pat\ 1236}#)
+ #{pat\ 1254}#)
(if (not (and-map
- (lambda (#{x\ 1242}#)
- (not (#{ellipsis?\ 174}#
- (car #{x\ 1242}#))))
- #{pvars\ 1241}#))
+ (lambda (#{x\ 1260}#)
+ (not (#{ellipsis?\ 175}#
+ (car #{x\ 1260}#))))
+ #{pvars\ 1259}#))
(syntax-violation
'syntax-case
"misplaced ellipsis"
- #{pat\ 1236}#)
- (let ((#{y\ 1243}#
- (#{gen-var\ 176}# (quote tmp))))
+ #{pat\ 1254}#)
+ (let ((#{y\ 1261}#
+ (#{gen-var\ 177}# (quote tmp))))
(#{build-application\ 96}#
#f
- (#{build-lambda\ 105}#
+ (#{build-simple-lambda\ 105}#
#f
(list (quote tmp))
- (list #{y\ 1243}#)
#f
- (let ((#{y\ 1244}#
+ (list #{y\ 1261}#)
+ #f
+ (let ((#{y\ 1262}#
(#{build-lexical-reference\ 98}#
'value
#f
'tmp
- #{y\ 1243}#)))
+ #{y\ 1261}#)))
(#{build-conditional\ 97}#
#f
- ((lambda (#{tmp\ 1245}#)
- ((lambda (#{tmp\ 1246}#)
- (if #{tmp\ 1246}#
- (apply (lambda () #{y\ 1244}#)
- #{tmp\ 1246}#)
- ((lambda (#{_\ 1247}#)
+ ((lambda (#{tmp\ 1263}#)
+ ((lambda (#{tmp\ 1264}#)
+ (if #{tmp\ 1264}#
+ (apply (lambda () #{y\ 1262}#)
+ #{tmp\ 1264}#)
+ ((lambda (#{_\ 1265}#)
(#{build-conditional\ 97}#
#f
- #{y\ 1244}#
- (#{build-dispatch-call\ 1212}#
- #{pvars\ 1241}#
- #{fender\ 1237}#
- #{y\ 1244}#
- #{r\ 1235}#
- #{mod\ 1239}#)
- (#{build-data\ 107}#
+ #{y\ 1262}#
+ (#{build-dispatch-call\ 1230}#
+ #{pvars\ 1259}#
+ #{fender\ 1255}#
+ #{y\ 1262}#
+ #{r\ 1253}#
+ #{mod\ 1257}#)
+ (#{build-data\ 109}#
#f
#f)))
- #{tmp\ 1245}#)))
+ #{tmp\ 1263}#)))
($sc-dispatch
- #{tmp\ 1245}#
+ #{tmp\ 1263}#
'#(atom #t))))
- #{fender\ 1237}#)
- (#{build-dispatch-call\ 1212}#
- #{pvars\ 1241}#
- #{exp\ 1238}#
- #{y\ 1244}#
- #{r\ 1235}#
- #{mod\ 1239}#)
- (#{gen-syntax-case\ 1214}#
- #{x\ 1232}#
- #{keys\ 1233}#
- #{clauses\ 1234}#
- #{r\ 1235}#
- #{mod\ 1239}#))))
- (list (if (eq? #{p\ 1240}# (quote any))
+ #{fender\ 1255}#)
+ (#{build-dispatch-call\ 1230}#
+ #{pvars\ 1259}#
+ #{exp\ 1256}#
+ #{y\ 1262}#
+ #{r\ 1253}#
+ #{mod\ 1257}#)
+ (#{gen-syntax-case\ 1232}#
+ #{x\ 1250}#
+ #{keys\ 1251}#
+ #{clauses\ 1252}#
+ #{r\ 1253}#
+ #{mod\ 1257}#))))
+ (list (if (eq? #{p\ 1258}# (quote any))
(#{build-application\ 96}#
#f
- (#{build-primref\ 106}#
+ (#{build-primref\ 108}#
#f
'list)
- (list #{x\ 1232}#))
+ (list #{x\ 1250}#))
(#{build-application\ 96}#
#f
- (#{build-primref\ 106}#
+ (#{build-primref\ 108}#
#f
'$sc-dispatch)
- (list #{x\ 1232}#
- (#{build-data\ 107}#
+ (list #{x\ 1250}#
+ (#{build-data\ 109}#
#f
- #{p\ 1240}#)))))))))))))
- (#{build-dispatch-call\ 1212}#
- (lambda (#{pvars\ 1248}#
- #{exp\ 1249}#
- #{y\ 1250}#
- #{r\ 1251}#
- #{mod\ 1252}#)
- (let ((#{ids\ 1253}# (map car #{pvars\ 1248}#))
- (#{levels\ 1254}# (map cdr #{pvars\ 1248}#)))
- (let ((#{labels\ 1255}#
- (#{gen-labels\ 135}# #{ids\ 1253}#))
- (#{new-vars\ 1256}#
- (map #{gen-var\ 176}# #{ids\ 1253}#)))
+ #{p\ 1258}#)))))))))))))
+ (#{build-dispatch-call\ 1230}#
+ (lambda (#{pvars\ 1266}#
+ #{exp\ 1267}#
+ #{y\ 1268}#
+ #{r\ 1269}#
+ #{mod\ 1270}#)
+ (let ((#{ids\ 1271}# (map car #{pvars\ 1266}#))
+ (#{levels\ 1272}# (map cdr #{pvars\ 1266}#)))
+ (let ((#{labels\ 1273}#
+ (#{gen-labels\ 137}# #{ids\ 1271}#))
+ (#{new-vars\ 1274}#
+ (map #{gen-var\ 177}# #{ids\ 1271}#)))
(#{build-application\ 96}#
#f
- (#{build-primref\ 106}# #f (quote apply))
- (list (#{build-lambda\ 105}#
+ (#{build-primref\ 108}# #f (quote apply))
+ (list (#{build-simple-lambda\ 105}#
#f
- (map syntax->datum #{ids\ 1253}#)
- #{new-vars\ 1256}#
+ (map syntax->datum #{ids\ 1271}#)
#f
- (#{chi\ 165}#
- #{exp\ 1249}#
- (#{extend-env\ 123}#
- #{labels\ 1255}#
- (map (lambda (#{var\ 1257}#
- #{level\ 1258}#)
+ #{new-vars\ 1274}#
+ #f
+ (#{chi\ 167}#
+ #{exp\ 1267}#
+ (#{extend-env\ 125}#
+ #{labels\ 1273}#
+ (map (lambda (#{var\ 1275}#
+ #{level\ 1276}#)
(cons 'syntax
- (cons #{var\ 1257}#
- #{level\ 1258}#)))
- #{new-vars\ 1256}#
- (map cdr #{pvars\ 1248}#))
- #{r\ 1251}#)
- (#{make-binding-wrap\ 146}#
- #{ids\ 1253}#
- #{labels\ 1255}#
+ (cons #{var\ 1275}#
+ #{level\ 1276}#)))
+ #{new-vars\ 1274}#
+ (map cdr #{pvars\ 1266}#))
+ #{r\ 1269}#)
+ (#{make-binding-wrap\ 148}#
+ #{ids\ 1271}#
+ #{labels\ 1273}#
'(()))
- #{mod\ 1252}#))
- #{y\ 1250}#))))))
- (#{convert-pattern\ 1211}#
- (lambda (#{pattern\ 1259}# #{keys\ 1260}#)
- (letrec ((#{cvt\ 1261}#
- (lambda (#{p\ 1262}# #{n\ 1263}# #{ids\ 1264}#)
- (if (#{id?\ 129}# #{p\ 1262}#)
- (if (#{bound-id-member?\ 156}#
- #{p\ 1262}#
- #{keys\ 1260}#)
+ #{mod\ 1270}#))
+ #{y\ 1268}#))))))
+ (#{convert-pattern\ 1229}#
+ (lambda (#{pattern\ 1277}# #{keys\ 1278}#)
+ (letrec ((#{cvt\ 1279}#
+ (lambda (#{p\ 1280}# #{n\ 1281}# #{ids\ 1282}#)
+ (if (#{id?\ 131}# #{p\ 1280}#)
+ (if (#{bound-id-member?\ 158}#
+ #{p\ 1280}#
+ #{keys\ 1278}#)
(values
- (vector (quote free-id) #{p\ 1262}#)
- #{ids\ 1264}#)
+ (vector (quote free-id) #{p\ 1280}#)
+ #{ids\ 1282}#)
(values
'any
- (cons (cons #{p\ 1262}# #{n\ 1263}#)
- #{ids\ 1264}#)))
- ((lambda (#{tmp\ 1265}#)
- ((lambda (#{tmp\ 1266}#)
- (if (if #{tmp\ 1266}#
- (apply (lambda (#{x\ 1267}#
- #{dots\ 1268}#)
- (#{ellipsis?\ 174}#
- #{dots\ 1268}#))
- #{tmp\ 1266}#)
+ (cons (cons #{p\ 1280}# #{n\ 1281}#)
+ #{ids\ 1282}#)))
+ ((lambda (#{tmp\ 1283}#)
+ ((lambda (#{tmp\ 1284}#)
+ (if (if #{tmp\ 1284}#
+ (apply (lambda (#{x\ 1285}#
+ #{dots\ 1286}#)
+ (#{ellipsis?\ 175}#
+ #{dots\ 1286}#))
+ #{tmp\ 1284}#)
#f)
- (apply (lambda (#{x\ 1269}#
- #{dots\ 1270}#)
+ (apply (lambda (#{x\ 1287}#
+ #{dots\ 1288}#)
(call-with-values
(lambda ()
- (#{cvt\ 1261}#
- #{x\ 1269}#
+ (#{cvt\ 1279}#
+ #{x\ 1287}#
(#{fx+\ 86}#
- #{n\ 1263}#
+ #{n\ 1281}#
1)
- #{ids\ 1264}#))
- (lambda (#{p\ 1271}#
- #{ids\ 1272}#)
+ #{ids\ 1282}#))
+ (lambda (#{p\ 1289}#
+ #{ids\ 1290}#)
(values
- (if (eq? #{p\ 1271}#
+ (if (eq? #{p\ 1289}#
'any)
'each-any
(vector
'each
- #{p\ 1271}#))
- #{ids\ 1272}#))))
- #{tmp\ 1266}#)
- ((lambda (#{tmp\ 1273}#)
- (if #{tmp\ 1273}#
- (apply (lambda (#{x\ 1274}#
- #{y\ 1275}#)
+ #{p\ 1289}#))
+ #{ids\ 1290}#))))
+ #{tmp\ 1284}#)
+ ((lambda (#{tmp\ 1291}#)
+ (if #{tmp\ 1291}#
+ (apply (lambda (#{x\ 1292}#
+ #{y\ 1293}#)
(call-with-values
(lambda ()
- (#{cvt\ 1261}#
- #{y\ 1275}#
- #{n\ 1263}#
- #{ids\ 1264}#))
- (lambda (#{y\ 1276}#
- #{ids\ 1277}#)
+ (#{cvt\ 1279}#
+ #{y\ 1293}#
+ #{n\ 1281}#
+ #{ids\ 1282}#))
+ (lambda (#{y\ 1294}#
+ #{ids\ 1295}#)
(call-with-values
(lambda ()
- (#{cvt\ 1261}#
- #{x\ 1274}#
- #{n\ 1263}#
- #{ids\ 1277}#))
- (lambda (#{x\ 1278}#
- #{ids\ 1279}#)
+ (#{cvt\ 1279}#
+ #{x\ 1292}#
+ #{n\ 1281}#
+ #{ids\ 1295}#))
+ (lambda (#{x\ 1296}#
+ #{ids\ 1297}#)
(values
- (cons #{x\ 1278}#
- #{y\ 1276}#)
- #{ids\ 1279}#))))))
- #{tmp\ 1273}#)
- ((lambda (#{tmp\ 1280}#)
- (if #{tmp\ 1280}#
+ (cons #{x\ 1296}#
+ #{y\ 1294}#)
+ #{ids\ 1297}#))))))
+ #{tmp\ 1291}#)
+ ((lambda (#{tmp\ 1298}#)
+ (if #{tmp\ 1298}#
(apply (lambda ()
(values
'()
- #{ids\ 1264}#))
- #{tmp\ 1280}#)
- ((lambda (#{tmp\ 1281}#)
- (if #{tmp\ 1281}#
- (apply (lambda (#{x\ 1282}#)
+ #{ids\ 1282}#))
+ #{tmp\ 1298}#)
+ ((lambda (#{tmp\ 1299}#)
+ (if #{tmp\ 1299}#
+ (apply (lambda (#{x\ 1300}#)
(call-with-values
(lambda ()
- (#{cvt\ 1261}#
- #{x\ 1282}#
- #{n\ 1263}#
- #{ids\ 1264}#))
- (lambda (#{p\ 1284}#
- #{ids\ 1285}#)
+ (#{cvt\ 1279}#
+ #{x\ 1300}#
+ #{n\ 1281}#
+ #{ids\ 1282}#))
+ (lambda (#{p\ 1302}#
+ #{ids\ 1303}#)
(values
(vector
'vector
- #{p\ 1284}#)
- #{ids\ 1285}#))))
- #{tmp\ 1281}#)
- ((lambda (#{x\ 1286}#)
+ #{p\ 1302}#)
+ #{ids\ 1303}#))))
+ #{tmp\ 1299}#)
+ ((lambda (#{x\ 1304}#)
(values
(vector
'atom
- (#{strip\ 175}#
- #{p\ 1262}#
+ (#{strip\ 176}#
+ #{p\ 1280}#
'(())))
- #{ids\ 1264}#))
- #{tmp\ 1265}#)))
+ #{ids\ 1282}#))
+ #{tmp\ 1283}#)))
($sc-dispatch
- #{tmp\ 1265}#
+ #{tmp\ 1283}#
'#(vector
each-any)))))
($sc-dispatch
- #{tmp\ 1265}#
+ #{tmp\ 1283}#
'()))))
($sc-dispatch
- #{tmp\ 1265}#
+ #{tmp\ 1283}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 1265}#
+ #{tmp\ 1283}#
'(any any))))
- #{p\ 1262}#)))))
- (#{cvt\ 1261}# #{pattern\ 1259}# 0 (quote ()))))))
- (lambda (#{e\ 1287}#
- #{r\ 1288}#
- #{w\ 1289}#
- #{s\ 1290}#
- #{mod\ 1291}#)
- (let ((#{e\ 1292}#
- (#{source-wrap\ 158}#
- #{e\ 1287}#
- #{w\ 1289}#
- #{s\ 1290}#
- #{mod\ 1291}#)))
- ((lambda (#{tmp\ 1293}#)
- ((lambda (#{tmp\ 1294}#)
- (if #{tmp\ 1294}#
- (apply (lambda (#{_\ 1295}#
- #{val\ 1296}#
- #{key\ 1297}#
- #{m\ 1298}#)
+ #{p\ 1280}#)))))
+ (#{cvt\ 1279}# #{pattern\ 1277}# 0 (quote ()))))))
+ (lambda (#{e\ 1305}#
+ #{r\ 1306}#
+ #{w\ 1307}#
+ #{s\ 1308}#
+ #{mod\ 1309}#)
+ (let ((#{e\ 1310}#
+ (#{source-wrap\ 160}#
+ #{e\ 1305}#
+ #{w\ 1307}#
+ #{s\ 1308}#
+ #{mod\ 1309}#)))
+ ((lambda (#{tmp\ 1311}#)
+ ((lambda (#{tmp\ 1312}#)
+ (if #{tmp\ 1312}#
+ (apply (lambda (#{_\ 1313}#
+ #{val\ 1314}#
+ #{key\ 1315}#
+ #{m\ 1316}#)
(if (and-map
- (lambda (#{x\ 1299}#)
- (if (#{id?\ 129}# #{x\ 1299}#)
- (not (#{ellipsis?\ 174}# #{x\ 1299}#))
+ (lambda (#{x\ 1317}#)
+ (if (#{id?\ 131}# #{x\ 1317}#)
+ (not (#{ellipsis?\ 175}# #{x\ 1317}#))
#f))
- #{key\ 1297}#)
- (let ((#{x\ 1301}#
- (#{gen-var\ 176}# (quote tmp))))
+ #{key\ 1315}#)
+ (let ((#{x\ 1319}#
+ (#{gen-var\ 177}# (quote tmp))))
(#{build-application\ 96}#
- #{s\ 1290}#
- (#{build-lambda\ 105}#
+ #{s\ 1308}#
+ (#{build-simple-lambda\ 105}#
#f
(list (quote tmp))
- (list #{x\ 1301}#)
#f
- (#{gen-syntax-case\ 1214}#
+ (list #{x\ 1319}#)
+ #f
+ (#{gen-syntax-case\ 1232}#
(#{build-lexical-reference\ 98}#
'value
#f
'tmp
- #{x\ 1301}#)
- #{key\ 1297}#
- #{m\ 1298}#
- #{r\ 1288}#
- #{mod\ 1291}#))
- (list (#{chi\ 165}#
- #{val\ 1296}#
- #{r\ 1288}#
+ #{x\ 1319}#)
+ #{key\ 1315}#
+ #{m\ 1316}#
+ #{r\ 1306}#
+ #{mod\ 1309}#))
+ (list (#{chi\ 167}#
+ #{val\ 1314}#
+ #{r\ 1306}#
'(())
- #{mod\ 1291}#))))
+ #{mod\ 1309}#))))
(syntax-violation
'syntax-case
"invalid literals list"
- #{e\ 1292}#)))
- #{tmp\ 1294}#)
+ #{e\ 1310}#)))
+ #{tmp\ 1312}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1293}#)))
+ #{tmp\ 1311}#)))
($sc-dispatch
- #{tmp\ 1293}#
+ #{tmp\ 1311}#
'(any any each-any . each-any))))
- #{e\ 1292}#)))))
+ #{e\ 1310}#)))))
(set! sc-expand
- (lambda (#{x\ 1305}# . #{rest\ 1304}#)
- (if (if (pair? #{x\ 1305}#)
- (equal? (car #{x\ 1305}#) #{noexpand\ 84}#)
+ (lambda (#{x\ 1322}# . #{rest\ 1323}#)
+ (if (if (pair? #{x\ 1322}#)
+ (equal? (car #{x\ 1322}#) #{noexpand\ 84}#)
#f)
- (cadr #{x\ 1305}#)
- (let ((#{m\ 1306}#
- (if (null? #{rest\ 1304}#)
+ (cadr #{x\ 1322}#)
+ (let ((#{m\ 1324}#
+ (if (null? #{rest\ 1323}#)
'e
- (car #{rest\ 1304}#)))
- (#{esew\ 1307}#
- (if (let ((#{t\ 1308}# (null? #{rest\ 1304}#)))
- (if #{t\ 1308}#
- #{t\ 1308}#
- (null? (cdr #{rest\ 1304}#))))
+ (car #{rest\ 1323}#)))
+ (#{esew\ 1325}#
+ (if (let ((#{t\ 1326}# (null? #{rest\ 1323}#)))
+ (if #{t\ 1326}#
+ #{t\ 1326}#
+ (null? (cdr #{rest\ 1323}#))))
'(eval)
- (cadr #{rest\ 1304}#))))
+ (cadr #{rest\ 1323}#))))
(with-fluid*
#{*mode*\ 85}#
- #{m\ 1306}#
+ #{m\ 1324}#
(lambda ()
- (#{chi-top\ 164}#
- #{x\ 1305}#
+ (#{chi-top\ 166}#
+ #{x\ 1322}#
'()
'((top))
- #{m\ 1306}#
- #{esew\ 1307}#
+ #{m\ 1324}#
+ #{esew\ 1325}#
(cons 'hygiene
(module-name (current-module))))))))))
(set! identifier?
- (lambda (#{x\ 1309}#)
- (#{nonsymbol-id?\ 128}# #{x\ 1309}#)))
+ (lambda (#{x\ 1327}#)
+ (#{nonsymbol-id?\ 130}# #{x\ 1327}#)))
(set! datum->syntax
- (lambda (#{id\ 1310}# #{datum\ 1311}#)
- (#{make-syntax-object\ 112}#
- #{datum\ 1311}#
- (#{syntax-object-wrap\ 115}# #{id\ 1310}#)
+ (lambda (#{id\ 1328}# #{datum\ 1329}#)
+ (#{make-syntax-object\ 114}#
+ #{datum\ 1329}#
+ (#{syntax-object-wrap\ 117}# #{id\ 1328}#)
#f)))
(set! syntax->datum
- (lambda (#{x\ 1312}#)
- (#{strip\ 175}# #{x\ 1312}# (quote (())))))
+ (lambda (#{x\ 1330}#)
+ (#{strip\ 176}# #{x\ 1330}# (quote (())))))
(set! generate-temporaries
- (lambda (#{ls\ 1313}#)
+ (lambda (#{ls\ 1331}#)
(begin
- (let ((#{x\ 1314}# #{ls\ 1313}#))
- (if (not (list? #{x\ 1314}#))
+ (let ((#{x\ 1332}# #{ls\ 1331}#))
+ (if (not (list? #{x\ 1332}#))
(syntax-violation
'generate-temporaries
"invalid argument"
- #{x\ 1314}#)))
- (map (lambda (#{x\ 1315}#)
- (#{wrap\ 157}# (gensym) (quote ((top))) #f))
- #{ls\ 1313}#))))
+ #{x\ 1332}#)))
+ (map (lambda (#{x\ 1333}#)
+ (#{wrap\ 159}# (gensym) (quote ((top))) #f))
+ #{ls\ 1331}#))))
(set! free-identifier=?
- (lambda (#{x\ 1316}# #{y\ 1317}#)
+ (lambda (#{x\ 1334}# #{y\ 1335}#)
(begin
- (let ((#{x\ 1318}# #{x\ 1316}#))
- (if (not (#{nonsymbol-id?\ 128}# #{x\ 1318}#))
+ (let ((#{x\ 1336}# #{x\ 1334}#))
+ (if (not (#{nonsymbol-id?\ 130}# #{x\ 1336}#))
(syntax-violation
'free-identifier=?
"invalid argument"
- #{x\ 1318}#)))
- (let ((#{x\ 1319}# #{y\ 1317}#))
- (if (not (#{nonsymbol-id?\ 128}# #{x\ 1319}#))
+ #{x\ 1336}#)))
+ (let ((#{x\ 1337}# #{y\ 1335}#))
+ (if (not (#{nonsymbol-id?\ 130}# #{x\ 1337}#))
(syntax-violation
'free-identifier=?
"invalid argument"
- #{x\ 1319}#)))
- (#{free-id=?\ 152}# #{x\ 1316}# #{y\ 1317}#))))
+ #{x\ 1337}#)))
+ (#{free-id=?\ 154}# #{x\ 1334}# #{y\ 1335}#))))
(set! bound-identifier=?
- (lambda (#{x\ 1320}# #{y\ 1321}#)
+ (lambda (#{x\ 1338}# #{y\ 1339}#)
(begin
- (let ((#{x\ 1322}# #{x\ 1320}#))
- (if (not (#{nonsymbol-id?\ 128}# #{x\ 1322}#))
+ (let ((#{x\ 1340}# #{x\ 1338}#))
+ (if (not (#{nonsymbol-id?\ 130}# #{x\ 1340}#))
(syntax-violation
'bound-identifier=?
"invalid argument"
- #{x\ 1322}#)))
- (let ((#{x\ 1323}# #{y\ 1321}#))
- (if (not (#{nonsymbol-id?\ 128}# #{x\ 1323}#))
+ #{x\ 1340}#)))
+ (let ((#{x\ 1341}# #{y\ 1339}#))
+ (if (not (#{nonsymbol-id?\ 130}# #{x\ 1341}#))
(syntax-violation
'bound-identifier=?
"invalid argument"
- #{x\ 1323}#)))
- (#{bound-id=?\ 153}# #{x\ 1320}# #{y\ 1321}#))))
+ #{x\ 1341}#)))
+ (#{bound-id=?\ 155}# #{x\ 1338}# #{y\ 1339}#))))
(set! syntax-violation
- (lambda (#{who\ 1327}#
- #{message\ 1326}#
- #{form\ 1325}#
+ (lambda (#{who\ 1342}#
+ #{message\ 1343}#
+ #{form\ 1344}#
.
- #{subform\ 1324}#)
+ #{subform\ 1345}#)
(begin
- (let ((#{x\ 1328}# #{who\ 1327}#))
- (if (not ((lambda (#{x\ 1329}#)
- (let ((#{t\ 1330}# (not #{x\ 1329}#)))
- (if #{t\ 1330}#
- #{t\ 1330}#
- (let ((#{t\ 1331}# (string? #{x\ 1329}#)))
- (if #{t\ 1331}#
- #{t\ 1331}#
- (symbol? #{x\ 1329}#))))))
- #{x\ 1328}#))
+ (let ((#{x\ 1346}# #{who\ 1342}#))
+ (if (not ((lambda (#{x\ 1347}#)
+ (let ((#{t\ 1348}# (not #{x\ 1347}#)))
+ (if #{t\ 1348}#
+ #{t\ 1348}#
+ (let ((#{t\ 1349}# (string? #{x\ 1347}#)))
+ (if #{t\ 1349}#
+ #{t\ 1349}#
+ (symbol? #{x\ 1347}#))))))
+ #{x\ 1346}#))
(syntax-violation
'syntax-violation
"invalid argument"
- #{x\ 1328}#)))
- (let ((#{x\ 1332}# #{message\ 1326}#))
- (if (not (string? #{x\ 1332}#))
+ #{x\ 1346}#)))
+ (let ((#{x\ 1350}# #{message\ 1343}#))
+ (if (not (string? #{x\ 1350}#))
(syntax-violation
'syntax-violation
"invalid argument"
- #{x\ 1332}#)))
+ #{x\ 1350}#)))
(scm-error
'syntax-error
'sc-expand
(string-append
- (if #{who\ 1327}# "~a: " "")
+ (if #{who\ 1342}# "~a: " "")
"~a "
- (if (null? #{subform\ 1324}#)
+ (if (null? #{subform\ 1345}#)
"in ~a"
"in subform `~s' of `~s'"))
- (let ((#{tail\ 1333}#
- (cons #{message\ 1326}#
- (map (lambda (#{x\ 1334}#)
- (#{strip\ 175}# #{x\ 1334}# (quote (()))))
+ (let ((#{tail\ 1351}#
+ (cons #{message\ 1343}#
+ (map (lambda (#{x\ 1352}#)
+ (#{strip\ 176}# #{x\ 1352}# (quote (()))))
(append
- #{subform\ 1324}#
- (list #{form\ 1325}#))))))
- (if #{who\ 1327}#
- (cons #{who\ 1327}# #{tail\ 1333}#)
- #{tail\ 1333}#))
+ #{subform\ 1345}#
+ (list #{form\ 1344}#))))))
+ (if #{who\ 1342}#
+ (cons #{who\ 1342}# #{tail\ 1351}#)
+ #{tail\ 1351}#))
#f))))
- (letrec ((#{match\ 1339}#
- (lambda (#{e\ 1340}#
- #{p\ 1341}#
- #{w\ 1342}#
- #{r\ 1343}#
- #{mod\ 1344}#)
- (if (not #{r\ 1343}#)
+ (letrec ((#{match\ 1357}#
+ (lambda (#{e\ 1358}#
+ #{p\ 1359}#
+ #{w\ 1360}#
+ #{r\ 1361}#
+ #{mod\ 1362}#)
+ (if (not #{r\ 1361}#)
#f
- (if (eq? #{p\ 1341}# (quote any))
- (cons (#{wrap\ 157}#
- #{e\ 1340}#
- #{w\ 1342}#
- #{mod\ 1344}#)
- #{r\ 1343}#)
- (if (#{syntax-object?\ 113}# #{e\ 1340}#)
- (#{match*\ 1338}#
- (#{syntax-object-expression\ 114}# #{e\ 1340}#)
- #{p\ 1341}#
- (#{join-wraps\ 148}#
- #{w\ 1342}#
- (#{syntax-object-wrap\ 115}# #{e\ 1340}#))
- #{r\ 1343}#
- (#{syntax-object-module\ 116}# #{e\ 1340}#))
- (#{match*\ 1338}#
- #{e\ 1340}#
- #{p\ 1341}#
- #{w\ 1342}#
- #{r\ 1343}#
- #{mod\ 1344}#))))))
- (#{match*\ 1338}#
- (lambda (#{e\ 1345}#
- #{p\ 1346}#
- #{w\ 1347}#
- #{r\ 1348}#
- #{mod\ 1349}#)
- (if (null? #{p\ 1346}#)
- (if (null? #{e\ 1345}#) #{r\ 1348}# #f)
- (if (pair? #{p\ 1346}#)
- (if (pair? #{e\ 1345}#)
- (#{match\ 1339}#
- (car #{e\ 1345}#)
- (car #{p\ 1346}#)
- #{w\ 1347}#
- (#{match\ 1339}#
- (cdr #{e\ 1345}#)
- (cdr #{p\ 1346}#)
- #{w\ 1347}#
- #{r\ 1348}#
- #{mod\ 1349}#)
- #{mod\ 1349}#)
+ (if (eq? #{p\ 1359}# (quote any))
+ (cons (#{wrap\ 159}#
+ #{e\ 1358}#
+ #{w\ 1360}#
+ #{mod\ 1362}#)
+ #{r\ 1361}#)
+ (if (#{syntax-object?\ 115}# #{e\ 1358}#)
+ (#{match*\ 1356}#
+ (#{syntax-object-expression\ 116}# #{e\ 1358}#)
+ #{p\ 1359}#
+ (#{join-wraps\ 150}#
+ #{w\ 1360}#
+ (#{syntax-object-wrap\ 117}# #{e\ 1358}#))
+ #{r\ 1361}#
+ (#{syntax-object-module\ 118}# #{e\ 1358}#))
+ (#{match*\ 1356}#
+ #{e\ 1358}#
+ #{p\ 1359}#
+ #{w\ 1360}#
+ #{r\ 1361}#
+ #{mod\ 1362}#))))))
+ (#{match*\ 1356}#
+ (lambda (#{e\ 1363}#
+ #{p\ 1364}#
+ #{w\ 1365}#
+ #{r\ 1366}#
+ #{mod\ 1367}#)
+ (if (null? #{p\ 1364}#)
+ (if (null? #{e\ 1363}#) #{r\ 1366}# #f)
+ (if (pair? #{p\ 1364}#)
+ (if (pair? #{e\ 1363}#)
+ (#{match\ 1357}#
+ (car #{e\ 1363}#)
+ (car #{p\ 1364}#)
+ #{w\ 1365}#
+ (#{match\ 1357}#
+ (cdr #{e\ 1363}#)
+ (cdr #{p\ 1364}#)
+ #{w\ 1365}#
+ #{r\ 1366}#
+ #{mod\ 1367}#)
+ #{mod\ 1367}#)
#f)
- (if (eq? #{p\ 1346}# (quote each-any))
- (let ((#{l\ 1350}#
- (#{match-each-any\ 1336}#
- #{e\ 1345}#
- #{w\ 1347}#
- #{mod\ 1349}#)))
- (if #{l\ 1350}#
- (cons #{l\ 1350}# #{r\ 1348}#)
+ (if (eq? #{p\ 1364}# (quote each-any))
+ (let ((#{l\ 1368}#
+ (#{match-each-any\ 1354}#
+ #{e\ 1363}#
+ #{w\ 1365}#
+ #{mod\ 1367}#)))
+ (if #{l\ 1368}#
+ (cons #{l\ 1368}# #{r\ 1366}#)
#f))
- (let ((#{atom-key\ 1351}# (vector-ref #{p\ 1346}# 0)))
- (if (memv #{atom-key\ 1351}# (quote (each)))
- (if (null? #{e\ 1345}#)
- (#{match-empty\ 1337}#
- (vector-ref #{p\ 1346}# 1)
- #{r\ 1348}#)
- (let ((#{l\ 1352}#
- (#{match-each\ 1335}#
- #{e\ 1345}#
- (vector-ref #{p\ 1346}# 1)
- #{w\ 1347}#
- #{mod\ 1349}#)))
- (if #{l\ 1352}#
- (letrec ((#{collect\ 1353}#
- (lambda (#{l\ 1354}#)
- (if (null? (car #{l\ 1354}#))
- #{r\ 1348}#
- (cons (map car #{l\ 1354}#)
- (#{collect\ 1353}#
+ (let ((#{atom-key\ 1369}# (vector-ref #{p\ 1364}# 0)))
+ (if (memv #{atom-key\ 1369}# (quote (each)))
+ (if (null? #{e\ 1363}#)
+ (#{match-empty\ 1355}#
+ (vector-ref #{p\ 1364}# 1)
+ #{r\ 1366}#)
+ (let ((#{l\ 1370}#
+ (#{match-each\ 1353}#
+ #{e\ 1363}#
+ (vector-ref #{p\ 1364}# 1)
+ #{w\ 1365}#
+ #{mod\ 1367}#)))
+ (if #{l\ 1370}#
+ (letrec ((#{collect\ 1371}#
+ (lambda (#{l\ 1372}#)
+ (if (null? (car #{l\ 1372}#))
+ #{r\ 1366}#
+ (cons (map car #{l\ 1372}#)
+ (#{collect\ 1371}#
(map cdr
- #{l\ 1354}#)))))))
- (#{collect\ 1353}# #{l\ 1352}#))
+ #{l\ 1372}#)))))))
+ (#{collect\ 1371}# #{l\ 1370}#))
#f)))
- (if (memv #{atom-key\ 1351}# (quote (free-id)))
- (if (#{id?\ 129}# #{e\ 1345}#)
- (if (#{free-id=?\ 152}#
- (#{wrap\ 157}#
- #{e\ 1345}#
- #{w\ 1347}#
- #{mod\ 1349}#)
- (vector-ref #{p\ 1346}# 1))
- #{r\ 1348}#
+ (if (memv #{atom-key\ 1369}# (quote (free-id)))
+ (if (#{id?\ 131}# #{e\ 1363}#)
+ (if (#{free-id=?\ 154}#
+ (#{wrap\ 159}#
+ #{e\ 1363}#
+ #{w\ 1365}#
+ #{mod\ 1367}#)
+ (vector-ref #{p\ 1364}# 1))
+ #{r\ 1366}#
#f)
#f)
- (if (memv #{atom-key\ 1351}# (quote (atom)))
+ (if (memv #{atom-key\ 1369}# (quote (atom)))
(if (equal?
- (vector-ref #{p\ 1346}# 1)
- (#{strip\ 175}#
- #{e\ 1345}#
- #{w\ 1347}#))
- #{r\ 1348}#
+ (vector-ref #{p\ 1364}# 1)
+ (#{strip\ 176}#
+ #{e\ 1363}#
+ #{w\ 1365}#))
+ #{r\ 1366}#
#f)
- (if (memv #{atom-key\ 1351}# (quote (vector)))
- (if (vector? #{e\ 1345}#)
- (#{match\ 1339}#
- (vector->list #{e\ 1345}#)
- (vector-ref #{p\ 1346}# 1)
- #{w\ 1347}#
- #{r\ 1348}#
- #{mod\ 1349}#)
+ (if (memv #{atom-key\ 1369}# (quote (vector)))
+ (if (vector? #{e\ 1363}#)
+ (#{match\ 1357}#
+ (vector->list #{e\ 1363}#)
+ (vector-ref #{p\ 1364}# 1)
+ #{w\ 1365}#
+ #{r\ 1366}#
+ #{mod\ 1367}#)
#f)))))))))))
- (#{match-empty\ 1337}#
- (lambda (#{p\ 1355}# #{r\ 1356}#)
- (if (null? #{p\ 1355}#)
- #{r\ 1356}#
- (if (eq? #{p\ 1355}# (quote any))
- (cons (quote ()) #{r\ 1356}#)
- (if (pair? #{p\ 1355}#)
- (#{match-empty\ 1337}#
- (car #{p\ 1355}#)
- (#{match-empty\ 1337}#
- (cdr #{p\ 1355}#)
- #{r\ 1356}#))
- (if (eq? #{p\ 1355}# (quote each-any))
- (cons (quote ()) #{r\ 1356}#)
- (let ((#{atom-key\ 1357}#
- (vector-ref #{p\ 1355}# 0)))
- (if (memv #{atom-key\ 1357}# (quote (each)))
- (#{match-empty\ 1337}#
- (vector-ref #{p\ 1355}# 1)
- #{r\ 1356}#)
- (if (memv #{atom-key\ 1357}#
+ (#{match-empty\ 1355}#
+ (lambda (#{p\ 1373}# #{r\ 1374}#)
+ (if (null? #{p\ 1373}#)
+ #{r\ 1374}#
+ (if (eq? #{p\ 1373}# (quote any))
+ (cons (quote ()) #{r\ 1374}#)
+ (if (pair? #{p\ 1373}#)
+ (#{match-empty\ 1355}#
+ (car #{p\ 1373}#)
+ (#{match-empty\ 1355}#
+ (cdr #{p\ 1373}#)
+ #{r\ 1374}#))
+ (if (eq? #{p\ 1373}# (quote each-any))
+ (cons (quote ()) #{r\ 1374}#)
+ (let ((#{atom-key\ 1375}#
+ (vector-ref #{p\ 1373}# 0)))
+ (if (memv #{atom-key\ 1375}# (quote (each)))
+ (#{match-empty\ 1355}#
+ (vector-ref #{p\ 1373}# 1)
+ #{r\ 1374}#)
+ (if (memv #{atom-key\ 1375}#
'(free-id atom))
- #{r\ 1356}#
- (if (memv #{atom-key\ 1357}# (quote (vector)))
- (#{match-empty\ 1337}#
- (vector-ref #{p\ 1355}# 1)
- #{r\ 1356}#)))))))))))
- (#{match-each-any\ 1336}#
- (lambda (#{e\ 1358}# #{w\ 1359}# #{mod\ 1360}#)
- (if (pair? #{e\ 1358}#)
- (let ((#{l\ 1361}#
- (#{match-each-any\ 1336}#
- (cdr #{e\ 1358}#)
- #{w\ 1359}#
- #{mod\ 1360}#)))
- (if #{l\ 1361}#
- (cons (#{wrap\ 157}#
- (car #{e\ 1358}#)
- #{w\ 1359}#
- #{mod\ 1360}#)
- #{l\ 1361}#)
+ #{r\ 1374}#
+ (if (memv #{atom-key\ 1375}# (quote (vector)))
+ (#{match-empty\ 1355}#
+ (vector-ref #{p\ 1373}# 1)
+ #{r\ 1374}#)))))))))))
+ (#{match-each-any\ 1354}#
+ (lambda (#{e\ 1376}# #{w\ 1377}# #{mod\ 1378}#)
+ (if (pair? #{e\ 1376}#)
+ (let ((#{l\ 1379}#
+ (#{match-each-any\ 1354}#
+ (cdr #{e\ 1376}#)
+ #{w\ 1377}#
+ #{mod\ 1378}#)))
+ (if #{l\ 1379}#
+ (cons (#{wrap\ 159}#
+ (car #{e\ 1376}#)
+ #{w\ 1377}#
+ #{mod\ 1378}#)
+ #{l\ 1379}#)
#f))
- (if (null? #{e\ 1358}#)
+ (if (null? #{e\ 1376}#)
'()
- (if (#{syntax-object?\ 113}# #{e\ 1358}#)
- (#{match-each-any\ 1336}#
- (#{syntax-object-expression\ 114}# #{e\ 1358}#)
- (#{join-wraps\ 148}#
- #{w\ 1359}#
- (#{syntax-object-wrap\ 115}# #{e\ 1358}#))
- #{mod\ 1360}#)
+ (if (#{syntax-object?\ 115}# #{e\ 1376}#)
+ (#{match-each-any\ 1354}#
+ (#{syntax-object-expression\ 116}# #{e\ 1376}#)
+ (#{join-wraps\ 150}#
+ #{w\ 1377}#
+ (#{syntax-object-wrap\ 117}# #{e\ 1376}#))
+ #{mod\ 1378}#)
#f)))))
- (#{match-each\ 1335}#
- (lambda (#{e\ 1362}#
- #{p\ 1363}#
- #{w\ 1364}#
- #{mod\ 1365}#)
- (if (pair? #{e\ 1362}#)
- (let ((#{first\ 1366}#
- (#{match\ 1339}#
- (car #{e\ 1362}#)
- #{p\ 1363}#
- #{w\ 1364}#
+ (#{match-each\ 1353}#
+ (lambda (#{e\ 1380}#
+ #{p\ 1381}#
+ #{w\ 1382}#
+ #{mod\ 1383}#)
+ (if (pair? #{e\ 1380}#)
+ (let ((#{first\ 1384}#
+ (#{match\ 1357}#
+ (car #{e\ 1380}#)
+ #{p\ 1381}#
+ #{w\ 1382}#
'()
- #{mod\ 1365}#)))
- (if #{first\ 1366}#
- (let ((#{rest\ 1367}#
- (#{match-each\ 1335}#
- (cdr #{e\ 1362}#)
- #{p\ 1363}#
- #{w\ 1364}#
- #{mod\ 1365}#)))
- (if #{rest\ 1367}#
- (cons #{first\ 1366}# #{rest\ 1367}#)
+ #{mod\ 1383}#)))
+ (if #{first\ 1384}#
+ (let ((#{rest\ 1385}#
+ (#{match-each\ 1353}#
+ (cdr #{e\ 1380}#)
+ #{p\ 1381}#
+ #{w\ 1382}#
+ #{mod\ 1383}#)))
+ (if #{rest\ 1385}#
+ (cons #{first\ 1384}# #{rest\ 1385}#)
#f))
#f))
- (if (null? #{e\ 1362}#)
+ (if (null? #{e\ 1380}#)
'()
- (if (#{syntax-object?\ 113}# #{e\ 1362}#)
- (#{match-each\ 1335}#
- (#{syntax-object-expression\ 114}# #{e\ 1362}#)
- #{p\ 1363}#
- (#{join-wraps\ 148}#
- #{w\ 1364}#
- (#{syntax-object-wrap\ 115}# #{e\ 1362}#))
- (#{syntax-object-module\ 116}# #{e\ 1362}#))
+ (if (#{syntax-object?\ 115}# #{e\ 1380}#)
+ (#{match-each\ 1353}#
+ (#{syntax-object-expression\ 116}# #{e\ 1380}#)
+ #{p\ 1381}#
+ (#{join-wraps\ 150}#
+ #{w\ 1382}#
+ (#{syntax-object-wrap\ 117}# #{e\ 1380}#))
+ (#{syntax-object-module\ 118}# #{e\ 1380}#))
#f))))))
(set! $sc-dispatch
- (lambda (#{e\ 1368}# #{p\ 1369}#)
- (if (eq? #{p\ 1369}# (quote any))
- (list #{e\ 1368}#)
- (if (#{syntax-object?\ 113}# #{e\ 1368}#)
- (#{match*\ 1338}#
- (#{syntax-object-expression\ 114}# #{e\ 1368}#)
- #{p\ 1369}#
- (#{syntax-object-wrap\ 115}# #{e\ 1368}#)
+ (lambda (#{e\ 1386}# #{p\ 1387}#)
+ (if (eq? #{p\ 1387}# (quote any))
+ (list #{e\ 1386}#)
+ (if (#{syntax-object?\ 115}# #{e\ 1386}#)
+ (#{match*\ 1356}#
+ (#{syntax-object-expression\ 116}# #{e\ 1386}#)
+ #{p\ 1387}#
+ (#{syntax-object-wrap\ 117}# #{e\ 1386}#)
'()
- (#{syntax-object-module\ 116}# #{e\ 1368}#))
- (#{match*\ 1338}#
- #{e\ 1368}#
- #{p\ 1369}#
+ (#{syntax-object-module\ 118}# #{e\ 1386}#))
+ (#{match*\ 1356}#
+ #{e\ 1386}#
+ #{p\ 1387}#
'(())
'()
#f)))))))))
@@ -9179,11 +9305,11 @@
(define with-syntax
(make-syncase-macro
'macro
- (lambda (#{x\ 1370}#)
- ((lambda (#{tmp\ 1371}#)
- ((lambda (#{tmp\ 1372}#)
- (if #{tmp\ 1372}#
- (apply (lambda (#{_\ 1373}# #{e1\ 1374}# #{e2\ 1375}#)
+ (lambda (#{x\ 1388}#)
+ ((lambda (#{tmp\ 1389}#)
+ ((lambda (#{tmp\ 1390}#)
+ (if #{tmp\ 1390}#
+ (apply (lambda (#{_\ 1391}# #{e1\ 1392}# #{e2\ 1393}#)
(cons '#(syntax-object
begin
((top)
@@ -9194,15 +9320,15 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- (cons #{e1\ 1374}# #{e2\ 1375}#)))
- #{tmp\ 1372}#)
- ((lambda (#{tmp\ 1377}#)
- (if #{tmp\ 1377}#
- (apply (lambda (#{_\ 1378}#
- #{out\ 1379}#
- #{in\ 1380}#
- #{e1\ 1381}#
- #{e2\ 1382}#)
+ (cons #{e1\ 1392}# #{e2\ 1393}#)))
+ #{tmp\ 1390}#)
+ ((lambda (#{tmp\ 1395}#)
+ (if #{tmp\ 1395}#
+ (apply (lambda (#{_\ 1396}#
+ #{out\ 1397}#
+ #{in\ 1398}#
+ #{e1\ 1399}#
+ #{e2\ 1400}#)
(list '#(syntax-object
syntax-case
((top)
@@ -9213,9 +9339,9 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- #{in\ 1380}#
+ #{in\ 1398}#
'()
- (list #{out\ 1379}#
+ (list #{out\ 1397}#
(cons '#(syntax-object
begin
((top)
@@ -9233,16 +9359,16 @@
#((top))
#("i")))
(hygiene guile))
- (cons #{e1\ 1381}#
- #{e2\ 1382}#)))))
- #{tmp\ 1377}#)
- ((lambda (#{tmp\ 1384}#)
- (if #{tmp\ 1384}#
- (apply (lambda (#{_\ 1385}#
- #{out\ 1386}#
- #{in\ 1387}#
- #{e1\ 1388}#
- #{e2\ 1389}#)
+ (cons #{e1\ 1399}#
+ #{e2\ 1400}#)))))
+ #{tmp\ 1395}#)
+ ((lambda (#{tmp\ 1402}#)
+ (if #{tmp\ 1402}#
+ (apply (lambda (#{_\ 1403}#
+ #{out\ 1404}#
+ #{in\ 1405}#
+ #{e1\ 1406}#
+ #{e2\ 1407}#)
(list '#(syntax-object
syntax-case
((top)
@@ -9270,9 +9396,9 @@
#((top))
#("i")))
(hygiene guile))
- #{in\ 1387}#)
+ #{in\ 1405}#)
'()
- (list #{out\ 1386}#
+ (list #{out\ 1404}#
(cons '#(syntax-object
begin
((top)
@@ -9294,36 +9420,36 @@
#((top))
#("i")))
(hygiene guile))
- (cons #{e1\ 1388}#
- #{e2\ 1389}#)))))
- #{tmp\ 1384}#)
+ (cons #{e1\ 1406}#
+ #{e2\ 1407}#)))))
+ #{tmp\ 1402}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1371}#)))
+ #{tmp\ 1389}#)))
($sc-dispatch
- #{tmp\ 1371}#
+ #{tmp\ 1389}#
'(any #(each (any any)) any . each-any)))))
($sc-dispatch
- #{tmp\ 1371}#
+ #{tmp\ 1389}#
'(any ((any any)) any . each-any)))))
($sc-dispatch
- #{tmp\ 1371}#
+ #{tmp\ 1389}#
'(any () any . each-any))))
- #{x\ 1370}#))))
+ #{x\ 1388}#))))
(define syntax-rules
(make-syncase-macro
'macro
- (lambda (#{x\ 1393}#)
- ((lambda (#{tmp\ 1394}#)
- ((lambda (#{tmp\ 1395}#)
- (if #{tmp\ 1395}#
- (apply (lambda (#{_\ 1396}#
- #{k\ 1397}#
- #{keyword\ 1398}#
- #{pattern\ 1399}#
- #{template\ 1400}#)
+ (lambda (#{x\ 1411}#)
+ ((lambda (#{tmp\ 1412}#)
+ ((lambda (#{tmp\ 1413}#)
+ (if #{tmp\ 1413}#
+ (apply (lambda (#{_\ 1414}#
+ #{k\ 1415}#
+ #{keyword\ 1416}#
+ #{pattern\ 1417}#
+ #{template\ 1418}#)
(list '#(syntax-object
lambda
((top)
@@ -9364,9 +9490,9 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- (cons #{k\ 1397}#
- (map (lambda (#{tmp\ 1403}#
- #{tmp\ 1402}#)
+ (cons #{k\ 1415}#
+ (map (lambda (#{tmp\ 1421}#
+ #{tmp\ 1420}#)
(list (cons '#(syntax-object
dummy
((top)
@@ -9396,7 +9522,7 @@
#("i")))
(hygiene
guile))
- #{tmp\ 1402}#)
+ #{tmp\ 1420}#)
(list '#(syntax-object
syntax
((top)
@@ -9426,43 +9552,43 @@
#("i")))
(hygiene
guile))
- #{tmp\ 1403}#)))
- #{template\ 1400}#
- #{pattern\ 1399}#))))))
- #{tmp\ 1395}#)
+ #{tmp\ 1421}#)))
+ #{template\ 1418}#
+ #{pattern\ 1417}#))))))
+ #{tmp\ 1413}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1394}#)))
+ #{tmp\ 1412}#)))
($sc-dispatch
- #{tmp\ 1394}#
+ #{tmp\ 1412}#
'(any each-any . #(each ((any . any) any))))))
- #{x\ 1393}#))))
+ #{x\ 1411}#))))
(define let*
(make-extended-syncase-macro
(module-ref (current-module) (quote let*))
'macro
- (lambda (#{x\ 1404}#)
- ((lambda (#{tmp\ 1405}#)
- ((lambda (#{tmp\ 1406}#)
- (if (if #{tmp\ 1406}#
- (apply (lambda (#{let*\ 1407}#
- #{x\ 1408}#
- #{v\ 1409}#
- #{e1\ 1410}#
- #{e2\ 1411}#)
- (and-map identifier? #{x\ 1408}#))
- #{tmp\ 1406}#)
+ (lambda (#{x\ 1422}#)
+ ((lambda (#{tmp\ 1423}#)
+ ((lambda (#{tmp\ 1424}#)
+ (if (if #{tmp\ 1424}#
+ (apply (lambda (#{let*\ 1425}#
+ #{x\ 1426}#
+ #{v\ 1427}#
+ #{e1\ 1428}#
+ #{e2\ 1429}#)
+ (and-map identifier? #{x\ 1426}#))
+ #{tmp\ 1424}#)
#f)
- (apply (lambda (#{let*\ 1413}#
- #{x\ 1414}#
- #{v\ 1415}#
- #{e1\ 1416}#
- #{e2\ 1417}#)
- (letrec ((#{f\ 1418}#
- (lambda (#{bindings\ 1419}#)
- (if (null? #{bindings\ 1419}#)
+ (apply (lambda (#{let*\ 1431}#
+ #{x\ 1432}#
+ #{v\ 1433}#
+ #{e1\ 1434}#
+ #{e2\ 1435}#)
+ (letrec ((#{f\ 1436}#
+ (lambda (#{bindings\ 1437}#)
+ (if (null? #{bindings\ 1437}#)
(cons '#(syntax-object
let
((top)
@@ -9486,13 +9612,13 @@
#("i")))
(hygiene guile))
(cons '()
- (cons #{e1\ 1416}#
- #{e2\ 1417}#)))
- ((lambda (#{tmp\ 1423}#)
- ((lambda (#{tmp\ 1424}#)
- (if #{tmp\ 1424}#
- (apply (lambda (#{body\ 1425}#
- #{binding\ 1426}#)
+ (cons #{e1\ 1434}#
+ #{e2\ 1435}#)))
+ ((lambda (#{tmp\ 1441}#)
+ ((lambda (#{tmp\ 1442}#)
+ (if #{tmp\ 1442}#
+ (apply (lambda (#{body\ 1443}#
+ #{binding\ 1444}#)
(list '#(syntax-object
let
((top)
@@ -9538,52 +9664,52 @@
#("i")))
(hygiene
guile))
- (list #{binding\ 1426}#)
- #{body\ 1425}#))
- #{tmp\ 1424}#)
+ (list #{binding\ 1444}#)
+ #{body\ 1443}#))
+ #{tmp\ 1442}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1423}#)))
+ #{tmp\ 1441}#)))
($sc-dispatch
- #{tmp\ 1423}#
+ #{tmp\ 1441}#
'(any any))))
- (list (#{f\ 1418}#
- (cdr #{bindings\ 1419}#))
- (car #{bindings\ 1419}#)))))))
- (#{f\ 1418}# (map list #{x\ 1414}# #{v\ 1415}#))))
- #{tmp\ 1406}#)
+ (list (#{f\ 1436}#
+ (cdr #{bindings\ 1437}#))
+ (car #{bindings\ 1437}#)))))))
+ (#{f\ 1436}# (map list #{x\ 1432}# #{v\ 1433}#))))
+ #{tmp\ 1424}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1405}#)))
+ #{tmp\ 1423}#)))
($sc-dispatch
- #{tmp\ 1405}#
+ #{tmp\ 1423}#
'(any #(each (any any)) any . each-any))))
- #{x\ 1404}#))))
+ #{x\ 1422}#))))
(define do
(make-extended-syncase-macro
(module-ref (current-module) (quote do))
'macro
- (lambda (#{orig-x\ 1427}#)
- ((lambda (#{tmp\ 1428}#)
- ((lambda (#{tmp\ 1429}#)
- (if #{tmp\ 1429}#
- (apply (lambda (#{_\ 1430}#
- #{var\ 1431}#
- #{init\ 1432}#
- #{step\ 1433}#
- #{e0\ 1434}#
- #{e1\ 1435}#
- #{c\ 1436}#)
- ((lambda (#{tmp\ 1437}#)
- ((lambda (#{tmp\ 1438}#)
- (if #{tmp\ 1438}#
- (apply (lambda (#{step\ 1439}#)
- ((lambda (#{tmp\ 1440}#)
- ((lambda (#{tmp\ 1441}#)
- (if #{tmp\ 1441}#
+ (lambda (#{orig-x\ 1445}#)
+ ((lambda (#{tmp\ 1446}#)
+ ((lambda (#{tmp\ 1447}#)
+ (if #{tmp\ 1447}#
+ (apply (lambda (#{_\ 1448}#
+ #{var\ 1449}#
+ #{init\ 1450}#
+ #{step\ 1451}#
+ #{e0\ 1452}#
+ #{e1\ 1453}#
+ #{c\ 1454}#)
+ ((lambda (#{tmp\ 1455}#)
+ ((lambda (#{tmp\ 1456}#)
+ (if #{tmp\ 1456}#
+ (apply (lambda (#{step\ 1457}#)
+ ((lambda (#{tmp\ 1458}#)
+ ((lambda (#{tmp\ 1459}#)
+ (if #{tmp\ 1459}#
(apply (lambda ()
(list '#(syntax-object
let
@@ -9664,8 +9790,8 @@
(hygiene
guile))
(map list
- #{var\ 1431}#
- #{init\ 1432}#)
+ #{var\ 1449}#
+ #{init\ 1450}#)
(list '#(syntax-object
if
((top)
@@ -9744,7 +9870,7 @@
#("i")))
(hygiene
guile))
- #{e0\ 1434}#)
+ #{e0\ 1452}#)
(cons '#(syntax-object
begin
((top)
@@ -9785,7 +9911,7 @@
(hygiene
guile))
(append
- #{c\ 1436}#
+ #{c\ 1454}#
(list (cons '#(syntax-object
doloop
((top)
@@ -9825,12 +9951,12 @@
#("i")))
(hygiene
guile))
- #{step\ 1439}#)))))))
- #{tmp\ 1441}#)
- ((lambda (#{tmp\ 1446}#)
- (if #{tmp\ 1446}#
- (apply (lambda (#{e1\ 1447}#
- #{e2\ 1448}#)
+ #{step\ 1457}#)))))))
+ #{tmp\ 1459}#)
+ ((lambda (#{tmp\ 1464}#)
+ (if #{tmp\ 1464}#
+ (apply (lambda (#{e1\ 1465}#
+ #{e2\ 1466}#)
(list '#(syntax-object
let
((top)
@@ -9924,8 +10050,8 @@
(hygiene
guile))
(map list
- #{var\ 1431}#
- #{init\ 1432}#)
+ #{var\ 1449}#
+ #{init\ 1450}#)
(list '#(syntax-object
if
((top)
@@ -9972,7 +10098,7 @@
#("i")))
(hygiene
guile))
- #{e0\ 1434}#
+ #{e0\ 1452}#
(cons '#(syntax-object
begin
((top)
@@ -10019,8 +10145,8 @@
#("i")))
(hygiene
guile))
- (cons #{e1\ 1447}#
- #{e2\ 1448}#))
+ (cons #{e1\ 1465}#
+ #{e2\ 1466}#))
(cons '#(syntax-object
begin
((top)
@@ -10068,7 +10194,7 @@
(hygiene
guile))
(append
- #{c\ 1436}#
+ #{c\ 1454}#
(list (cons '#(syntax-object
doloop
((top)
@@ -10115,81 +10241,81 @@
#("i")))
(hygiene
guile))
- #{step\ 1439}#)))))))
- #{tmp\ 1446}#)
+ #{step\ 1457}#)))))))
+ #{tmp\ 1464}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1440}#)))
+ #{tmp\ 1458}#)))
($sc-dispatch
- #{tmp\ 1440}#
+ #{tmp\ 1458}#
'(any . each-any)))))
($sc-dispatch
- #{tmp\ 1440}#
+ #{tmp\ 1458}#
'())))
- #{e1\ 1435}#))
- #{tmp\ 1438}#)
+ #{e1\ 1453}#))
+ #{tmp\ 1456}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1437}#)))
- ($sc-dispatch #{tmp\ 1437}# (quote each-any))))
- (map (lambda (#{v\ 1455}# #{s\ 1456}#)
- ((lambda (#{tmp\ 1457}#)
- ((lambda (#{tmp\ 1458}#)
- (if #{tmp\ 1458}#
- (apply (lambda () #{v\ 1455}#)
- #{tmp\ 1458}#)
- ((lambda (#{tmp\ 1459}#)
- (if #{tmp\ 1459}#
- (apply (lambda (#{e\ 1460}#)
- #{e\ 1460}#)
- #{tmp\ 1459}#)
- ((lambda (#{_\ 1461}#)
+ #{tmp\ 1455}#)))
+ ($sc-dispatch #{tmp\ 1455}# (quote each-any))))
+ (map (lambda (#{v\ 1473}# #{s\ 1474}#)
+ ((lambda (#{tmp\ 1475}#)
+ ((lambda (#{tmp\ 1476}#)
+ (if #{tmp\ 1476}#
+ (apply (lambda () #{v\ 1473}#)
+ #{tmp\ 1476}#)
+ ((lambda (#{tmp\ 1477}#)
+ (if #{tmp\ 1477}#
+ (apply (lambda (#{e\ 1478}#)
+ #{e\ 1478}#)
+ #{tmp\ 1477}#)
+ ((lambda (#{_\ 1479}#)
(syntax-violation
'do
"bad step expression"
- #{orig-x\ 1427}#
- #{s\ 1456}#))
- #{tmp\ 1457}#)))
+ #{orig-x\ 1445}#
+ #{s\ 1474}#))
+ #{tmp\ 1475}#)))
($sc-dispatch
- #{tmp\ 1457}#
+ #{tmp\ 1475}#
'(any)))))
- ($sc-dispatch #{tmp\ 1457}# (quote ()))))
- #{s\ 1456}#))
- #{var\ 1431}#
- #{step\ 1433}#)))
- #{tmp\ 1429}#)
+ ($sc-dispatch #{tmp\ 1475}# (quote ()))))
+ #{s\ 1474}#))
+ #{var\ 1449}#
+ #{step\ 1451}#)))
+ #{tmp\ 1447}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1428}#)))
+ #{tmp\ 1446}#)))
($sc-dispatch
- #{tmp\ 1428}#
+ #{tmp\ 1446}#
'(any #(each (any any . any))
(any . each-any)
.
each-any))))
- #{orig-x\ 1427}#))))
+ #{orig-x\ 1445}#))))
(define quasiquote
(make-extended-syncase-macro
(module-ref (current-module) (quote quasiquote))
'macro
- (letrec ((#{quasicons\ 1464}#
- (lambda (#{x\ 1468}# #{y\ 1469}#)
- ((lambda (#{tmp\ 1470}#)
- ((lambda (#{tmp\ 1471}#)
- (if #{tmp\ 1471}#
- (apply (lambda (#{x\ 1472}# #{y\ 1473}#)
- ((lambda (#{tmp\ 1474}#)
- ((lambda (#{tmp\ 1475}#)
- (if #{tmp\ 1475}#
- (apply (lambda (#{dy\ 1476}#)
- ((lambda (#{tmp\ 1477}#)
- ((lambda (#{tmp\ 1478}#)
- (if #{tmp\ 1478}#
- (apply (lambda (#{dx\ 1479}#)
+ (letrec ((#{quasicons\ 1482}#
+ (lambda (#{x\ 1486}# #{y\ 1487}#)
+ ((lambda (#{tmp\ 1488}#)
+ ((lambda (#{tmp\ 1489}#)
+ (if #{tmp\ 1489}#
+ (apply (lambda (#{x\ 1490}# #{y\ 1491}#)
+ ((lambda (#{tmp\ 1492}#)
+ ((lambda (#{tmp\ 1493}#)
+ (if #{tmp\ 1493}#
+ (apply (lambda (#{dy\ 1494}#)
+ ((lambda (#{tmp\ 1495}#)
+ ((lambda (#{tmp\ 1496}#)
+ (if #{tmp\ 1496}#
+ (apply (lambda (#{dx\ 1497}#)
(list '#(syntax-object
quote
((top)
@@ -10238,11 +10364,11 @@
"i")))
(hygiene
guile))
- (cons #{dx\ 1479}#
- #{dy\ 1476}#)))
- #{tmp\ 1478}#)
- ((lambda (#{_\ 1480}#)
- (if (null? #{dy\ 1476}#)
+ (cons #{dx\ 1497}#
+ #{dy\ 1494}#)))
+ #{tmp\ 1496}#)
+ ((lambda (#{_\ 1498}#)
+ (if (null? #{dy\ 1494}#)
(list '#(syntax-object
list
((top)
@@ -10291,7 +10417,7 @@
"i")))
(hygiene
guile))
- #{x\ 1472}#)
+ #{x\ 1490}#)
(list '#(syntax-object
cons
((top)
@@ -10340,11 +10466,11 @@
"i")))
(hygiene
guile))
- #{x\ 1472}#
- #{y\ 1473}#)))
- #{tmp\ 1477}#)))
+ #{x\ 1490}#
+ #{y\ 1491}#)))
+ #{tmp\ 1495}#)))
($sc-dispatch
- #{tmp\ 1477}#
+ #{tmp\ 1495}#
'(#(free-id
#(syntax-object
quote
@@ -10387,11 +10513,11 @@
(hygiene
guile)))
any))))
- #{x\ 1472}#))
- #{tmp\ 1475}#)
- ((lambda (#{tmp\ 1481}#)
- (if #{tmp\ 1481}#
- (apply (lambda (#{stuff\ 1482}#)
+ #{x\ 1490}#))
+ #{tmp\ 1493}#)
+ ((lambda (#{tmp\ 1499}#)
+ (if #{tmp\ 1499}#
+ (apply (lambda (#{stuff\ 1500}#)
(cons '#(syntax-object
list
((top)
@@ -10432,10 +10558,10 @@
"i")))
(hygiene
guile))
- (cons #{x\ 1472}#
- #{stuff\ 1482}#)))
- #{tmp\ 1481}#)
- ((lambda (#{else\ 1483}#)
+ (cons #{x\ 1490}#
+ #{stuff\ 1500}#)))
+ #{tmp\ 1499}#)
+ ((lambda (#{else\ 1501}#)
(list '#(syntax-object
cons
((top)
@@ -10467,11 +10593,11 @@
"i"
"i")))
(hygiene guile))
- #{x\ 1472}#
- #{y\ 1473}#))
- #{tmp\ 1474}#)))
+ #{x\ 1490}#
+ #{y\ 1491}#))
+ #{tmp\ 1492}#)))
($sc-dispatch
- #{tmp\ 1474}#
+ #{tmp\ 1492}#
'(#(free-id
#(syntax-object
list
@@ -10500,7 +10626,7 @@
.
any)))))
($sc-dispatch
- #{tmp\ 1474}#
+ #{tmp\ 1492}#
'(#(free-id
#(syntax-object
quote
@@ -10524,26 +10650,26 @@
#("i" "i" "i" "i")))
(hygiene guile)))
any))))
- #{y\ 1473}#))
- #{tmp\ 1471}#)
+ #{y\ 1491}#))
+ #{tmp\ 1489}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1470}#)))
- ($sc-dispatch #{tmp\ 1470}# (quote (any any)))))
- (list #{x\ 1468}# #{y\ 1469}#))))
- (#{quasiappend\ 1465}#
- (lambda (#{x\ 1484}# #{y\ 1485}#)
- ((lambda (#{tmp\ 1486}#)
- ((lambda (#{tmp\ 1487}#)
- (if #{tmp\ 1487}#
- (apply (lambda (#{x\ 1488}# #{y\ 1489}#)
- ((lambda (#{tmp\ 1490}#)
- ((lambda (#{tmp\ 1491}#)
- (if #{tmp\ 1491}#
- (apply (lambda () #{x\ 1488}#)
- #{tmp\ 1491}#)
- ((lambda (#{_\ 1492}#)
+ #{tmp\ 1488}#)))
+ ($sc-dispatch #{tmp\ 1488}# (quote (any any)))))
+ (list #{x\ 1486}# #{y\ 1487}#))))
+ (#{quasiappend\ 1483}#
+ (lambda (#{x\ 1502}# #{y\ 1503}#)
+ ((lambda (#{tmp\ 1504}#)
+ ((lambda (#{tmp\ 1505}#)
+ (if #{tmp\ 1505}#
+ (apply (lambda (#{x\ 1506}# #{y\ 1507}#)
+ ((lambda (#{tmp\ 1508}#)
+ ((lambda (#{tmp\ 1509}#)
+ (if #{tmp\ 1509}#
+ (apply (lambda () #{x\ 1506}#)
+ #{tmp\ 1509}#)
+ ((lambda (#{_\ 1510}#)
(list '#(syntax-object
append
((top)
@@ -10572,11 +10698,11 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile))
- #{x\ 1488}#
- #{y\ 1489}#))
- #{tmp\ 1490}#)))
+ #{x\ 1506}#
+ #{y\ 1507}#))
+ #{tmp\ 1508}#)))
($sc-dispatch
- #{tmp\ 1490}#
+ #{tmp\ 1508}#
'(#(free-id
#(syntax-object
quote
@@ -10600,22 +10726,22 @@
#("i" "i" "i" "i")))
(hygiene guile)))
()))))
- #{y\ 1489}#))
- #{tmp\ 1487}#)
+ #{y\ 1507}#))
+ #{tmp\ 1505}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1486}#)))
- ($sc-dispatch #{tmp\ 1486}# (quote (any any)))))
- (list #{x\ 1484}# #{y\ 1485}#))))
- (#{quasivector\ 1466}#
- (lambda (#{x\ 1493}#)
- ((lambda (#{tmp\ 1494}#)
- ((lambda (#{x\ 1495}#)
- ((lambda (#{tmp\ 1496}#)
- ((lambda (#{tmp\ 1497}#)
- (if #{tmp\ 1497}#
- (apply (lambda (#{x\ 1498}#)
+ #{tmp\ 1504}#)))
+ ($sc-dispatch #{tmp\ 1504}# (quote (any any)))))
+ (list #{x\ 1502}# #{y\ 1503}#))))
+ (#{quasivector\ 1484}#
+ (lambda (#{x\ 1511}#)
+ ((lambda (#{tmp\ 1512}#)
+ ((lambda (#{x\ 1513}#)
+ ((lambda (#{tmp\ 1514}#)
+ ((lambda (#{tmp\ 1515}#)
+ (if #{tmp\ 1515}#
+ (apply (lambda (#{x\ 1516}#)
(list '#(syntax-object
quote
((top)
@@ -10641,11 +10767,11 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- (list->vector #{x\ 1498}#)))
- #{tmp\ 1497}#)
- ((lambda (#{tmp\ 1500}#)
- (if #{tmp\ 1500}#
- (apply (lambda (#{x\ 1501}#)
+ (list->vector #{x\ 1516}#)))
+ #{tmp\ 1515}#)
+ ((lambda (#{tmp\ 1518}#)
+ (if #{tmp\ 1518}#
+ (apply (lambda (#{x\ 1519}#)
(cons '#(syntax-object
vector
((top)
@@ -10674,9 +10800,9 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile))
- #{x\ 1501}#))
- #{tmp\ 1500}#)
- ((lambda (#{_\ 1503}#)
+ #{x\ 1519}#))
+ #{tmp\ 1518}#)
+ ((lambda (#{_\ 1521}#)
(list '#(syntax-object
list->vector
((top)
@@ -10702,10 +10828,10 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- #{x\ 1495}#))
- #{tmp\ 1496}#)))
+ #{x\ 1513}#))
+ #{tmp\ 1514}#)))
($sc-dispatch
- #{tmp\ 1496}#
+ #{tmp\ 1514}#
'(#(free-id
#(syntax-object
list
@@ -10725,7 +10851,7 @@
.
each-any)))))
($sc-dispatch
- #{tmp\ 1496}#
+ #{tmp\ 1514}#
'(#(free-id
#(syntax-object
quote
@@ -10743,18 +10869,18 @@
#("i" "i" "i" "i")))
(hygiene guile)))
each-any))))
- #{x\ 1495}#))
- #{tmp\ 1494}#))
- #{x\ 1493}#)))
- (#{quasi\ 1467}#
- (lambda (#{p\ 1504}# #{lev\ 1505}#)
- ((lambda (#{tmp\ 1506}#)
- ((lambda (#{tmp\ 1507}#)
- (if #{tmp\ 1507}#
- (apply (lambda (#{p\ 1508}#)
- (if (= #{lev\ 1505}# 0)
- #{p\ 1508}#
- (#{quasicons\ 1464}#
+ #{x\ 1513}#))
+ #{tmp\ 1512}#))
+ #{x\ 1511}#)))
+ (#{quasi\ 1485}#
+ (lambda (#{p\ 1522}# #{lev\ 1523}#)
+ ((lambda (#{tmp\ 1524}#)
+ ((lambda (#{tmp\ 1525}#)
+ (if #{tmp\ 1525}#
+ (apply (lambda (#{p\ 1526}#)
+ (if (= #{lev\ 1523}# 0)
+ #{p\ 1526}#
+ (#{quasicons\ 1482}#
'(#(syntax-object
quote
((top)
@@ -10789,21 +10915,21 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile)))
- (#{quasi\ 1467}#
- (list #{p\ 1508}#)
- (- #{lev\ 1505}# 1)))))
- #{tmp\ 1507}#)
- ((lambda (#{tmp\ 1509}#)
- (if (if #{tmp\ 1509}#
- (apply (lambda (#{args\ 1510}#)
- (= #{lev\ 1505}# 0))
- #{tmp\ 1509}#)
+ (#{quasi\ 1485}#
+ (list #{p\ 1526}#)
+ (- #{lev\ 1523}# 1)))))
+ #{tmp\ 1525}#)
+ ((lambda (#{tmp\ 1527}#)
+ (if (if #{tmp\ 1527}#
+ (apply (lambda (#{args\ 1528}#)
+ (= #{lev\ 1523}# 0))
+ #{tmp\ 1527}#)
#f)
- (apply (lambda (#{args\ 1511}#)
+ (apply (lambda (#{args\ 1529}#)
(syntax-violation
'unquote
"unquote takes exactly one argument"
- #{p\ 1504}#
+ #{p\ 1522}#
(cons '#(syntax-object
unquote
((top)
@@ -10824,19 +10950,19 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- #{args\ 1511}#)))
- #{tmp\ 1509}#)
- ((lambda (#{tmp\ 1512}#)
- (if #{tmp\ 1512}#
- (apply (lambda (#{p\ 1513}# #{q\ 1514}#)
- (if (= #{lev\ 1505}# 0)
- (#{quasiappend\ 1465}#
- #{p\ 1513}#
- (#{quasi\ 1467}#
- #{q\ 1514}#
- #{lev\ 1505}#))
- (#{quasicons\ 1464}#
- (#{quasicons\ 1464}#
+ #{args\ 1529}#)))
+ #{tmp\ 1527}#)
+ ((lambda (#{tmp\ 1530}#)
+ (if #{tmp\ 1530}#
+ (apply (lambda (#{p\ 1531}# #{q\ 1532}#)
+ (if (= #{lev\ 1523}# 0)
+ (#{quasiappend\ 1483}#
+ #{p\ 1531}#
+ (#{quasi\ 1485}#
+ #{q\ 1532}#
+ #{lev\ 1523}#))
+ (#{quasicons\ 1482}#
+ (#{quasicons\ 1482}#
'(#(syntax-object
quote
((top)
@@ -10883,26 +11009,26 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile)))
- (#{quasi\ 1467}#
- (list #{p\ 1513}#)
- (- #{lev\ 1505}# 1)))
- (#{quasi\ 1467}#
- #{q\ 1514}#
- #{lev\ 1505}#))))
- #{tmp\ 1512}#)
- ((lambda (#{tmp\ 1515}#)
- (if (if #{tmp\ 1515}#
- (apply (lambda (#{args\ 1516}#
- #{q\ 1517}#)
- (= #{lev\ 1505}# 0))
- #{tmp\ 1515}#)
+ (#{quasi\ 1485}#
+ (list #{p\ 1531}#)
+ (- #{lev\ 1523}# 1)))
+ (#{quasi\ 1485}#
+ #{q\ 1532}#
+ #{lev\ 1523}#))))
+ #{tmp\ 1530}#)
+ ((lambda (#{tmp\ 1533}#)
+ (if (if #{tmp\ 1533}#
+ (apply (lambda (#{args\ 1534}#
+ #{q\ 1535}#)
+ (= #{lev\ 1523}# 0))
+ #{tmp\ 1533}#)
#f)
- (apply (lambda (#{args\ 1518}#
- #{q\ 1519}#)
+ (apply (lambda (#{args\ 1536}#
+ #{q\ 1537}#)
(syntax-violation
'unquote-splicing
"unquote-splicing takes exactly one argument"
- #{p\ 1504}#
+ #{p\ 1522}#
(cons '#(syntax-object
unquote-splicing
((top)
@@ -10932,12 +11058,12 @@
"i"
"i")))
(hygiene guile))
- #{args\ 1518}#)))
- #{tmp\ 1515}#)
- ((lambda (#{tmp\ 1520}#)
- (if #{tmp\ 1520}#
- (apply (lambda (#{p\ 1521}#)
- (#{quasicons\ 1464}#
+ #{args\ 1536}#)))
+ #{tmp\ 1533}#)
+ ((lambda (#{tmp\ 1538}#)
+ (if #{tmp\ 1538}#
+ (apply (lambda (#{p\ 1539}#)
+ (#{quasicons\ 1482}#
'(#(syntax-object
quote
((top)
@@ -10996,32 +11122,32 @@
"i"
"i")))
(hygiene guile)))
- (#{quasi\ 1467}#
- (list #{p\ 1521}#)
- (+ #{lev\ 1505}#
+ (#{quasi\ 1485}#
+ (list #{p\ 1539}#)
+ (+ #{lev\ 1523}#
1))))
- #{tmp\ 1520}#)
- ((lambda (#{tmp\ 1522}#)
- (if #{tmp\ 1522}#
- (apply (lambda (#{p\ 1523}#
- #{q\ 1524}#)
- (#{quasicons\ 1464}#
- (#{quasi\ 1467}#
- #{p\ 1523}#
- #{lev\ 1505}#)
- (#{quasi\ 1467}#
- #{q\ 1524}#
- #{lev\ 1505}#)))
- #{tmp\ 1522}#)
- ((lambda (#{tmp\ 1525}#)
- (if #{tmp\ 1525}#
- (apply (lambda (#{x\ 1526}#)
- (#{quasivector\ 1466}#
- (#{quasi\ 1467}#
- #{x\ 1526}#
- #{lev\ 1505}#)))
- #{tmp\ 1525}#)
- ((lambda (#{p\ 1528}#)
+ #{tmp\ 1538}#)
+ ((lambda (#{tmp\ 1540}#)
+ (if #{tmp\ 1540}#
+ (apply (lambda (#{p\ 1541}#
+ #{q\ 1542}#)
+ (#{quasicons\ 1482}#
+ (#{quasi\ 1485}#
+ #{p\ 1541}#
+ #{lev\ 1523}#)
+ (#{quasi\ 1485}#
+ #{q\ 1542}#
+ #{lev\ 1523}#)))
+ #{tmp\ 1540}#)
+ ((lambda (#{tmp\ 1543}#)
+ (if #{tmp\ 1543}#
+ (apply (lambda (#{x\ 1544}#)
+ (#{quasivector\ 1484}#
+ (#{quasi\ 1485}#
+ #{x\ 1544}#
+ #{lev\ 1523}#)))
+ #{tmp\ 1543}#)
+ ((lambda (#{p\ 1546}#)
(list '#(syntax-object
quote
((top)
@@ -11054,16 +11180,16 @@
"i")))
(hygiene
guile))
- #{p\ 1528}#))
- #{tmp\ 1506}#)))
+ #{p\ 1546}#))
+ #{tmp\ 1524}#)))
($sc-dispatch
- #{tmp\ 1506}#
+ #{tmp\ 1524}#
'#(vector each-any)))))
($sc-dispatch
- #{tmp\ 1506}#
+ #{tmp\ 1524}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 1506}#
+ #{tmp\ 1524}#
'(#(free-id
#(syntax-object
quasiquote
@@ -11083,7 +11209,7 @@
(hygiene guile)))
any)))))
($sc-dispatch
- #{tmp\ 1506}#
+ #{tmp\ 1524}#
'((#(free-id
#(syntax-object
unquote-splicing
@@ -11106,7 +11232,7 @@
.
any)))))
($sc-dispatch
- #{tmp\ 1506}#
+ #{tmp\ 1524}#
'((#(free-id
#(syntax-object
unquote-splicing
@@ -11128,7 +11254,7 @@
.
any)))))
($sc-dispatch
- #{tmp\ 1506}#
+ #{tmp\ 1524}#
'(#(free-id
#(syntax-object
unquote
@@ -11146,7 +11272,7 @@
.
any)))))
($sc-dispatch
- #{tmp\ 1506}#
+ #{tmp\ 1524}#
'(#(free-id
#(syntax-object
unquote
@@ -11159,49 +11285,49 @@
#("i" "i" "i" "i")))
(hygiene guile)))
any))))
- #{p\ 1504}#))))
- (lambda (#{x\ 1529}#)
- ((lambda (#{tmp\ 1530}#)
- ((lambda (#{tmp\ 1531}#)
- (if #{tmp\ 1531}#
- (apply (lambda (#{_\ 1532}# #{e\ 1533}#)
- (#{quasi\ 1467}# #{e\ 1533}# 0))
- #{tmp\ 1531}#)
+ #{p\ 1522}#))))
+ (lambda (#{x\ 1547}#)
+ ((lambda (#{tmp\ 1548}#)
+ ((lambda (#{tmp\ 1549}#)
+ (if #{tmp\ 1549}#
+ (apply (lambda (#{_\ 1550}# #{e\ 1551}#)
+ (#{quasi\ 1485}# #{e\ 1551}# 0))
+ #{tmp\ 1549}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1530}#)))
- ($sc-dispatch #{tmp\ 1530}# (quote (any any)))))
- #{x\ 1529}#)))))
+ #{tmp\ 1548}#)))
+ ($sc-dispatch #{tmp\ 1548}# (quote (any any)))))
+ #{x\ 1547}#)))))
(define include
(make-syncase-macro
'macro
- (lambda (#{x\ 1534}#)
- (letrec ((#{read-file\ 1535}#
- (lambda (#{fn\ 1536}# #{k\ 1537}#)
- (let ((#{p\ 1538}# (open-input-file #{fn\ 1536}#)))
- (letrec ((#{f\ 1539}#
- (lambda (#{x\ 1540}#)
- (if (eof-object? #{x\ 1540}#)
+ (lambda (#{x\ 1552}#)
+ (letrec ((#{read-file\ 1553}#
+ (lambda (#{fn\ 1554}# #{k\ 1555}#)
+ (let ((#{p\ 1556}# (open-input-file #{fn\ 1554}#)))
+ (letrec ((#{f\ 1557}#
+ (lambda (#{x\ 1558}#)
+ (if (eof-object? #{x\ 1558}#)
(begin
- (close-input-port #{p\ 1538}#)
+ (close-input-port #{p\ 1556}#)
'())
(cons (datum->syntax
- #{k\ 1537}#
- #{x\ 1540}#)
- (#{f\ 1539}# (read #{p\ 1538}#)))))))
- (#{f\ 1539}# (read #{p\ 1538}#)))))))
- ((lambda (#{tmp\ 1541}#)
- ((lambda (#{tmp\ 1542}#)
- (if #{tmp\ 1542}#
- (apply (lambda (#{k\ 1543}# #{filename\ 1544}#)
- (let ((#{fn\ 1545}#
- (syntax->datum #{filename\ 1544}#)))
- ((lambda (#{tmp\ 1546}#)
- ((lambda (#{tmp\ 1547}#)
- (if #{tmp\ 1547}#
- (apply (lambda (#{exp\ 1548}#)
+ #{k\ 1555}#
+ #{x\ 1558}#)
+ (#{f\ 1557}# (read #{p\ 1556}#)))))))
+ (#{f\ 1557}# (read #{p\ 1556}#)))))))
+ ((lambda (#{tmp\ 1559}#)
+ ((lambda (#{tmp\ 1560}#)
+ (if #{tmp\ 1560}#
+ (apply (lambda (#{k\ 1561}# #{filename\ 1562}#)
+ (let ((#{fn\ 1563}#
+ (syntax->datum #{filename\ 1562}#)))
+ ((lambda (#{tmp\ 1564}#)
+ ((lambda (#{tmp\ 1565}#)
+ (if #{tmp\ 1565}#
+ (apply (lambda (#{exp\ 1566}#)
(cons '#(syntax-object
begin
((top)
@@ -11228,76 +11354,76 @@
#((top))
#("i")))
(hygiene guile))
- #{exp\ 1548}#))
- #{tmp\ 1547}#)
+ #{exp\ 1566}#))
+ #{tmp\ 1565}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1546}#)))
- ($sc-dispatch #{tmp\ 1546}# (quote each-any))))
- (#{read-file\ 1535}# #{fn\ 1545}# #{k\ 1543}#))))
- #{tmp\ 1542}#)
+ #{tmp\ 1564}#)))
+ ($sc-dispatch #{tmp\ 1564}# (quote each-any))))
+ (#{read-file\ 1553}# #{fn\ 1563}# #{k\ 1561}#))))
+ #{tmp\ 1560}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1541}#)))
- ($sc-dispatch #{tmp\ 1541}# (quote (any any)))))
- #{x\ 1534}#)))))
+ #{tmp\ 1559}#)))
+ ($sc-dispatch #{tmp\ 1559}# (quote (any any)))))
+ #{x\ 1552}#)))))
(define unquote
(make-syncase-macro
'macro
- (lambda (#{x\ 1550}#)
- ((lambda (#{tmp\ 1551}#)
- ((lambda (#{tmp\ 1552}#)
- (if #{tmp\ 1552}#
- (apply (lambda (#{_\ 1553}# #{e\ 1554}#)
+ (lambda (#{x\ 1568}#)
+ ((lambda (#{tmp\ 1569}#)
+ ((lambda (#{tmp\ 1570}#)
+ (if #{tmp\ 1570}#
+ (apply (lambda (#{_\ 1571}# #{e\ 1572}#)
(syntax-violation
'unquote
"expression not valid outside of quasiquote"
- #{x\ 1550}#))
- #{tmp\ 1552}#)
+ #{x\ 1568}#))
+ #{tmp\ 1570}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1551}#)))
- ($sc-dispatch #{tmp\ 1551}# (quote (any any)))))
- #{x\ 1550}#))))
+ #{tmp\ 1569}#)))
+ ($sc-dispatch #{tmp\ 1569}# (quote (any any)))))
+ #{x\ 1568}#))))
(define unquote-splicing
(make-syncase-macro
'macro
- (lambda (#{x\ 1555}#)
- ((lambda (#{tmp\ 1556}#)
- ((lambda (#{tmp\ 1557}#)
- (if #{tmp\ 1557}#
- (apply (lambda (#{_\ 1558}# #{e\ 1559}#)
+ (lambda (#{x\ 1573}#)
+ ((lambda (#{tmp\ 1574}#)
+ ((lambda (#{tmp\ 1575}#)
+ (if #{tmp\ 1575}#
+ (apply (lambda (#{_\ 1576}# #{e\ 1577}#)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
- #{x\ 1555}#))
- #{tmp\ 1557}#)
+ #{x\ 1573}#))
+ #{tmp\ 1575}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1556}#)))
- ($sc-dispatch #{tmp\ 1556}# (quote (any any)))))
- #{x\ 1555}#))))
+ #{tmp\ 1574}#)))
+ ($sc-dispatch #{tmp\ 1574}# (quote (any any)))))
+ #{x\ 1573}#))))
(define case
(make-extended-syncase-macro
(module-ref (current-module) (quote case))
'macro
- (lambda (#{x\ 1560}#)
- ((lambda (#{tmp\ 1561}#)
- ((lambda (#{tmp\ 1562}#)
- (if #{tmp\ 1562}#
- (apply (lambda (#{_\ 1563}#
- #{e\ 1564}#
- #{m1\ 1565}#
- #{m2\ 1566}#)
- ((lambda (#{tmp\ 1567}#)
- ((lambda (#{body\ 1568}#)
+ (lambda (#{x\ 1578}#)
+ ((lambda (#{tmp\ 1579}#)
+ ((lambda (#{tmp\ 1580}#)
+ (if #{tmp\ 1580}#
+ (apply (lambda (#{_\ 1581}#
+ #{e\ 1582}#
+ #{m1\ 1583}#
+ #{m2\ 1584}#)
+ ((lambda (#{tmp\ 1585}#)
+ ((lambda (#{body\ 1586}#)
(list '#(syntax-object
let
((top)
@@ -11326,17 +11452,17 @@
#((top))
#("i")))
(hygiene guile))
- #{e\ 1564}#))
- #{body\ 1568}#))
- #{tmp\ 1567}#))
- (letrec ((#{f\ 1569}#
- (lambda (#{clause\ 1570}# #{clauses\ 1571}#)
- (if (null? #{clauses\ 1571}#)
- ((lambda (#{tmp\ 1573}#)
- ((lambda (#{tmp\ 1574}#)
- (if #{tmp\ 1574}#
- (apply (lambda (#{e1\ 1575}#
- #{e2\ 1576}#)
+ #{e\ 1582}#))
+ #{body\ 1586}#))
+ #{tmp\ 1585}#))
+ (letrec ((#{f\ 1587}#
+ (lambda (#{clause\ 1588}# #{clauses\ 1589}#)
+ (if (null? #{clauses\ 1589}#)
+ ((lambda (#{tmp\ 1591}#)
+ ((lambda (#{tmp\ 1592}#)
+ (if #{tmp\ 1592}#
+ (apply (lambda (#{e1\ 1593}#
+ #{e2\ 1594}#)
(cons '#(syntax-object
begin
((top)
@@ -11382,14 +11508,14 @@
#("i")))
(hygiene
guile))
- (cons #{e1\ 1575}#
- #{e2\ 1576}#)))
- #{tmp\ 1574}#)
- ((lambda (#{tmp\ 1578}#)
- (if #{tmp\ 1578}#
- (apply (lambda (#{k\ 1579}#
- #{e1\ 1580}#
- #{e2\ 1581}#)
+ (cons #{e1\ 1593}#
+ #{e2\ 1594}#)))
+ #{tmp\ 1592}#)
+ ((lambda (#{tmp\ 1596}#)
+ (if #{tmp\ 1596}#
+ (apply (lambda (#{k\ 1597}#
+ #{e1\ 1598}#
+ #{e2\ 1599}#)
(list '#(syntax-object
if
((top)
@@ -11590,7 +11716,7 @@
#("i")))
(hygiene
guile))
- #{k\ 1579}#))
+ #{k\ 1597}#))
(cons '#(syntax-object
begin
((top)
@@ -11641,24 +11767,24 @@
#("i")))
(hygiene
guile))
- (cons #{e1\ 1580}#
- #{e2\ 1581}#))))
- #{tmp\ 1578}#)
- ((lambda (#{_\ 1584}#)
+ (cons #{e1\ 1598}#
+ #{e2\ 1599}#))))
+ #{tmp\ 1596}#)
+ ((lambda (#{_\ 1602}#)
(syntax-violation
'case
"bad clause"
- #{x\ 1560}#
- #{clause\ 1570}#))
- #{tmp\ 1573}#)))
+ #{x\ 1578}#
+ #{clause\ 1588}#))
+ #{tmp\ 1591}#)))
($sc-dispatch
- #{tmp\ 1573}#
+ #{tmp\ 1591}#
'(each-any
any
.
each-any)))))
($sc-dispatch
- #{tmp\ 1573}#
+ #{tmp\ 1591}#
'(#(free-id
#(syntax-object
else
@@ -11684,15 +11810,15 @@
any
.
each-any))))
- #{clause\ 1570}#)
- ((lambda (#{tmp\ 1585}#)
- ((lambda (#{rest\ 1586}#)
- ((lambda (#{tmp\ 1587}#)
- ((lambda (#{tmp\ 1588}#)
- (if #{tmp\ 1588}#
- (apply (lambda (#{k\ 1589}#
- #{e1\ 1590}#
- #{e2\ 1591}#)
+ #{clause\ 1588}#)
+ ((lambda (#{tmp\ 1603}#)
+ ((lambda (#{rest\ 1604}#)
+ ((lambda (#{tmp\ 1605}#)
+ ((lambda (#{tmp\ 1606}#)
+ (if #{tmp\ 1606}#
+ (apply (lambda (#{k\ 1607}#
+ #{e1\ 1608}#
+ #{e2\ 1609}#)
(list '#(syntax-object
if
((top)
@@ -11909,7 +12035,7 @@
#("i")))
(hygiene
guile))
- #{k\ 1589}#))
+ #{k\ 1607}#))
(cons '#(syntax-object
begin
((top)
@@ -11964,47 +12090,47 @@
#("i")))
(hygiene
guile))
- (cons #{e1\ 1590}#
- #{e2\ 1591}#))
- #{rest\ 1586}#))
- #{tmp\ 1588}#)
- ((lambda (#{_\ 1594}#)
+ (cons #{e1\ 1608}#
+ #{e2\ 1609}#))
+ #{rest\ 1604}#))
+ #{tmp\ 1606}#)
+ ((lambda (#{_\ 1612}#)
(syntax-violation
'case
"bad clause"
- #{x\ 1560}#
- #{clause\ 1570}#))
- #{tmp\ 1587}#)))
+ #{x\ 1578}#
+ #{clause\ 1588}#))
+ #{tmp\ 1605}#)))
($sc-dispatch
- #{tmp\ 1587}#
+ #{tmp\ 1605}#
'(each-any
any
.
each-any))))
- #{clause\ 1570}#))
- #{tmp\ 1585}#))
- (#{f\ 1569}#
- (car #{clauses\ 1571}#)
- (cdr #{clauses\ 1571}#)))))))
- (#{f\ 1569}# #{m1\ 1565}# #{m2\ 1566}#))))
- #{tmp\ 1562}#)
+ #{clause\ 1588}#))
+ #{tmp\ 1603}#))
+ (#{f\ 1587}#
+ (car #{clauses\ 1589}#)
+ (cdr #{clauses\ 1589}#)))))))
+ (#{f\ 1587}# #{m1\ 1583}# #{m2\ 1584}#))))
+ #{tmp\ 1580}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1561}#)))
+ #{tmp\ 1579}#)))
($sc-dispatch
- #{tmp\ 1561}#
+ #{tmp\ 1579}#
'(any any any . each-any))))
- #{x\ 1560}#))))
+ #{x\ 1578}#))))
(define identifier-syntax
(make-syncase-macro
'macro
- (lambda (#{x\ 1595}#)
- ((lambda (#{tmp\ 1596}#)
- ((lambda (#{tmp\ 1597}#)
- (if #{tmp\ 1597}#
- (apply (lambda (#{_\ 1598}# #{e\ 1599}#)
+ (lambda (#{x\ 1613}#)
+ ((lambda (#{tmp\ 1614}#)
+ ((lambda (#{tmp\ 1615}#)
+ (if #{tmp\ 1615}#
+ (apply (lambda (#{_\ 1616}# #{e\ 1617}#)
(list '#(syntax-object
lambda
((top)
@@ -12093,8 +12219,8 @@
#((top))
#("i")))
(hygiene guile))
- #{e\ 1599}#))
- (list (cons #{_\ 1598}#
+ #{e\ 1617}#))
+ (list (cons #{_\ 1616}#
'(#(syntax-object
x
((top)
@@ -12134,7 +12260,7 @@
#((top))
#("i")))
(hygiene guile))
- (cons #{e\ 1599}#
+ (cons #{e\ 1617}#
'(#(syntax-object
x
((top)
@@ -12162,11 +12288,11 @@
#("i")))
(hygiene
guile)))))))))
- #{tmp\ 1597}#)
+ #{tmp\ 1615}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1596}#)))
- ($sc-dispatch #{tmp\ 1596}# (quote (any any)))))
- #{x\ 1595}#))))
+ #{tmp\ 1614}#)))
+ ($sc-dispatch #{tmp\ 1614}# (quote (any any)))))
+ #{x\ 1613}#))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 1b5adddd0..10f39c160 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -448,17 +448,66 @@
((@ (language tree-il) make-toplevel-define) source var exp))
(else (decorate-source `(define ,var ,exp) source)))))
-(define build-lambda
- (lambda (src ids vars docstring exp)
+;; Ideally we would have all lambdas be case lambdas, but that would
+;; need special support in the interpreter for the full capabilities of
+;; case-lambda, with optional and keyword args, predicates, and else
+;; clauses. This will come with the new interpreter, but for now we
+;; separate the cases.
+(define build-simple-lambda
+ (lambda (src req rest vars docstring exp)
(case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-lambda) src ids vars
+ ((c) ((@ (language tree-il) make-lambda) src
(if docstring `((documentation . ,docstring)) '())
- exp))
+ ;; hah, a case in which kwargs would be nice.
+ ((@ (language tree-il) make-lambda-case)
+ ;; src req opt rest kw vars predicate body else
+ src req #f rest #f vars #f exp #f)))
(else (decorate-source
- `(lambda ,vars ,@(if docstring (list docstring) '())
- ,exp)
+ `(lambda ,(if rest (apply cons* vars) vars)
+ ,@(if docstring (list docstring) '())
+ ,exp)
src)))))
+(define build-case-lambda
+ (lambda (src docstring body)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-lambda) src
+ (if docstring `((documentation . ,docstring)) '())
+ body))
+ (else (decorate-source
+ ;; really gross hack
+ `(lambda %%args
+ ,@(if docstring (list docstring) '())
+ (cond ,@body))
+ src)))))
+
+(define build-lambda-case
+ ;; kw: ((keyword var init) ...)
+ (lambda (src req opt rest kw vars predicate body else-case)
+ (case (fluid-ref *mode*)
+ ((c)
+ ((@ (language tree-il) make-lambda-case)
+ src req opt rest kw vars predicate body else-case))
+ (else
+ (let ((nkw (map (lambda (x)
+ `(list ,(car x)
+ ;; grr
+ ,(let lp ((vars vars) (i 0))
+ (cond ((null? vars) (error "bad kwarg" x))
+ ((eq? (cadr x) (car vars)) i)
+ (else (lp (cdr vars) (1+ i)))))
+ (lambda () ,(caddr x))))
+ kw)))
+ (decorate-source
+ `((((@@ (ice-9 optargs) parse-lambda-case)
+ (list ,(length req) ,(length opt) ,(and rest #t) ,nkw
+ ,(if predicate (error "not yet implemented") #f))
+ %%args)
+ => (lambda ,vars ,body))
+ ,@(or else-case
+ `((%%args (error "wrong number of arguments" %%args)))))
+ src))))))
+
(define build-primref
(lambda (src name)
(if (equal? (module-name (current-module)) '(guile))
@@ -506,7 +555,7 @@
(ids (cdr ids)))
(case (fluid-ref *mode*)
((c)
- (let ((proc (build-lambda src ids vars #f body-exp)))
+ (let ((proc (build-simple-lambda src ids #f vars #f body-exp)))
(maybe-name-value! f-name proc)
(for-each maybe-name-value! ids val-exps)
((@ (language tree-il) make-letrec) src
@@ -1455,48 +1504,6 @@
(cons (cons er (source-wrap e w s mod))
(cdr body)))))))))))))))))
-(define chi-lambda-clause
- (lambda (e docstring c r w mod k)
- (syntax-case c ()
- ((args doc e1 e2 ...)
- (and (string? (syntax->datum (syntax doc))) (not docstring))
- (chi-lambda-clause e (syntax doc) (syntax (args e1 e2 ...)) r w mod k))
- (((id ...) e1 e2 ...)
- (let ((ids (syntax (id ...))))
- (if (not (valid-bound-ids? ids))
- (syntax-violation 'lambda "invalid parameter list" e)
- (let ((labels (gen-labels ids))
- (new-vars (map gen-var ids)))
- (k (map syntax->datum ids)
- new-vars
- (and docstring (syntax->datum docstring))
- (chi-body (syntax (e1 e2 ...))
- e
- (extend-var-env labels new-vars r)
- (make-binding-wrap ids labels w)
- mod))))))
- ((ids e1 e2 ...)
- (let ((old-ids (lambda-var-list (syntax ids))))
- (if (not (valid-bound-ids? old-ids))
- (syntax-violation 'lambda "invalid parameter list" e)
- (let ((labels (gen-labels old-ids))
- (new-vars (map gen-var old-ids)))
- (k (let f ((ls1 (cdr old-ids)) (ls2 (car old-ids)))
- (if (null? ls1)
- (syntax->datum ls2)
- (f (cdr ls1) (cons (syntax->datum (car ls1)) ls2))))
- (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
- (if (null? ls1)
- ls2
- (f (cdr ls1) (cons (car ls1) ls2))))
- (and docstring (syntax->datum docstring))
- (chi-body (syntax (e1 e2 ...))
- e
- (extend-var-env labels new-vars r)
- (make-binding-wrap old-ids labels w)
- mod))))))
- (_ (syntax-violation 'lambda "bad lambda" e)))))
-
(define chi-local-syntax
(lambda (rec? e r w s mod k)
(syntax-case e ()
@@ -1574,6 +1581,7 @@
(let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
(build-lexical-var no-source id))))
+;; appears to return a reversed list
(define lambda-var-list
(lambda (vars)
(let lvl ((vars vars) (ls '()) (w empty-wrap))
@@ -1777,7 +1785,10 @@
((ref) (build-lexical-reference 'value no-source (cadr x) (cadr x)))
((primitive) (build-primref no-source (cadr x)))
((quote) (build-data no-source (cadr x)))
- ((lambda) (build-lambda no-source (cadr x) (cadr x) #f (regen (caddr x))))
+ ((lambda)
+ (if (list? (cadr x))
+ (build-simple-lambda no-source (cadr x) #f (cadr x) #f (regen (caddr x)))
+ (error "how did we get here" x)))
(else (build-application no-source
(build-primref no-source (car x))
(map regen (cdr x)))))))
@@ -1794,11 +1805,55 @@
(global-extend 'core 'lambda
(lambda (e r w s mod)
- (syntax-case e ()
- ((_ . c)
- (chi-lambda-clause (source-wrap e w s mod) #f (syntax c) r w mod
- (lambda (names vars docstring body)
- (build-lambda s names vars docstring body)))))))
+ (define (docstring&body ids vars labels c)
+ (syntax-case c ()
+ ((docstring e1 e2 ...)
+ (string? (syntax->datum (syntax docstring)))
+ (values (syntax->datum (syntax docstring))
+ (chi-body (syntax (e1 e2 ...))
+ (source-wrap e w s mod)
+ (extend-var-env labels vars r)
+ (make-binding-wrap ids labels w)
+ mod)))
+ ((e1 e2 ...)
+ (values #f
+ (chi-body (syntax (e1 e2 ...))
+ (source-wrap e w s mod)
+ (extend-var-env labels vars r)
+ (make-binding-wrap ids labels w)
+ mod)))))
+ (syntax-case e ()
+ ((_ (id ...) e1 e2 ...)
+ (let ((ids (syntax (id ...))))
+ (if (not (valid-bound-ids? ids))
+ (syntax-violation 'lambda "invalid parameter list" e)
+ (let ((vars (map gen-var ids))
+ (labels (gen-labels ids)))
+ (call-with-values
+ (lambda ()
+ (docstring&body ids vars labels
+ (syntax (e1 e2 ...))))
+ (lambda (docstring body)
+ (build-simple-lambda s (map syntax->datum ids) #f
+ vars docstring body)))))))
+ ((_ ids e1 e2 ...)
+ (let ((rids (lambda-var-list (syntax ids))))
+ (if (not (valid-bound-ids? rids))
+ (syntax-violation 'lambda "invalid parameter list" e)
+ (let* ((req (reverse (cdr rids)))
+ (rest (car rids))
+ (rrids (reverse rids))
+ (vars (map gen-var rrids))
+ (labels (gen-labels rrids)))
+ (call-with-values
+ (lambda ()
+ (docstring&body rrids vars labels
+ (syntax (e1 e2 ...))))
+ (lambda (docstring body)
+ (build-simple-lambda s (map syntax->datum req)
+ (syntax->datum rest)
+ vars docstring body)))))))
+ (_ (syntax-violation 'lambda "bad lambda" e)))))
(global-extend 'core 'let
@@ -1975,7 +2030,7 @@
(let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
(build-application no-source
(build-primref no-source 'apply)
- (list (build-lambda no-source (map syntax->datum ids) new-vars #f
+ (list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars #f
(chi exp
(extend-env
labels
@@ -2002,7 +2057,7 @@
(let ((y (gen-var 'tmp)))
; fat finger binding and references to temp variable y
(build-application no-source
- (build-lambda no-source (list 'tmp) (list y) #f
+ (build-simple-lambda no-source (list 'tmp) #f (list y) #f
(let ((y (build-lexical-reference 'value no-source
'tmp y)))
(build-conditional no-source
@@ -2039,16 +2094,16 @@
(let ((labels (list (gen-label)))
(var (gen-var (syntax pat))))
(build-application no-source
- (build-lambda no-source
- (list (syntax->datum (syntax pat))) (list var)
- #f
- (chi (syntax exp)
- (extend-env labels
- (list (make-binding 'syntax `(,var . 0)))
- r)
- (make-binding-wrap (syntax (pat))
- labels empty-wrap)
- mod))
+ (build-simple-lambda
+ no-source (list (syntax->datum (syntax pat))) #f (list var)
+ #f
+ (chi (syntax exp)
+ (extend-env labels
+ (list (make-binding 'syntax `(,var . 0)))
+ r)
+ (make-binding-wrap (syntax (pat))
+ labels empty-wrap)
+ mod))
(list x)))
(gen-clause x keys (cdr clauses) r
(syntax pat) #t (syntax exp) mod)))
@@ -2067,7 +2122,7 @@
(let ((x (gen-var 'tmp)))
; fat finger binding and references to temp variable x
(build-application s
- (build-lambda no-source (list 'tmp) (list x) #f
+ (build-simple-lambda no-source (list 'tmp) #f (list x) #f
(gen-syntax-case (build-lexical-reference 'value no-source
'tmp x)
(syntax (key ...)) (syntax (m ...))
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 123363208..d645cafd5 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -36,11 +36,14 @@
<conditional> conditional? make-conditional conditional-src conditional-test conditional-then conditional-else
<application> application? make-application application-src application-proc application-args
<sequence> sequence? make-sequence sequence-src sequence-exps
- <lambda> lambda? make-lambda lambda-src lambda-names lambda-vars lambda-meta lambda-body
+ <lambda> lambda? make-lambda lambda-src lambda-meta lambda-body
+ <lambda-case> lambda-case? make-lambda-case lambda-case-src
+ lambda-case-req lambda-case-opt lambda-case-rest lambda-case-kw lambda-case-vars
+ lambda-case-predicate lambda-case-body lambda-case-else
<let> let? make-let let-src let-names let-vars let-vals let-body
<letrec> letrec? make-letrec letrec-src letrec-names letrec-vars letrec-vals letrec-body
<fix> fix? make-fix fix-src fix-names fix-vars fix-vals fix-body
- <let-values> let-values? make-let-values let-values-src let-values-names let-values-vars let-values-exp let-values-body
+ <let-values> let-values? make-let-values let-values-src let-values-exp let-values-body
parse-tree-il
unparse-tree-il
@@ -65,11 +68,12 @@
(<conditional> test then else)
(<application> proc args)
(<sequence> exps)
- (<lambda> names vars meta body)
+ (<lambda> meta body)
+ (<lambda-case> req opt rest kw vars predicate body else)
(<let> names vars vals body)
(<letrec> names vars vals body)
(<fix> names vars vals body)
- (<let-values> names vars exp body))
+ (<let-values> exp body))
@@ -127,11 +131,14 @@
((define ,name ,exp) (guard (symbol? name))
(make-toplevel-define loc name (retrans exp)))
- ((lambda ,names ,vars ,exp)
- (make-lambda loc names vars '() (retrans exp)))
+ ((lambda ,meta ,body)
+ (make-lambda loc meta (retrans body)))
- ((lambda ,names ,vars ,meta ,exp)
- (make-lambda loc names vars meta (retrans exp)))
+ ((lambda-case ((,req ,opt ,rest ,kw ,vars ,predicate) ,body) ,else)
+ (make-lambda-case loc req opt rest kw vars
+ (and=> predicate retrans)
+ (retrans body)
+ (and=> else retrans)))
((const ,exp)
(make-const loc exp))
@@ -148,8 +155,8 @@
((fix ,names ,vars ,vals ,body)
(make-fix loc names vars (map retrans vals) (retrans body)))
- ((let-values ,names ,vars ,exp ,body)
- (make-let-values loc names vars (retrans exp) (retrans body)))
+ ((let-values ,exp ,body)
+ (make-let-values loc (retrans exp) (retrans body)))
(else
(error "unrecognized tree-il" exp)))))
@@ -189,8 +196,13 @@
((<toplevel-define> name exp)
`(define ,name ,(unparse-tree-il exp)))
- ((<lambda> names vars meta body)
- `(lambda ,names ,vars ,meta ,(unparse-tree-il body)))
+ ((<lambda> meta body)
+ `(lambda ,meta ,(unparse-tree-il body)))
+
+ ((<lambda-case> req opt rest kw vars predicate body else)
+ `(lambda-case ((,req ,opt ,rest ,kw ,vars ,(and=> predicate unparse-tree-il))
+ ,(unparse-tree-il body))
+ ,(and=> else unparse-tree-il)))
((<const> exp)
`(const ,exp))
@@ -207,8 +219,8 @@
((<fix> names vars vals body)
`(fix ,names ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il body)))
- ((<let-values> names vars exp body)
- `(let-values ,names ,vars ,(unparse-tree-il exp) ,(unparse-tree-il body)))))
+ ((<let-values> exp body)
+ `(let-values ,(unparse-tree-il exp) ,(unparse-tree-il body)))))
(define (tree-il->scheme e)
(record-case e
@@ -247,10 +259,31 @@
((<toplevel-define> name exp)
`(define ,name ,(tree-il->scheme exp)))
- ((<lambda> vars meta body)
- `(lambda ,vars
- ,@(cond ((assq-ref meta 'documentation) => list) (else '()))
- ,(tree-il->scheme body)))
+ ((<lambda> meta body)
+ ;; fixme: put in docstring
+ (if (and (lambda-case? body)
+ (not (lambda-case-else body)))
+ `(lambda ,@(car (tree-il->scheme body)))
+ `(case-lambda ,@(tree-il->scheme body))))
+
+ ((<lambda-case> req opt rest kw vars predicate body else)
+ ;; FIXME
+ #; `(((,@req
+ ,@(if (not opt)
+ '()
+ (cons #:optional opt))
+ ,@(if (not kw)
+ '()
+ (cons #:key (cdr kw)))
+ ,@(if predicate
+ (list #:predicate (tree-il->scheme predicate))
+ '())
+ . ,(or rest '()))
+ ,(tree-il->scheme body))
+ ,@(if else (tree-il->scheme else) '()))
+ `((,(if rest (apply cons* vars) vars)
+ ,(tree-il->scheme body))
+ ,@(if else (tree-il->scheme else) '())))
((<const> exp)
(if (and (self-evaluating? exp) (not (vector? exp)))
@@ -272,7 +305,7 @@
((<let-values> vars exp body)
`(call-with-values (lambda () ,(tree-il->scheme exp))
- (lambda ,vars ,(tree-il->scheme body))))))
+ ,(tree-il->scheme (make-lambda #f '() body))))))
(define (tree-il-fold leaf down up seed tree)
@@ -306,6 +339,15 @@ This is an implementation of `foldts' as described by Andy Wingo in
(up tree (loop exps (down tree result))))
((<lambda> body)
(up tree (loop body (down tree result))))
+ ((<lambda-case> predicate body else)
+ (up tree (if else
+ (loop else
+ (if predicate
+ (loop body (loop predicate (down tree result)))
+ (loop body (down tree result))))
+ (if predicate
+ (loop body (loop predicate (down tree result)))
+ (loop body (down tree result))))))
((<let> vals body)
(up tree (loop body
(loop vals
@@ -357,6 +399,18 @@ This is an implementation of `foldts' as described by Andy Wingo in
(fold-values foldts exps seed ...))
((<lambda> body)
(foldts body seed ...))
+ ((<lambda-case> predicate body else)
+ (if predicate
+ (if else
+ (let*-values (((seed ...) (foldts predicate seed ...))
+ ((seed ...) (foldts body seed ...)))
+ (foldts else seed ...))
+ (let-values (((seed ...) (foldts predicate seed ...)))
+ (foldts body seed ...)))
+ (if else
+ (let-values (((seed ...) (foldts body seed ...)))
+ (foldts else seed ...))
+ (foldts body seed ...))))
((<let> vals body)
(let*-values (((seed ...) (fold-values foldts vals seed ...)))
(foldts body seed ...)))
@@ -397,9 +451,16 @@ This is an implementation of `foldts' as described by Andy Wingo in
((<toplevel-define> name exp)
(set! (toplevel-define-exp x) (lp exp)))
- ((<lambda> vars meta body)
+ ((<lambda> body)
(set! (lambda-body x) (lp body)))
+ ((<lambda-case> predicate body else)
+ (if predicate
+ (set! (lambda-case-predicate x) (lp predicate)))
+ (set! (lambda-case-body x) (lp body))
+ (if else
+ (set! (lambda-case-else x) (lp else))))
+
((<sequence> exps)
(set! (sequence-exps x) (map lp exps)))
@@ -415,7 +476,7 @@ This is an implementation of `foldts' as described by Andy Wingo in
(set! (fix-vals x) (map lp vals))
(set! (fix-body x) (lp body)))
- ((<let-values> vars exp body)
+ ((<let-values> exp body)
(set! (let-values-exp x) (lp exp))
(set! (let-values-body x) (lp body)))
@@ -451,6 +512,11 @@ This is an implementation of `foldts' as described by Andy Wingo in
((<lambda> body)
(set! (lambda-body x) (lp body)))
+ ((<lambda-case> predicate body else)
+ (if predicate (set! (lambda-case-predicate x) (lp predicate)))
+ (set! (lambda-case-body x) (lp body))
+ (if else (set! (lambda-case-else x) (lp else))))
+
((<sequence> exps)
(set! (sequence-exps x) (map lp exps)))
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 656c18752..c44352129 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -112,13 +112,20 @@
;; translated into labels, and information on what free variables to
;; capture from its lexical parent procedure.
;;
+;; In addition, we have a conflation: while we're traversing the code,
+;; recording information to pass to the compiler, we take the
+;; opportunity to generate labels for each lambda-case clause, so that
+;; generated code can skip argument checks at runtime if they match at
+;; compile-time.
+;;
;; That is:
;;
;; sym -> {lambda -> address}
-;; lambda -> (nlocs labels . free-locs)
+;; lambda -> (labels . free-locs)
+;; lambda-case -> (gensym . nlocs)
;;
;; address ::= (local? boxed? . index)
-;; labels ::= ((sym . lambda-vars) ...)
+;; labels ::= ((sym . lambda) ...)
;; free-locs ::= ((sym0 . address0) (sym1 . address1) ...)
;; free variable addresses are relative to parent proc.
@@ -141,9 +148,9 @@
;; refcounts: sym -> count
;; allows us to detect the or-expansion in O(1) time
(define refcounts (make-hash-table))
- ;; labels: sym -> lambda-vars
+ ;; labels: sym -> lambda
;; for determining if fixed-point procedures can be rendered as
- ;; labels. lambda-vars may be an improper list.
+ ;; labels.
(define labels (make-hash-table))
;; returns variables referenced in expr
@@ -167,9 +174,21 @@
(hashq-set! refcounts gensym (1+ (hashq-ref refcounts gensym 0)))
(if (not (and tail-call-args
(memq gensym labels-in-proc)
- (let ((args (hashq-ref labels gensym)))
- (and (list? args)
- (= (length args) (length tail-call-args))))))
+ (let ((p (hashq-ref labels gensym)))
+ (and p
+ (let lp ((c (lambda-body p)))
+ (and c (lambda-case? c)
+ (or
+ ;; for now prohibit optional &
+ ;; keyword arguments; can relax this
+ ;; restriction later
+ (and (= (length (lambda-case-req c))
+ (length tail-call-args))
+ (not (lambda-case-opt c))
+ (not (lambda-case-kw c))
+ (not (lambda-case-rest c))
+ (not (lambda-case-predicate c)))
+ (lp (lambda-case-else c)))))))))
(hashq-set! labels gensym #f))
(list gensym))
@@ -195,19 +214,24 @@
(else
(lp (cdr exps) (lset-union eq? ret (step (car exps))))))))
- ((<lambda> vars body)
- (let ((locally-bound (let rev* ((vars vars) (out '()))
- (cond ((null? vars) out)
- ((pair? vars) (rev* (cdr vars)
- (cons (car vars) out)))
- (else (cons vars out))))))
- (hashq-set! bound-vars x locally-bound)
- (let* ((referenced (recur body x))
- (free (lset-difference eq? referenced locally-bound))
- (all-bound (reverse! (hashq-ref bound-vars x))))
- (hashq-set! bound-vars x all-bound)
- (hashq-set! free-vars x free)
- free)))
+ ((<lambda> body)
+ ;; order is important here
+ (hashq-set! bound-vars x '())
+ (let ((free (recur body x)))
+ (hashq-set! bound-vars x (reverse! (hashq-ref bound-vars x)))
+ (hashq-set! free-vars x free)
+ free))
+
+ ((<lambda-case> vars predicate body else)
+ (hashq-set! bound-vars proc
+ (append (reverse vars) (hashq-ref bound-vars proc)))
+ (lset-union
+ eq?
+ (lset-difference eq?
+ (lset-union eq? (if predicate (step predicate) '())
+ (step-tail body))
+ vars)
+ (if else (step-tail else) '())))
((<let> vars vals body)
(hashq-set! bound-vars proc
@@ -226,7 +250,7 @@
((<fix> vars vals body)
;; Try to allocate these procedures as labels.
- (for-each (lambda (sym val) (hashq-set! labels sym (lambda-vars val)))
+ (for-each (lambda (sym val) (hashq-set! labels sym val))
vars vals)
(hashq-set! bound-vars proc
(append (reverse vars) (hashq-ref bound-vars proc)))
@@ -240,21 +264,14 @@
;; prevent label allocation.)
(lambda (x)
(record-case x
- ((<lambda> (lvars vars) body)
- (let ((locally-bound
- (let rev* ((lvars lvars) (out '()))
- (cond ((null? lvars) out)
- ((pair? lvars) (rev* (cdr lvars)
- (cons (car lvars) out)))
- (else (cons lvars out))))))
- (hashq-set! bound-vars x locally-bound)
- ;; recur/labels, the difference from the closure case
- (let* ((referenced (recur/labels body x vars))
- (free (lset-difference eq? referenced locally-bound))
- (all-bound (reverse! (hashq-ref bound-vars x))))
- (hashq-set! bound-vars x all-bound)
- (hashq-set! free-vars x free)
- free)))))
+ ((<lambda> body)
+ ;; just like the closure case, except here we use
+ ;; recur/labels instead of recur
+ (hashq-set! bound-vars x '())
+ (let ((free (recur/labels body x vars)))
+ (hashq-set! bound-vars x (reverse! (hashq-ref bound-vars x)))
+ (hashq-set! free-vars x free)
+ free))))
vals))
(vars-with-refs (map cons vars var-refs))
(body-refs (recur/labels body proc vars)))
@@ -302,15 +319,8 @@
(apply lset-union eq? body-refs var-refs)
vars)))
- ((<let-values> vars exp body)
- (let ((bound (let lp ((out (hashq-ref bound-vars proc)) (in vars))
- (if (pair? in)
- (lp (cons (car in) out) (cdr in))
- (if (null? in) out (cons in out))))))
- (hashq-set! bound-vars proc bound)
- (lset-difference eq?
- (lset-union eq? (step exp) (step-tail body))
- bound)))
+ ((<let-values> exp body)
+ (lset-union eq? (step exp) (step body)))
(else '())))
@@ -342,7 +352,7 @@
((<sequence> exps)
(apply max (map recur exps)))
- ((<lambda> vars body)
+ ((<lambda> body)
;; allocate closure vars in order
(let lp ((c (hashq-ref free-vars x)) (n 0))
(if (pair? c)
@@ -352,18 +362,7 @@
`(#f ,(hashq-ref assigned (car c)) . ,n))
(lp (cdr c) (1+ n)))))
- (let ((nlocs
- (let lp ((vars vars) (n 0))
- (if (not (null? vars))
- ;; allocate args
- (let ((v (if (pair? vars) (car vars) vars)))
- (hashq-set! allocation v
- (make-hashq
- x `(#t ,(hashq-ref assigned v) . ,n)))
- (lp (if (pair? vars) (cdr vars) '()) (1+ n)))
- ;; allocate body, return total number of locals
- ;; (including arguments)
- (allocate! body x n))))
+ (let ((nlocs (allocate! body x 0))
(free-addresses
(map (lambda (v)
(hashq-ref (hashq-ref allocation v) proc))
@@ -373,9 +372,25 @@
(cons sym (hashq-ref labels sym)))
(hashq-ref bound-vars x)))))
;; set procedure allocations
- (hashq-set! allocation x (cons* nlocs labels free-addresses)))
+ (hashq-set! allocation x (cons labels free-addresses)))
n)
+ ((<lambda-case> vars predicate body else)
+ (max
+ (let lp ((vars vars) (n n))
+ (if (null? vars)
+ (let ((nlocs (max (if predicate (allocate! predicate body n) n)
+ (allocate! body proc n))))
+ ;; label and nlocs for the case
+ (hashq-set! allocation x (cons (gensym ":LCASE") nlocs))
+ nlocs)
+ (begin
+ (hashq-set! allocation (car vars)
+ (make-hashq
+ proc `(#t ,(hashq-ref assigned (car vars)) . ,n)))
+ (lp (cdr vars) (1+ n)))))
+ (if else (allocate! else proc n) n)))
+
((<let> vars vals body)
(let ((nmax (apply max (map recur vals))))
(cond
@@ -427,22 +442,12 @@
((null? vars)
(max nmax (allocate! body proc n)))
((hashq-ref labels (car vars))
- ;; allocate label bindings & body inline to proc
+ ;; allocate lambda body inline to proc
(lp (cdr vars)
(cdr vals)
(record-case (car vals)
- ((<lambda> vars body)
- (let lp ((vars vars) (n n))
- (if (not (null? vars))
- ;; allocate bindings
- (let ((v (if (pair? vars) (car vars) vars)))
- (hashq-set!
- allocation v
- (make-hashq
- proc `(#t ,(hashq-ref assigned v) . ,n)))
- (lp (if (pair? vars) (cdr vars) '()) (1+ n)))
- ;; allocate body
- (max nmax (allocate! body proc n))))))))
+ ((<lambda> body)
+ (max nmax (allocate! body proc n))))))
(else
;; allocate closure
(lp (cdr vars)
@@ -461,25 +466,8 @@
(hashq-set! allocation v (make-hashq proc `(#t #f . ,n)))
(lp (cdr in) (1+ n))))))))
- ((<let-values> vars exp body)
- (let ((nmax (recur exp)))
- (let lp ((vars vars) (n n))
- (cond
- ((null? vars)
- (max nmax (allocate! body proc n)))
- ((not (pair? vars))
- (hashq-set! allocation vars
- (make-hashq proc
- `(#t ,(hashq-ref assigned vars) . ,n)))
- ;; the 1+ for this var
- (max nmax (allocate! body proc (1+ n))))
- (else
- (let ((v (car vars)))
- (hashq-set!
- allocation v
- (make-hashq proc
- `(#t ,(hashq-ref assigned v) . ,n)))
- (lp (cdr vars) (1+ n))))))))
+ ((<let-values> exp body)
+ (max (recur exp) (recur body)))
(else n)))
@@ -504,21 +492,10 @@
(refs binding-info-refs) ;; (GENSYM ...)
(locs binding-info-locs)) ;; (LOCATION ...)
+;; FIXME!!
(define (report-unused-variables tree env)
"Report about unused variables in TREE. Return TREE."
- (define (dotless-list lst)
- ;; If LST is a dotted list, return a proper list equal to LST except that
- ;; the very last element is a pair; otherwise return LST.
- (let loop ((lst lst)
- (result '()))
- (cond ((null? lst)
- (reverse result))
- ((pair? lst)
- (loop (cdr lst) (cons (car lst) result)))
- (else
- (loop '() (cons lst result))))))
-
(tree-il-fold (lambda (x info)
;; X is a leaf: extend INFO's refs accordingly.
(let ((refs (binding-info-refs info))
@@ -546,9 +523,9 @@
((<lexical-set> gensym)
(make-binding-info vars (cons gensym refs)
(cons src locs)))
- ((<lambda> vars names)
- (let ((vars (dotless-list vars))
- (names (dotless-list names)))
+ ((<lambda-case> req opt rest kw vars)
+ ;; FIXME keywords.
+ (let ((names `(,@req ,@(or opt '()) . ,(or rest '()))))
(make-binding-info (extend vars names) refs
(cons src locs))))
((<let> vars names)
@@ -560,9 +537,6 @@
((<fix> vars names)
(make-binding-info (extend vars names) refs
(cons src locs)))
- ((<let-values> vars names)
- (make-binding-info (extend vars names) refs
- (cons src locs)))
(else info))))
(lambda (x info)
@@ -577,7 +551,7 @@
;; Don't report lambda parameters as
;; unused.
(if (and (not (memq gensym refs))
- (not (and (lambda? x)
+ (not (and (lambda-case? x)
(memq gensym
inner-vars))))
(let ((name (cadr var))
@@ -597,10 +571,9 @@
;; It doesn't hurt as these are unique names, it just
;; makes REFS unnecessarily fat.
(record-case x
- ((<lambda> vars)
- (let ((vars (dotless-list vars)))
- (make-binding-info (shrink vars refs) refs
- (cdr locs))))
+ ((<lambda-case> vars)
+ (make-binding-info (shrink vars refs) refs
+ (cdr locs)))
((<let> vars)
(make-binding-info (shrink vars refs) refs
(cdr locs)))
@@ -610,9 +583,6 @@
((<fix> vars)
(make-binding-info (shrink vars refs) refs
(cdr locs)))
- ((<let-values> vars)
- (make-binding-info (shrink vars refs) refs
- (cdr locs)))
(else info))))
(make-binding-info '() '() '())
tree)
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index a641ceda0..41926e600 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -32,9 +32,11 @@
;; allocation:
;; sym -> {lambda -> address}
-;; lambda -> (nlocs labels . free-locs)
+;; lambda -> (labels . free-locs)
+;; lambda-case -> (gensym . nlocs)
;;
-;; address := (local? boxed? . index)
+;; address ::= (local? boxed? . index)
+;; labels ::= ((sym . lambda) ...)
;; free-locs ::= ((sym0 . address0) (sym1 . address1) ...)
;; free variable addresses are relative to parent proc.
@@ -56,7 +58,8 @@
(warn x e))))
warnings)
- (let* ((x (make-lambda (tree-il-src x) '() '() '() x))
+ (let* ((x (make-lambda (tree-il-src x) '()
+ (make-lambda-case #f '() #f #f #f '() #f x #f)))
(x (optimize! x e opts))
(allocation (analyze-lexicals x)))
@@ -173,47 +176,21 @@
(reverse out)))
(define (flatten-lambda x self-label allocation)
- (receive (ids vars nargs nrest)
- (let lp ((ids (lambda-names x)) (vars (lambda-vars x))
- (oids '()) (ovars '()) (n 0))
- (cond ((null? vars) (values (reverse oids) (reverse ovars) n 0))
- ((pair? vars) (lp (cdr ids) (cdr vars)
- (cons (car ids) oids) (cons (car vars) ovars)
- (1+ n)))
- (else (values (reverse (cons ids oids))
- (reverse (cons vars ovars))
- (1+ n) 1))))
- (let ((nlocs (car (hashq-ref allocation x)))
- (labels (cadr (hashq-ref allocation x))))
- (make-glil-program
- (lambda-meta x)
- (with-output-to-code
- (lambda (emit-code)
- ;; write source info for proc
- (if (lambda-src x)
- (emit-code #f (make-glil-source (lambda-src x))))
- ;; the prelude, to check args & reset the stack pointer,
- ;; allowing room for locals
- (if (zero? nrest)
- (emit-code #f (make-glil-std-prelude nargs nlocs #f))
- (emit-code #f (make-glil-opt-prelude (1- nargs) 0 #t nlocs #f)))
- ;; write bindings info
- (if (not (null? ids))
- (emit-bindings #f ids vars allocation x emit-code))
- ;; post-prelude label for self tail calls
- (if self-label
- (emit-code #f (make-glil-label self-label)))
- ;; box args if necessary
- (for-each
- (lambda (v)
- (pmatch (hashq-ref (hashq-ref allocation v) x)
- ((#t #t . ,n)
- (emit-code #f (make-glil-lexical #t #f 'ref n))
- (emit-code #f (make-glil-lexical #t #t 'box n)))))
- vars)
- ;; and here, here, dear reader: we compile.
- (flatten (lambda-body x) allocation x self-label
- labels emit-code)))))))
+ (record-case x
+ ((<lambda> src meta body)
+ (make-glil-program
+ meta
+ (with-output-to-code
+ (lambda (emit-code)
+ ;; write source info for proc
+ (if src (emit-code #f (make-glil-source src)))
+ ;; emit pre-prelude label for self tail calls in which the
+ ;; number of arguments doesn't check out at compile time
+ (if self-label
+ (emit-code #f (make-glil-label self-label)))
+ ;; compile the body, yo
+ (flatten body allocation x self-label (car (hashq-ref allocation x))
+ emit-code)))))))
(define (flatten x allocation self self-label fix-labels emit-code)
(define (emit-label label)
@@ -410,43 +387,78 @@
(error "bad primitive op: too many pushes"
op (instruction-pushes op))))))
- ;; da capo al fine
+ ;; self-call in tail position
((and (lexical-ref? proc)
self-label (eq? (lexical-ref-gensym proc) self-label)
- ;; self-call in tail position is a goto
- (eq? context 'tail)
- ;; make sure the arity is right
- (list? (lambda-vars self))
- (= (length args) (length (lambda-vars self))))
- ;; evaluate new values
+ (eq? context 'tail))
+ ;; first, evaluate new values, pushing them on the stack
(for-each comp-push args)
- ;; rename & goto
- (for-each (lambda (sym)
- (pmatch (hashq-ref (hashq-ref allocation sym) self)
- ((#t ,boxed? . ,index)
- ;; set unboxed, as the proc prelude will box if needed
- (emit-code #f (make-glil-lexical #t #f 'set index)))
- (,x (error "what" x))))
- (reverse (lambda-vars self)))
- (emit-branch src 'br self-label))
+ (let lp ((lcase (lambda-body self)))
+ (cond
+ ((and (lambda-case? lcase)
+ (not (lambda-case-kw lcase))
+ (not (lambda-case-opt lcase))
+ (not (lambda-case-rest lcase))
+ (= (length args) (length (lambda-case-req lcase))))
+ ;; we have a case that matches the args; rename variables
+ ;; and goto the case label
+ (for-each (lambda (sym)
+ (pmatch (hashq-ref (hashq-ref allocation sym) self)
+ ((#t #f . ,index) ; unboxed
+ (emit-code #f (make-glil-lexical #t #f 'set index)))
+ ((#t #t . ,index) ; boxed
+ ;; new box
+ (emit-code #f (make-glil-lexical #t #t 'box index)))
+ (,x (error "what" x))))
+ (reverse (lambda-case-vars lcase)))
+ (emit-branch src 'br (car (hashq-ref allocation lcase))))
+ ((lambda-case? lcase)
+ ;; no match, try next case
+ (lp (lambda-case-else lcase)))
+ (else
+ ;; no cases left; shuffle args down and jump before the prelude.
+ (for-each (lambda (i)
+ (emit-code #f (make-glil-lexical #t #f 'set index)))
+ (reverse (iota (length args))))
+ (emit-branch src 'br self-label)))))
;; lambda, the ultimate goto
((and (lexical-ref? proc)
(assq (lexical-ref-gensym proc) fix-labels))
- ;; evaluate new values, assuming that analyze-lexicals did its
- ;; job, and that the arity was right
+ ;; like the self-tail-call case, though we can handle "drop"
+ ;; contexts too. first, evaluate new values, pushing them on
+ ;; the stack
(for-each comp-push args)
- ;; rename
- (for-each (lambda (sym)
- (pmatch (hashq-ref (hashq-ref allocation sym) self)
- ((#t #f . ,index)
- (emit-code #f (make-glil-lexical #t #f 'set index)))
- ((#t #t . ,index)
- (emit-code #f (make-glil-lexical #t #t 'box index)))
- (,x (error "what" x))))
- (reverse (assq-ref fix-labels (lexical-ref-gensym proc))))
- ;; goto!
- (emit-branch src 'br (lexical-ref-gensym proc)))
+ ;; find the specific case, rename args, and goto the case label
+ (let lp ((lcase (lambda-body
+ (assq-ref fix-labels (lexical-ref-gensym proc)))))
+ (cond
+ ((and (lambda-case? lcase)
+ (not (lambda-case-kw lcase))
+ (not (lambda-case-opt lcase))
+ (not (lambda-case-rest lcase))
+ (= (length args) (length (lambda-case-req lcase))))
+ ;; we have a case that matches the args; rename variables
+ ;; and goto the case label
+ (for-each (lambda (sym)
+ (pmatch (hashq-ref (hashq-ref allocation sym) self)
+ ((#t #f . ,index) ; unboxed
+ (emit-code #f (make-glil-lexical #t #f 'set index)))
+ ((#t #t . ,index) ; boxed
+ (emit-code #f (make-glil-lexical #t #t 'box index)))
+ (,x (error "what" x))))
+ (reverse (lambda-case-vars lcase)))
+ (emit-branch src 'br (car (hashq-ref allocation lcase))))
+ ((lambda-case? lcase)
+ ;; no match, try next case
+ (lp (lambda-case-else lcase)))
+ (else
+ ;; no cases left. we can't really handle this currently.
+ ;; ideally we would push on a new frame, then do a "local
+ ;; call" -- which doesn't require consing up a program
+ ;; object. but for now error, as this sort of case should
+ ;; preclude label allocation.
+ (error "couldn't find matching case for label call" x)))))
(else
(if (not (eq? context 'tail))
@@ -570,7 +582,7 @@
(maybe-emit-return))
((<lambda>)
- (let ((free-locs (cddr (hashq-ref allocation x))))
+ (let ((free-locs (cdr (hashq-ref allocation x))))
(case context
((push vals tail)
(emit-code #f (flatten-lambda x #f allocation))
@@ -587,6 +599,44 @@
(emit-code #f (make-glil-call 'make-closure 2)))))))
(maybe-emit-return))
+ ((<lambda-case> req opt kw rest vars predicate else body)
+ ;; the prelude, to check args & reset the stack pointer,
+ ;; allowing room for locals
+ (let ((nlocs (cdr (hashq-ref allocation x))))
+ (if rest
+ (emit-code #f (make-glil-opt-prelude (length req) 0 #t nlocs #f))
+ (emit-code #f (make-glil-std-prelude (length req) nlocs #f))))
+ ;; box args if necessary
+ (for-each
+ (lambda (v)
+ (pmatch (hashq-ref (hashq-ref allocation v) self)
+ ((#t #t . ,n)
+ (emit-code #f (make-glil-lexical #t #f 'ref n))
+ (emit-code #f (make-glil-lexical #t #t 'box n)))))
+ vars)
+ ;; write bindings info -- FIXME deal with opt/kw
+ (if (not (null? vars))
+ (emit-bindings #f (append req (if rest (list rest) '()))
+ vars allocation self emit-code))
+ ;; post-prelude case label for label calls
+ (emit-label (car (hashq-ref allocation x)))
+ (let ((else-label (and else (make-label))))
+ (if predicate
+ (begin
+ (comp-push predicate)
+ (if else-label
+ ;; fixme: debox if necessary
+ (emit-branch src 'br-if-not else-label)
+ ;; fixme: better error
+ (emit-code src (make-glil-call 'assert-true 0)))))
+ (comp-tail body)
+ (if (not (null? vars))
+ (emit-code #f (make-glil-unbind)))
+ (if else-label
+ (begin
+ (emit-label else-label)
+ (comp-tail else)))))
+
((<let> src names vars vals body)
(for-each comp-push vals)
(emit-bindings src names vars allocation self emit-code)
@@ -637,7 +687,7 @@
((hashq-ref allocation x)
;; allocating a closure
(emit-code #f (flatten-lambda x v allocation))
- (if (not (null? (cddr (hashq-ref allocation x))))
+ (if (not (null? (cdr (hashq-ref allocation x))))
;; Need to make-closure first, but with a temporary #f
;; free-variables vector, so we are mutating fresh
;; closures on the heap.
@@ -652,15 +702,19 @@
;; labels allocation: emit label & body, but jump over it
(let ((POST (make-label)))
(emit-branch #f 'br POST)
- (emit-label v)
- ;; we know the lambda vars are a list
- (emit-bindings #f (lambda-names x) (lambda-vars x)
- allocation self emit-code)
- (if (lambda-src x)
- (emit-code #f (make-glil-source (lambda-src x))))
- (comp-fix (lambda-body x) (or RA new-RA))
- (emit-code #f (make-glil-unbind))
- (emit-label POST)))))
+ (let lp ((lcase (lambda-body x)))
+ (if lcase
+ (record-case lcase
+ ((<lambda-case> src req vars body else)
+ (emit-label (car (hashq-ref allocation lcase)))
+ ;; FIXME: opt & kw args in the bindings
+ (emit-bindings #f req vars allocation self emit-code)
+ (if src
+ (emit-code #f (make-glil-source src)))
+ (comp-fix body (or RA new-RA))
+ (emit-code #f (make-glil-unbind))
+ (lp else)))
+ (emit-label POST)))))))
vals
vars)
;; Emit bindings metadata for closures
@@ -677,7 +731,7 @@
(for-each
(lambda (x v)
(let ((free-locs (if (hashq-ref allocation x)
- (cddr (hashq-ref allocation x))
+ (cdr (hashq-ref allocation x))
;; can hit this latter case for labels allocation
'())))
(if (not (null? free-locs))
@@ -701,31 +755,27 @@
(emit-label new-RA))
(emit-code #f (make-glil-unbind))))
- ((<let-values> src names vars exp body)
- (let lp ((names '()) (vars '()) (inames names) (ivars vars) (rest? #f))
- (cond
- ((pair? inames)
- (lp (cons (car inames) names) (cons (car ivars) vars)
- (cdr inames) (cdr ivars) #f))
- ((not (null? inames))
- (lp (cons inames names) (cons ivars vars) '() '() #t))
- (else
- (let ((names (reverse! names))
- (vars (reverse! vars))
- (MV (make-label)))
- (comp-vals exp MV)
- (emit-code #f (make-glil-const 1))
- (emit-label MV)
- (emit-code src (make-glil-mv-bind
- (vars->bind-list names vars allocation self)
- rest?))
- (for-each (lambda (v)
- (pmatch (hashq-ref (hashq-ref allocation v) self)
- ((#t #f . ,n)
- (emit-code src (make-glil-lexical #t #f 'set n)))
- ((#t #t . ,n)
- (emit-code src (make-glil-lexical #t #t 'box n)))
- (,loc (error "badness" x loc))))
- (reverse vars))
- (comp-tail body)
- (emit-code #f (make-glil-unbind))))))))))
+ ((<let-values> src exp body)
+ (record-case body
+ ((<lambda-case> req opt kw rest vars predicate body else)
+ (if (or opt kw predicate else)
+ (error "unexpected lambda-case in let-values" x))
+ (let ((MV (make-label)))
+ (comp-vals exp MV)
+ (emit-code #f (make-glil-const 1))
+ (emit-label MV)
+ (emit-code src (make-glil-mv-bind
+ (vars->bind-list
+ (append req (if rest (list rest) '()))
+ vars allocation self)
+ (and rest #t)))
+ (for-each (lambda (v)
+ (pmatch (hashq-ref (hashq-ref allocation v) self)
+ ((#t #f . ,n)
+ (emit-code src (make-glil-lexical #t #f 'set n)))
+ ((#t #t . ,n)
+ (emit-code src (make-glil-lexical #t #t 'box n)))
+ (,loc (error "badness" x loc))))
+ (reverse vars))
+ (comp-tail body)
+ (emit-code #f (make-glil-unbind)))))))))
diff --git a/module/language/tree-il/inline.scm b/module/language/tree-il/inline.scm
index adc3f18bd..d596a7bcf 100644
--- a/module/language/tree-il/inline.scm
+++ b/module/language/tree-il/inline.scm
@@ -17,6 +17,7 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (language tree-il inline)
+ #:use-module (system base pmatch)
#:use-module (system base syntax)
#:use-module (language tree-il)
#:export (inline!))
@@ -34,16 +35,20 @@
;; This is a completely brain-dead optimization pass whose sole claim to
;; fame is ((lambda () x)) => x.
(define (inline! x)
- (post-order!
- (lambda (x)
- (record-case x
- ((<application> src proc args)
- (cond
-
- ;; ((lambda () x)) => x
- ((and (lambda? proc) (null? (lambda-vars proc))
- (null? args))
- (lambda-body proc))
+ (define (inline1 x)
+ (record-case x
+ ((<application> src proc args)
+ (record-case proc
+ ;; ((lambda (y ...) x) z ...) => (let ((y z) ...) x)
+ ((<lambda> body)
+ (let lp ((lcase body))
+ (and lcase
+ (record-case lcase
+ ((<lambda-case> req opt rest kw vars predicate body else)
+ (if (and (= (length vars) (length req) (length args)))
+ (let ((x (make-let src req vars args body)))
+ (or (inline1 x) x))
+ (lp else)))))))
;; (call-with-values (lambda () foo) (lambda (a b . c) bar))
;; => (let-values (((a b . c) foo)) bar)
@@ -51,31 +56,33 @@
;; Note that this is a singly-binding form of let-values. Also
;; note that Scheme's let-values expands into call-with-values,
;; then here we reduce it to tree-il's let-values.
- ((and (primitive-ref? proc)
- (eq? (primitive-ref-name proc) '@call-with-values)
- (= (length args) 2)
- (lambda? (cadr args)))
- (let ((producer (car args))
- (consumer (cadr args)))
- (make-let-values src
- (lambda-names consumer)
- (lambda-vars consumer)
- (if (and (lambda? producer)
- (null? (lambda-names producer)))
- (lambda-body producer)
- (make-application src producer '()))
- (lambda-body consumer))))
+ ((<primitive-ref> name)
+ (and (eq? name '@call-with-values)
+ (pmatch args
+ ((,producer ,consumer)
+ (guard (lambda? consumer)
+ (lambda-case? (lambda-body consumer))
+ (not (lambda-case-opt (lambda-body consumer)))
+ (not (lambda-case-kw (lambda-body consumer)))
+ (not (lambda-case-predicate (lambda-body consumer)))
+ (not (lambda-case-else (lambda-body consumer))))
+ (make-let-values
+ src
+ (let ((x (make-application src producer '())))
+ (or (inline1 x) x))
+ (lambda-body consumer)))
+ (else #f))))
(else #f)))
- ((<let> vars body)
- (if (null? vars) body x))
+ ((<let> vars body)
+ (if (null? vars) body x))
- ((<letrec> vars body)
- (if (null? vars) body x))
+ ((<letrec> vars body)
+ (if (null? vars) body x))
- ((<fix> vars body)
- (if (null? vars) body x))
+ ((<fix> vars body)
+ (if (null? vars) body x))
- (else #f)))
- x))
+ (else #f)))
+ (post-order! inline1 x))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index c094a3306..a9f2787c0 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -48,14 +48,6 @@
(define-syntax assert-tree-il->glil
(syntax-rules ()
- ((_ in out)
- (pass-if 'in
- (let ((tree-il (strip-source (parse-tree-il 'in))))
- (equal? (unparse-glil (compile tree-il #:from 'tree-il #:to 'glil))
- 'out))))))
-
-(define-syntax assert-tree-il->glil/pmatch
- (syntax-rules ()
((_ in pat test ...)
(let ((exp 'in))
(pass-if 'in
@@ -69,21 +61,21 @@
(with-test-prefix "void"
(assert-tree-il->glil
(void)
- (program () (std-prelude 0 0 #f) (void) (call return 1)))
+ (program () (std-prelude 0 0 #f) (label _) (void) (call return 1)))
(assert-tree-il->glil
(begin (void) (const 1))
- (program () (std-prelude 0 0 #f) (const 1) (call return 1)))
+ (program () (std-prelude 0 0 #f) (label _) (const 1) (call return 1)))
(assert-tree-il->glil
(apply (primitive +) (void) (const 1))
- (program () (std-prelude 0 0 #f) (void) (call add1 1) (call return 1))))
+ (program () (std-prelude 0 0 #f) (label _) (void) (call add1 1) (call return 1))))
(with-test-prefix "application"
(assert-tree-il->glil
(apply (toplevel foo) (const 1))
- (program () (std-prelude 0 0 #f) (toplevel ref foo) (const 1) (call goto/args 1)))
- (assert-tree-il->glil/pmatch
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (const 1) (call goto/args 1)))
+ (assert-tree-il->glil
(begin (apply (toplevel foo) (const 1)) (void))
- (program () (std-prelude 0 0 #f) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
+ (program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
(call drop 1) (branch br ,l2)
(label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
@@ -91,26 +83,26 @@
(and (eq? l1 l3) (eq? l2 l4)))
(assert-tree-il->glil
(apply (toplevel foo) (apply (toplevel bar)))
- (program () (std-prelude 0 0 #f)(toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
(call goto/args 1))))
(with-test-prefix "conditional"
- (assert-tree-il->glil/pmatch
+ (assert-tree-il->glil
(if (const #t) (const 1) (const 2))
- (program () (std-prelude 0 0 #f) (const #t) (branch br-if-not ,l1)
+ (program () (std-prelude 0 0 #f) (label _) (const #t) (branch br-if-not ,l1)
(const 1) (call return 1)
(label ,l2) (const 2) (call return 1))
(eq? l1 l2))
- (assert-tree-il->glil/pmatch
+ (assert-tree-il->glil
(begin (if (const #t) (const 1) (const 2)) (const #f))
- (program () (std-prelude 0 0 #f) (const #t) (branch br-if-not ,l1) (branch br ,l2)
+ (program () (std-prelude 0 0 #f) (label _) (const #t) (branch br-if-not ,l1) (branch br ,l2)
(label ,l3) (label ,l4) (const #f) (call return 1))
(eq? l1 l3) (eq? l2 l4))
- (assert-tree-il->glil/pmatch
+ (assert-tree-il->glil
(apply (primitive null?) (if (const #t) (const 1) (const 2)))
- (program () (std-prelude 0 0 #f) (const #t) (branch br-if-not ,l1)
+ (program () (std-prelude 0 0 #f) (label _) (const #t) (branch br-if-not ,l1)
(const 1) (branch br ,l2)
(label ,l3) (const 2) (label ,l4)
(call null? 1) (call return 1))
@@ -119,35 +111,35 @@
(with-test-prefix "primitive-ref"
(assert-tree-il->glil
(primitive +)
- (program () (std-prelude 0 0 #f) (toplevel ref +) (call return 1)))
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref +) (call return 1)))
(assert-tree-il->glil
(begin (primitive +) (const #f))
- (program () (std-prelude 0 0 #f) (const #f) (call return 1)))
+ (program () (std-prelude 0 0 #f) (label _) (const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (primitive +))
- (program () (std-prelude 0 0 #f) (toplevel ref +) (call null? 1)
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref +) (call null? 1)
(call return 1))))
(with-test-prefix "lexical refs"
(assert-tree-il->glil
(let (x) (y) ((const 1)) (lexical x y))
- (program () (std-prelude 0 1 #f)
+ (program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (call return 1)
(unbind)))
(assert-tree-il->glil
(let (x) (y) ((const 1)) (begin (lexical x y) (const #f)))
- (program () (std-prelude 0 1 #f)
+ (program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(const #f) (call return 1)
(unbind)))
(assert-tree-il->glil
(let (x) (y) ((const 1)) (apply (primitive null?) (lexical x y)))
- (program () (std-prelude 0 1 #f)
+ (program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (call null? 1) (call return 1)
(unbind))))
@@ -157,7 +149,7 @@
;; unreferenced sets may be optimized away -- make sure they are ref'd
(let (x) (y) ((const 1))
(set! (lexical x y) (apply (primitive 1+) (lexical x y))))
- (program () (std-prelude 0 1 #f)
+ (program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #t 0)) (lexical #t #t box 0)
(lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
(void) (call return 1)
@@ -167,7 +159,7 @@
(let (x) (y) ((const 1))
(begin (set! (lexical x y) (apply (primitive 1+) (lexical x y)))
(lexical x y)))
- (program () (std-prelude 0 1 #f)
+ (program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #t 0)) (lexical #t #t box 0)
(lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
(lexical #t #t ref 0) (call return 1)
@@ -177,7 +169,7 @@
(let (x) (y) ((const 1))
(apply (primitive null?)
(set! (lexical x y) (apply (primitive 1+) (lexical x y)))))
- (program () (std-prelude 0 1 #f)
+ (program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #t 0)) (lexical #t #t box 0)
(lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0) (void)
(call null? 1) (call return 1)
@@ -186,234 +178,259 @@
(with-test-prefix "module refs"
(assert-tree-il->glil
(@ (foo) bar)
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(module public ref (foo) bar)
(call return 1)))
(assert-tree-il->glil
(begin (@ (foo) bar) (const #f))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(module public ref (foo) bar) (call drop 1)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (@ (foo) bar))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(module public ref (foo) bar)
(call null? 1) (call return 1)))
(assert-tree-il->glil
(@@ (foo) bar)
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(module private ref (foo) bar)
(call return 1)))
(assert-tree-il->glil
(begin (@@ (foo) bar) (const #f))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(module private ref (foo) bar) (call drop 1)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (@@ (foo) bar))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(module private ref (foo) bar)
(call null? 1) (call return 1))))
(with-test-prefix "module sets"
(assert-tree-il->glil
(set! (@ (foo) bar) (const 2))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (module public set (foo) bar)
(void) (call return 1)))
(assert-tree-il->glil
(begin (set! (@ (foo) bar) (const 2)) (const #f))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (module public set (foo) bar)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (set! (@ (foo) bar) (const 2)))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (module public set (foo) bar)
(void) (call null? 1) (call return 1)))
(assert-tree-il->glil
(set! (@@ (foo) bar) (const 2))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (module private set (foo) bar)
(void) (call return 1)))
(assert-tree-il->glil
(begin (set! (@@ (foo) bar) (const 2)) (const #f))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (module private set (foo) bar)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (set! (@@ (foo) bar) (const 2)))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (module private set (foo) bar)
(void) (call null? 1) (call return 1))))
(with-test-prefix "toplevel refs"
(assert-tree-il->glil
(toplevel bar)
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(toplevel ref bar)
(call return 1)))
(assert-tree-il->glil
(begin (toplevel bar) (const #f))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(toplevel ref bar) (call drop 1)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (toplevel bar))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(toplevel ref bar)
(call null? 1) (call return 1))))
(with-test-prefix "toplevel sets"
(assert-tree-il->glil
(set! (toplevel bar) (const 2))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (toplevel set bar)
(void) (call return 1)))
(assert-tree-il->glil
(begin (set! (toplevel bar) (const 2)) (const #f))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (toplevel set bar)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (set! (toplevel bar) (const 2)))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (toplevel set bar)
(void) (call null? 1) (call return 1))))
(with-test-prefix "toplevel defines"
(assert-tree-il->glil
(define bar (const 2))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (toplevel define bar)
(void) (call return 1)))
(assert-tree-il->glil
(begin (define bar (const 2)) (const #f))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (toplevel define bar)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (define bar (const 2)))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (toplevel define bar)
(void) (call null? 1) (call return 1))))
(with-test-prefix "constants"
(assert-tree-il->glil
(const 2)
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (call return 1)))
(assert-tree-il->glil
(begin (const 2) (const #f))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (const 2))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (call null? 1) (call return 1))))
(with-test-prefix "lambda"
(assert-tree-il->glil
- (lambda (x) (y) () (const 2))
- (program () (std-prelude 0 0 #f)
+ (lambda ()
+ (lambda-case (((x) #f #f #f (y) #f) (const 2)) #f))
+ (program () (std-prelude 0 0 #f) (label _)
(program () (std-prelude 1 1 #f)
- (bind (x #f 0))
- (const 2) (call return 1))
+ (bind (x #f 0)) (label _)
+ (const 2) (call return 1) (unbind))
(call return 1)))
(assert-tree-il->glil
- (lambda (x x1) (y y1) () (const 2))
- (program () (std-prelude 0 0 #f)
+ (lambda ()
+ (lambda-case (((x y) #f #f #f (x1 y1) #f)
+ (const 2))
+ #f))
+ (program () (std-prelude 0 0 #f) (label _)
(program () (std-prelude 2 2 #f)
- (bind (x #f 0) (x1 #f 1))
- (const 2) (call return 1))
+ (bind (x #f 0) (y #f 1)) (label _)
+ (const 2) (call return 1)
+ (unbind))
(call return 1)))
(assert-tree-il->glil
- (lambda x y () (const 2))
- (program () (std-prelude 0 0 #f)
- (program () (opt-prelude 0 0 #t 1 #f)
- (bind (x #f 0))
- (const 2) (call return 1))
+ (lambda ()
+ (lambda-case ((() #f x #f (y) #f) (const 2))
+ #f))
+ (program () (std-prelude 0 0 #f) (label _)
+ (program () (opt-prelude 0 0 #t 1 #f)
+ (bind (x #f 0)) (label _)
+ (const 2) (call return 1)
+ (unbind))
(call return 1)))
(assert-tree-il->glil
- (lambda (x . x1) (y . y1) () (const 2))
- (program () (std-prelude 0 0 #f)
+ (lambda ()
+ (lambda-case (((x) #f x1 #f (y y1) #f) (const 2))
+ #f))
+ (program () (std-prelude 0 0 #f) (label _)
(program () (opt-prelude 1 0 #t 2 #f)
- (bind (x #f 0) (x1 #f 1))
- (const 2) (call return 1))
+ (bind (x #f 0) (x1 #f 1)) (label _)
+ (const 2) (call return 1)
+ (unbind))
(call return 1)))
(assert-tree-il->glil
- (lambda (x . x1) (y . y1) () (lexical x y))
- (program () (std-prelude 0 0 #f)
+ (lambda ()
+ (lambda-case (((x) #f x1 #f (y y1) #f) (lexical x y))
+ #f))
+ (program () (std-prelude 0 0 #f) (label _)
(program () (opt-prelude 1 0 #t 2 #f)
- (bind (x #f 0) (x1 #f 1))
- (lexical #t #f ref 0) (call return 1))
+ (bind (x #f 0) (x1 #f 1)) (label _)
+ (lexical #t #f ref 0) (call return 1)
+ (unbind))
(call return 1)))
(assert-tree-il->glil
- (lambda (x . x1) (y . y1) () (lexical x1 y1))
- (program () (std-prelude 0 0 #f)
+ (lambda ()
+ (lambda-case (((x) #f x1 #f (y y1) #f) (lexical x1 y1))
+ #f))
+ (program () (std-prelude 0 0 #f) (label _)
(program () (opt-prelude 1 0 #t 2 #f)
- (bind (x #f 0) (x1 #f 1))
- (lexical #t #f ref 1) (call return 1))
+ (bind (x #f 0) (x1 #f 1)) (label _)
+ (lexical #t #f ref 1) (call return 1)
+ (unbind))
(call return 1)))
(assert-tree-il->glil
- (lambda (x) (x1) () (lambda (y) (y1) () (lexical x x1)))
- (program () (std-prelude 0 0 #f)
- (program () (std-prelude 1 1 #f)
- (bind (x #f 0))
+ (lambda ()
+ (lambda-case (((x) #f #f #f (x1) #f)
+ (lambda ()
+ (lambda-case (((y) #f #f #f (y1) #f)
+ (lexical x x1))
+ #f)))
+ #f))
+ (program () (std-prelude 0 0 #f) (label _)
+ (program () (std-prelude 1 1 #f)
+ (bind (x #f 0)) (label _)
(program () (std-prelude 1 1 #f)
- (bind (y #f 0))
- (lexical #f #f ref 0) (call return 1))
+ (bind (y #f 0)) (label _)
+ (lexical #f #f ref 0) (call return 1)
+ (unbind))
(lexical #t #f ref 0)
(call vector 1)
(call make-closure 2)
- (call return 1))
+ (call return 1)
+ (unbind))
(call return 1))))
(with-test-prefix "sequence"
(assert-tree-il->glil
(begin (begin (const 2) (const #f)) (const #t))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const #t) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (begin (const #f) (const 2)))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(const 2) (call null? 1) (call return 1))))
;; FIXME: binding info for or-hacked locals might bork the disassembler,
;; and could be tightened in any case
(with-test-prefix "the or hack"
- (assert-tree-il->glil/pmatch
+ (assert-tree-il->glil
(let (x) (y) ((const 1))
(if (lexical x y)
(lexical x y)
(let (a) (b) ((const 2))
(lexical a b))))
- (program () (std-prelude 0 1 #f)
+ (program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (branch br-if-not ,l1)
(lexical #t #f ref 0) (call return 1)
@@ -425,13 +442,13 @@
(eq? l1 l2))
;; second bound var is unreferenced
- (assert-tree-il->glil/pmatch
+ (assert-tree-il->glil
(let (x) (y) ((const 1))
(if (lexical x y)
(lexical x y)
(let (a) (b) ((const 2))
(lexical x y))))
- (program () (std-prelude 0 1 #f)
+ (program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (branch br-if-not ,l1)
(lexical #t #f ref 0) (call return 1)
@@ -443,10 +460,10 @@
(with-test-prefix "apply"
(assert-tree-il->glil
(apply (primitive @apply) (toplevel foo) (toplevel bar))
- (program () (std-prelude 0 0 #f) (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
- (assert-tree-il->glil/pmatch
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
+ (assert-tree-il->glil
(begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(call new-frame 0) (toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
@@ -454,7 +471,7 @@
(and (eq? l1 l3) (eq? l2 l4)))
(assert-tree-il->glil
(apply (toplevel foo) (apply (toplevel @apply) (toplevel bar) (toplevel baz)))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(toplevel ref foo)
(call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2)
(call goto/args 1))))
@@ -462,10 +479,10 @@
(with-test-prefix "call/cc"
(assert-tree-il->glil
(apply (primitive @call-with-current-continuation) (toplevel foo))
- (program () (std-prelude 0 0 #f) (toplevel ref foo) (call goto/cc 1)))
- (assert-tree-il->glil/pmatch
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call goto/cc 1)))
+ (assert-tree-il->glil
(begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
@@ -474,7 +491,7 @@
(assert-tree-il->glil
(apply (toplevel foo)
(apply (toplevel @call-with-current-continuation) (toplevel bar)))
- (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 0 0 #f) (label _)
(toplevel ref foo)
(toplevel ref bar) (call call/cc 1)
(call goto/args 1))))
@@ -507,15 +524,18 @@
(1+ y))
0
(parse-tree-il
- '(lambda (x y) (x1 y1)
- (apply (toplevel +)
- (lexical x x1)
- (lexical y y1)))))))
+ '(lambda ()
+ (lambda-case
+ (((x y) #f #f #f (x1 y1) #f)
+ (apply (toplevel +)
+ (lexical x x1)
+ (lexical y y1)))
+ #f))))))
(and (equal? (map strip-source leaves)
(list (make-lexical-ref #f 'y 'y1)
(make-lexical-ref #f 'x 'x1)
(make-toplevel-ref #f '+)))
- (= (length downs) 2)
+ (= (length downs) 3)
(equal? (reverse (map strip-source ups))
(map strip-source downs))))))