diff options
author | Andy Wingo <wingo@pobox.com> | 2009-10-14 00:08:35 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-10-23 15:10:25 +0200 |
commit | 8a4ca0ea3bd3e378fc63ef719ce828b7252b3985 (patch) | |
tree | ff71f102d96cc8f10f67618cf136aa35fc55a47f | |
parent | c783b0827c5e5485209879b6cd329a7f095ecf9c (diff) | |
download | guile-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.scm | 8228 | ||||
-rw-r--r-- | module/ice-9/psyntax.scm | 191 | ||||
-rw-r--r-- | module/language/tree-il.scm | 108 | ||||
-rw-r--r-- | module/language/tree-il/analyze.scm | 204 | ||||
-rw-r--r-- | module/language/tree-il/compile-glil.scm | 276 | ||||
-rw-r--r-- | module/language/tree-il/inline.scm | 71 | ||||
-rw-r--r-- | test-suite/tests/tree-il.test | 230 |
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)))))) |