[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. e0c90f9084
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. e0c90f9084914956d90db73b21ef2ab32d1a477a |
|
Date: |
Fri, 22 May 2009 13:54:28 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=e0c90f9084914956d90db73b21ef2ab32d1a477a
The branch, syncase-in-boot-9 has been updated
via e0c90f9084914956d90db73b21ef2ab32d1a477a (commit)
via e6b94431794ad5cffedfbdbe949789d04ef97761 (commit)
via 7902c547130235438fa170d94c43e0c271adb71d (commit)
via 9ecac781bf3b33abca137c242ceaa7c49f604958 (commit)
via dc1eed52f71004bca74028d03ae35bbf569be709 (commit)
via 0260421208267eb202f9c9628cdaf39b531a5129 (commit)
from 40b36cfbbe4676f52bd4d6b45ae1642756642907 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit e0c90f9084914956d90db73b21ef2ab32d1a477a
Author: Andy Wingo <address@hidden>
Date: Fri May 22 13:00:23 2009 +0200
fix tree-il test to work if source info happens to be present
* module/language/tree-il/compile-glil.scm (flatten-lambda): Fix source
emission.
* test-suite/tests/tree-il.test (strip-source): Strip source info on
tree-il before compiling, so we don't get extraneous source info in the
glil. Make check passes!
commit e6b94431794ad5cffedfbdbe949789d04ef97761
Author: Andy Wingo <address@hidden>
Date: Fri May 22 12:48:45 2009 +0200
fix bad call to make-glil-src
* module/language/tree-il/compile-glil.scm (flatten-lambda): Fix bad call
to make-glil-src, unfortunately not hit during production because
psyntax doesn't yet understand source locations.
commit 7902c547130235438fa170d94c43e0c271adb71d
Author: Andy Wingo <address@hidden>
Date: Fri May 22 12:45:49 2009 +0200
fix expansion of (ice-9 threads)
* module/ice-9/threads.scm: Move syntax definitions before the procedures
that use them, and rewrite as hygienic macros since they are so much
nicer that way. Fixes the thread tests.
commit 9ecac781bf3b33abca137c242ceaa7c49f604958
Author: Andy Wingo <address@hidden>
Date: Fri May 22 12:22:39 2009 +0200
syntax.test is passing, yay
* test-suite/tests/syntax.test ("top-level define"): Remove the test for
currying, as we don't do that any more by default. It should be easy
for the user to add in if she wants it, though.
("do"): Remove unmemoization tests, as sc-expand fully expands `do'.
("while"): Remove while tests in empty environments. They have been
throwing 'unresolved, and the problem they seek to test is fully
handled by hygiene anyway.
And otherwise tweak expected exception strings, and everything passes!
commit dc1eed52f71004bca74028d03ae35bbf569be709
Author: Andy Wingo <address@hidden>
Date: Fri May 22 12:08:50 2009 +0200
residualize names into procedures. re-implement srfi-61. module naming foo.
* module/ice-9/boot-9.scm (cond): Implement srfi-61; most of the code is
from the SRFI itself. Yuk.
(%print-module, make-modules-in, %app, (%app modules))
(module-name): Syncase needs to get at the names of modules, even at
anonymous modules. So lazily assign gensyms as module names. Name %app
as (%app), but since (%app modules) is at the top of the module
hierarchy, name it ().
* module/ice-9/psyntax.scm: When building tree-il, try to name lambdas in
definitions and in lets.
(let, letrec): Give more specific errors in a couple of cases.
* module/ice-9/psyntax-pp.scm: Regenerated.
* test-suite/tests/syntax.test: More work. Many exceptions have different
messages than they used to, many more generic; we can roll this back to
be faithful to the original strings, but it doesn't seem necessary to
me.
commit 0260421208267eb202f9c9628cdaf39b531a5129
Author: Andy Wingo <address@hidden>
Date: Thu May 21 22:43:07 2009 +0200
some work on syntax.test
* module/language/tree-il.scm (tree-il->scheme):
* module/ice-9/psyntax.scm (build-conditional): Attempt to not generate
(if #f #f) as the second arm of an if, but it doesn't seem to be
successful.
* module/ice-9/psyntax-pp.scm (syntax-rules): Regenerate.
* test-suite/tests/syntax.test (exception:unexpected-syntax): Change
capitalization.
("unquote-splicing"): Update test.
("begin"): Add in second arms on these ifs, to avoid the strange though
harmless expansion of `if'.
(matches?): New helper macro.
("lambda"): Match on lexically bound symbols, as they will be
alpha-renamed.
-----------------------------------------------------------------------
Summary of changes:
module/ice-9/boot-9.scm | 85 ++++---
module/ice-9/psyntax-pp.scm | 22 +-
module/ice-9/psyntax.scm | 45 +++-
module/ice-9/threads.scm | 114 +++++-----
module/language/tree-il.scm | 4 +-
module/language/tree-il/compile-glil.scm | 2 +-
test-suite/tests/syntax.test | 381 +++++++++++++----------------
test-suite/tests/tree-il.test | 16 +-
8 files changed, 342 insertions(+), 327 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 6666f80..fa05de6 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -222,31 +222,44 @@
((_ x) x)
((_ x y ...) (let ((t x)) (if t t (or y ...))))))
+;; The "maybe-more" bits are something of a hack, so that we can support
+;; SRFI-61. Rewrites into a standalone syntax-case macro would be
+;; appreciated.
(define-syntax cond
- (syntax-rules (else =>)
- ((cond (else result1 result2 ...))
- (begin result1 result2 ...))
- ((cond (test => result))
- (let ((temp test))
- (if temp (result temp))))
- ((cond (test => result) clause1 clause2 ...)
- (let ((temp test))
- (if temp
- (result temp)
- (cond clause1 clause2 ...))))
- ((cond (test)) test)
- ((cond (test) clause1 clause2 ...)
- (let ((temp test))
- (if temp
- temp
- (cond clause1 clause2 ...))))
- ((cond (test result1 result2 ...))
- (if test (begin result1 result2 ...)))
- ((cond (test result1 result2 ...)
- clause1 clause2 ...)
- (if test
- (begin result1 result2 ...)
- (cond clause1 clause2 ...)))))
+ (syntax-rules (=> else)
+ ((_ "maybe-more" test consequent)
+ (if test consequent))
+
+ ((_ "maybe-more" test consequent clause ...)
+ (if test consequent (cond clause ...)))
+
+ ((_ (else else1 else2 ...))
+ (begin else1 else2 ...))
+
+ ((_ (test => receiver) more-clause ...)
+ (let ((t test))
+ (cond "maybe-more" t (receiver t) more-clause ...)))
+
+ ((_ (generator guard => receiver) more-clause ...)
+ (call-with-values (lambda () generator)
+ (lambda t
+ (cond "maybe-more"
+ (apply guard t) (apply receiver t) more-clause ...))))
+
+ ((_ (test => receiver ...) more-clause ...)
+ (syntax-violation 'cond "wrong number of receiver expressions"
+ '(test => receiver ...)))
+ ((_ (generator guard => receiver ...) more-clause ...)
+ (syntax-violation 'cond "wrong number of receiver expressions"
+ '(generator guard => receiver ...)))
+
+ ((_ (test) more-clause ...)
+ (let ((t test))
+ (cond "maybe-more" t t more-clause ...)))
+
+ ((_ (test body1 body2 ...) more-clause ...)
+ (cond "maybe-more"
+ test (begin body1 body2 ...) more-clause ...))))
(define-syntax case
(syntax-rules (else)
@@ -1233,11 +1246,8 @@
(define (%print-module mod port) ; unused args: depth length style table)
(display "#<" port)
(display (or (module-kind mod) "module") port)
- (let ((name (module-name mod)))
- (if name
- (begin
- (display " " port)
- (display name port))))
+ (display " " port)
+ (display (module-name mod) port)
(display " " port)
(display (number->string (object-address mod) 16) port)
(display ">" port))
@@ -1902,7 +1912,7 @@
val
(let ((m (make-module 31)))
(set-module-kind! m 'directory)
- (set-module-name! m (append (or (module-name module) '())
+ (set-module-name! m (append (module-name module)
(list (car name))))
(module-define! module (car name) m)
m)))
@@ -1956,17 +1966,26 @@
(define default-duplicate-binding-procedures #f)
(define %app (make-module 31))
+(set-module-name! %app '(%app))
(define app %app) ;; for backwards compatability
-(local-define '(%app modules) (make-module 31))
+(let ((m (make-module 31)))
+ (set-module-name! m '())
+ (local-define '(%app modules) m))
(local-define '(%app modules guile) the-root-module)
;; This boots the module system. All bindings needed by modules.c
;; must have been defined by now.
;;
(set-current-module the-root-module)
-;; definition deferred for syncase's benefit
-(define module-name (record-accessor module-type 'name))
+;; definition deferred for syncase's benefit.
+(define module-name
+ (let ((accessor (record-accessor module-type 'name)))
+ (lambda (mod)
+ (or (accessor mod)
+ (begin
+ (set-module-name! mod (list (gensym)))
+ (accessor mod))))))
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 5b646d8..b5347f2 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,13 +1,13 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
-(letrec ((and-map*17 (lambda (f57 first56 . rest55) (let ((t58 (null?
first56))) (if t58 t58 (if (null? rest55) (letrec ((andmap59 (lambda (first60)
(let ((x61 (car first60)) (first62 (cdr first60))) (if (null? first62) (f57
x61) (if (f57 x61) (andmap59 first62) #f)))))) (andmap59 first56)) (letrec
((andmap63 (lambda (first64 rest65) (let ((x66 (car first64)) (xr67 (map car
rest65)) (first68 (cdr first64)) (rest69 (map cdr rest65))) (if (null? first68)
(apply f57 (cons x66 xr67)) (if (apply f57 (cons x66 xr67)) (andmap63 first68
rest69) #f)))))) (andmap63 first56 rest55)))))))) (letrec ((lambda-var-list162
(lambda (vars291) (letrec ((lvl292 (lambda (vars293 ls294 w295) (if (pair?
vars293) (lvl292 (cdr vars293) (cons (wrap141 (car vars293) w295 #f) ls294)
w295) (if (id?113 vars293) (cons (wrap141 vars293 w295 #f) ls294) (if (null?
vars293) ls294 (if (syntax-object?97 vars293) (lvl292
(syntax-object-expression98 vars293) ls294 (join-wraps132 w295
(syntax-object-wrap99 vars293))) (if (annotation? vars293) (lvl292
(annotation-expression vars293) ls294 w295) (cons vars293 ls294)))))))))
(lvl292 vars291 (quote ()) (quote (())))))) (gen-var161 (lambda (id296) (let
((id297 (if (syntax-object?97 id296) (syntax-object-expression98 id296)
id296))) (if (annotation? id297) (gensym (symbol->string (annotation-expression
id297))) (gensym (symbol->string id297)))))) (strip160 (lambda (x298 w299) (if
(memq (quote top) (wrap-marks116 w299)) (if (let ((t300 (annotation? x298)))
(if t300 t300 (if (pair? x298) (annotation? (car x298)) #f)))
(strip-annotation159 x298 #f) x298) (letrec ((f301 (lambda (x302) (if
(syntax-object?97 x302) (strip160 (syntax-object-expression98 x302)
(syntax-object-wrap99 x302)) (if (pair? x302) (let ((a303 (f301 (car x302)))
(d304 (f301 (cdr x302)))) (if (if (eq? a303 (car x302)) (eq? d304 (cdr x302))
#f) x302 (cons a303 d304))) (if (vector? x302) (let ((old305 (vector->list
x302))) (let ((new306 (map f301 old305))) (if (and-map*17 eq? old305 new306)
x302 (list->vector new306)))) x302)))))) (f301 x298))))) (strip-annotation159
(lambda (x307 parent308) (if (pair? x307) (let ((new309 (cons #f #f))) (begin
(if parent308 (set-annotation-stripped! parent308 new309) (if #f #f)) (set-car!
new309 (strip-annotation159 (car x307) #f)) (set-cdr! new309
(strip-annotation159 (cdr x307) #f)) new309)) (if (annotation? x307) (let
((t310 (annotation-stripped x307))) (if t310 t310 (strip-annotation159
(annotation-expression x307) x307))) (if (vector? x307) (let ((new311
(make-vector (vector-length x307)))) (begin (if parent308
(set-annotation-stripped! parent308 new311) (if #f #f)) (letrec ((loop312
(lambda (i313) (unless (fx<75 i313 0) (vector-set! new311 i313
(strip-annotation159 (vector-ref x307 i313) #f)) (loop312 (fx-73 i313 1))))))
(loop312 (- (vector-length x307) 1))) new311)) x307))))) (ellipsis?158 (lambda
(x314) (if (nonsymbol-id?112 x314) (free-id=?136 x314 (quote #(syntax-object
... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top))
#("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f)))
(chi-void157 (lambda () (build-void80 #f))) (eval-local-transformer156 (lambda
(expanded315 mod316) (let ((p317 (local-eval-hook77 expanded315 mod316))) (if
(procedure? p317) p317 (syntax-violation #f "nonprocedure transformer"
p317))))) (chi-local-syntax155 (lambda (rec?318 e319 r320 w321 s322 mod323
k324) ((lambda (tmp325) ((lambda (tmp326) (if tmp326 (apply (lambda (_327 id328
val329 e1330 e2331) (let ((ids332 id328)) (if (not (valid-bound-ids?138
ids332)) (syntax-violation #f "duplicate bound keyword" e319) (let ((labels334
(gen-labels119 ids332))) (let ((new-w335 (make-binding-wrap130 ids332 labels334
w321))) (k324 (cons e1330 e2331) (extend-env107 labels334 (let ((w337 (if
rec?318 new-w335 w321)) (trans-r338 (macros-only-env109 r320))) (map (lambda
(x339) (cons (quote macro) (eval-local-transformer156 (chi149 x339 trans-r338
w337 mod323) mod323))) val329)) r320) new-w335 s322 mod323)))))) tmp326)
((lambda (_341) (syntax-violation #f "bad local syntax definition"
(source-wrap142 e319 w321 s322 mod323))) tmp325))) ($sc-dispatch tmp325 (quote
(any #(each (any any)) any . each-any))))) e319))) (chi-lambda-clause154
(lambda (e342 docstring343 c344 r345 w346 mod347 k348) ((lambda (tmp349)
((lambda (tmp350) (if (if tmp350 (apply (lambda (args351 doc352 e1353 e2354)
(if (string? (syntax->datum doc352)) (not docstring343) #f)) tmp350) #f) (apply
(lambda (args355 doc356 e1357 e2358) (chi-lambda-clause154 e342 doc356 (cons
args355 (cons e1357 e2358)) r345 w346 mod347 k348)) tmp350) ((lambda (tmp360)
(if tmp360 (apply (lambda (id361 e1362 e2363) (let ((ids364 id361)) (if (not
(valid-bound-ids?138 ids364)) (syntax-violation (quote lambda) "invalid
parameter list" e342) (let ((labels366 (gen-labels119 ids364)) (new-vars367
(map gen-var161 ids364))) (k348 (map syntax->datum ids364) new-vars367 (if
docstring343 (syntax->datum docstring343) #f) (chi-body153 (cons e1362 e2363)
e342 (extend-var-env108 labels366 new-vars367 r345) (make-binding-wrap130
ids364 labels366 w346) mod347)))))) tmp360) ((lambda (tmp369) (if tmp369 (apply
(lambda (ids370 e1371 e2372) (let ((old-ids373 (lambda-var-list162 ids370)))
(if (not (valid-bound-ids?138 old-ids373)) (syntax-violation (quote lambda)
"invalid parameter list" e342) (let ((labels374 (gen-labels119 old-ids373))
(new-vars375 (map gen-var161 old-ids373))) (k348 (letrec ((f376 (lambda (ls1377
ls2378) (if (null? ls1377) (syntax->datum ls2378) (f376 (cdr ls1377) (cons
(syntax->datum (car ls1377)) ls2378)))))) (f376 (cdr old-ids373) (car
old-ids373))) (letrec ((f379 (lambda (ls1380 ls2381) (if (null? ls1380) ls2381
(f379 (cdr ls1380) (cons (car ls1380) ls2381)))))) (f379 (cdr new-vars375) (car
new-vars375))) (if docstring343 (syntax->datum docstring343) #f) (chi-body153
(cons e1371 e2372) e342 (extend-var-env108 labels374 new-vars375 r345)
(make-binding-wrap130 old-ids373 labels374 w346) mod347)))))) tmp369) ((lambda
(_383) (syntax-violation (quote lambda) "bad lambda" e342)) tmp349)))
($sc-dispatch tmp349 (quote (any any . each-any)))))) ($sc-dispatch tmp349
(quote (each-any any . each-any)))))) ($sc-dispatch tmp349 (quote (any any any
. each-any))))) c344))) (chi-body153 (lambda (body384 outer-form385 r386 w387
mod388) (let ((r389 (cons (quote ("placeholder" placeholder)) r386))) (let
((ribcage390 (make-ribcage120 (quote ()) (quote ()) (quote ())))) (let ((w391
(make-wrap115 (wrap-marks116 w387) (cons ribcage390 (wrap-subst117 w387)))))
(letrec ((parse392 (lambda (body393 ids394 labels395 vars396 vals397
bindings398) (if (null? body393) (syntax-violation #f "no expressions in body"
outer-form385) (let ((e400 (cdar body393)) (er401 (caar body393)))
(call-with-values (lambda () (syntax-type147 e400 er401 (quote (())) #f
ribcage390 mod388)) (lambda (type402 value403 e404 w405 s406 mod407) (if (memv
type402 (quote (define-form))) (let ((id408 (wrap141 value403 w405 mod407))
(label409 (gen-label118))) (let ((var410 (gen-var161 id408))) (begin
(extend-ribcage!129 ribcage390 id408 label409) (parse392 (cdr body393) (cons
id408 ids394) (cons label409 labels395) (cons var410 vars396) (cons (cons er401
(wrap141 e404 w405 mod407)) vals397) (cons (cons (quote lexical) var410)
bindings398))))) (if (memv type402 (quote (define-syntax-form))) (let ((id411
(wrap141 value403 w405 mod407)) (label412 (gen-label118))) (begin
(extend-ribcage!129 ribcage390 id411 label412) (parse392 (cdr body393) (cons
id411 ids394) (cons label412 labels395) vars396 vals397 (cons (cons (quote
macro) (cons er401 (wrap141 e404 w405 mod407))) bindings398)))) (if (memv
type402 (quote (begin-form))) ((lambda (tmp413) ((lambda (tmp414) (if tmp414
(apply (lambda (_415 e1416) (parse392 (letrec ((f417 (lambda (forms418) (if
(null? forms418) (cdr body393) (cons (cons er401 (wrap141 (car forms418) w405
mod407)) (f417 (cdr forms418))))))) (f417 e1416)) ids394 labels395 vars396
vals397 bindings398)) tmp414) (syntax-violation #f "source expression failed to
match any pattern" tmp413))) ($sc-dispatch tmp413 (quote (any . each-any)))))
e404) (if (memv type402 (quote (local-syntax-form))) (chi-local-syntax155
value403 e404 er401 w405 s406 mod407 (lambda (forms420 er421 w422 s423 mod424)
(parse392 (letrec ((f425 (lambda (forms426) (if (null? forms426) (cdr body393)
(cons (cons er421 (wrap141 (car forms426) w422 mod424)) (f425 (cdr
forms426))))))) (f425 forms420)) ids394 labels395 vars396 vals397
bindings398))) (if (null? ids394) (build-sequence92 #f (map (lambda (x427)
(chi149 (cdr x427) (car x427) (quote (())) mod407)) (cons (cons er401
(source-wrap142 e404 w405 s406 mod407)) (cdr body393)))) (begin (if (not
(valid-bound-ids?138 ids394)) (syntax-violation #f "invalid or duplicate
identifier in definition" outer-form385) (if #f #f)) (letrec ((loop428 (lambda
(bs429 er-cache430 r-cache431) (if (not (null? bs429)) (let ((b432 (car
bs429))) (if (eq? (car b432) (quote macro)) (let ((er433 (cadr b432))) (let
((r-cache434 (if (eq? er433 er-cache430) r-cache431 (macros-only-env109
er433)))) (begin (set-cdr! b432 (eval-local-transformer156 (chi149 (cddr b432)
r-cache434 (quote (())) mod407) mod407)) (loop428 (cdr bs429) er433
r-cache434)))) (loop428 (cdr bs429) er-cache430 r-cache431))) (if #f #f)))))
(loop428 bindings398 #f #f)) (set-cdr! r389 (extend-env107 labels395
bindings398 (cdr r389))) (build-letrec95 #f (map syntax->datum ids394) vars396
(map (lambda (x435) (chi149 (cdr x435) (car x435) (quote (())) mod407))
vals397) (build-sequence92 #f (map (lambda (x436) (chi149 (cdr x436) (car x436)
(quote (())) mod407)) (cons (cons er401 (source-wrap142 e404 w405 s406 mod407))
(cdr body393)))))))))))))))))) (parse392 (map (lambda (x399) (cons r389
(wrap141 x399 w391 mod388))) body384) (quote ()) (quote ()) (quote ()) (quote
()) (quote ())))))))) (chi-macro152 (lambda (p437 e438 r439 w440 rib441 mod442)
(letrec ((rebuild-macro-output443 (lambda (x444 m445) (if (pair? x444) (cons
(rebuild-macro-output443 (car x444) m445) (rebuild-macro-output443 (cdr x444)
m445)) (if (syntax-object?97 x444) (let ((w446 (syntax-object-wrap99 x444)))
(let ((ms447 (wrap-marks116 w446)) (s448 (wrap-subst117 w446))) (if (if (pair?
ms447) (eq? (car ms447) #f) #f) (make-syntax-object96
(syntax-object-expression98 x444) (make-wrap115 (cdr ms447) (if rib441 (cons
rib441 (cdr s448)) (cdr s448))) (syntax-object-module100 x444))
(make-syntax-object96 (syntax-object-expression98 x444) (make-wrap115 (cons
m445 ms447) (if rib441 (cons rib441 (cons (quote shift) s448)) (cons (quote
shift) s448))) (let ((pmod449 (procedure-module p437))) (if pmod449 (cons
(quote hygiene) (module-name pmod449)) (quote (hygiene guile)))))))) (if
(vector? x444) (let ((n450 (vector-length x444))) (let ((v451 (make-vector
n450))) (letrec ((loop452 (lambda (i453) (if (fx=74 i453 n450) (begin (if #f #f
(if #f #f)) v451) (begin (vector-set! v451 i453 (rebuild-macro-output443
(vector-ref x444 i453) m445)) (loop452 (fx+72 i453 1))))))) (loop452 0)))) (if
(symbol? x444) (syntax-violation #f "encountered raw symbol in macro output"
(source-wrap142 e438 w440 s mod442) x444) x444))))))) (rebuild-macro-output443
(p437 (wrap141 e438 (anti-mark128 w440) mod442)) (string #\m)))))
(chi-application151 (lambda (x454 e455 r456 w457 s458 mod459) ((lambda (tmp460)
((lambda (tmp461) (if tmp461 (apply (lambda (e0462 e1463) (build-application81
s458 x454 (map (lambda (e464) (chi149 e464 r456 w457 mod459)) e1463))) tmp461)
(syntax-violation #f "source expression failed to match any pattern" tmp460)))
($sc-dispatch tmp460 (quote (any . each-any))))) e455))) (chi-expr150 (lambda
(type466 value467 e468 r469 w470 s471 mod472) (if (memv type466 (quote
(lexical))) (build-lexical-reference83 (quote value) s471 e468 value467) (if
(memv type466 (quote (core external-macro))) (value467 e468 r469 w470 s471
mod472) (if (memv type466 (quote (module-ref))) (call-with-values (lambda ()
(value467 e468)) (lambda (id473 mod474) (build-global-reference86 s471 id473
mod474))) (if (memv type466 (quote (lexical-call))) (chi-application151
(build-lexical-reference83 (quote fun) (source-annotation104 (car e468)) (car
e468) value467) e468 r469 w470 s471 mod472) (if (memv type466 (quote
(global-call))) (chi-application151 (build-global-reference86
(source-annotation104 (car e468)) value467 (if (syntax-object?97 (car e468))
(syntax-object-module100 (car e468)) mod472)) e468 r469 w470 s471 mod472) (if
(memv type466 (quote (constant))) (build-data91 s471 (strip160 (source-wrap142
e468 w470 s471 mod472) (quote (())))) (if (memv type466 (quote (global)))
(build-global-reference86 s471 value467 mod472) (if (memv type466 (quote
(call))) (chi-application151 (chi149 (car e468) r469 w470 mod472) e468 r469
w470 s471 mod472) (if (memv type466 (quote (begin-form))) ((lambda (tmp475)
((lambda (tmp476) (if tmp476 (apply (lambda (_477 e1478 e2479) (chi-sequence143
(cons e1478 e2479) r469 w470 s471 mod472)) tmp476) (syntax-violation #f "source
expression failed to match any pattern" tmp475))) ($sc-dispatch tmp475 (quote
(any any . each-any))))) e468) (if (memv type466 (quote (local-syntax-form)))
(chi-local-syntax155 value467 e468 r469 w470 s471 mod472 chi-sequence143) (if
(memv type466 (quote (eval-when-form))) ((lambda (tmp481) ((lambda (tmp482) (if
tmp482 (apply (lambda (_483 x484 e1485 e2486) (let ((when-list487
(chi-when-list146 e468 x484 w470))) (if (memq (quote eval) when-list487)
(chi-sequence143 (cons e1485 e2486) r469 w470 s471 mod472) (chi-void157))))
tmp482) (syntax-violation #f "source expression failed to match any pattern"
tmp481))) ($sc-dispatch tmp481 (quote (any each-any any . each-any))))) e468)
(if (memv type466 (quote (define-form define-syntax-form))) (syntax-violation
#f "definition in expression context" e468 (wrap141 value467 w470 mod472)) (if
(memv type466 (quote (syntax))) (syntax-violation #f "reference to pattern
variable outside syntax form" (source-wrap142 e468 w470 s471 mod472)) (if (memv
type466 (quote (displaced-lexical))) (syntax-violation #f "reference to
identifier outside its scope" (source-wrap142 e468 w470 s471 mod472))
(syntax-violation #f "unexpected syntax" (source-wrap142 e468 w470 s471
mod472)))))))))))))))))) (chi149 (lambda (e490 r491 w492 mod493)
(call-with-values (lambda () (syntax-type147 e490 r491 w492 #f #f mod493))
(lambda (type494 value495 e496 w497 s498 mod499) (chi-expr150 type494 value495
e496 r491 w497 s498 mod499))))) (chi-top148 (lambda (e500 r501 w502 m503
esew504 mod505) (call-with-values (lambda () (syntax-type147 e500 r501 w502 #f
#f mod505)) (lambda (type513 value514 e515 w516 s517 mod518) (if (memv type513
(quote (begin-form))) ((lambda (tmp519) ((lambda (tmp520) (if tmp520 (apply
(lambda (_521) (chi-void157)) tmp520) ((lambda (tmp522) (if tmp522 (apply
(lambda (_523 e1524 e2525) (chi-top-sequence144 (cons e1524 e2525) r501 w516
s517 m503 esew504 mod518)) tmp522) (syntax-violation #f "source expression
failed to match any pattern" tmp519))) ($sc-dispatch tmp519 (quote (any any .
each-any)))))) ($sc-dispatch tmp519 (quote (any))))) e515) (if (memv type513
(quote (local-syntax-form))) (chi-local-syntax155 value514 e515 r501 w516 s517
mod518 (lambda (body527 r528 w529 s530 mod531) (chi-top-sequence144 body527
r528 w529 s530 m503 esew504 mod531))) (if (memv type513 (quote
(eval-when-form))) ((lambda (tmp532) ((lambda (tmp533) (if tmp533 (apply
(lambda (_534 x535 e1536 e2537) (let ((when-list538 (chi-when-list146 e515 x535
w516)) (body539 (cons e1536 e2537))) (if (eq? m503 (quote e)) (if (memq (quote
eval) when-list538) (chi-top-sequence144 body539 r501 w516 s517 (quote e)
(quote (eval)) mod518) (chi-void157)) (if (memq (quote load) when-list538) (if
(let ((t542 (memq (quote compile) when-list538))) (if t542 t542 (if (eq? m503
(quote c&e)) (memq (quote eval) when-list538) #f))) (chi-top-sequence144
body539 r501 w516 s517 (quote c&e) (quote (compile load)) mod518) (if (memq
m503 (quote (c c&e))) (chi-top-sequence144 body539 r501 w516 s517 (quote c)
(quote (load)) mod518) (chi-void157))) (if (let ((t543 (memq (quote compile)
when-list538))) (if t543 t543 (if (eq? m503 (quote c&e)) (memq (quote eval)
when-list538) #f))) (begin (top-level-eval-hook76 (chi-top-sequence144 body539
r501 w516 s517 (quote e) (quote (eval)) mod518) mod518) (chi-void157))
(chi-void157)))))) tmp533) (syntax-violation #f "source expression failed to
match any pattern" tmp532))) ($sc-dispatch tmp532 (quote (any each-any any .
each-any))))) e515) (if (memv type513 (quote (define-syntax-form))) (let ((n544
(id-var-name135 value514 w516)) (r545 (macros-only-env109 r501))) (if (memv
m503 (quote (c))) (if (memq (quote compile) esew504) (let ((e546
(chi-install-global145 n544 (chi149 e515 r545 w516 mod518)))) (begin
(top-level-eval-hook76 e546 mod518) (if (memq (quote load) esew504) e546
(chi-void157)))) (if (memq (quote load) esew504) (chi-install-global145 n544
(chi149 e515 r545 w516 mod518)) (chi-void157))) (if (memv m503 (quote (c&e)))
(let ((e547 (chi-install-global145 n544 (chi149 e515 r545 w516 mod518))))
(begin (top-level-eval-hook76 e547 mod518) e547)) (begin (if (memq (quote eval)
esew504) (top-level-eval-hook76 (chi-install-global145 n544 (chi149 e515 r545
w516 mod518)) mod518) (if #f #f)) (chi-void157))))) (if (memv type513 (quote
(define-form))) (let ((n548 (id-var-name135 value514 w516))) (let ((type549
(binding-type105 (lookup110 n548 r501 mod518)))) (if (memv type549 (quote
(global core macro module-ref))) (let ((x550 (build-global-definition88 s517
n548 (chi149 e515 r501 w516 mod518)))) (begin (if (eq? m503 (quote c&e))
(top-level-eval-hook76 x550 mod518) (if #f #f)) x550)) (if (memv type549 (quote
(displaced-lexical))) (syntax-violation #f "identifier out of context" e515
(wrap141 value514 w516 mod518)) (syntax-violation #f "cannot define keyword at
top level" e515 (wrap141 value514 w516 mod518)))))) (let ((x551 (chi-expr150
type513 value514 e515 r501 w516 s517 mod518))) (begin (if (eq? m503 (quote
c&e)) (top-level-eval-hook76 x551 mod518) (if #f #f)) x551)))))))))))
(syntax-type147 (lambda (e552 r553 w554 s555 rib556 mod557) (if (symbol? e552)
(let ((n558 (id-var-name135 e552 w554))) (let ((b559 (lookup110 n558 r553
mod557))) (let ((type560 (binding-type105 b559))) (if (memv type560 (quote
(lexical))) (values type560 (binding-value106 b559) e552 w554 s555 mod557) (if
(memv type560 (quote (global))) (values type560 n558 e552 w554 s555 mod557) (if
(memv type560 (quote (macro))) (syntax-type147 (chi-macro152 (binding-value106
b559) e552 r553 w554 rib556 mod557) r553 (quote (())) s555 rib556 mod557)
(values type560 (binding-value106 b559) e552 w554 s555 mod557))))))) (if (pair?
e552) (let ((first561 (car e552))) (if (id?113 first561) (let ((n562
(id-var-name135 first561 w554))) (let ((b563 (lookup110 n562 r553 (let ((t564
(if (syntax-object?97 first561) (syntax-object-module100 first561) #f))) (if
t564 t564 mod557))))) (let ((type565 (binding-type105 b563))) (if (memv type565
(quote (lexical))) (values (quote lexical-call) (binding-value106 b563) e552
w554 s555 mod557) (if (memv type565 (quote (global))) (values (quote
global-call) n562 e552 w554 s555 mod557) (if (memv type565 (quote (macro)))
(syntax-type147 (chi-macro152 (binding-value106 b563) e552 r553 w554 rib556
mod557) r553 (quote (())) s555 rib556 mod557) (if (memv type565 (quote (core
external-macro module-ref))) (values type565 (binding-value106 b563) e552 w554
s555 mod557) (if (memv type565 (quote (local-syntax))) (values (quote
local-syntax-form) (binding-value106 b563) e552 w554 s555 mod557) (if (memv
type565 (quote (begin))) (values (quote begin-form) #f e552 w554 s555 mod557)
(if (memv type565 (quote (eval-when))) (values (quote eval-when-form) #f e552
w554 s555 mod557) (if (memv type565 (quote (define))) ((lambda (tmp566)
((lambda (tmp567) (if (if tmp567 (apply (lambda (_568 name569 val570) (id?113
name569)) tmp567) #f) (apply (lambda (_571 name572 val573) (values (quote
define-form) name572 val573 w554 s555 mod557)) tmp567) ((lambda (tmp574) (if
(if tmp574 (apply (lambda (_575 name576 args577 e1578 e2579) (if (id?113
name576) (valid-bound-ids?138 (lambda-var-list162 args577)) #f)) tmp574) #f)
(apply (lambda (_580 name581 args582 e1583 e2584) (values (quote define-form)
(wrap141 name581 w554 mod557) (cons (quote #(syntax-object lambda ((top)
#(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i"
"i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage
#(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
(wrap141 (cons args582 (cons e1583 e2584)) w554 mod557)) (quote (())) s555
mod557)) tmp574) ((lambda (tmp586) (if (if tmp586 (apply (lambda (_587 name588)
(id?113 name588)) tmp586) #f) (apply (lambda (_589 name590) (values (quote
define-form) (wrap141 name590 w554 mod557) (quote (#(syntax-object if ((top)
#(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var
strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks
join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage
new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap
set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels
ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label
make-rename rename-marks rename-new rename-old subst-rename? wrap-subst
wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id?
global-extend lookup macros-only-env extend-var-env extend-env null-env
binding-value binding-type make-binding arg-check source-annotation no-source
unannotate set-syntax-object-module! set-syntax-object-wrap!
set-syntax-object-expression! syntax-object-module syntax-object-wrap
syntax-object-expression syntax-object? make-syntax-object build-lexical-var
build-letrec build-named-let build-let build-sequence build-data build-primref
build-lambda build-global-definition build-global-assignment
build-global-reference analyze-variable build-lexical-assignment
build-lexical-reference build-conditional build-application build-void
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i")))
(hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))
#(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e
r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
(())) s555 mod557)) tmp586) (syntax-violation #f "source expression failed to
match any pattern" tmp566))) ($sc-dispatch tmp566 (quote (any any))))))
($sc-dispatch tmp566 (quote (any (any . any) any . each-any)))))) ($sc-dispatch
tmp566 (quote (any any any))))) e552) (if (memv type565 (quote
(define-syntax))) ((lambda (tmp591) ((lambda (tmp592) (if (if tmp592 (apply
(lambda (_593 name594 val595) (id?113 name594)) tmp592) #f) (apply (lambda
(_596 name597 val598) (values (quote define-syntax-form) name597 val598 w554
s555 mod557)) tmp592) (syntax-violation #f "source expression failed to match
any pattern" tmp591))) ($sc-dispatch tmp591 (quote (any any any))))) e552)
(values (quote call) #f e552 w554 s555 mod557))))))))))))) (values (quote call)
#f e552 w554 s555 mod557))) (if (syntax-object?97 e552) (syntax-type147
(syntax-object-expression98 e552) r553 (join-wraps132 w554
(syntax-object-wrap99 e552)) #f rib556 (let ((t599 (syntax-object-module100
e552))) (if t599 t599 mod557))) (if (annotation? e552) (syntax-type147
(annotation-expression e552) r553 w554 (annotation-source e552) rib556 mod557)
(if (self-evaluating? e552) (values (quote constant) #f e552 w554 s555 mod557)
(values (quote other) #f e552 w554 s555 mod557)))))))) (chi-when-list146
(lambda (e600 when-list601 w602) (letrec ((f603 (lambda (when-list604
situations605) (if (null? when-list604) situations605 (f603 (cdr when-list604)
(cons (let ((x606 (car when-list604))) (if (free-id=?136 x606 (quote
#(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list
situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
compile) (if (free-id=?136 x606 (quote #(syntax-object load ((top) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
load) (if (free-id=?136 x606 (quote #(syntax-object eval ((top) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
eval) (syntax-violation (quote eval-when) "invalid situation" e600 (wrap141
x606 w602 #f)))))) situations605)))))) (f603 when-list601 (quote ())))))
(chi-install-global145 (lambda (name607 e608) (build-global-definition88 #f
name607 (if (let ((v609 (module-variable (current-module) name607))) (if v609
(if (variable-bound? v609) (if (macro? (variable-ref v609)) (not (eq?
(macro-type (variable-ref v609)) (quote syncase-macro))) #f) #f) #f))
(build-application81 #f (build-primref90 #f (quote
make-extended-syncase-macro)) (list (build-application81 #f (build-primref90 #f
(quote module-ref)) (list (build-application81 #f (build-primref90 #f (quote
current-module)) (quote ())) (build-data91 #f name607))) (build-data91 #f
(quote macro)) e608)) (build-application81 #f (build-primref90 #f (quote
make-syncase-macro)) (list (build-data91 #f (quote macro)) e608))))))
(chi-top-sequence144 (lambda (body610 r611 w612 s613 m614 esew615 mod616)
(build-sequence92 s613 (letrec ((dobody617 (lambda (body618 r619 w620 m621
esew622 mod623) (if (null? body618) (quote ()) (let ((first624 (chi-top148 (car
body618) r619 w620 m621 esew622 mod623))) (cons first624 (dobody617 (cdr
body618) r619 w620 m621 esew622 mod623))))))) (dobody617 body610 r611 w612 m614
esew615 mod616))))) (chi-sequence143 (lambda (body625 r626 w627 s628 mod629)
(build-sequence92 s628 (letrec ((dobody630 (lambda (body631 r632 w633 mod634)
(if (null? body631) (quote ()) (let ((first635 (chi149 (car body631) r632 w633
mod634))) (cons first635 (dobody630 (cdr body631) r632 w633 mod634)))))))
(dobody630 body625 r626 w627 mod629))))) (source-wrap142 (lambda (x636 w637
s638 defmod639) (wrap141 (if s638 (make-annotation x636 s638 #f) x636) w637
defmod639))) (wrap141 (lambda (x640 w641 defmod642) (if (if (null?
(wrap-marks116 w641)) (null? (wrap-subst117 w641)) #f) x640 (if
(syntax-object?97 x640) (make-syntax-object96 (syntax-object-expression98 x640)
(join-wraps132 w641 (syntax-object-wrap99 x640)) (syntax-object-module100
x640)) (if (null? x640) x640 (make-syntax-object96 x640 w641 defmod642))))))
(bound-id-member?140 (lambda (x643 list644) (if (not (null? list644)) (let
((t645 (bound-id=?137 x643 (car list644)))) (if t645 t645 (bound-id-member?140
x643 (cdr list644)))) #f))) (distinct-bound-ids?139 (lambda (ids646) (letrec
((distinct?647 (lambda (ids648) (let ((t649 (null? ids648))) (if t649 t649 (if
(not (bound-id-member?140 (car ids648) (cdr ids648))) (distinct?647 (cdr
ids648)) #f)))))) (distinct?647 ids646)))) (valid-bound-ids?138 (lambda
(ids650) (if (letrec ((all-ids?651 (lambda (ids652) (let ((t653 (null?
ids652))) (if t653 t653 (if (id?113 (car ids652)) (all-ids?651 (cdr ids652))
#f)))))) (all-ids?651 ids650)) (distinct-bound-ids?139 ids650) #f)))
(bound-id=?137 (lambda (i654 j655) (if (if (syntax-object?97 i654)
(syntax-object?97 j655) #f) (if (eq? (let ((e656 (syntax-object-expression98
i654))) (if (annotation? e656) (annotation-expression e656) e656)) (let ((e657
(syntax-object-expression98 j655))) (if (annotation? e657)
(annotation-expression e657) e657))) (same-marks?134 (wrap-marks116
(syntax-object-wrap99 i654)) (wrap-marks116 (syntax-object-wrap99 j655))) #f)
(eq? (let ((e658 i654)) (if (annotation? e658) (annotation-expression e658)
e658)) (let ((e659 j655)) (if (annotation? e659) (annotation-expression e659)
e659)))))) (free-id=?136 (lambda (i660 j661) (if (eq? (let ((x662 i660)) (let
((e663 (if (syntax-object?97 x662) (syntax-object-expression98 x662) x662)))
(if (annotation? e663) (annotation-expression e663) e663))) (let ((x664 j661))
(let ((e665 (if (syntax-object?97 x664) (syntax-object-expression98 x664)
x664))) (if (annotation? e665) (annotation-expression e665) e665)))) (eq?
(id-var-name135 i660 (quote (()))) (id-var-name135 j661 (quote (())))) #f)))
(id-var-name135 (lambda (id666 w667) (letrec ((search-vector-rib670 (lambda
(sym676 subst677 marks678 symnames679 ribcage680) (let ((n681 (vector-length
symnames679))) (letrec ((f682 (lambda (i683) (if (fx=74 i683 n681) (search668
sym676 (cdr subst677) marks678) (if (if (eq? (vector-ref symnames679 i683)
sym676) (same-marks?134 marks678 (vector-ref (ribcage-marks123 ribcage680)
i683)) #f) (values (vector-ref (ribcage-labels124 ribcage680) i683) marks678)
(f682 (fx+72 i683 1))))))) (f682 0))))) (search-list-rib669 (lambda (sym684
subst685 marks686 symnames687 ribcage688) (letrec ((f689 (lambda (symnames690
i691) (if (null? symnames690) (search668 sym684 (cdr subst685) marks686) (if
(if (eq? (car symnames690) sym684) (same-marks?134 marks686 (list-ref
(ribcage-marks123 ribcage688) i691)) #f) (values (list-ref (ribcage-labels124
ribcage688) i691) marks686) (f689 (cdr symnames690) (fx+72 i691 1))))))) (f689
symnames687 0)))) (search668 (lambda (sym692 subst693 marks694) (if (null?
subst693) (values #f marks694) (let ((fst695 (car subst693))) (if (eq? fst695
(quote shift)) (search668 sym692 (cdr subst693) (cdr marks694)) (let
((symnames696 (ribcage-symnames122 fst695))) (if (vector? symnames696)
(search-vector-rib670 sym692 subst693 marks694 symnames696 fst695)
(search-list-rib669 sym692 subst693 marks694 symnames696 fst695))))))))) (if
(symbol? id666) (let ((t697 (call-with-values (lambda () (search668 id666
(wrap-subst117 w667) (wrap-marks116 w667))) (lambda (x699 . ignore698) x699))))
(if t697 t697 id666)) (if (syntax-object?97 id666) (let ((id700 (let ((e702
(syntax-object-expression98 id666))) (if (annotation? e702)
(annotation-expression e702) e702))) (w1701 (syntax-object-wrap99 id666))) (let
((marks703 (join-marks133 (wrap-marks116 w667) (wrap-marks116 w1701))))
(call-with-values (lambda () (search668 id700 (wrap-subst117 w667) marks703))
(lambda (new-id704 marks705) (let ((t706 new-id704)) (if t706 t706 (let ((t707
(call-with-values (lambda () (search668 id700 (wrap-subst117 w1701) marks705))
(lambda (x709 . ignore708) x709)))) (if t707 t707 id700)))))))) (if
(annotation? id666) (let ((id710 (let ((e711 id666)) (if (annotation? e711)
(annotation-expression e711) e711)))) (let ((t712 (call-with-values (lambda ()
(search668 id710 (wrap-subst117 w667) (wrap-marks116 w667))) (lambda (x714 .
ignore713) x714)))) (if t712 t712 id710))) (syntax-violation (quote
id-var-name) "invalid id" id666))))))) (same-marks?134 (lambda (x715 y716) (let
((t717 (eq? x715 y716))) (if t717 t717 (if (not (null? x715)) (if (not (null?
y716)) (if (eq? (car x715) (car y716)) (same-marks?134 (cdr x715) (cdr y716))
#f) #f) #f))))) (join-marks133 (lambda (m1718 m2719) (smart-append131 m1718
m2719))) (join-wraps132 (lambda (w1720 w2721) (let ((m1722 (wrap-marks116
w1720)) (s1723 (wrap-subst117 w1720))) (if (null? m1722) (if (null? s1723)
w2721 (make-wrap115 (wrap-marks116 w2721) (smart-append131 s1723 (wrap-subst117
w2721)))) (make-wrap115 (smart-append131 m1722 (wrap-marks116 w2721))
(smart-append131 s1723 (wrap-subst117 w2721))))))) (smart-append131 (lambda
(m1724 m2725) (if (null? m2725) m1724 (append m1724 m2725))))
(make-binding-wrap130 (lambda (ids726 labels727 w728) (if (null? ids726) w728
(make-wrap115 (wrap-marks116 w728) (cons (let ((labelvec729 (list->vector
labels727))) (let ((n730 (vector-length labelvec729))) (let ((symnamevec731
(make-vector n730)) (marksvec732 (make-vector n730))) (begin (letrec ((f733
(lambda (ids734 i735) (if (not (null? ids734)) (call-with-values (lambda ()
(id-sym-name&marks114 (car ids734) w728)) (lambda (symname736 marks737) (begin
(vector-set! symnamevec731 i735 symname736) (vector-set! marksvec732 i735
marks737) (f733 (cdr ids734) (fx+72 i735 1))))) (if #f #f))))) (f733 ids726 0))
(make-ribcage120 symnamevec731 marksvec732 labelvec729))))) (wrap-subst117
w728)))))) (extend-ribcage!129 (lambda (ribcage738 id739 label740) (begin
(set-ribcage-symnames!125 ribcage738 (cons (let ((e741
(syntax-object-expression98 id739))) (if (annotation? e741)
(annotation-expression e741) e741)) (ribcage-symnames122 ribcage738)))
(set-ribcage-marks!126 ribcage738 (cons (wrap-marks116 (syntax-object-wrap99
id739)) (ribcage-marks123 ribcage738))) (set-ribcage-labels!127 ribcage738
(cons label740 (ribcage-labels124 ribcage738)))))) (anti-mark128 (lambda (w742)
(make-wrap115 (cons #f (wrap-marks116 w742)) (cons (quote shift) (wrap-subst117
w742))))) (set-ribcage-labels!127 (lambda (x743 update744) (vector-set! x743 3
update744))) (set-ribcage-marks!126 (lambda (x745 update746) (vector-set! x745
2 update746))) (set-ribcage-symnames!125 (lambda (x747 update748) (vector-set!
x747 1 update748))) (ribcage-labels124 (lambda (x749) (vector-ref x749 3)))
(ribcage-marks123 (lambda (x750) (vector-ref x750 2))) (ribcage-symnames122
(lambda (x751) (vector-ref x751 1))) (ribcage?121 (lambda (x752) (if (vector?
x752) (if (= (vector-length x752) 4) (eq? (vector-ref x752 0) (quote ribcage))
#f) #f))) (make-ribcage120 (lambda (symnames753 marks754 labels755) (vector
(quote ribcage) symnames753 marks754 labels755))) (gen-labels119 (lambda
(ls756) (if (null? ls756) (quote ()) (cons (gen-label118) (gen-labels119 (cdr
ls756)))))) (gen-label118 (lambda () (string #\i))) (wrap-subst117 cdr)
(wrap-marks116 car) (make-wrap115 cons) (id-sym-name&marks114 (lambda (x757
w758) (if (syntax-object?97 x757) (values (let ((e759
(syntax-object-expression98 x757))) (if (annotation? e759)
(annotation-expression e759) e759)) (join-marks133 (wrap-marks116 w758)
(wrap-marks116 (syntax-object-wrap99 x757)))) (values (let ((e760 x757)) (if
(annotation? e760) (annotation-expression e760) e760)) (wrap-marks116 w758)))))
(id?113 (lambda (x761) (if (symbol? x761) #t (if (syntax-object?97 x761)
(symbol? (let ((e762 (syntax-object-expression98 x761))) (if (annotation? e762)
(annotation-expression e762) e762))) (if (annotation? x761) (symbol?
(annotation-expression x761)) #f))))) (nonsymbol-id?112 (lambda (x763) (if
(syntax-object?97 x763) (symbol? (let ((e764 (syntax-object-expression98
x763))) (if (annotation? e764) (annotation-expression e764) e764))) #f)))
(global-extend111 (lambda (type765 sym766 val767) (put-global-definition-hook78
sym766 type765 val767))) (lookup110 (lambda (x768 r769 mod770) (let ((temp771
(assq x768 r769))) (if temp771 (cdr temp771) (if (symbol? x768) (let ((t772
(get-global-definition-hook79 x768 mod770))) (if t772 t772 (quote (global))))
(quote (displaced-lexical))))))) (macros-only-env109 (lambda (r773) (if (null?
r773) (quote ()) (let ((a774 (car r773))) (if (eq? (cadr a774) (quote macro))
(cons a774 (macros-only-env109 (cdr r773))) (macros-only-env109 (cdr
r773))))))) (extend-var-env108 (lambda (labels775 vars776 r777) (if (null?
labels775) r777 (extend-var-env108 (cdr labels775) (cdr vars776) (cons (cons
(car labels775) (cons (quote lexical) (car vars776))) r777))))) (extend-env107
(lambda (labels778 bindings779 r780) (if (null? labels778) r780 (extend-env107
(cdr labels778) (cdr bindings779) (cons (cons (car labels778) (car
bindings779)) r780))))) (binding-value106 cdr) (binding-type105 car)
(source-annotation104 (lambda (x781) (if (annotation? x781) (annotation-source
x781) (if (syntax-object?97 x781) (source-annotation104
(syntax-object-expression98 x781)) #f)))) (set-syntax-object-module!103 (lambda
(x782 update783) (vector-set! x782 3 update783))) (set-syntax-object-wrap!102
(lambda (x784 update785) (vector-set! x784 2 update785)))
(set-syntax-object-expression!101 (lambda (x786 update787) (vector-set! x786 1
update787))) (syntax-object-module100 (lambda (x788) (vector-ref x788 3)))
(syntax-object-wrap99 (lambda (x789) (vector-ref x789 2)))
(syntax-object-expression98 (lambda (x790) (vector-ref x790 1)))
(syntax-object?97 (lambda (x791) (if (vector? x791) (if (= (vector-length x791)
4) (eq? (vector-ref x791 0) (quote syntax-object)) #f) #f)))
(make-syntax-object96 (lambda (expression792 wrap793 module794) (vector (quote
syntax-object) expression792 wrap793 module794))) (build-letrec95 (lambda
(src795 ids796 vars797 val-exps798 body-exp799) (if (null? vars797) body-exp799
(let ((atom-key800 (fluid-ref *mode*71))) (if (memv atom-key800 (quote (c)))
((@ (language tree-il) make-letrec) src795 ids796 vars797 val-exps798
body-exp799) (list (quote letrec) (map list vars797 val-exps798)
body-exp799)))))) (build-named-let94 (lambda (src801 ids802 vars803 val-exps804
body-exp805) (let ((f806 (car vars803)) (f-name807 (car ids802)) (vars808 (cdr
vars803)) (ids809 (cdr ids802))) (let ((atom-key810 (fluid-ref *mode*71))) (if
(memv atom-key810 (quote (c))) ((@ (language tree-il) make-letrec) src801 (list
f-name807) (list f806) (list (build-lambda89 src801 ids809 vars808 #f
body-exp805)) (build-application81 src801 (build-lexical-reference83 (quote
fun) src801 f-name807 f806) val-exps804)) (list (quote let) f806 (map list
vars808 val-exps804) body-exp805)))))) (build-let93 (lambda (src811 ids812
vars813 val-exps814 body-exp815) (if (null? vars813) body-exp815 (let
((atom-key816 (fluid-ref *mode*71))) (if (memv atom-key816 (quote (c))) ((@
(language tree-il) make-let) src811 ids812 vars813 val-exps814 body-exp815)
(list (quote let) (map list vars813 val-exps814) body-exp815))))))
(build-sequence92 (lambda (src817 exps818) (if (null? (cdr exps818)) (car
exps818) (let ((atom-key819 (fluid-ref *mode*71))) (if (memv atom-key819 (quote
(c))) ((@ (language tree-il) make-sequence) src817 exps818) (cons (quote begin)
exps818)))))) (build-data91 (lambda (src820 exp821) (let ((atom-key822
(fluid-ref *mode*71))) (if (memv atom-key822 (quote (c))) ((@ (language
tree-il) make-const) src820 exp821) (if (if (self-evaluating? exp821) (not
(vector? exp821)) #f) exp821 (list (quote quote) exp821)))))) (build-primref90
(lambda (src823 name824) (if (equal? (module-name (current-module)) (quote
(guile))) (let ((atom-key825 (fluid-ref *mode*71))) (if (memv atom-key825
(quote (c))) ((@ (language tree-il) make-toplevel-ref) src823 name824)
name824)) (let ((atom-key826 (fluid-ref *mode*71))) (if (memv atom-key826
(quote (c))) ((@ (language tree-il) make-module-ref) src823 (quote (guile))
name824 #f) (list (quote @@) (quote (guile)) name824)))))) (build-lambda89
(lambda (src827 ids828 vars829 docstring830 exp831) (let ((atom-key832
(fluid-ref *mode*71))) (if (memv atom-key832 (quote (c))) ((@ (language
tree-il) make-lambda) src827 ids828 vars829 (if docstring830 (list (cons (quote
documentation) docstring830)) (quote ())) exp831) (cons (quote lambda) (cons
vars829 (append (if docstring830 (list docstring830) (quote ())) (list
exp831)))))))) (build-global-definition88 (lambda (source833 var834 exp835)
(let ((atom-key836 (fluid-ref *mode*71))) (if (memv atom-key836 (quote (c)))
((@ (language tree-il) make-toplevel-define) source833 var834 exp835) (list
(quote define) var834 exp835))))) (build-global-assignment87 (lambda (source837
var838 exp839 mod840) (analyze-variable85 mod840 var838 (lambda (mod841 var842
public?843) (let ((atom-key844 (fluid-ref *mode*71))) (if (memv atom-key844
(quote (c))) ((@ (language tree-il) make-module-set) source837 mod841 var842
public?843 exp839) (list (quote set!) (list (if public?843 (quote @) (quote
@@)) mod841 var842) exp839)))) (lambda (var845) (let ((atom-key846 (fluid-ref
*mode*71))) (if (memv atom-key846 (quote (c))) ((@ (language tree-il)
make-toplevel-set) source837 var845 exp839) (list (quote set!) var845
exp839))))))) (build-global-reference86 (lambda (source847 var848 mod849)
(analyze-variable85 mod849 var848 (lambda (mod850 var851 public?852) (let
((atom-key853 (fluid-ref *mode*71))) (if (memv atom-key853 (quote (c))) ((@
(language tree-il) make-module-ref) source847 mod850 var851 public?852) (list
(if public?852 (quote @) (quote @@)) mod850 var851)))) (lambda (var854) (let
((atom-key855 (fluid-ref *mode*71))) (if (memv atom-key855 (quote (c))) ((@
(language tree-il) make-toplevel-ref) source847 var854) var854))))))
(analyze-variable85 (lambda (mod856 var857 modref-cont858 bare-cont859) (if
(not mod856) (bare-cont859 var857) (let ((kind860 (car mod856)) (mod861 (cdr
mod856))) (if (memv kind860 (quote (public))) (modref-cont858 mod861 var857 #t)
(if (memv kind860 (quote (private))) (if (not (equal? mod861 (module-name
(current-module)))) (modref-cont858 mod861 var857 #f) (bare-cont859 var857))
(if (memv kind860 (quote (bare))) (bare-cont859 var857) (if (memv kind860
(quote (hygiene))) (if (if (not (equal? mod861 (module-name (current-module))))
(module-variable (resolve-module mod861) var857) #f) (modref-cont858 mod861
var857 #f) (bare-cont859 var857)) (syntax-violation #f "bad module kind" var857
mod861))))))))) (build-lexical-assignment84 (lambda (source862 name863 var864
exp865) (let ((atom-key866 (fluid-ref *mode*71))) (if (memv atom-key866 (quote
(c))) ((@ (language tree-il) make-lexical-set) source862 name863 var864 exp865)
(list (quote set!) var864 exp865))))) (build-lexical-reference83 (lambda
(type867 source868 name869 var870) (let ((atom-key871 (fluid-ref *mode*71)))
(if (memv atom-key871 (quote (c))) ((@ (language tree-il) make-lexical-ref)
source868 name869 var870) var870)))) (build-conditional82 (lambda (source872
test-exp873 then-exp874 else-exp875) (let ((atom-key876 (fluid-ref *mode*71)))
(if (memv atom-key876 (quote (c))) ((@ (language tree-il) make-conditional)
source872 test-exp873 then-exp874 else-exp875) (list (quote if) test-exp873
then-exp874 else-exp875))))) (build-application81 (lambda (source877 fun-exp878
arg-exps879) (let ((atom-key880 (fluid-ref *mode*71))) (if (memv atom-key880
(quote (c))) ((@ (language tree-il) make-application) source877 fun-exp878
arg-exps879) (cons fun-exp878 arg-exps879))))) (build-void80 (lambda
(source881) (let ((atom-key882 (fluid-ref *mode*71))) (if (memv atom-key882
(quote (c))) ((@ (language tree-il) make-void) source881) (quote (if #f
#f)))))) (get-global-definition-hook79 (lambda (symbol883 module884) (begin (if
(if (not module884) (current-module) #f) (warn "module system is booted, we
should have a module" symbol883) (if #f #f)) (let ((v885 (module-variable (if
module884 (resolve-module (cdr module884)) (current-module)) symbol883))) (if
v885 (if (variable-bound? v885) (let ((val886 (variable-ref v885))) (if (macro?
val886) (if (syncase-macro-type val886) (cons (syncase-macro-type val886)
(syncase-macro-binding val886)) #f) #f)) #f) #f)))))
(put-global-definition-hook78 (lambda (symbol887 type888 val889) (let
((existing890 (let ((v891 (module-variable (current-module) symbol887))) (if
v891 (if (variable-bound? v891) (let ((val892 (variable-ref v891))) (if (macro?
val892) (if (not (syncase-macro-type val892)) val892 #f) #f)) #f) #f))))
(module-define! (current-module) symbol887 (if existing890
(make-extended-syncase-macro existing890 type888 val889) (make-syncase-macro
type888 val889)))))) (local-eval-hook77 (lambda (x893 mod894) (primitive-eval
(list noexpand70 (let ((atom-key895 (fluid-ref *mode*71))) (if (memv
atom-key895 (quote (c))) ((@ (language tree-il) tree-il->scheme) x893)
x893)))))) (top-level-eval-hook76 (lambda (x896 mod897) (primitive-eval (list
noexpand70 (let ((atom-key898 (fluid-ref *mode*71))) (if (memv atom-key898
(quote (c))) ((@ (language tree-il) tree-il->scheme) x896) x896)))))) (fx<75 <)
(fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand"))
(begin (global-extend111 (quote local-syntax) (quote letrec-syntax) #t)
(global-extend111 (quote local-syntax) (quote let-syntax) #f) (global-extend111
(quote core) (quote fluid-let-syntax) (lambda (e899 r900 w901 s902 mod903)
((lambda (tmp904) ((lambda (tmp905) (if (if tmp905 (apply (lambda (_906 var907
val908 e1909 e2910) (valid-bound-ids?138 var907)) tmp905) #f) (apply (lambda
(_912 var913 val914 e1915 e2916) (let ((names917 (map (lambda (x918)
(id-var-name135 x918 w901)) var913))) (begin (for-each (lambda (id920 n921)
(let ((atom-key922 (binding-type105 (lookup110 n921 r900 mod903)))) (if (memv
atom-key922 (quote (displaced-lexical))) (syntax-violation (quote
fluid-let-syntax) "identifier out of context" e899 (source-wrap142 id920 w901
s902 mod903)) (if #f #f)))) var913 names917) (chi-body153 (cons e1915 e2916)
(source-wrap142 e899 w901 s902 mod903) (extend-env107 names917 (let
((trans-r925 (macros-only-env109 r900))) (map (lambda (x926) (cons (quote
macro) (eval-local-transformer156 (chi149 x926 trans-r925 w901 mod903)
mod903))) val914)) r900) w901 mod903)))) tmp905) ((lambda (_928)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap142 e899
w901 s902 mod903))) tmp904))) ($sc-dispatch tmp904 (quote (any #(each (any
any)) any . each-any))))) e899))) (global-extend111 (quote core) (quote quote)
(lambda (e929 r930 w931 s932 mod933) ((lambda (tmp934) ((lambda (tmp935) (if
tmp935 (apply (lambda (_936 e937) (build-data91 s932 (strip160 e937 w931)))
tmp935) ((lambda (_938) (syntax-violation (quote quote) "bad syntax"
(source-wrap142 e929 w931 s932 mod933))) tmp934))) ($sc-dispatch tmp934 (quote
(any any))))) e929))) (global-extend111 (quote core) (quote syntax) (letrec
((regen946 (lambda (x947) (let ((atom-key948 (car x947))) (if (memv atom-key948
(quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x947) (cadr
x947)) (if (memv atom-key948 (quote (primitive))) (build-primref90 #f (cadr
x947)) (if (memv atom-key948 (quote (quote))) (build-data91 #f (cadr x947)) (if
(memv atom-key948 (quote (lambda))) (build-lambda89 #f (cadr x947) (cadr x947)
#f (regen946 (caddr x947))) (if (memv atom-key948 (quote (map))) (let ((ls949
(map regen946 (cdr x947)))) (build-application81 #f (build-primref90 #f (quote
map)) ls949)) (build-application81 #f (build-primref90 #f (car x947)) (map
regen946 (cdr x947))))))))))) (gen-vector945 (lambda (x950) (if (eq? (car x950)
(quote list)) (cons (quote vector) (cdr x950)) (if (eq? (car x950) (quote
quote)) (list (quote quote) (list->vector (cadr x950))) (list (quote
list->vector) x950))))) (gen-append944 (lambda (x951 y952) (if (equal? y952
(quote (quote ()))) x951 (list (quote append) x951 y952)))) (gen-cons943
(lambda (x953 y954) (let ((atom-key955 (car y954))) (if (memv atom-key955
(quote (quote))) (if (eq? (car x953) (quote quote)) (list (quote quote) (cons
(cadr x953) (cadr y954))) (if (eq? (cadr y954) (quote ())) (list (quote list)
x953) (list (quote cons) x953 y954))) (if (memv atom-key955 (quote (list)))
(cons (quote list) (cons x953 (cdr y954))) (list (quote cons) x953 y954))))))
(gen-map942 (lambda (e956 map-env957) (let ((formals958 (map cdr map-env957))
(actuals959 (map (lambda (x960) (list (quote ref) (car x960))) map-env957)))
(if (eq? (car e956) (quote ref)) (car actuals959) (if (and-map (lambda (x961)
(if (eq? (car x961) (quote ref)) (memq (cadr x961) formals958) #f)) (cdr e956))
(cons (quote map) (cons (list (quote primitive) (car e956)) (map (let ((r962
(map cons formals958 actuals959))) (lambda (x963) (cdr (assq (cadr x963)
r962)))) (cdr e956)))) (cons (quote map) (cons (list (quote lambda) formals958
e956) actuals959))))))) (gen-mappend941 (lambda (e964 map-env965) (list (quote
apply) (quote (primitive append)) (gen-map942 e964 map-env965)))) (gen-ref940
(lambda (src966 var967 level968 maps969) (if (fx=74 level968 0) (values var967
maps969) (if (null? maps969) (syntax-violation (quote syntax) "missing
ellipsis" src966) (call-with-values (lambda () (gen-ref940 src966 var967 (fx-73
level968 1) (cdr maps969))) (lambda (outer-var970 outer-maps971) (let ((b972
(assq outer-var970 (car maps969)))) (if b972 (values (cdr b972) maps969) (let
((inner-var973 (gen-var161 (quote tmp)))) (values inner-var973 (cons (cons
(cons outer-var970 inner-var973) (car maps969)) outer-maps971)))))))))))
(gen-syntax939 (lambda (src974 e975 r976 maps977 ellipsis?978 mod979) (if
(id?113 e975) (let ((label980 (id-var-name135 e975 (quote (()))))) (let ((b981
(lookup110 label980 r976 mod979))) (if (eq? (binding-type105 b981) (quote
syntax)) (call-with-values (lambda () (let ((var.lev982 (binding-value106
b981))) (gen-ref940 src974 (car var.lev982) (cdr var.lev982) maps977))) (lambda
(var983 maps984) (values (list (quote ref) var983) maps984))) (if (ellipsis?978
e975) (syntax-violation (quote syntax) "misplaced ellipsis" src974) (values
(list (quote quote) e975) maps977))))) ((lambda (tmp985) ((lambda (tmp986) (if
(if tmp986 (apply (lambda (dots987 e988) (ellipsis?978 dots987)) tmp986) #f)
(apply (lambda (dots989 e990) (gen-syntax939 src974 e990 r976 maps977 (lambda
(x991) #f) mod979)) tmp986) ((lambda (tmp992) (if (if tmp992 (apply (lambda
(x993 dots994 y995) (ellipsis?978 dots994)) tmp992) #f) (apply (lambda (x996
dots997 y998) (letrec ((f999 (lambda (y1000 k1001) ((lambda (tmp1005) ((lambda
(tmp1006) (if (if tmp1006 (apply (lambda (dots1007 y1008) (ellipsis?978
dots1007)) tmp1006) #f) (apply (lambda (dots1009 y1010) (f999 y1010 (lambda
(maps1011) (call-with-values (lambda () (k1001 (cons (quote ()) maps1011)))
(lambda (x1012 maps1013) (if (null? (car maps1013)) (syntax-violation (quote
syntax) "extra ellipsis" src974) (values (gen-mappend941 x1012 (car maps1013))
(cdr maps1013)))))))) tmp1006) ((lambda (_1014) (call-with-values (lambda ()
(gen-syntax939 src974 y1000 r976 maps977 ellipsis?978 mod979)) (lambda (y1015
maps1016) (call-with-values (lambda () (k1001 maps1016)) (lambda (x1017
maps1018) (values (gen-append944 x1017 y1015) maps1018)))))) tmp1005)))
($sc-dispatch tmp1005 (quote (any . any))))) y1000)))) (f999 y998 (lambda
(maps1002) (call-with-values (lambda () (gen-syntax939 src974 x996 r976 (cons
(quote ()) maps1002) ellipsis?978 mod979)) (lambda (x1003 maps1004) (if (null?
(car maps1004)) (syntax-violation (quote syntax) "extra ellipsis" src974)
(values (gen-map942 x1003 (car maps1004)) (cdr maps1004))))))))) tmp992)
((lambda (tmp1019) (if tmp1019 (apply (lambda (x1020 y1021) (call-with-values
(lambda () (gen-syntax939 src974 x1020 r976 maps977 ellipsis?978 mod979))
(lambda (x1022 maps1023) (call-with-values (lambda () (gen-syntax939 src974
y1021 r976 maps1023 ellipsis?978 mod979)) (lambda (y1024 maps1025) (values
(gen-cons943 x1022 y1024) maps1025)))))) tmp1019) ((lambda (tmp1026) (if
tmp1026 (apply (lambda (e11027 e21028) (call-with-values (lambda ()
(gen-syntax939 src974 (cons e11027 e21028) r976 maps977 ellipsis?978 mod979))
(lambda (e1030 maps1031) (values (gen-vector945 e1030) maps1031)))) tmp1026)
((lambda (_1032) (values (list (quote quote) e975) maps977)) tmp985)))
($sc-dispatch tmp985 (quote #(vector (any . each-any))))))) ($sc-dispatch
tmp985 (quote (any . any)))))) ($sc-dispatch tmp985 (quote (any any . any))))))
($sc-dispatch tmp985 (quote (any any))))) e975))))) (lambda (e1033 r1034 w1035
s1036 mod1037) (let ((e1038 (source-wrap142 e1033 w1035 s1036 mod1037)))
((lambda (tmp1039) ((lambda (tmp1040) (if tmp1040 (apply (lambda (_1041 x1042)
(call-with-values (lambda () (gen-syntax939 e1038 x1042 r1034 (quote ())
ellipsis?158 mod1037)) (lambda (e1043 maps1044) (regen946 e1043)))) tmp1040)
((lambda (_1045) (syntax-violation (quote syntax) "bad `syntax' form" e1038))
tmp1039))) ($sc-dispatch tmp1039 (quote (any any))))) e1038)))))
(global-extend111 (quote core) (quote lambda) (lambda (e1046 r1047 w1048 s1049
mod1050) ((lambda (tmp1051) ((lambda (tmp1052) (if tmp1052 (apply (lambda
(_1053 c1054) (chi-lambda-clause154 (source-wrap142 e1046 w1048 s1049 mod1050)
#f c1054 r1047 w1048 mod1050 (lambda (names1055 vars1056 docstring1057
body1058) (build-lambda89 s1049 names1055 vars1056 docstring1057 body1058))))
tmp1052) (syntax-violation #f "source expression failed to match any pattern"
tmp1051))) ($sc-dispatch tmp1051 (quote (any . any))))) e1046)))
(global-extend111 (quote core) (quote let) (letrec ((chi-let1059 (lambda (e1060
r1061 w1062 s1063 mod1064 constructor1065 ids1066 vals1067 exps1068) (if (not
(valid-bound-ids?138 ids1066)) (syntax-violation (quote let) "duplicate bound
variable" e1060) (let ((labels1069 (gen-labels119 ids1066)) (new-vars1070 (map
gen-var161 ids1066))) (let ((nw1071 (make-binding-wrap130 ids1066 labels1069
w1062)) (nr1072 (extend-var-env108 labels1069 new-vars1070 r1061)))
(constructor1065 s1063 (map syntax->datum ids1066) new-vars1070 (map (lambda
(x1073) (chi149 x1073 r1061 w1062 mod1064)) vals1067) (chi-body153 exps1068
(source-wrap142 e1060 nw1071 s1063 mod1064) nr1072 nw1071 mod1064))))))))
(lambda (e1074 r1075 w1076 s1077 mod1078) ((lambda (tmp1079) ((lambda (tmp1080)
(if tmp1080 (apply (lambda (_1081 id1082 val1083 e11084 e21085) (chi-let1059
e1074 r1075 w1076 s1077 mod1078 build-let93 id1082 val1083 (cons e11084
e21085))) tmp1080) ((lambda (tmp1089) (if (if tmp1089 (apply (lambda (_1090
f1091 id1092 val1093 e11094 e21095) (id?113 f1091)) tmp1089) #f) (apply (lambda
(_1096 f1097 id1098 val1099 e11100 e21101) (chi-let1059 e1074 r1075 w1076 s1077
mod1078 build-named-let94 (cons f1097 id1098) val1099 (cons e11100 e21101)))
tmp1089) ((lambda (_1105) (syntax-violation (quote let) "bad let"
(source-wrap142 e1074 w1076 s1077 mod1078))) tmp1079))) ($sc-dispatch tmp1079
(quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1079
(quote (any #(each (any any)) any . each-any))))) e1074)))) (global-extend111
(quote core) (quote letrec) (lambda (e1106 r1107 w1108 s1109 mod1110) ((lambda
(tmp1111) ((lambda (tmp1112) (if tmp1112 (apply (lambda (_1113 id1114 val1115
e11116 e21117) (let ((ids1118 id1114)) (if (not (valid-bound-ids?138 ids1118))
(syntax-violation (quote letrec) "duplicate bound variable" e1106) (let
((labels1120 (gen-labels119 ids1118)) (new-vars1121 (map gen-var161 ids1118)))
(let ((w1122 (make-binding-wrap130 ids1118 labels1120 w1108)) (r1123
(extend-var-env108 labels1120 new-vars1121 r1107))) (build-letrec95 s1109 (map
syntax->datum ids1118) new-vars1121 (map (lambda (x1124) (chi149 x1124 r1123
w1122 mod1110)) val1115) (chi-body153 (cons e11116 e21117) (source-wrap142
e1106 w1122 s1109 mod1110) r1123 w1122 mod1110))))))) tmp1112) ((lambda (_1127)
(syntax-violation (quote letrec) "bad letrec" (source-wrap142 e1106 w1108 s1109
mod1110))) tmp1111))) ($sc-dispatch tmp1111 (quote (any #(each (any any)) any .
each-any))))) e1106))) (global-extend111 (quote core) (quote set!) (lambda
(e1128 r1129 w1130 s1131 mod1132) ((lambda (tmp1133) ((lambda (tmp1134) (if (if
tmp1134 (apply (lambda (_1135 id1136 val1137) (id?113 id1136)) tmp1134) #f)
(apply (lambda (_1138 id1139 val1140) (let ((val1141 (chi149 val1140 r1129
w1130 mod1132)) (n1142 (id-var-name135 id1139 w1130))) (let ((b1143 (lookup110
n1142 r1129 mod1132))) (let ((atom-key1144 (binding-type105 b1143))) (if (memv
atom-key1144 (quote (lexical))) (build-lexical-assignment84 s1131
(syntax->datum id1139) (binding-value106 b1143) val1141) (if (memv atom-key1144
(quote (global))) (build-global-assignment87 s1131 n1142 val1141 mod1132) (if
(memv atom-key1144 (quote (displaced-lexical))) (syntax-violation (quote set!)
"identifier out of context" (wrap141 id1139 w1130 mod1132)) (syntax-violation
(quote set!) "bad set!" (source-wrap142 e1128 w1130 s1131 mod1132)))))))))
tmp1134) ((lambda (tmp1145) (if tmp1145 (apply (lambda (_1146 head1147 tail1148
val1149) (call-with-values (lambda () (syntax-type147 head1147 r1129 (quote
(())) #f #f mod1132)) (lambda (type1150 value1151 ee1152 ww1153 ss1154
modmod1155) (if (memv type1150 (quote (module-ref))) (let ((val1156 (chi149
val1149 r1129 w1130 mod1132))) (call-with-values (lambda () (value1151 (cons
head1147 tail1148))) (lambda (id1158 mod1159) (build-global-assignment87 s1131
id1158 val1156 mod1159)))) (build-application81 s1131 (chi149 (list (quote
#(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage
#(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
head1147) r1129 w1130 mod1132) (map (lambda (e1160) (chi149 e1160 r1129 w1130
mod1132)) (append tail1148 (list val1149)))))))) tmp1145) ((lambda (_1162)
(syntax-violation (quote set!) "bad set!" (source-wrap142 e1128 w1130 s1131
mod1132))) tmp1133))) ($sc-dispatch tmp1133 (quote (any (any . each-any)
any)))))) ($sc-dispatch tmp1133 (quote (any any any))))) e1128)))
(global-extend111 (quote module-ref) (quote @) (lambda (e1163) ((lambda
(tmp1164) ((lambda (tmp1165) (if (if tmp1165 (apply (lambda (_1166 mod1167
id1168) (if (and-map id?113 mod1167) (id?113 id1168) #f)) tmp1165) #f) (apply
(lambda (_1170 mod1171 id1172) (values (syntax->datum id1172) (syntax->datum
(cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i"))
#(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
mod1171)))) tmp1165) (syntax-violation #f "source expression failed to match
any pattern" tmp1164))) ($sc-dispatch tmp1164 (quote (any each-any any)))))
e1163))) (global-extend111 (quote module-ref) (quote @@) (lambda (e1174)
((lambda (tmp1175) ((lambda (tmp1176) (if (if tmp1176 (apply (lambda (_1177
mod1178 id1179) (if (and-map id?113 mod1178) (id?113 id1179) #f)) tmp1176) #f)
(apply (lambda (_1181 mod1182 id1183) (values (syntax->datum id1183)
(syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod
id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e)
#((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
mod1182)))) tmp1176) (syntax-violation #f "source expression failed to match
any pattern" tmp1175))) ($sc-dispatch tmp1175 (quote (any each-any any)))))
e1174))) (global-extend111 (quote core) (quote if) (lambda (e1185 r1186 w1187
s1188 mod1189) ((lambda (tmp1190) ((lambda (tmp1191) (if tmp1191 (apply (lambda
(_1192 test1193 then1194) (build-conditional82 s1188 (chi149 test1193 r1186
w1187 mod1189) (chi149 then1194 r1186 w1187 mod1189) (build-void80 #f)))
tmp1191) ((lambda (tmp1195) (if tmp1195 (apply (lambda (_1196 test1197 then1198
else1199) (build-conditional82 s1188 (chi149 test1197 r1186 w1187 mod1189)
(chi149 then1198 r1186 w1187 mod1189) (chi149 else1199 r1186 w1187 mod1189)))
tmp1195) (syntax-violation #f "source expression failed to match any pattern"
tmp1190))) ($sc-dispatch tmp1190 (quote (any any any any)))))) ($sc-dispatch
tmp1190 (quote (any any any))))) e1185))) (global-extend111 (quote begin)
(quote begin) (quote ())) (global-extend111 (quote define) (quote define)
(quote ())) (global-extend111 (quote define-syntax) (quote define-syntax)
(quote ())) (global-extend111 (quote eval-when) (quote eval-when) (quote ()))
(global-extend111 (quote core) (quote syntax-case) (letrec
((gen-syntax-case1203 (lambda (x1204 keys1205 clauses1206 r1207 mod1208) (if
(null? clauses1206) (build-application81 #f (build-primref90 #f (quote
syntax-violation)) (list (build-data91 #f #f) (build-data91 #f "source
expression failed to match any pattern") x1204)) ((lambda (tmp1209) ((lambda
(tmp1210) (if tmp1210 (apply (lambda (pat1211 exp1212) (if (if (id?113 pat1211)
(and-map (lambda (x1213) (not (free-id=?136 pat1211 x1213))) (cons (quote
#(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause
build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top))
("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
keys1205)) #f) (let ((labels1214 (list (gen-label118))) (var1215 (gen-var161
pat1211))) (build-application81 #f (build-lambda89 #f (list (syntax->datum
pat1211)) (list var1215) #f (chi149 exp1212 (extend-env107 labels1214 (list
(cons (quote syntax) (cons var1215 0))) r1207) (make-binding-wrap130 (list
pat1211) labels1214 (quote (()))) mod1208)) (list x1204))) (gen-clause1202
x1204 keys1205 (cdr clauses1206) r1207 pat1211 #t exp1212 mod1208))) tmp1210)
((lambda (tmp1216) (if tmp1216 (apply (lambda (pat1217 fender1218 exp1219)
(gen-clause1202 x1204 keys1205 (cdr clauses1206) r1207 pat1217 fender1218
exp1219 mod1208)) tmp1216) ((lambda (_1220) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses1206))) tmp1209))) ($sc-dispatch
tmp1209 (quote (any any any)))))) ($sc-dispatch tmp1209 (quote (any any)))))
(car clauses1206))))) (gen-clause1202 (lambda (x1221 keys1222 clauses1223 r1224
pat1225 fender1226 exp1227 mod1228) (call-with-values (lambda ()
(convert-pattern1200 pat1225 keys1222)) (lambda (p1229 pvars1230) (if (not
(distinct-bound-ids?139 (map car pvars1230))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat1225) (if (not (and-map (lambda
(x1231) (not (ellipsis?158 (car x1231)))) pvars1230)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat1225) (let ((y1232 (gen-var161 (quote
tmp)))) (build-application81 #f (build-lambda89 #f (list (quote tmp)) (list
y1232) #f (let ((y1233 (build-lexical-reference83 (quote value) #f (quote tmp)
y1232))) (build-conditional82 #f ((lambda (tmp1234) ((lambda (tmp1235) (if
tmp1235 (apply (lambda () y1233) tmp1235) ((lambda (_1236) (build-conditional82
#f y1233 (build-dispatch-call1201 pvars1230 fender1226 y1233 r1224 mod1228)
(build-data91 #f #f))) tmp1234))) ($sc-dispatch tmp1234 (quote #(atom #t)))))
fender1226) (build-dispatch-call1201 pvars1230 exp1227 y1233 r1224 mod1228)
(gen-syntax-case1203 x1221 keys1222 clauses1223 r1224 mod1228)))) (list (if
(eq? p1229 (quote any)) (build-application81 #f (build-primref90 #f (quote
list)) (list x1221)) (build-application81 #f (build-primref90 #f (quote
$sc-dispatch)) (list x1221 (build-data91 #f p1229)))))))))))))
(build-dispatch-call1201 (lambda (pvars1237 exp1238 y1239 r1240 mod1241) (let
((ids1242 (map car pvars1237)) (levels1243 (map cdr pvars1237))) (let
((labels1244 (gen-labels119 ids1242)) (new-vars1245 (map gen-var161 ids1242)))
(build-application81 #f (build-primref90 #f (quote apply)) (list
(build-lambda89 #f (map syntax->datum ids1242) new-vars1245 #f (chi149 exp1238
(extend-env107 labels1244 (map (lambda (var1246 level1247) (cons (quote syntax)
(cons var1246 level1247))) new-vars1245 (map cdr pvars1237)) r1240)
(make-binding-wrap130 ids1242 labels1244 (quote (()))) mod1241)) y1239))))))
(convert-pattern1200 (lambda (pattern1248 keys1249) (letrec ((cvt1250 (lambda
(p1251 n1252 ids1253) (if (id?113 p1251) (if (bound-id-member?140 p1251
keys1249) (values (vector (quote free-id) p1251) ids1253) (values (quote any)
(cons (cons p1251 n1252) ids1253))) ((lambda (tmp1254) ((lambda (tmp1255) (if
(if tmp1255 (apply (lambda (x1256 dots1257) (ellipsis?158 dots1257)) tmp1255)
#f) (apply (lambda (x1258 dots1259) (call-with-values (lambda () (cvt1250 x1258
(fx+72 n1252 1) ids1253)) (lambda (p1260 ids1261) (values (if (eq? p1260 (quote
any)) (quote each-any) (vector (quote each) p1260)) ids1261)))) tmp1255)
((lambda (tmp1262) (if tmp1262 (apply (lambda (x1263 y1264) (call-with-values
(lambda () (cvt1250 y1264 n1252 ids1253)) (lambda (y1265 ids1266)
(call-with-values (lambda () (cvt1250 x1263 n1252 ids1266)) (lambda (x1267
ids1268) (values (cons x1267 y1265) ids1268)))))) tmp1262) ((lambda (tmp1269)
(if tmp1269 (apply (lambda () (values (quote ()) ids1253)) tmp1269) ((lambda
(tmp1270) (if tmp1270 (apply (lambda (x1271) (call-with-values (lambda ()
(cvt1250 x1271 n1252 ids1253)) (lambda (p1273 ids1274) (values (vector (quote
vector) p1273) ids1274)))) tmp1270) ((lambda (x1275) (values (vector (quote
atom) (strip160 p1251 (quote (())))) ids1253)) tmp1254))) ($sc-dispatch tmp1254
(quote #(vector each-any)))))) ($sc-dispatch tmp1254 (quote ())))))
($sc-dispatch tmp1254 (quote (any . any)))))) ($sc-dispatch tmp1254 (quote (any
any))))) p1251))))) (cvt1250 pattern1248 0 (quote ())))))) (lambda (e1276 r1277
w1278 s1279 mod1280) (let ((e1281 (source-wrap142 e1276 w1278 s1279 mod1280)))
((lambda (tmp1282) ((lambda (tmp1283) (if tmp1283 (apply (lambda (_1284 val1285
key1286 m1287) (if (and-map (lambda (x1288) (if (id?113 x1288) (not
(ellipsis?158 x1288)) #f)) key1286) (let ((x1290 (gen-var161 (quote tmp))))
(build-application81 s1279 (build-lambda89 #f (list (quote tmp)) (list x1290)
#f (gen-syntax-case1203 (build-lexical-reference83 (quote value) #f (quote tmp)
x1290) key1286 m1287 r1277 mod1280)) (list (chi149 val1285 r1277 (quote (()))
mod1280)))) (syntax-violation (quote syntax-case) "invalid literals list"
e1281))) tmp1283) (syntax-violation #f "source expression failed to match any
pattern" tmp1282))) ($sc-dispatch tmp1282 (quote (any any each-any .
each-any))))) e1281))))) (set! sc-expand (lambda (x1294 . rest1293) (if (if
(pair? x1294) (equal? (car x1294) noexpand70) #f) (cadr x1294) (let ((m1295 (if
(null? rest1293) (quote e) (car rest1293))) (esew1296 (if (let ((t1297 (null?
rest1293))) (if t1297 t1297 (null? (cdr rest1293)))) (quote (eval)) (cadr
rest1293)))) (with-fluid* *mode*71 m1295 (lambda () (chi-top148 x1294 (quote
()) (quote ((top))) m1295 esew1296 (cons (quote hygiene) (module-name
(current-module)))))))))) (set! identifier? (lambda (x1298) (nonsymbol-id?112
x1298))) (set! datum->syntax (lambda (id1299 datum1300) (make-syntax-object96
datum1300 (syntax-object-wrap99 id1299) #f))) (set! syntax->datum (lambda
(x1301) (strip160 x1301 (quote (()))))) (set! generate-temporaries (lambda
(ls1302) (begin (let ((x1303 ls1302)) (if (not (list? x1303)) (syntax-violation
(quote generate-temporaries) "invalid argument" x1303) (if #f #f))) (map
(lambda (x1304) (wrap141 (gensym) (quote ((top))) #f)) ls1302)))) (set!
free-identifier=? (lambda (x1305 y1306) (begin (let ((x1307 x1305)) (if (not
(nonsymbol-id?112 x1307)) (syntax-violation (quote free-identifier=?) "invalid
argument" x1307) (if #f #f))) (let ((x1308 y1306)) (if (not (nonsymbol-id?112
x1308)) (syntax-violation (quote free-identifier=?) "invalid argument" x1308)
(if #f #f))) (free-id=?136 x1305 y1306)))) (set! bound-identifier=? (lambda
(x1309 y1310) (begin (let ((x1311 x1309)) (if (not (nonsymbol-id?112 x1311))
(syntax-violation (quote bound-identifier=?) "invalid argument" x1311) (if #f
#f))) (let ((x1312 y1310)) (if (not (nonsymbol-id?112 x1312)) (syntax-violation
(quote bound-identifier=?) "invalid argument" x1312) (if #f #f)))
(bound-id=?137 x1309 y1310)))) (set! syntax-violation (lambda (who1316
message1315 form1314 . subform1313) (begin (let ((x1317 who1316)) (if (not
((lambda (x1318) (let ((t1319 (not x1318))) (if t1319 t1319 (let ((t1320
(string? x1318))) (if t1320 t1320 (symbol? x1318)))))) x1317))
(syntax-violation (quote syntax-violation) "invalid argument" x1317) (if #f
#f))) (let ((x1321 message1315)) (if (not (string? x1321)) (syntax-violation
(quote syntax-violation) "invalid argument" x1321) (if #f #f))) (scm-error
(quote syntax-error) (quote sc-expand) (string-append (if who1316 "~a: " "")
"~a " (if (null? subform1313) "in ~a" "in subform `~s' of `~s'")) (let
((tail1322 (cons message1315 (map (lambda (x1323) (strip160 x1323 (quote
(())))) (append subform1313 (list form1314)))))) (if who1316 (cons who1316
tail1322) tail1322)) #f)))) (letrec ((match1328 (lambda (e1329 p1330 w1331
r1332 mod1333) (if (not r1332) #f (if (eq? p1330 (quote any)) (cons (wrap141
e1329 w1331 mod1333) r1332) (if (syntax-object?97 e1329) (match*1327 (let
((e1334 (syntax-object-expression98 e1329))) (if (annotation? e1334)
(annotation-expression e1334) e1334)) p1330 (join-wraps132 w1331
(syntax-object-wrap99 e1329)) r1332 (syntax-object-module100 e1329))
(match*1327 (let ((e1335 e1329)) (if (annotation? e1335) (annotation-expression
e1335) e1335)) p1330 w1331 r1332 mod1333)))))) (match*1327 (lambda (e1336 p1337
w1338 r1339 mod1340) (if (null? p1337) (if (null? e1336) r1339 #f) (if (pair?
p1337) (if (pair? e1336) (match1328 (car e1336) (car p1337) w1338 (match1328
(cdr e1336) (cdr p1337) w1338 r1339 mod1340) mod1340) #f) (if (eq? p1337 (quote
each-any)) (let ((l1341 (match-each-any1325 e1336 w1338 mod1340))) (if l1341
(cons l1341 r1339) #f)) (let ((atom-key1342 (vector-ref p1337 0))) (if (memv
atom-key1342 (quote (each))) (if (null? e1336) (match-empty1326 (vector-ref
p1337 1) r1339) (let ((l1343 (match-each1324 e1336 (vector-ref p1337 1) w1338
mod1340))) (if l1343 (letrec ((collect1344 (lambda (l1345) (if (null? (car
l1345)) r1339 (cons (map car l1345) (collect1344 (map cdr l1345)))))))
(collect1344 l1343)) #f))) (if (memv atom-key1342 (quote (free-id))) (if
(id?113 e1336) (if (free-id=?136 (wrap141 e1336 w1338 mod1340) (vector-ref
p1337 1)) r1339 #f) #f) (if (memv atom-key1342 (quote (atom))) (if (equal?
(vector-ref p1337 1) (strip160 e1336 w1338)) r1339 #f) (if (memv atom-key1342
(quote (vector))) (if (vector? e1336) (match1328 (vector->list e1336)
(vector-ref p1337 1) w1338 r1339 mod1340) #f) (if #f #f)))))))))))
(match-empty1326 (lambda (p1346 r1347) (if (null? p1346) r1347 (if (eq? p1346
(quote any)) (cons (quote ()) r1347) (if (pair? p1346) (match-empty1326 (car
p1346) (match-empty1326 (cdr p1346) r1347)) (if (eq? p1346 (quote each-any))
(cons (quote ()) r1347) (let ((atom-key1348 (vector-ref p1346 0))) (if (memv
atom-key1348 (quote (each))) (match-empty1326 (vector-ref p1346 1) r1347) (if
(memv atom-key1348 (quote (free-id atom))) r1347 (if (memv atom-key1348 (quote
(vector))) (match-empty1326 (vector-ref p1346 1) r1347) (if #f #f)))))))))))
(match-each-any1325 (lambda (e1349 w1350 mod1351) (if (annotation? e1349)
(match-each-any1325 (annotation-expression e1349) w1350 mod1351) (if (pair?
e1349) (let ((l1352 (match-each-any1325 (cdr e1349) w1350 mod1351))) (if l1352
(cons (wrap141 (car e1349) w1350 mod1351) l1352) #f)) (if (null? e1349) (quote
()) (if (syntax-object?97 e1349) (match-each-any1325
(syntax-object-expression98 e1349) (join-wraps132 w1350 (syntax-object-wrap99
e1349)) mod1351) #f)))))) (match-each1324 (lambda (e1353 p1354 w1355 mod1356)
(if (annotation? e1353) (match-each1324 (annotation-expression e1353) p1354
w1355 mod1356) (if (pair? e1353) (let ((first1357 (match1328 (car e1353) p1354
w1355 (quote ()) mod1356))) (if first1357 (let ((rest1358 (match-each1324 (cdr
e1353) p1354 w1355 mod1356))) (if rest1358 (cons first1357 rest1358) #f)) #f))
(if (null? e1353) (quote ()) (if (syntax-object?97 e1353) (match-each1324
(syntax-object-expression98 e1353) p1354 (join-wraps132 w1355
(syntax-object-wrap99 e1353)) (syntax-object-module100 e1353)) #f))))))) (set!
$sc-dispatch (lambda (e1359 p1360) (if (eq? p1360 (quote any)) (list e1359) (if
(syntax-object?97 e1359) (match*1327 (let ((e1361 (syntax-object-expression98
e1359))) (if (annotation? e1361) (annotation-expression e1361) e1361)) p1360
(syntax-object-wrap99 e1359) (quote ()) (syntax-object-module100 e1359))
(match*1327 (let ((e1362 e1359)) (if (annotation? e1362) (annotation-expression
e1362) e1362)) p1360 (quote (())) (quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x1363) ((lambda
(tmp1364) ((lambda (tmp1365) (if tmp1365 (apply (lambda (_1366 e11367 e21368)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11367 e21368))) tmp1365) ((lambda (tmp1370) (if
tmp1370 (apply (lambda (_1371 out1372 in1373 e11374 e21375) (list (quote
#(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) in1373 (quote ()) (list out1372 (cons
(quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons e11374 e21375))))) tmp1370) ((lambda
(tmp1377) (if tmp1377 (apply (lambda (_1378 out1379 in1380 e11381 e21382) (list
(quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list
((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) in1380) (quote ()) (list out1379 (cons (quote #(syntax-object begin
((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (cons e11381 e21382))))) tmp1377) (syntax-violation #f "source
expression failed to match any pattern" tmp1364))) ($sc-dispatch tmp1364 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1364 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp1364 (quote (any () any .
each-any))))) x1363))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1386)
((lambda (tmp1387) ((lambda (tmp1388) (if tmp1388 (apply (lambda (_1389 k1390
keyword1391 pattern1392 template1393) (list (quote #(syntax-object lambda
((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top))
#("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k
keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern
template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote
#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons k1390 (map (lambda (tmp1396
tmp1395) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k
keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
tmp1395) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword
pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
tmp1396))) template1393 pattern1392)))))) tmp1388) (syntax-violation #f "source
expression failed to match any pattern" tmp1387))) ($sc-dispatch tmp1387 (quote
(any each-any . #(each ((any . any) any))))))) x1386))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x1397) ((lambda (tmp1398) ((lambda (tmp1399) (if
(if tmp1399 (apply (lambda (let*1400 x1401 v1402 e11403 e21404) (and-map
identifier? x1401)) tmp1399) #f) (apply (lambda (let*1406 x1407 v1408 e11409
e21410) (letrec ((f1411 (lambda (bindings1412) (if (null? bindings1412) (cons
(quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings)
#((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11409 e21410)))
((lambda (tmp1416) ((lambda (tmp1417) (if tmp1417 (apply (lambda (body1418
binding1419) (list (quote #(syntax-object let ((top) #(ribcage #(body binding)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top)
(top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (list binding1419) body1418)) tmp1417) (syntax-violation #f
"source expression failed to match any pattern" tmp1416))) ($sc-dispatch
tmp1416 (quote (any any))))) (list (f1411 (cdr bindings1412)) (car
bindings1412))))))) (f1411 (map list x1407 v1408)))) tmp1399) (syntax-violation
#f "source expression failed to match any pattern" tmp1398))) ($sc-dispatch
tmp1398 (quote (any #(each (any any)) any . each-any))))) x1397))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x1420) ((lambda (tmp1421) ((lambda (tmp1422)
(if tmp1422 (apply (lambda (_1423 var1424 init1425 step1426 e01427 e11428
c1429) ((lambda (tmp1430) ((lambda (tmp1431) (if tmp1431 (apply (lambda
(step1432) ((lambda (tmp1433) ((lambda (tmp1434) (if tmp1434 (apply (lambda ()
(list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i"))
#(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x)
#((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top)
#(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top)
(top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list
var1424 init1425) (list (quote #(syntax-object if ((top) #(ribcage #(step)
#((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var
init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i"
"i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")))
(hygiene guile))) e01427) (cons (quote #(syntax-object begin ((top) #(ribcage
#(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top)
(top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () ()
()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1429 (list
(cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i"))
#(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x)
#((top)) #("i"))) (hygiene guile))) step1432))))))) tmp1434) ((lambda (tmp1439)
(if tmp1439 (apply (lambda (e11440 e21441) (list (quote #(syntax-object let
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1424 init1425) (list
(quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i"))
#(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top)
(top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01427 (cons
(quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i"
"i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c)
#((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile)))
(cons e11440 e21441)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1
e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_
var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")))
(hygiene guile))) (append c1429 (list (cons (quote #(syntax-object doloop
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) step1432))))))) tmp1439)
(syntax-violation #f "source expression failed to match any pattern" tmp1433)))
($sc-dispatch tmp1433 (quote (any . each-any)))))) ($sc-dispatch tmp1433 (quote
())))) e11428)) tmp1431) (syntax-violation #f "source expression failed to
match any pattern" tmp1430))) ($sc-dispatch tmp1430 (quote each-any)))) (map
(lambda (v1448 s1449) ((lambda (tmp1450) ((lambda (tmp1451) (if tmp1451 (apply
(lambda () v1448) tmp1451) ((lambda (tmp1452) (if tmp1452 (apply (lambda
(e1453) e1453) tmp1452) ((lambda (_1454) (syntax-violation (quote do) "bad step
expression" orig-x1420 s1449)) tmp1450))) ($sc-dispatch tmp1450 (quote
(any)))))) ($sc-dispatch tmp1450 (quote ())))) s1449)) var1424 step1426)))
tmp1422) (syntax-violation #f "source expression failed to match any pattern"
tmp1421))) ($sc-dispatch tmp1421 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x1420))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons1457 (lambda (x1461 y1462)
((lambda (tmp1463) ((lambda (tmp1464) (if tmp1464 (apply (lambda (x1465 y1466)
((lambda (tmp1467) ((lambda (tmp1468) (if tmp1468 (apply (lambda (dy1469)
((lambda (tmp1470) ((lambda (tmp1471) (if tmp1471 (apply (lambda (dx1472) (list
(quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage
#(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) (cons dx1472 dy1469))) tmp1471) ((lambda
(_1473) (if (null? dy1469) (list (quote #(syntax-object list ((top) #(ribcage
#(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y)
#((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi)
#((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1465) (list
(quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage
#(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) x1465 y1466))) tmp1470))) ($sc-dispatch
tmp1470 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top))
#("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) any))))) x1465)) tmp1468) ((lambda (tmp1474) (if
tmp1474 (apply (lambda (stuff1475) (cons (quote #(syntax-object list ((top)
#(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i"
"i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top)
(top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1465 stuff1475))) tmp1474)
((lambda (else1476) (list (quote #(syntax-object cons ((top) #(ribcage #(else)
#((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) x1465 y1466)) tmp1467))) ($sc-dispatch tmp1467
(quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any))))))
($sc-dispatch tmp1467 (quote (#(free-id #(syntax-object quote ((top) #(ribcage
#(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any))))) y1466)) tmp1464) (syntax-violation #f "source expression
failed to match any pattern" tmp1463))) ($sc-dispatch tmp1463 (quote (any
any))))) (list x1461 y1462)))) (quasiappend1458 (lambda (x1477 y1478) ((lambda
(tmp1479) ((lambda (tmp1480) (if tmp1480 (apply (lambda (x1481 y1482) ((lambda
(tmp1483) ((lambda (tmp1484) (if tmp1484 (apply (lambda () x1481) tmp1484)
((lambda (_1485) (list (quote #(syntax-object append ((top) #(ribcage #(_)
#((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) x1481 y1482)) tmp1483))) ($sc-dispatch tmp1483
(quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1482))
tmp1480) (syntax-violation #f "source expression failed to match any pattern"
tmp1479))) ($sc-dispatch tmp1479 (quote (any any))))) (list x1477 y1478))))
(quasivector1459 (lambda (x1486) ((lambda (tmp1487) ((lambda (x1488) ((lambda
(tmp1489) ((lambda (tmp1490) (if tmp1490 (apply (lambda (x1491) (list (quote
#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x)
#((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector
x1491))) tmp1490) ((lambda (tmp1493) (if tmp1493 (apply (lambda (x1494) (cons
(quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage
#(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1494)) tmp1493)
((lambda (_1496) (list (quote #(syntax-object list->vector ((top) #(ribcage
#(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) x1488)) tmp1489))) ($sc-dispatch tmp1489 (quote (#(free-id
#(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) . each-any)))))) ($sc-dispatch tmp1489 (quote (#(free-id
#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) each-any))))) x1488)) tmp1487)) x1486))) (quasi1460 (lambda
(p1497 lev1498) ((lambda (tmp1499) ((lambda (tmp1500) (if tmp1500 (apply
(lambda (p1501) (if (= lev1498 0) p1501 (quasicons1457 (quote (#(syntax-object
quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p
lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector
quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))
#(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile)))) (quasi1460 (list p1501) (- lev1498 1))))) tmp1500) ((lambda
(tmp1502) (if (if tmp1502 (apply (lambda (args1503) (= lev1498 0)) tmp1502) #f)
(apply (lambda (args1504) (syntax-violation (quote unquote) "unquote takes
exactly one argument" p1497 (cons (quote #(syntax-object unquote ((top)
#(ribcage #(args) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev)
#((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi)
#((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1504)))
tmp1502) ((lambda (tmp1505) (if tmp1505 (apply (lambda (p1506 q1507) (if (=
lev1498 0) (quasiappend1458 p1506 (quasi1460 q1507 lev1498)) (quasicons1457
(quasicons1457 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i"
"i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top)
(top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing
((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ())
#(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile)))) (quasi1460 (list p1506) (- lev1498 1))) (quasi1460 q1507 lev1498))))
tmp1505) ((lambda (tmp1508) (if (if tmp1508 (apply (lambda (args1509 q1510) (=
lev1498 0)) tmp1508) #f) (apply (lambda (args1511 q1512) (syntax-violation
(quote unquote-splicing) "unquote-splicing takes exactly one argument" p1497
(cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args q)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1511))) tmp1508)
((lambda (tmp1513) (if tmp1513 (apply (lambda (p1514) (quasicons1457 (quote
(#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile)))) (quasi1460 (list p1514) (+ lev1498
1)))) tmp1513) ((lambda (tmp1515) (if tmp1515 (apply (lambda (p1516 q1517)
(quasicons1457 (quasi1460 p1516 lev1498) (quasi1460 q1517 lev1498))) tmp1515)
((lambda (tmp1518) (if tmp1518 (apply (lambda (x1519) (quasivector1459
(quasi1460 x1519 lev1498))) tmp1518) ((lambda (p1521) (list (quote
#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) p1521)) tmp1499))) ($sc-dispatch tmp1499 (quote #(vector
each-any)))))) ($sc-dispatch tmp1499 (quote (any . any)))))) ($sc-dispatch
tmp1499 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ())
#(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any)))))) ($sc-dispatch tmp1499 (quote ((#(free-id #(syntax-object
unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top))
#("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top)
(top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any) . any))))))
($sc-dispatch tmp1499 (quote ((#(free-id #(syntax-object unquote-splicing
((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1499
(quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage
#(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) . any)))))) ($sc-dispatch tmp1499 (quote (#(free-id #(syntax-object
unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i"
"i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top)
(top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p1497)))) (lambda
(x1522) ((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (_1525
e1526) (quasi1460 e1526 0)) tmp1524) (syntax-violation #f "source expression
failed to match any pattern" tmp1523))) ($sc-dispatch tmp1523 (quote (any
any))))) x1522)))))
-(define include (make-syncase-macro (quote macro) (lambda (x1527) (letrec
((read-file1528 (lambda (fn1529 k1530) (let ((p1531 (open-input-file fn1529)))
(letrec ((f1532 (lambda (x1533) (if (eof-object? x1533) (begin
(close-input-port p1531) (quote ())) (cons (datum->syntax k1530 x1533) (f1532
(read p1531))))))) (f1532 (read p1531))))))) ((lambda (tmp1534) ((lambda
(tmp1535) (if tmp1535 (apply (lambda (k1536 filename1537) (let ((fn1538
(syntax->datum filename1537))) ((lambda (tmp1539) ((lambda (tmp1540) (if
tmp1540 (apply (lambda (exp1541) (cons (quote #(syntax-object begin ((top)
#(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i"
"i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) exp1541)) tmp1540) (syntax-violation #f "source expression
failed to match any pattern" tmp1539))) ($sc-dispatch tmp1539 (quote
each-any)))) (read-file1528 fn1538 k1536)))) tmp1535) (syntax-violation #f
"source expression failed to match any pattern" tmp1534))) ($sc-dispatch
tmp1534 (quote (any any))))) x1527)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x1543) ((lambda
(tmp1544) ((lambda (tmp1545) (if tmp1545 (apply (lambda (_1546 e1547)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x1543)) tmp1545) (syntax-violation #f "source expression failed to match any
pattern" tmp1544))) ($sc-dispatch tmp1544 (quote (any any))))) x1543))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1548)
((lambda (tmp1549) ((lambda (tmp1550) (if tmp1550 (apply (lambda (_1551 e1552)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x1548)) tmp1550) (syntax-violation #f "source expression failed to
match any pattern" tmp1549))) ($sc-dispatch tmp1549 (quote (any any)))))
x1548))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x1553) ((lambda (tmp1554) ((lambda (tmp1555) (if
tmp1555 (apply (lambda (_1556 e1557 m11558 m21559) ((lambda (tmp1560) ((lambda
(body1561) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top))
#("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list
(list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1557)) body1561))
tmp1560)) (letrec ((f1562 (lambda (clause1563 clauses1564) (if (null?
clauses1564) ((lambda (tmp1566) ((lambda (tmp1567) (if tmp1567 (apply (lambda
(e11568 e21569) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11568 e21569))) tmp1567) ((lambda (tmp1571) (if
tmp1571 (apply (lambda (k1572 e11573 e21574) (list (quote #(syntax-object if
((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top))
#("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i"
"i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top)
(top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) k1572)) (cons (quote #(syntax-object begin ((top) #(ribcage
#(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2)
#((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons e11573 e21574)))) tmp1571)
((lambda (_1577) (syntax-violation (quote case) "bad clause" x1553 clause1563))
tmp1566))) ($sc-dispatch tmp1566 (quote (each-any any . each-any))))))
($sc-dispatch tmp1566 (quote (#(free-id #(syntax-object else ((top) #(ribcage
() () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any .
each-any))))) clause1563) ((lambda (tmp1578) ((lambda (rest1579) ((lambda
(tmp1580) ((lambda (tmp1581) (if tmp1581 (apply (lambda (k1582 e11583 e21584)
(list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
#(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object
memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
#(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top)
(top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i"
"i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f
clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2)
#((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) k1582)) (cons (quote #(syntax-object
begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause
clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top)
(top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons e11583 e21584)) rest1579)) tmp1581)
((lambda (_1587) (syntax-violation (quote case) "bad clause" x1553 clause1563))
tmp1580))) ($sc-dispatch tmp1580 (quote (each-any any . each-any)))))
clause1563)) tmp1578)) (f1562 (car clauses1564) (cdr clauses1564))))))) (f1562
m11558 m21559)))) tmp1555) (syntax-violation #f "source expression failed to
match any pattern" tmp1554))) ($sc-dispatch tmp1554 (quote (any any any .
each-any))))) x1553))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1588)
((lambda (tmp1589) ((lambda (tmp1590) (if tmp1590 (apply (lambda (_1591 e1592)
(list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list
(quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
e1592)) (list (cons _1591 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e1592 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)))))))))) tmp1590) (syntax-violation #f "source expression failed to
match any pattern" tmp1589))) ($sc-dispatch tmp1589 (quote (any any)))))
x1588))))
+(letrec ((and-map*17 (lambda (f57 first56 . rest55) (let ((t58 (null?
first56))) (if t58 t58 (if (null? rest55) (letrec ((andmap59 (lambda (first60)
(let ((x61 (car first60)) (first62 (cdr first60))) (if (null? first62) (f57
x61) (if (f57 x61) (andmap59 first62) #f)))))) (andmap59 first56)) (letrec
((andmap63 (lambda (first64 rest65) (let ((x66 (car first64)) (xr67 (map car
rest65)) (first68 (cdr first64)) (rest69 (map cdr rest65))) (if (null? first68)
(apply f57 (cons x66 xr67)) (if (apply f57 (cons x66 xr67)) (andmap63 first68
rest69) #f)))))) (andmap63 first56 rest55)))))))) (letrec ((lambda-var-list163
(lambda (vars292) (letrec ((lvl293 (lambda (vars294 ls295 w296) (if (pair?
vars294) (lvl293 (cdr vars294) (cons (wrap142 (car vars294) w296 #f) ls295)
w296) (if (id?114 vars294) (cons (wrap142 vars294 w296 #f) ls295) (if (null?
vars294) ls295 (if (syntax-object?98 vars294) (lvl293
(syntax-object-expression99 vars294) ls295 (join-wraps133 w296
(syntax-object-wrap100 vars294))) (if (annotation? vars294) (lvl293
(annotation-expression vars294) ls295 w296) (cons vars294 ls295)))))))))
(lvl293 vars292 (quote ()) (quote (())))))) (gen-var162 (lambda (id297) (let
((id298 (if (syntax-object?98 id297) (syntax-object-expression99 id297)
id297))) (if (annotation? id298) (gensym (symbol->string (annotation-expression
id298))) (gensym (symbol->string id298)))))) (strip161 (lambda (x299 w300) (if
(memq (quote top) (wrap-marks117 w300)) (if (let ((t301 (annotation? x299)))
(if t301 t301 (if (pair? x299) (annotation? (car x299)) #f)))
(strip-annotation160 x299 #f) x299) (letrec ((f302 (lambda (x303) (if
(syntax-object?98 x303) (strip161 (syntax-object-expression99 x303)
(syntax-object-wrap100 x303)) (if (pair? x303) (let ((a304 (f302 (car x303)))
(d305 (f302 (cdr x303)))) (if (if (eq? a304 (car x303)) (eq? d305 (cdr x303))
#f) x303 (cons a304 d305))) (if (vector? x303) (let ((old306 (vector->list
x303))) (let ((new307 (map f302 old306))) (if (and-map*17 eq? old306 new307)
x303 (list->vector new307)))) x303)))))) (f302 x299))))) (strip-annotation160
(lambda (x308 parent309) (if (pair? x308) (let ((new310 (cons #f #f))) (begin
(if parent309 (set-annotation-stripped! parent309 new310)) (set-car! new310
(strip-annotation160 (car x308) #f)) (set-cdr! new310 (strip-annotation160 (cdr
x308) #f)) new310)) (if (annotation? x308) (let ((t311 (annotation-stripped
x308))) (if t311 t311 (strip-annotation160 (annotation-expression x308) x308)))
(if (vector? x308) (let ((new312 (make-vector (vector-length x308)))) (begin
(if parent309 (set-annotation-stripped! parent309 new312)) (letrec ((loop313
(lambda (i314) (unless (fx<75 i314 0) (vector-set! new312 i314
(strip-annotation160 (vector-ref x308 i314) #f)) (loop313 (fx-73 i314 1))))))
(loop313 (- (vector-length x308) 1))) new312)) x308))))) (ellipsis?159 (lambda
(x315) (if (nonsymbol-id?113 x315) (free-id=?137 x315 (quote #(syntax-object
... ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top))
#("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) #f)))
(chi-void158 (lambda () (build-void80 #f))) (eval-local-transformer157 (lambda
(expanded316 mod317) (let ((p318 (local-eval-hook77 expanded316 mod317))) (if
(procedure? p318) p318 (syntax-violation #f "nonprocedure transformer"
p318))))) (chi-local-syntax156 (lambda (rec?319 e320 r321 w322 s323 mod324
k325) ((lambda (tmp326) ((lambda (tmp327) (if tmp327 (apply (lambda (_328 id329
val330 e1331 e2332) (let ((ids333 id329)) (if (not (valid-bound-ids?139
ids333)) (syntax-violation #f "duplicate bound keyword" e320) (let ((labels335
(gen-labels120 ids333))) (let ((new-w336 (make-binding-wrap131 ids333 labels335
w322))) (k325 (cons e1331 e2332) (extend-env108 labels335 (let ((w338 (if
rec?319 new-w336 w322)) (trans-r339 (macros-only-env110 r321))) (map (lambda
(x340) (cons (quote macro) (eval-local-transformer157 (chi150 x340 trans-r339
w338 mod324) mod324))) val330)) r321) new-w336 s323 mod324)))))) tmp327)
((lambda (_342) (syntax-violation #f "bad local syntax definition"
(source-wrap143 e320 w322 s323 mod324))) tmp326))) ($sc-dispatch tmp326 (quote
(any #(each (any any)) any . each-any))))) e320))) (chi-lambda-clause155
(lambda (e343 docstring344 c345 r346 w347 mod348 k349) ((lambda (tmp350)
((lambda (tmp351) (if (if tmp351 (apply (lambda (args352 doc353 e1354 e2355)
(if (string? (syntax->datum doc353)) (not docstring344) #f)) tmp351) #f) (apply
(lambda (args356 doc357 e1358 e2359) (chi-lambda-clause155 e343 doc357 (cons
args356 (cons e1358 e2359)) r346 w347 mod348 k349)) tmp351) ((lambda (tmp361)
(if tmp361 (apply (lambda (id362 e1363 e2364) (let ((ids365 id362)) (if (not
(valid-bound-ids?139 ids365)) (syntax-violation (quote lambda) "invalid
parameter list" e343) (let ((labels367 (gen-labels120 ids365)) (new-vars368
(map gen-var162 ids365))) (k349 (map syntax->datum ids365) new-vars368 (if
docstring344 (syntax->datum docstring344) #f) (chi-body154 (cons e1363 e2364)
e343 (extend-var-env109 labels367 new-vars368 r346) (make-binding-wrap131
ids365 labels367 w347) mod348)))))) tmp361) ((lambda (tmp370) (if tmp370 (apply
(lambda (ids371 e1372 e2373) (let ((old-ids374 (lambda-var-list163 ids371)))
(if (not (valid-bound-ids?139 old-ids374)) (syntax-violation (quote lambda)
"invalid parameter list" e343) (let ((labels375 (gen-labels120 old-ids374))
(new-vars376 (map gen-var162 old-ids374))) (k349 (letrec ((f377 (lambda (ls1378
ls2379) (if (null? ls1378) (syntax->datum ls2379) (f377 (cdr ls1378) (cons
(syntax->datum (car ls1378)) ls2379)))))) (f377 (cdr old-ids374) (car
old-ids374))) (letrec ((f380 (lambda (ls1381 ls2382) (if (null? ls1381) ls2382
(f380 (cdr ls1381) (cons (car ls1381) ls2382)))))) (f380 (cdr new-vars376) (car
new-vars376))) (if docstring344 (syntax->datum docstring344) #f) (chi-body154
(cons e1372 e2373) e343 (extend-var-env109 labels375 new-vars376 r346)
(make-binding-wrap131 old-ids374 labels375 w347) mod348)))))) tmp370) ((lambda
(_384) (syntax-violation (quote lambda) "bad lambda" e343)) tmp350)))
($sc-dispatch tmp350 (quote (any any . each-any)))))) ($sc-dispatch tmp350
(quote (each-any any . each-any)))))) ($sc-dispatch tmp350 (quote (any any any
. each-any))))) c345))) (chi-body154 (lambda (body385 outer-form386 r387 w388
mod389) (let ((r390 (cons (quote ("placeholder" placeholder)) r387))) (let
((ribcage391 (make-ribcage121 (quote ()) (quote ()) (quote ())))) (let ((w392
(make-wrap116 (wrap-marks117 w388) (cons ribcage391 (wrap-subst118 w388)))))
(letrec ((parse393 (lambda (body394 ids395 labels396 vars397 vals398
bindings399) (if (null? body394) (syntax-violation #f "no expressions in body"
outer-form386) (let ((e401 (cdar body394)) (er402 (caar body394)))
(call-with-values (lambda () (syntax-type148 e401 er402 (quote (())) #f
ribcage391 mod389)) (lambda (type403 value404 e405 w406 s407 mod408) (if (memv
type403 (quote (define-form))) (let ((id409 (wrap142 value404 w406 mod408))
(label410 (gen-label119))) (let ((var411 (gen-var162 id409))) (begin
(extend-ribcage!130 ribcage391 id409 label410) (parse393 (cdr body394) (cons
id409 ids395) (cons label410 labels396) (cons var411 vars397) (cons (cons er402
(wrap142 e405 w406 mod408)) vals398) (cons (cons (quote lexical) var411)
bindings399))))) (if (memv type403 (quote (define-syntax-form))) (let ((id412
(wrap142 value404 w406 mod408)) (label413 (gen-label119))) (begin
(extend-ribcage!130 ribcage391 id412 label413) (parse393 (cdr body394) (cons
id412 ids395) (cons label413 labels396) vars397 vals398 (cons (cons (quote
macro) (cons er402 (wrap142 e405 w406 mod408))) bindings399)))) (if (memv
type403 (quote (begin-form))) ((lambda (tmp414) ((lambda (tmp415) (if tmp415
(apply (lambda (_416 e1417) (parse393 (letrec ((f418 (lambda (forms419) (if
(null? forms419) (cdr body394) (cons (cons er402 (wrap142 (car forms419) w406
mod408)) (f418 (cdr forms419))))))) (f418 e1417)) ids395 labels396 vars397
vals398 bindings399)) tmp415) (syntax-violation #f "source expression failed to
match any pattern" tmp414))) ($sc-dispatch tmp414 (quote (any . each-any)))))
e405) (if (memv type403 (quote (local-syntax-form))) (chi-local-syntax156
value404 e405 er402 w406 s407 mod408 (lambda (forms421 er422 w423 s424 mod425)
(parse393 (letrec ((f426 (lambda (forms427) (if (null? forms427) (cdr body394)
(cons (cons er422 (wrap142 (car forms427) w423 mod425)) (f426 (cdr
forms427))))))) (f426 forms421)) ids395 labels396 vars397 vals398
bindings399))) (if (null? ids395) (build-sequence93 #f (map (lambda (x428)
(chi150 (cdr x428) (car x428) (quote (())) mod408)) (cons (cons er402
(source-wrap143 e405 w406 s407 mod408)) (cdr body394)))) (begin (if (not
(valid-bound-ids?139 ids395)) (syntax-violation #f "invalid or duplicate
identifier in definition" outer-form386)) (letrec ((loop429 (lambda (bs430
er-cache431 r-cache432) (if (not (null? bs430)) (let ((b433 (car bs430))) (if
(eq? (car b433) (quote macro)) (let ((er434 (cadr b433))) (let ((r-cache435 (if
(eq? er434 er-cache431) r-cache432 (macros-only-env110 er434)))) (begin
(set-cdr! b433 (eval-local-transformer157 (chi150 (cddr b433) r-cache435 (quote
(())) mod408) mod408)) (loop429 (cdr bs430) er434 r-cache435)))) (loop429 (cdr
bs430) er-cache431 r-cache432))))))) (loop429 bindings399 #f #f)) (set-cdr!
r390 (extend-env108 labels396 bindings399 (cdr r390))) (build-letrec96 #f (map
syntax->datum ids395) vars397 (map (lambda (x436) (chi150 (cdr x436) (car x436)
(quote (())) mod408)) vals398) (build-sequence93 #f (map (lambda (x437) (chi150
(cdr x437) (car x437) (quote (())) mod408)) (cons (cons er402 (source-wrap143
e405 w406 s407 mod408)) (cdr body394)))))))))))))))))) (parse393 (map (lambda
(x400) (cons r390 (wrap142 x400 w392 mod389))) body385) (quote ()) (quote ())
(quote ()) (quote ()) (quote ())))))))) (chi-macro153 (lambda (p438 e439 r440
w441 rib442 mod443) (letrec ((rebuild-macro-output444 (lambda (x445 m446) (if
(pair? x445) (cons (rebuild-macro-output444 (car x445) m446)
(rebuild-macro-output444 (cdr x445) m446)) (if (syntax-object?98 x445) (let
((w447 (syntax-object-wrap100 x445))) (let ((ms448 (wrap-marks117 w447)) (s449
(wrap-subst118 w447))) (if (if (pair? ms448) (eq? (car ms448) #f) #f)
(make-syntax-object97 (syntax-object-expression99 x445) (make-wrap116 (cdr
ms448) (if rib442 (cons rib442 (cdr s449)) (cdr s449)))
(syntax-object-module101 x445)) (make-syntax-object97
(syntax-object-expression99 x445) (make-wrap116 (cons m446 ms448) (if rib442
(cons rib442 (cons (quote shift) s449)) (cons (quote shift) s449))) (let
((pmod450 (procedure-module p438))) (if pmod450 (cons (quote hygiene)
(module-name pmod450)) (quote (hygiene guile)))))))) (if (vector? x445) (let
((n451 (vector-length x445))) (let ((v452 (make-vector n451))) (letrec
((loop453 (lambda (i454) (if (fx=74 i454 n451) (begin (if #f #f) v452) (begin
(vector-set! v452 i454 (rebuild-macro-output444 (vector-ref x445 i454) m446))
(loop453 (fx+72 i454 1))))))) (loop453 0)))) (if (symbol? x445)
(syntax-violation #f "encountered raw symbol in macro output" (source-wrap143
e439 w441 s mod443) x445) x445))))))) (rebuild-macro-output444 (p438 (wrap142
e439 (anti-mark129 w441) mod443)) (string #\m))))) (chi-application152 (lambda
(x455 e456 r457 w458 s459 mod460) ((lambda (tmp461) ((lambda (tmp462) (if
tmp462 (apply (lambda (e0463 e1464) (build-application81 s459 x455 (map (lambda
(e465) (chi150 e465 r457 w458 mod460)) e1464))) tmp462) (syntax-violation #f
"source expression failed to match any pattern" tmp461))) ($sc-dispatch tmp461
(quote (any . each-any))))) e456))) (chi-expr151 (lambda (type467 value468 e469
r470 w471 s472 mod473) (if (memv type467 (quote (lexical)))
(build-lexical-reference83 (quote value) s472 e469 value468) (if (memv type467
(quote (core external-macro))) (value468 e469 r470 w471 s472 mod473) (if (memv
type467 (quote (module-ref))) (call-with-values (lambda () (value468 e469))
(lambda (id474 mod475) (build-global-reference86 s472 id474 mod475))) (if (memv
type467 (quote (lexical-call))) (chi-application152 (build-lexical-reference83
(quote fun) (source-annotation105 (car e469)) (car e469) value468) e469 r470
w471 s472 mod473) (if (memv type467 (quote (global-call))) (chi-application152
(build-global-reference86 (source-annotation105 (car e469)) value468 (if
(syntax-object?98 (car e469)) (syntax-object-module101 (car e469)) mod473))
e469 r470 w471 s472 mod473) (if (memv type467 (quote (constant))) (build-data92
s472 (strip161 (source-wrap143 e469 w471 s472 mod473) (quote (())))) (if (memv
type467 (quote (global))) (build-global-reference86 s472 value468 mod473) (if
(memv type467 (quote (call))) (chi-application152 (chi150 (car e469) r470 w471
mod473) e469 r470 w471 s472 mod473) (if (memv type467 (quote (begin-form)))
((lambda (tmp476) ((lambda (tmp477) (if tmp477 (apply (lambda (_478 e1479
e2480) (chi-sequence144 (cons e1479 e2480) r470 w471 s472 mod473)) tmp477)
(syntax-violation #f "source expression failed to match any pattern" tmp476)))
($sc-dispatch tmp476 (quote (any any . each-any))))) e469) (if (memv type467
(quote (local-syntax-form))) (chi-local-syntax156 value468 e469 r470 w471 s472
mod473 chi-sequence144) (if (memv type467 (quote (eval-when-form))) ((lambda
(tmp482) ((lambda (tmp483) (if tmp483 (apply (lambda (_484 x485 e1486 e2487)
(let ((when-list488 (chi-when-list147 e469 x485 w471))) (if (memq (quote eval)
when-list488) (chi-sequence144 (cons e1486 e2487) r470 w471 s472 mod473)
(chi-void158)))) tmp483) (syntax-violation #f "source expression failed to
match any pattern" tmp482))) ($sc-dispatch tmp482 (quote (any each-any any .
each-any))))) e469) (if (memv type467 (quote (define-form define-syntax-form)))
(syntax-violation #f "definition in expression context" e469 (wrap142 value468
w471 mod473)) (if (memv type467 (quote (syntax))) (syntax-violation #f
"reference to pattern variable outside syntax form" (source-wrap143 e469 w471
s472 mod473)) (if (memv type467 (quote (displaced-lexical))) (syntax-violation
#f "reference to identifier outside its scope" (source-wrap143 e469 w471 s472
mod473)) (syntax-violation #f "unexpected syntax" (source-wrap143 e469 w471
s472 mod473)))))))))))))))))) (chi150 (lambda (e491 r492 w493 mod494)
(call-with-values (lambda () (syntax-type148 e491 r492 w493 #f #f mod494))
(lambda (type495 value496 e497 w498 s499 mod500) (chi-expr151 type495 value496
e497 r492 w498 s499 mod500))))) (chi-top149 (lambda (e501 r502 w503 m504
esew505 mod506) (call-with-values (lambda () (syntax-type148 e501 r502 w503 #f
#f mod506)) (lambda (type514 value515 e516 w517 s518 mod519) (if (memv type514
(quote (begin-form))) ((lambda (tmp520) ((lambda (tmp521) (if tmp521 (apply
(lambda (_522) (chi-void158)) tmp521) ((lambda (tmp523) (if tmp523 (apply
(lambda (_524 e1525 e2526) (chi-top-sequence145 (cons e1525 e2526) r502 w517
s518 m504 esew505 mod519)) tmp523) (syntax-violation #f "source expression
failed to match any pattern" tmp520))) ($sc-dispatch tmp520 (quote (any any .
each-any)))))) ($sc-dispatch tmp520 (quote (any))))) e516) (if (memv type514
(quote (local-syntax-form))) (chi-local-syntax156 value515 e516 r502 w517 s518
mod519 (lambda (body528 r529 w530 s531 mod532) (chi-top-sequence145 body528
r529 w530 s531 m504 esew505 mod532))) (if (memv type514 (quote
(eval-when-form))) ((lambda (tmp533) ((lambda (tmp534) (if tmp534 (apply
(lambda (_535 x536 e1537 e2538) (let ((when-list539 (chi-when-list147 e516 x536
w517)) (body540 (cons e1537 e2538))) (if (eq? m504 (quote e)) (if (memq (quote
eval) when-list539) (chi-top-sequence145 body540 r502 w517 s518 (quote e)
(quote (eval)) mod519) (chi-void158)) (if (memq (quote load) when-list539) (if
(let ((t543 (memq (quote compile) when-list539))) (if t543 t543 (if (eq? m504
(quote c&e)) (memq (quote eval) when-list539) #f))) (chi-top-sequence145
body540 r502 w517 s518 (quote c&e) (quote (compile load)) mod519) (if (memq
m504 (quote (c c&e))) (chi-top-sequence145 body540 r502 w517 s518 (quote c)
(quote (load)) mod519) (chi-void158))) (if (let ((t544 (memq (quote compile)
when-list539))) (if t544 t544 (if (eq? m504 (quote c&e)) (memq (quote eval)
when-list539) #f))) (begin (top-level-eval-hook76 (chi-top-sequence145 body540
r502 w517 s518 (quote e) (quote (eval)) mod519) mod519) (chi-void158))
(chi-void158)))))) tmp534) (syntax-violation #f "source expression failed to
match any pattern" tmp533))) ($sc-dispatch tmp533 (quote (any each-any any .
each-any))))) e516) (if (memv type514 (quote (define-syntax-form))) (let ((n545
(id-var-name136 value515 w517)) (r546 (macros-only-env110 r502))) (if (memv
m504 (quote (c))) (if (memq (quote compile) esew505) (let ((e547
(chi-install-global146 n545 (chi150 e516 r546 w517 mod519)))) (begin
(top-level-eval-hook76 e547 mod519) (if (memq (quote load) esew505) e547
(chi-void158)))) (if (memq (quote load) esew505) (chi-install-global146 n545
(chi150 e516 r546 w517 mod519)) (chi-void158))) (if (memv m504 (quote (c&e)))
(let ((e548 (chi-install-global146 n545 (chi150 e516 r546 w517 mod519))))
(begin (top-level-eval-hook76 e548 mod519) e548)) (begin (if (memq (quote eval)
esew505) (top-level-eval-hook76 (chi-install-global146 n545 (chi150 e516 r546
w517 mod519)) mod519)) (chi-void158))))) (if (memv type514 (quote
(define-form))) (let ((n549 (id-var-name136 value515 w517))) (let ((type550
(binding-type106 (lookup111 n549 r502 mod519)))) (if (memv type550 (quote
(global core macro module-ref))) (let ((x551 (build-global-definition89 s518
n549 (chi150 e516 r502 w517 mod519)))) (begin (if (eq? m504 (quote c&e))
(top-level-eval-hook76 x551 mod519)) x551)) (if (memv type550 (quote
(displaced-lexical))) (syntax-violation #f "identifier out of context" e516
(wrap142 value515 w517 mod519)) (syntax-violation #f "cannot define keyword at
top level" e516 (wrap142 value515 w517 mod519)))))) (let ((x552 (chi-expr151
type514 value515 e516 r502 w517 s518 mod519))) (begin (if (eq? m504 (quote
c&e)) (top-level-eval-hook76 x552 mod519)) x552))))))))))) (syntax-type148
(lambda (e553 r554 w555 s556 rib557 mod558) (if (symbol? e553) (let ((n559
(id-var-name136 e553 w555))) (let ((b560 (lookup111 n559 r554 mod558))) (let
((type561 (binding-type106 b560))) (if (memv type561 (quote (lexical))) (values
type561 (binding-value107 b560) e553 w555 s556 mod558) (if (memv type561 (quote
(global))) (values type561 n559 e553 w555 s556 mod558) (if (memv type561 (quote
(macro))) (syntax-type148 (chi-macro153 (binding-value107 b560) e553 r554 w555
rib557 mod558) r554 (quote (())) s556 rib557 mod558) (values type561
(binding-value107 b560) e553 w555 s556 mod558))))))) (if (pair? e553) (let
((first562 (car e553))) (if (id?114 first562) (let ((n563 (id-var-name136
first562 w555))) (let ((b564 (lookup111 n563 r554 (let ((t565 (if
(syntax-object?98 first562) (syntax-object-module101 first562) #f))) (if t565
t565 mod558))))) (let ((type566 (binding-type106 b564))) (if (memv type566
(quote (lexical))) (values (quote lexical-call) (binding-value107 b564) e553
w555 s556 mod558) (if (memv type566 (quote (global))) (values (quote
global-call) n563 e553 w555 s556 mod558) (if (memv type566 (quote (macro)))
(syntax-type148 (chi-macro153 (binding-value107 b564) e553 r554 w555 rib557
mod558) r554 (quote (())) s556 rib557 mod558) (if (memv type566 (quote (core
external-macro module-ref))) (values type566 (binding-value107 b564) e553 w555
s556 mod558) (if (memv type566 (quote (local-syntax))) (values (quote
local-syntax-form) (binding-value107 b564) e553 w555 s556 mod558) (if (memv
type566 (quote (begin))) (values (quote begin-form) #f e553 w555 s556 mod558)
(if (memv type566 (quote (eval-when))) (values (quote eval-when-form) #f e553
w555 s556 mod558) (if (memv type566 (quote (define))) ((lambda (tmp567)
((lambda (tmp568) (if (if tmp568 (apply (lambda (_569 name570 val571) (id?114
name570)) tmp568) #f) (apply (lambda (_572 name573 val574) (values (quote
define-form) name573 val574 w555 s556 mod558)) tmp568) ((lambda (tmp575) (if
(if tmp575 (apply (lambda (_576 name577 args578 e1579 e2580) (if (id?114
name577) (valid-bound-ids?139 (lambda-var-list163 args578)) #f)) tmp575) #f)
(apply (lambda (_581 name582 args583 e1584 e2585) (values (quote define-form)
(wrap142 name582 w555 mod558) (cons (quote #(syntax-object lambda ((top)
#(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i"
"i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage
#(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var
strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks
join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage
new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap
set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels
ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label
make-rename rename-marks rename-new rename-old subst-rename? wrap-subst
wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id?
global-extend lookup macros-only-env extend-var-env extend-env null-env
binding-value binding-type make-binding arg-check source-annotation no-source
unannotate set-syntax-object-module! set-syntax-object-wrap!
set-syntax-object-expression! syntax-object-module syntax-object-wrap
syntax-object-expression syntax-object? make-syntax-object build-lexical-var
build-letrec build-named-let build-let build-sequence build-data build-primref
build-lambda build-global-definition maybe-name-value! build-global-assignment
build-global-reference analyze-variable build-lexical-assignment
build-lexical-reference build-conditional build-application build-void
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top))
("i" "i"))) (hygiene guile))) (wrap142 (cons args583 (cons e1584 e2585)) w555
mod558)) (quote (())) s556 mod558)) tmp575) ((lambda (tmp587) (if (if tmp587
(apply (lambda (_588 name589) (id?114 name589)) tmp587) #f) (apply (lambda
(_590 name591) (values (quote define-form) (wrap142 name591 w555 mod558) (quote
(#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage ()
() ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))
#(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage ()
() ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))
#(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage ()
() ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
(())) s556 mod558)) tmp587) (syntax-violation #f "source expression failed to
match any pattern" tmp567))) ($sc-dispatch tmp567 (quote (any any))))))
($sc-dispatch tmp567 (quote (any (any . any) any . each-any)))))) ($sc-dispatch
tmp567 (quote (any any any))))) e553) (if (memv type566 (quote
(define-syntax))) ((lambda (tmp592) ((lambda (tmp593) (if (if tmp593 (apply
(lambda (_594 name595 val596) (id?114 name595)) tmp593) #f) (apply (lambda
(_597 name598 val599) (values (quote define-syntax-form) name598 val599 w555
s556 mod558)) tmp593) (syntax-violation #f "source expression failed to match
any pattern" tmp592))) ($sc-dispatch tmp592 (quote (any any any))))) e553)
(values (quote call) #f e553 w555 s556 mod558))))))))))))) (values (quote call)
#f e553 w555 s556 mod558))) (if (syntax-object?98 e553) (syntax-type148
(syntax-object-expression99 e553) r554 (join-wraps133 w555
(syntax-object-wrap100 e553)) #f rib557 (let ((t600 (syntax-object-module101
e553))) (if t600 t600 mod558))) (if (annotation? e553) (syntax-type148
(annotation-expression e553) r554 w555 (annotation-source e553) rib557 mod558)
(if (self-evaluating? e553) (values (quote constant) #f e553 w555 s556 mod558)
(values (quote other) #f e553 w555 s556 mod558)))))))) (chi-when-list147
(lambda (e601 when-list602 w603) (letrec ((f604 (lambda (when-list605
situations606) (if (null? when-list605) situations606 (f604 (cdr when-list605)
(cons (let ((x607 (car when-list605))) (if (free-id=?137 x607 (quote
#(syntax-object compile ((top) #(ribcage () () ()) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
compile) (if (free-id=?137 x607 (quote #(syntax-object load ((top) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top))
#("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
load) (if (free-id=?137 x607 (quote #(syntax-object eval ((top) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top))
#("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote
eval) (syntax-violation (quote eval-when) "invalid situation" e601 (wrap142
x607 w603 #f)))))) situations606)))))) (f604 when-list602 (quote ())))))
(chi-install-global146 (lambda (name608 e609) (build-global-definition89 #f
name608 (if (let ((v610 (module-variable (current-module) name608))) (if v610
(if (variable-bound? v610) (if (macro? (variable-ref v610)) (not (eq?
(macro-type (variable-ref v610)) (quote syncase-macro))) #f) #f) #f))
(build-application81 #f (build-primref91 #f (quote
make-extended-syncase-macro)) (list (build-application81 #f (build-primref91 #f
(quote module-ref)) (list (build-application81 #f (build-primref91 #f (quote
current-module)) (quote ())) (build-data92 #f name608))) (build-data92 #f
(quote macro)) e609)) (build-application81 #f (build-primref91 #f (quote
make-syncase-macro)) (list (build-data92 #f (quote macro)) e609))))))
(chi-top-sequence145 (lambda (body611 r612 w613 s614 m615 esew616 mod617)
(build-sequence93 s614 (letrec ((dobody618 (lambda (body619 r620 w621 m622
esew623 mod624) (if (null? body619) (quote ()) (let ((first625 (chi-top149 (car
body619) r620 w621 m622 esew623 mod624))) (cons first625 (dobody618 (cdr
body619) r620 w621 m622 esew623 mod624))))))) (dobody618 body611 r612 w613 m615
esew616 mod617))))) (chi-sequence144 (lambda (body626 r627 w628 s629 mod630)
(build-sequence93 s629 (letrec ((dobody631 (lambda (body632 r633 w634 mod635)
(if (null? body632) (quote ()) (let ((first636 (chi150 (car body632) r633 w634
mod635))) (cons first636 (dobody631 (cdr body632) r633 w634 mod635)))))))
(dobody631 body626 r627 w628 mod630))))) (source-wrap143 (lambda (x637 w638
s639 defmod640) (wrap142 (if s639 (make-annotation x637 s639 #f) x637) w638
defmod640))) (wrap142 (lambda (x641 w642 defmod643) (if (if (null?
(wrap-marks117 w642)) (null? (wrap-subst118 w642)) #f) x641 (if
(syntax-object?98 x641) (make-syntax-object97 (syntax-object-expression99 x641)
(join-wraps133 w642 (syntax-object-wrap100 x641)) (syntax-object-module101
x641)) (if (null? x641) x641 (make-syntax-object97 x641 w642 defmod643))))))
(bound-id-member?141 (lambda (x644 list645) (if (not (null? list645)) (let
((t646 (bound-id=?138 x644 (car list645)))) (if t646 t646 (bound-id-member?141
x644 (cdr list645)))) #f))) (distinct-bound-ids?140 (lambda (ids647) (letrec
((distinct?648 (lambda (ids649) (let ((t650 (null? ids649))) (if t650 t650 (if
(not (bound-id-member?141 (car ids649) (cdr ids649))) (distinct?648 (cdr
ids649)) #f)))))) (distinct?648 ids647)))) (valid-bound-ids?139 (lambda
(ids651) (if (letrec ((all-ids?652 (lambda (ids653) (let ((t654 (null?
ids653))) (if t654 t654 (if (id?114 (car ids653)) (all-ids?652 (cdr ids653))
#f)))))) (all-ids?652 ids651)) (distinct-bound-ids?140 ids651) #f)))
(bound-id=?138 (lambda (i655 j656) (if (if (syntax-object?98 i655)
(syntax-object?98 j656) #f) (if (eq? (let ((e657 (syntax-object-expression99
i655))) (if (annotation? e657) (annotation-expression e657) e657)) (let ((e658
(syntax-object-expression99 j656))) (if (annotation? e658)
(annotation-expression e658) e658))) (same-marks?135 (wrap-marks117
(syntax-object-wrap100 i655)) (wrap-marks117 (syntax-object-wrap100 j656))) #f)
(eq? (let ((e659 i655)) (if (annotation? e659) (annotation-expression e659)
e659)) (let ((e660 j656)) (if (annotation? e660) (annotation-expression e660)
e660)))))) (free-id=?137 (lambda (i661 j662) (if (eq? (let ((x663 i661)) (let
((e664 (if (syntax-object?98 x663) (syntax-object-expression99 x663) x663)))
(if (annotation? e664) (annotation-expression e664) e664))) (let ((x665 j662))
(let ((e666 (if (syntax-object?98 x665) (syntax-object-expression99 x665)
x665))) (if (annotation? e666) (annotation-expression e666) e666)))) (eq?
(id-var-name136 i661 (quote (()))) (id-var-name136 j662 (quote (())))) #f)))
(id-var-name136 (lambda (id667 w668) (letrec ((search-vector-rib671 (lambda
(sym677 subst678 marks679 symnames680 ribcage681) (let ((n682 (vector-length
symnames680))) (letrec ((f683 (lambda (i684) (if (fx=74 i684 n682) (search669
sym677 (cdr subst678) marks679) (if (if (eq? (vector-ref symnames680 i684)
sym677) (same-marks?135 marks679 (vector-ref (ribcage-marks124 ribcage681)
i684)) #f) (values (vector-ref (ribcage-labels125 ribcage681) i684) marks679)
(f683 (fx+72 i684 1))))))) (f683 0))))) (search-list-rib670 (lambda (sym685
subst686 marks687 symnames688 ribcage689) (letrec ((f690 (lambda (symnames691
i692) (if (null? symnames691) (search669 sym685 (cdr subst686) marks687) (if
(if (eq? (car symnames691) sym685) (same-marks?135 marks687 (list-ref
(ribcage-marks124 ribcage689) i692)) #f) (values (list-ref (ribcage-labels125
ribcage689) i692) marks687) (f690 (cdr symnames691) (fx+72 i692 1))))))) (f690
symnames688 0)))) (search669 (lambda (sym693 subst694 marks695) (if (null?
subst694) (values #f marks695) (let ((fst696 (car subst694))) (if (eq? fst696
(quote shift)) (search669 sym693 (cdr subst694) (cdr marks695)) (let
((symnames697 (ribcage-symnames123 fst696))) (if (vector? symnames697)
(search-vector-rib671 sym693 subst694 marks695 symnames697 fst696)
(search-list-rib670 sym693 subst694 marks695 symnames697 fst696))))))))) (if
(symbol? id667) (let ((t698 (call-with-values (lambda () (search669 id667
(wrap-subst118 w668) (wrap-marks117 w668))) (lambda (x700 . ignore699) x700))))
(if t698 t698 id667)) (if (syntax-object?98 id667) (let ((id701 (let ((e703
(syntax-object-expression99 id667))) (if (annotation? e703)
(annotation-expression e703) e703))) (w1702 (syntax-object-wrap100 id667)))
(let ((marks704 (join-marks134 (wrap-marks117 w668) (wrap-marks117 w1702))))
(call-with-values (lambda () (search669 id701 (wrap-subst118 w668) marks704))
(lambda (new-id705 marks706) (let ((t707 new-id705)) (if t707 t707 (let ((t708
(call-with-values (lambda () (search669 id701 (wrap-subst118 w1702) marks706))
(lambda (x710 . ignore709) x710)))) (if t708 t708 id701)))))))) (if
(annotation? id667) (let ((id711 (let ((e712 id667)) (if (annotation? e712)
(annotation-expression e712) e712)))) (let ((t713 (call-with-values (lambda ()
(search669 id711 (wrap-subst118 w668) (wrap-marks117 w668))) (lambda (x715 .
ignore714) x715)))) (if t713 t713 id711))) (syntax-violation (quote
id-var-name) "invalid id" id667))))))) (same-marks?135 (lambda (x716 y717) (let
((t718 (eq? x716 y717))) (if t718 t718 (if (not (null? x716)) (if (not (null?
y717)) (if (eq? (car x716) (car y717)) (same-marks?135 (cdr x716) (cdr y717))
#f) #f) #f))))) (join-marks134 (lambda (m1719 m2720) (smart-append132 m1719
m2720))) (join-wraps133 (lambda (w1721 w2722) (let ((m1723 (wrap-marks117
w1721)) (s1724 (wrap-subst118 w1721))) (if (null? m1723) (if (null? s1724)
w2722 (make-wrap116 (wrap-marks117 w2722) (smart-append132 s1724 (wrap-subst118
w2722)))) (make-wrap116 (smart-append132 m1723 (wrap-marks117 w2722))
(smart-append132 s1724 (wrap-subst118 w2722))))))) (smart-append132 (lambda
(m1725 m2726) (if (null? m2726) m1725 (append m1725 m2726))))
(make-binding-wrap131 (lambda (ids727 labels728 w729) (if (null? ids727) w729
(make-wrap116 (wrap-marks117 w729) (cons (let ((labelvec730 (list->vector
labels728))) (let ((n731 (vector-length labelvec730))) (let ((symnamevec732
(make-vector n731)) (marksvec733 (make-vector n731))) (begin (letrec ((f734
(lambda (ids735 i736) (if (not (null? ids735)) (call-with-values (lambda ()
(id-sym-name&marks115 (car ids735) w729)) (lambda (symname737 marks738) (begin
(vector-set! symnamevec732 i736 symname737) (vector-set! marksvec733 i736
marks738) (f734 (cdr ids735) (fx+72 i736 1))))))))) (f734 ids727 0))
(make-ribcage121 symnamevec732 marksvec733 labelvec730))))) (wrap-subst118
w729)))))) (extend-ribcage!130 (lambda (ribcage739 id740 label741) (begin
(set-ribcage-symnames!126 ribcage739 (cons (let ((e742
(syntax-object-expression99 id740))) (if (annotation? e742)
(annotation-expression e742) e742)) (ribcage-symnames123 ribcage739)))
(set-ribcage-marks!127 ribcage739 (cons (wrap-marks117 (syntax-object-wrap100
id740)) (ribcage-marks124 ribcage739))) (set-ribcage-labels!128 ribcage739
(cons label741 (ribcage-labels125 ribcage739)))))) (anti-mark129 (lambda (w743)
(make-wrap116 (cons #f (wrap-marks117 w743)) (cons (quote shift) (wrap-subst118
w743))))) (set-ribcage-labels!128 (lambda (x744 update745) (vector-set! x744 3
update745))) (set-ribcage-marks!127 (lambda (x746 update747) (vector-set! x746
2 update747))) (set-ribcage-symnames!126 (lambda (x748 update749) (vector-set!
x748 1 update749))) (ribcage-labels125 (lambda (x750) (vector-ref x750 3)))
(ribcage-marks124 (lambda (x751) (vector-ref x751 2))) (ribcage-symnames123
(lambda (x752) (vector-ref x752 1))) (ribcage?122 (lambda (x753) (if (vector?
x753) (if (= (vector-length x753) 4) (eq? (vector-ref x753 0) (quote ribcage))
#f) #f))) (make-ribcage121 (lambda (symnames754 marks755 labels756) (vector
(quote ribcage) symnames754 marks755 labels756))) (gen-labels120 (lambda
(ls757) (if (null? ls757) (quote ()) (cons (gen-label119) (gen-labels120 (cdr
ls757)))))) (gen-label119 (lambda () (string #\i))) (wrap-subst118 cdr)
(wrap-marks117 car) (make-wrap116 cons) (id-sym-name&marks115 (lambda (x758
w759) (if (syntax-object?98 x758) (values (let ((e760
(syntax-object-expression99 x758))) (if (annotation? e760)
(annotation-expression e760) e760)) (join-marks134 (wrap-marks117 w759)
(wrap-marks117 (syntax-object-wrap100 x758)))) (values (let ((e761 x758)) (if
(annotation? e761) (annotation-expression e761) e761)) (wrap-marks117 w759)))))
(id?114 (lambda (x762) (if (symbol? x762) #t (if (syntax-object?98 x762)
(symbol? (let ((e763 (syntax-object-expression99 x762))) (if (annotation? e763)
(annotation-expression e763) e763))) (if (annotation? x762) (symbol?
(annotation-expression x762)) #f))))) (nonsymbol-id?113 (lambda (x764) (if
(syntax-object?98 x764) (symbol? (let ((e765 (syntax-object-expression99
x764))) (if (annotation? e765) (annotation-expression e765) e765))) #f)))
(global-extend112 (lambda (type766 sym767 val768) (put-global-definition-hook78
sym767 type766 val768))) (lookup111 (lambda (x769 r770 mod771) (let ((t772
(assq x769 r770))) (if t772 (cdr t772) (if (symbol? x769) (let ((t773
(get-global-definition-hook79 x769 mod771))) (if t773 t773 (quote (global))))
(quote (displaced-lexical))))))) (macros-only-env110 (lambda (r774) (if (null?
r774) (quote ()) (let ((a775 (car r774))) (if (eq? (cadr a775) (quote macro))
(cons a775 (macros-only-env110 (cdr r774))) (macros-only-env110 (cdr
r774))))))) (extend-var-env109 (lambda (labels776 vars777 r778) (if (null?
labels776) r778 (extend-var-env109 (cdr labels776) (cdr vars777) (cons (cons
(car labels776) (cons (quote lexical) (car vars777))) r778))))) (extend-env108
(lambda (labels779 bindings780 r781) (if (null? labels779) r781 (extend-env108
(cdr labels779) (cdr bindings780) (cons (cons (car labels779) (car
bindings780)) r781))))) (binding-value107 cdr) (binding-type106 car)
(source-annotation105 (lambda (x782) (if (annotation? x782) (annotation-source
x782) (if (syntax-object?98 x782) (source-annotation105
(syntax-object-expression99 x782)) #f)))) (set-syntax-object-module!104 (lambda
(x783 update784) (vector-set! x783 3 update784))) (set-syntax-object-wrap!103
(lambda (x785 update786) (vector-set! x785 2 update786)))
(set-syntax-object-expression!102 (lambda (x787 update788) (vector-set! x787 1
update788))) (syntax-object-module101 (lambda (x789) (vector-ref x789 3)))
(syntax-object-wrap100 (lambda (x790) (vector-ref x790 2)))
(syntax-object-expression99 (lambda (x791) (vector-ref x791 1)))
(syntax-object?98 (lambda (x792) (if (vector? x792) (if (= (vector-length x792)
4) (eq? (vector-ref x792 0) (quote syntax-object)) #f) #f)))
(make-syntax-object97 (lambda (expression793 wrap794 module795) (vector (quote
syntax-object) expression793 wrap794 module795))) (build-letrec96 (lambda
(src796 ids797 vars798 val-exps799 body-exp800) (if (null? vars798) body-exp800
(let ((atom-key801 (fluid-ref *mode*71))) (if (memv atom-key801 (quote (c)))
(begin (for-each maybe-name-value!88 ids797 val-exps799) ((@ (language tree-il)
make-letrec) src796 ids797 vars798 val-exps799 body-exp800)) (list (quote
letrec) (map list vars798 val-exps799) body-exp800)))))) (build-named-let95
(lambda (src802 ids803 vars804 val-exps805 body-exp806) (let ((f807 (car
vars804)) (f-name808 (car ids803)) (vars809 (cdr vars804)) (ids810 (cdr
ids803))) (let ((atom-key811 (fluid-ref *mode*71))) (if (memv atom-key811
(quote (c))) (let ((proc812 (build-lambda90 src802 ids810 vars809 #f
body-exp806))) (begin (maybe-name-value!88 f-name808 proc812) (for-each
maybe-name-value!88 ids810 val-exps805) ((@ (language tree-il) make-letrec)
src802 (list f-name808) (list f807) (list proc812) (build-application81 src802
(build-lexical-reference83 (quote fun) src802 f-name808 f807) val-exps805))))
(list (quote let) f807 (map list vars809 val-exps805) body-exp806))))))
(build-let94 (lambda (src813 ids814 vars815 val-exps816 body-exp817) (if (null?
vars815) body-exp817 (let ((atom-key818 (fluid-ref *mode*71))) (if (memv
atom-key818 (quote (c))) (begin (for-each maybe-name-value!88 ids814
val-exps816) ((@ (language tree-il) make-let) src813 ids814 vars815 val-exps816
body-exp817)) (list (quote let) (map list vars815 val-exps816)
body-exp817)))))) (build-sequence93 (lambda (src819 exps820) (if (null? (cdr
exps820)) (car exps820) (let ((atom-key821 (fluid-ref *mode*71))) (if (memv
atom-key821 (quote (c))) ((@ (language tree-il) make-sequence) src819 exps820)
(cons (quote begin) exps820)))))) (build-data92 (lambda (src822 exp823) (let
((atom-key824 (fluid-ref *mode*71))) (if (memv atom-key824 (quote (c))) ((@
(language tree-il) make-const) src822 exp823) (if (if (self-evaluating? exp823)
(not (vector? exp823)) #f) exp823 (list (quote quote) exp823))))))
(build-primref91 (lambda (src825 name826) (if (equal? (module-name
(current-module)) (quote (guile))) (let ((atom-key827 (fluid-ref *mode*71)))
(if (memv atom-key827 (quote (c))) ((@ (language tree-il) make-toplevel-ref)
src825 name826) name826)) (let ((atom-key828 (fluid-ref *mode*71))) (if (memv
atom-key828 (quote (c))) ((@ (language tree-il) make-module-ref) src825 (quote
(guile)) name826 #f) (list (quote @@) (quote (guile)) name826))))))
(build-lambda90 (lambda (src829 ids830 vars831 docstring832 exp833) (let
((atom-key834 (fluid-ref *mode*71))) (if (memv atom-key834 (quote (c))) ((@
(language tree-il) make-lambda) src829 ids830 vars831 (if docstring832 (list
(cons (quote documentation) docstring832)) (quote ())) exp833) (cons (quote
lambda) (cons vars831 (append (if docstring832 (list docstring832) (quote ()))
(list exp833)))))))) (build-global-definition89 (lambda (source835 var836
exp837) (let ((atom-key838 (fluid-ref *mode*71))) (if (memv atom-key838 (quote
(c))) (begin (maybe-name-value!88 var836 exp837) ((@ (language tree-il)
make-toplevel-define) source835 var836 exp837)) (list (quote define) var836
exp837))))) (maybe-name-value!88 (lambda (name839 val840) (if ((@ (language
tree-il) lambda?) val840) (let ((meta841 ((@ (language tree-il) lambda-meta)
val840))) (if (not (assq (quote name) meta841)) ((setter (@ (language tree-il)
lambda-meta)) val840 (acons (quote name) name839 meta841)))))))
(build-global-assignment87 (lambda (source842 var843 exp844 mod845)
(analyze-variable85 mod845 var843 (lambda (mod846 var847 public?848) (let
((atom-key849 (fluid-ref *mode*71))) (if (memv atom-key849 (quote (c))) ((@
(language tree-il) make-module-set) source842 mod846 var847 public?848 exp844)
(list (quote set!) (list (if public?848 (quote @) (quote @@)) mod846 var847)
exp844)))) (lambda (var850) (let ((atom-key851 (fluid-ref *mode*71))) (if (memv
atom-key851 (quote (c))) ((@ (language tree-il) make-toplevel-set) source842
var850 exp844) (list (quote set!) var850 exp844)))))))
(build-global-reference86 (lambda (source852 var853 mod854) (analyze-variable85
mod854 var853 (lambda (mod855 var856 public?857) (let ((atom-key858 (fluid-ref
*mode*71))) (if (memv atom-key858 (quote (c))) ((@ (language tree-il)
make-module-ref) source852 mod855 var856 public?857) (list (if public?857
(quote @) (quote @@)) mod855 var856)))) (lambda (var859) (let ((atom-key860
(fluid-ref *mode*71))) (if (memv atom-key860 (quote (c))) ((@ (language
tree-il) make-toplevel-ref) source852 var859) var859)))))) (analyze-variable85
(lambda (mod861 var862 modref-cont863 bare-cont864) (if (not mod861)
(bare-cont864 var862) (let ((kind865 (car mod861)) (mod866 (cdr mod861))) (if
(memv kind865 (quote (public))) (modref-cont863 mod866 var862 #t) (if (memv
kind865 (quote (private))) (if (not (equal? mod866 (module-name
(current-module)))) (modref-cont863 mod866 var862 #f) (bare-cont864 var862))
(if (memv kind865 (quote (bare))) (bare-cont864 var862) (if (memv kind865
(quote (hygiene))) (if (if (not (equal? mod866 (module-name (current-module))))
(module-variable (resolve-module mod866) var862) #f) (modref-cont863 mod866
var862 #f) (bare-cont864 var862)) (syntax-violation #f "bad module kind" var862
mod866))))))))) (build-lexical-assignment84 (lambda (source867 name868 var869
exp870) (let ((atom-key871 (fluid-ref *mode*71))) (if (memv atom-key871 (quote
(c))) ((@ (language tree-il) make-lexical-set) source867 name868 var869 exp870)
(list (quote set!) var869 exp870))))) (build-lexical-reference83 (lambda
(type872 source873 name874 var875) (let ((atom-key876 (fluid-ref *mode*71)))
(if (memv atom-key876 (quote (c))) ((@ (language tree-il) make-lexical-ref)
source873 name874 var875) var875)))) (build-conditional82 (lambda (source877
test-exp878 then-exp879 else-exp880) (let ((atom-key881 (fluid-ref *mode*71)))
(if (memv atom-key881 (quote (c))) ((@ (language tree-il) make-conditional)
source877 test-exp878 then-exp879 else-exp880) (if (equal? else-exp880 (quote
(if #f #f))) (list (quote if) test-exp878 then-exp879) (list (quote if)
test-exp878 then-exp879 else-exp880)))))) (build-application81 (lambda
(source882 fun-exp883 arg-exps884) (let ((atom-key885 (fluid-ref *mode*71)))
(if (memv atom-key885 (quote (c))) ((@ (language tree-il) make-application)
source882 fun-exp883 arg-exps884) (cons fun-exp883 arg-exps884)))))
(build-void80 (lambda (source886) (let ((atom-key887 (fluid-ref *mode*71))) (if
(memv atom-key887 (quote (c))) ((@ (language tree-il) make-void) source886)
(quote (if #f #f)))))) (get-global-definition-hook79 (lambda (symbol888
module889) (begin (if (if (not module889) (current-module) #f) (warn "module
system is booted, we should have a module" symbol888)) (let ((v890
(module-variable (if module889 (resolve-module (cdr module889))
(current-module)) symbol888))) (if v890 (if (variable-bound? v890) (let
((val891 (variable-ref v890))) (if (macro? val891) (if (syncase-macro-type
val891) (cons (syncase-macro-type val891) (syncase-macro-binding val891)) #f)
#f)) #f) #f))))) (put-global-definition-hook78 (lambda (symbol892 type893
val894) (let ((existing895 (let ((v896 (module-variable (current-module)
symbol892))) (if v896 (if (variable-bound? v896) (let ((val897 (variable-ref
v896))) (if (macro? val897) (if (not (syncase-macro-type val897)) val897 #f)
#f)) #f) #f)))) (module-define! (current-module) symbol892 (if existing895
(make-extended-syncase-macro existing895 type893 val894) (make-syncase-macro
type893 val894)))))) (local-eval-hook77 (lambda (x898 mod899) (primitive-eval
(list noexpand70 (let ((atom-key900 (fluid-ref *mode*71))) (if (memv
atom-key900 (quote (c))) ((@ (language tree-il) tree-il->scheme) x898)
x898)))))) (top-level-eval-hook76 (lambda (x901 mod902) (primitive-eval (list
noexpand70 (let ((atom-key903 (fluid-ref *mode*71))) (if (memv atom-key903
(quote (c))) ((@ (language tree-il) tree-il->scheme) x901) x901)))))) (fx<75 <)
(fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand"))
(begin (global-extend112 (quote local-syntax) (quote letrec-syntax) #t)
(global-extend112 (quote local-syntax) (quote let-syntax) #f) (global-extend112
(quote core) (quote fluid-let-syntax) (lambda (e904 r905 w906 s907 mod908)
((lambda (tmp909) ((lambda (tmp910) (if (if tmp910 (apply (lambda (_911 var912
val913 e1914 e2915) (valid-bound-ids?139 var912)) tmp910) #f) (apply (lambda
(_917 var918 val919 e1920 e2921) (let ((names922 (map (lambda (x923)
(id-var-name136 x923 w906)) var918))) (begin (for-each (lambda (id925 n926)
(let ((atom-key927 (binding-type106 (lookup111 n926 r905 mod908)))) (if (memv
atom-key927 (quote (displaced-lexical))) (syntax-violation (quote
fluid-let-syntax) "identifier out of context" e904 (source-wrap143 id925 w906
s907 mod908))))) var918 names922) (chi-body154 (cons e1920 e2921)
(source-wrap143 e904 w906 s907 mod908) (extend-env108 names922 (let
((trans-r930 (macros-only-env110 r905))) (map (lambda (x931) (cons (quote
macro) (eval-local-transformer157 (chi150 x931 trans-r930 w906 mod908)
mod908))) val919)) r905) w906 mod908)))) tmp910) ((lambda (_933)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap143 e904
w906 s907 mod908))) tmp909))) ($sc-dispatch tmp909 (quote (any #(each (any
any)) any . each-any))))) e904))) (global-extend112 (quote core) (quote quote)
(lambda (e934 r935 w936 s937 mod938) ((lambda (tmp939) ((lambda (tmp940) (if
tmp940 (apply (lambda (_941 e942) (build-data92 s937 (strip161 e942 w936)))
tmp940) ((lambda (_943) (syntax-violation (quote quote) "bad syntax"
(source-wrap143 e934 w936 s937 mod938))) tmp939))) ($sc-dispatch tmp939 (quote
(any any))))) e934))) (global-extend112 (quote core) (quote syntax) (letrec
((regen951 (lambda (x952) (let ((atom-key953 (car x952))) (if (memv atom-key953
(quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x952) (cadr
x952)) (if (memv atom-key953 (quote (primitive))) (build-primref91 #f (cadr
x952)) (if (memv atom-key953 (quote (quote))) (build-data92 #f (cadr x952)) (if
(memv atom-key953 (quote (lambda))) (build-lambda90 #f (cadr x952) (cadr x952)
#f (regen951 (caddr x952))) (if (memv atom-key953 (quote (map))) (let ((ls954
(map regen951 (cdr x952)))) (build-application81 #f (build-primref91 #f (quote
map)) ls954)) (build-application81 #f (build-primref91 #f (car x952)) (map
regen951 (cdr x952))))))))))) (gen-vector950 (lambda (x955) (if (eq? (car x955)
(quote list)) (cons (quote vector) (cdr x955)) (if (eq? (car x955) (quote
quote)) (list (quote quote) (list->vector (cadr x955))) (list (quote
list->vector) x955))))) (gen-append949 (lambda (x956 y957) (if (equal? y957
(quote (quote ()))) x956 (list (quote append) x956 y957)))) (gen-cons948
(lambda (x958 y959) (let ((atom-key960 (car y959))) (if (memv atom-key960
(quote (quote))) (if (eq? (car x958) (quote quote)) (list (quote quote) (cons
(cadr x958) (cadr y959))) (if (eq? (cadr y959) (quote ())) (list (quote list)
x958) (list (quote cons) x958 y959))) (if (memv atom-key960 (quote (list)))
(cons (quote list) (cons x958 (cdr y959))) (list (quote cons) x958 y959))))))
(gen-map947 (lambda (e961 map-env962) (let ((formals963 (map cdr map-env962))
(actuals964 (map (lambda (x965) (list (quote ref) (car x965))) map-env962)))
(if (eq? (car e961) (quote ref)) (car actuals964) (if (and-map (lambda (x966)
(if (eq? (car x966) (quote ref)) (memq (cadr x966) formals963) #f)) (cdr e961))
(cons (quote map) (cons (list (quote primitive) (car e961)) (map (let ((r967
(map cons formals963 actuals964))) (lambda (x968) (cdr (assq (cadr x968)
r967)))) (cdr e961)))) (cons (quote map) (cons (list (quote lambda) formals963
e961) actuals964))))))) (gen-mappend946 (lambda (e969 map-env970) (list (quote
apply) (quote (primitive append)) (gen-map947 e969 map-env970)))) (gen-ref945
(lambda (src971 var972 level973 maps974) (if (fx=74 level973 0) (values var972
maps974) (if (null? maps974) (syntax-violation (quote syntax) "missing
ellipsis" src971) (call-with-values (lambda () (gen-ref945 src971 var972 (fx-73
level973 1) (cdr maps974))) (lambda (outer-var975 outer-maps976) (let ((b977
(assq outer-var975 (car maps974)))) (if b977 (values (cdr b977) maps974) (let
((inner-var978 (gen-var162 (quote tmp)))) (values inner-var978 (cons (cons
(cons outer-var975 inner-var978) (car maps974)) outer-maps976)))))))))))
(gen-syntax944 (lambda (src979 e980 r981 maps982 ellipsis?983 mod984) (if
(id?114 e980) (let ((label985 (id-var-name136 e980 (quote (()))))) (let ((b986
(lookup111 label985 r981 mod984))) (if (eq? (binding-type106 b986) (quote
syntax)) (call-with-values (lambda () (let ((var.lev987 (binding-value107
b986))) (gen-ref945 src979 (car var.lev987) (cdr var.lev987) maps982))) (lambda
(var988 maps989) (values (list (quote ref) var988) maps989))) (if (ellipsis?983
e980) (syntax-violation (quote syntax) "misplaced ellipsis" src979) (values
(list (quote quote) e980) maps982))))) ((lambda (tmp990) ((lambda (tmp991) (if
(if tmp991 (apply (lambda (dots992 e993) (ellipsis?983 dots992)) tmp991) #f)
(apply (lambda (dots994 e995) (gen-syntax944 src979 e995 r981 maps982 (lambda
(x996) #f) mod984)) tmp991) ((lambda (tmp997) (if (if tmp997 (apply (lambda
(x998 dots999 y1000) (ellipsis?983 dots999)) tmp997) #f) (apply (lambda (x1001
dots1002 y1003) (letrec ((f1004 (lambda (y1005 k1006) ((lambda (tmp1010)
((lambda (tmp1011) (if (if tmp1011 (apply (lambda (dots1012 y1013)
(ellipsis?983 dots1012)) tmp1011) #f) (apply (lambda (dots1014 y1015) (f1004
y1015 (lambda (maps1016) (call-with-values (lambda () (k1006 (cons (quote ())
maps1016))) (lambda (x1017 maps1018) (if (null? (car maps1018))
(syntax-violation (quote syntax) "extra ellipsis" src979) (values
(gen-mappend946 x1017 (car maps1018)) (cdr maps1018)))))))) tmp1011) ((lambda
(_1019) (call-with-values (lambda () (gen-syntax944 src979 y1005 r981 maps982
ellipsis?983 mod984)) (lambda (y1020 maps1021) (call-with-values (lambda ()
(k1006 maps1021)) (lambda (x1022 maps1023) (values (gen-append949 x1022 y1020)
maps1023)))))) tmp1010))) ($sc-dispatch tmp1010 (quote (any . any)))))
y1005)))) (f1004 y1003 (lambda (maps1007) (call-with-values (lambda ()
(gen-syntax944 src979 x1001 r981 (cons (quote ()) maps1007) ellipsis?983
mod984)) (lambda (x1008 maps1009) (if (null? (car maps1009)) (syntax-violation
(quote syntax) "extra ellipsis" src979) (values (gen-map947 x1008 (car
maps1009)) (cdr maps1009))))))))) tmp997) ((lambda (tmp1024) (if tmp1024 (apply
(lambda (x1025 y1026) (call-with-values (lambda () (gen-syntax944 src979 x1025
r981 maps982 ellipsis?983 mod984)) (lambda (x1027 maps1028) (call-with-values
(lambda () (gen-syntax944 src979 y1026 r981 maps1028 ellipsis?983 mod984))
(lambda (y1029 maps1030) (values (gen-cons948 x1027 y1029) maps1030))))))
tmp1024) ((lambda (tmp1031) (if tmp1031 (apply (lambda (e11032 e21033)
(call-with-values (lambda () (gen-syntax944 src979 (cons e11032 e21033) r981
maps982 ellipsis?983 mod984)) (lambda (e1035 maps1036) (values (gen-vector950
e1035) maps1036)))) tmp1031) ((lambda (_1037) (values (list (quote quote) e980)
maps982)) tmp990))) ($sc-dispatch tmp990 (quote #(vector (any . each-any)))))))
($sc-dispatch tmp990 (quote (any . any)))))) ($sc-dispatch tmp990 (quote (any
any . any)))))) ($sc-dispatch tmp990 (quote (any any))))) e980))))) (lambda
(e1038 r1039 w1040 s1041 mod1042) (let ((e1043 (source-wrap143 e1038 w1040
s1041 mod1042))) ((lambda (tmp1044) ((lambda (tmp1045) (if tmp1045 (apply
(lambda (_1046 x1047) (call-with-values (lambda () (gen-syntax944 e1043 x1047
r1039 (quote ()) ellipsis?159 mod1042)) (lambda (e1048 maps1049) (regen951
e1048)))) tmp1045) ((lambda (_1050) (syntax-violation (quote syntax) "bad
`syntax' form" e1043)) tmp1044))) ($sc-dispatch tmp1044 (quote (any any)))))
e1043))))) (global-extend112 (quote core) (quote lambda) (lambda (e1051 r1052
w1053 s1054 mod1055) ((lambda (tmp1056) ((lambda (tmp1057) (if tmp1057 (apply
(lambda (_1058 c1059) (chi-lambda-clause155 (source-wrap143 e1051 w1053 s1054
mod1055) #f c1059 r1052 w1053 mod1055 (lambda (names1060 vars1061 docstring1062
body1063) (build-lambda90 s1054 names1060 vars1061 docstring1062 body1063))))
tmp1057) (syntax-violation #f "source expression failed to match any pattern"
tmp1056))) ($sc-dispatch tmp1056 (quote (any . any))))) e1051)))
(global-extend112 (quote core) (quote let) (letrec ((chi-let1064 (lambda (e1065
r1066 w1067 s1068 mod1069 constructor1070 ids1071 vals1072 exps1073) (if (not
(valid-bound-ids?139 ids1071)) (syntax-violation (quote let) "duplicate bound
variable" e1065) (let ((labels1074 (gen-labels120 ids1071)) (new-vars1075 (map
gen-var162 ids1071))) (let ((nw1076 (make-binding-wrap131 ids1071 labels1074
w1067)) (nr1077 (extend-var-env109 labels1074 new-vars1075 r1066)))
(constructor1070 s1068 (map syntax->datum ids1071) new-vars1075 (map (lambda
(x1078) (chi150 x1078 r1066 w1067 mod1069)) vals1072) (chi-body154 exps1073
(source-wrap143 e1065 nw1076 s1068 mod1069) nr1077 nw1076 mod1069))))))))
(lambda (e1079 r1080 w1081 s1082 mod1083) ((lambda (tmp1084) ((lambda (tmp1085)
(if (if tmp1085 (apply (lambda (_1086 id1087 val1088 e11089 e21090) (and-map
id?114 id1087)) tmp1085) #f) (apply (lambda (_1092 id1093 val1094 e11095
e21096) (chi-let1064 e1079 r1080 w1081 s1082 mod1083 build-let94 id1093 val1094
(cons e11095 e21096))) tmp1085) ((lambda (tmp1100) (if (if tmp1100 (apply
(lambda (_1101 f1102 id1103 val1104 e11105 e21106) (if (id?114 f1102) (and-map
id?114 id1103) #f)) tmp1100) #f) (apply (lambda (_1108 f1109 id1110 val1111
e11112 e21113) (chi-let1064 e1079 r1080 w1081 s1082 mod1083 build-named-let95
(cons f1109 id1110) val1111 (cons e11112 e21113))) tmp1100) ((lambda (_1117)
(syntax-violation (quote let) "bad let" (source-wrap143 e1079 w1081 s1082
mod1083))) tmp1084))) ($sc-dispatch tmp1084 (quote (any any #(each (any any))
any . each-any)))))) ($sc-dispatch tmp1084 (quote (any #(each (any any)) any .
each-any))))) e1079)))) (global-extend112 (quote core) (quote letrec) (lambda
(e1118 r1119 w1120 s1121 mod1122) ((lambda (tmp1123) ((lambda (tmp1124) (if (if
tmp1124 (apply (lambda (_1125 id1126 val1127 e11128 e21129) (and-map id?114
id1126)) tmp1124) #f) (apply (lambda (_1131 id1132 val1133 e11134 e21135) (let
((ids1136 id1132)) (if (not (valid-bound-ids?139 ids1136)) (syntax-violation
(quote letrec) "duplicate bound variable" e1118) (let ((labels1138
(gen-labels120 ids1136)) (new-vars1139 (map gen-var162 ids1136))) (let ((w1140
(make-binding-wrap131 ids1136 labels1138 w1120)) (r1141 (extend-var-env109
labels1138 new-vars1139 r1119))) (build-letrec96 s1121 (map syntax->datum
ids1136) new-vars1139 (map (lambda (x1142) (chi150 x1142 r1141 w1140 mod1122))
val1133) (chi-body154 (cons e11134 e21135) (source-wrap143 e1118 w1140 s1121
mod1122) r1141 w1140 mod1122))))))) tmp1124) ((lambda (_1145) (syntax-violation
(quote letrec) "bad letrec" (source-wrap143 e1118 w1120 s1121 mod1122)))
tmp1123))) ($sc-dispatch tmp1123 (quote (any #(each (any any)) any .
each-any))))) e1118))) (global-extend112 (quote core) (quote set!) (lambda
(e1146 r1147 w1148 s1149 mod1150) ((lambda (tmp1151) ((lambda (tmp1152) (if (if
tmp1152 (apply (lambda (_1153 id1154 val1155) (id?114 id1154)) tmp1152) #f)
(apply (lambda (_1156 id1157 val1158) (let ((val1159 (chi150 val1158 r1147
w1148 mod1150)) (n1160 (id-var-name136 id1157 w1148))) (let ((b1161 (lookup111
n1160 r1147 mod1150))) (let ((atom-key1162 (binding-type106 b1161))) (if (memv
atom-key1162 (quote (lexical))) (build-lexical-assignment84 s1149
(syntax->datum id1157) (binding-value107 b1161) val1159) (if (memv atom-key1162
(quote (global))) (build-global-assignment87 s1149 n1160 val1159 mod1150) (if
(memv atom-key1162 (quote (displaced-lexical))) (syntax-violation (quote set!)
"identifier out of context" (wrap142 id1157 w1148 mod1150)) (syntax-violation
(quote set!) "bad set!" (source-wrap143 e1146 w1148 s1149 mod1150)))))))))
tmp1152) ((lambda (tmp1163) (if tmp1163 (apply (lambda (_1164 head1165 tail1166
val1167) (call-with-values (lambda () (syntax-type148 head1165 r1147 (quote
(())) #f #f mod1150)) (lambda (type1168 value1169 ee1170 ww1171 ss1172
modmod1173) (if (memv type1168 (quote (module-ref))) (let ((val1174 (chi150
val1167 r1147 w1148 mod1150))) (call-with-values (lambda () (value1169 (cons
head1165 tail1166))) (lambda (id1176 mod1177) (build-global-assignment87 s1149
id1176 val1174 mod1177)))) (build-application81 s1149 (chi150 (list (quote
#(syntax-object setter ((top) #(ribcage () () ()) #(ribcage () () ()) #(ribcage
#(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
head1165) r1147 w1148 mod1150) (map (lambda (e1178) (chi150 e1178 r1147 w1148
mod1150)) (append tail1166 (list val1167)))))))) tmp1163) ((lambda (_1180)
(syntax-violation (quote set!) "bad set!" (source-wrap143 e1146 w1148 s1149
mod1150))) tmp1151))) ($sc-dispatch tmp1151 (quote (any (any . each-any)
any)))))) ($sc-dispatch tmp1151 (quote (any any any))))) e1146)))
(global-extend112 (quote module-ref) (quote @) (lambda (e1181) ((lambda
(tmp1182) ((lambda (tmp1183) (if (if tmp1183 (apply (lambda (_1184 mod1185
id1186) (if (and-map id?114 mod1185) (id?114 id1186) #f)) tmp1183) #f) (apply
(lambda (_1188 mod1189 id1190) (values (syntax->datum id1190) (syntax->datum
(cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i"))
#(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
mod1189)))) tmp1183) (syntax-violation #f "source expression failed to match
any pattern" tmp1182))) ($sc-dispatch tmp1182 (quote (any each-any any)))))
e1181))) (global-extend112 (quote module-ref) (quote @@) (lambda (e1192)
((lambda (tmp1193) ((lambda (tmp1194) (if (if tmp1194 (apply (lambda (_1195
mod1196 id1197) (if (and-map id?114 mod1196) (id?114 id1197) #f)) tmp1194) #f)
(apply (lambda (_1199 mod1200 id1201) (values (syntax->datum id1201)
(syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod
id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e)
#((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
mod1200)))) tmp1194) (syntax-violation #f "source expression failed to match
any pattern" tmp1193))) ($sc-dispatch tmp1193 (quote (any each-any any)))))
e1192))) (global-extend112 (quote core) (quote if) (lambda (e1203 r1204 w1205
s1206 mod1207) ((lambda (tmp1208) ((lambda (tmp1209) (if tmp1209 (apply (lambda
(_1210 test1211 then1212) (build-conditional82 s1206 (chi150 test1211 r1204
w1205 mod1207) (chi150 then1212 r1204 w1205 mod1207) (build-void80 #f)))
tmp1209) ((lambda (tmp1213) (if tmp1213 (apply (lambda (_1214 test1215 then1216
else1217) (build-conditional82 s1206 (chi150 test1215 r1204 w1205 mod1207)
(chi150 then1216 r1204 w1205 mod1207) (chi150 else1217 r1204 w1205 mod1207)))
tmp1213) (syntax-violation #f "source expression failed to match any pattern"
tmp1208))) ($sc-dispatch tmp1208 (quote (any any any any)))))) ($sc-dispatch
tmp1208 (quote (any any any))))) e1203))) (global-extend112 (quote begin)
(quote begin) (quote ())) (global-extend112 (quote define) (quote define)
(quote ())) (global-extend112 (quote define-syntax) (quote define-syntax)
(quote ())) (global-extend112 (quote eval-when) (quote eval-when) (quote ()))
(global-extend112 (quote core) (quote syntax-case) (letrec
((gen-syntax-case1221 (lambda (x1222 keys1223 clauses1224 r1225 mod1226) (if
(null? clauses1224) (build-application81 #f (build-primref91 #f (quote
syntax-violation)) (list (build-data92 #f #f) (build-data92 #f "source
expression failed to match any pattern") x1222)) ((lambda (tmp1227) ((lambda
(tmp1228) (if tmp1228 (apply (lambda (pat1229 exp1230) (if (if (id?114 pat1229)
(and-map (lambda (x1231) (not (free-id=?137 pat1229 x1231))) (cons (quote
#(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause
build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage
(define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))
keys1223)) #f) (let ((labels1232 (list (gen-label119))) (var1233 (gen-var162
pat1229))) (build-application81 #f (build-lambda90 #f (list (syntax->datum
pat1229)) (list var1233) #f (chi150 exp1230 (extend-env108 labels1232 (list
(cons (quote syntax) (cons var1233 0))) r1225) (make-binding-wrap131 (list
pat1229) labels1232 (quote (()))) mod1226)) (list x1222))) (gen-clause1220
x1222 keys1223 (cdr clauses1224) r1225 pat1229 #t exp1230 mod1226))) tmp1228)
((lambda (tmp1234) (if tmp1234 (apply (lambda (pat1235 fender1236 exp1237)
(gen-clause1220 x1222 keys1223 (cdr clauses1224) r1225 pat1235 fender1236
exp1237 mod1226)) tmp1234) ((lambda (_1238) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses1224))) tmp1227))) ($sc-dispatch
tmp1227 (quote (any any any)))))) ($sc-dispatch tmp1227 (quote (any any)))))
(car clauses1224))))) (gen-clause1220 (lambda (x1239 keys1240 clauses1241 r1242
pat1243 fender1244 exp1245 mod1246) (call-with-values (lambda ()
(convert-pattern1218 pat1243 keys1240)) (lambda (p1247 pvars1248) (if (not
(distinct-bound-ids?140 (map car pvars1248))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat1243) (if (not (and-map (lambda
(x1249) (not (ellipsis?159 (car x1249)))) pvars1248)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat1243) (let ((y1250 (gen-var162 (quote
tmp)))) (build-application81 #f (build-lambda90 #f (list (quote tmp)) (list
y1250) #f (let ((y1251 (build-lexical-reference83 (quote value) #f (quote tmp)
y1250))) (build-conditional82 #f ((lambda (tmp1252) ((lambda (tmp1253) (if
tmp1253 (apply (lambda () y1251) tmp1253) ((lambda (_1254) (build-conditional82
#f y1251 (build-dispatch-call1219 pvars1248 fender1244 y1251 r1242 mod1246)
(build-data92 #f #f))) tmp1252))) ($sc-dispatch tmp1252 (quote #(atom #t)))))
fender1244) (build-dispatch-call1219 pvars1248 exp1245 y1251 r1242 mod1246)
(gen-syntax-case1221 x1239 keys1240 clauses1241 r1242 mod1246)))) (list (if
(eq? p1247 (quote any)) (build-application81 #f (build-primref91 #f (quote
list)) (list x1239)) (build-application81 #f (build-primref91 #f (quote
$sc-dispatch)) (list x1239 (build-data92 #f p1247)))))))))))))
(build-dispatch-call1219 (lambda (pvars1255 exp1256 y1257 r1258 mod1259) (let
((ids1260 (map car pvars1255)) (levels1261 (map cdr pvars1255))) (let
((labels1262 (gen-labels120 ids1260)) (new-vars1263 (map gen-var162 ids1260)))
(build-application81 #f (build-primref91 #f (quote apply)) (list
(build-lambda90 #f (map syntax->datum ids1260) new-vars1263 #f (chi150 exp1256
(extend-env108 labels1262 (map (lambda (var1264 level1265) (cons (quote syntax)
(cons var1264 level1265))) new-vars1263 (map cdr pvars1255)) r1258)
(make-binding-wrap131 ids1260 labels1262 (quote (()))) mod1259)) y1257))))))
(convert-pattern1218 (lambda (pattern1266 keys1267) (letrec ((cvt1268 (lambda
(p1269 n1270 ids1271) (if (id?114 p1269) (if (bound-id-member?141 p1269
keys1267) (values (vector (quote free-id) p1269) ids1271) (values (quote any)
(cons (cons p1269 n1270) ids1271))) ((lambda (tmp1272) ((lambda (tmp1273) (if
(if tmp1273 (apply (lambda (x1274 dots1275) (ellipsis?159 dots1275)) tmp1273)
#f) (apply (lambda (x1276 dots1277) (call-with-values (lambda () (cvt1268 x1276
(fx+72 n1270 1) ids1271)) (lambda (p1278 ids1279) (values (if (eq? p1278 (quote
any)) (quote each-any) (vector (quote each) p1278)) ids1279)))) tmp1273)
((lambda (tmp1280) (if tmp1280 (apply (lambda (x1281 y1282) (call-with-values
(lambda () (cvt1268 y1282 n1270 ids1271)) (lambda (y1283 ids1284)
(call-with-values (lambda () (cvt1268 x1281 n1270 ids1284)) (lambda (x1285
ids1286) (values (cons x1285 y1283) ids1286)))))) tmp1280) ((lambda (tmp1287)
(if tmp1287 (apply (lambda () (values (quote ()) ids1271)) tmp1287) ((lambda
(tmp1288) (if tmp1288 (apply (lambda (x1289) (call-with-values (lambda ()
(cvt1268 x1289 n1270 ids1271)) (lambda (p1291 ids1292) (values (vector (quote
vector) p1291) ids1292)))) tmp1288) ((lambda (x1293) (values (vector (quote
atom) (strip161 p1269 (quote (())))) ids1271)) tmp1272))) ($sc-dispatch tmp1272
(quote #(vector each-any)))))) ($sc-dispatch tmp1272 (quote ())))))
($sc-dispatch tmp1272 (quote (any . any)))))) ($sc-dispatch tmp1272 (quote (any
any))))) p1269))))) (cvt1268 pattern1266 0 (quote ())))))) (lambda (e1294 r1295
w1296 s1297 mod1298) (let ((e1299 (source-wrap143 e1294 w1296 s1297 mod1298)))
((lambda (tmp1300) ((lambda (tmp1301) (if tmp1301 (apply (lambda (_1302 val1303
key1304 m1305) (if (and-map (lambda (x1306) (if (id?114 x1306) (not
(ellipsis?159 x1306)) #f)) key1304) (let ((x1308 (gen-var162 (quote tmp))))
(build-application81 s1297 (build-lambda90 #f (list (quote tmp)) (list x1308)
#f (gen-syntax-case1221 (build-lexical-reference83 (quote value) #f (quote tmp)
x1308) key1304 m1305 r1295 mod1298)) (list (chi150 val1303 r1295 (quote (()))
mod1298)))) (syntax-violation (quote syntax-case) "invalid literals list"
e1299))) tmp1301) (syntax-violation #f "source expression failed to match any
pattern" tmp1300))) ($sc-dispatch tmp1300 (quote (any any each-any .
each-any))))) e1299))))) (set! sc-expand (lambda (x1312 . rest1311) (if (if
(pair? x1312) (equal? (car x1312) noexpand70) #f) (cadr x1312) (let ((m1313 (if
(null? rest1311) (quote e) (car rest1311))) (esew1314 (if (let ((t1315 (null?
rest1311))) (if t1315 t1315 (null? (cdr rest1311)))) (quote (eval)) (cadr
rest1311)))) (with-fluid* *mode*71 m1313 (lambda () (chi-top149 x1312 (quote
()) (quote ((top))) m1313 esew1314 (cons (quote hygiene) (module-name
(current-module)))))))))) (set! identifier? (lambda (x1316) (nonsymbol-id?113
x1316))) (set! datum->syntax (lambda (id1317 datum1318) (make-syntax-object97
datum1318 (syntax-object-wrap100 id1317) #f))) (set! syntax->datum (lambda
(x1319) (strip161 x1319 (quote (()))))) (set! generate-temporaries (lambda
(ls1320) (begin (let ((x1321 ls1320)) (if (not (list? x1321)) (syntax-violation
(quote generate-temporaries) "invalid argument" x1321))) (map (lambda (x1322)
(wrap142 (gensym) (quote ((top))) #f)) ls1320)))) (set! free-identifier=?
(lambda (x1323 y1324) (begin (let ((x1325 x1323)) (if (not (nonsymbol-id?113
x1325)) (syntax-violation (quote free-identifier=?) "invalid argument" x1325)))
(let ((x1326 y1324)) (if (not (nonsymbol-id?113 x1326)) (syntax-violation
(quote free-identifier=?) "invalid argument" x1326))) (free-id=?137 x1323
y1324)))) (set! bound-identifier=? (lambda (x1327 y1328) (begin (let ((x1329
x1327)) (if (not (nonsymbol-id?113 x1329)) (syntax-violation (quote
bound-identifier=?) "invalid argument" x1329))) (let ((x1330 y1328)) (if (not
(nonsymbol-id?113 x1330)) (syntax-violation (quote bound-identifier=?) "invalid
argument" x1330))) (bound-id=?138 x1327 y1328)))) (set! syntax-violation
(lambda (who1334 message1333 form1332 . subform1331) (begin (let ((x1335
who1334)) (if (not ((lambda (x1336) (let ((t1337 (not x1336))) (if t1337 t1337
(let ((t1338 (string? x1336))) (if t1338 t1338 (symbol? x1336)))))) x1335))
(syntax-violation (quote syntax-violation) "invalid argument" x1335))) (let
((x1339 message1333)) (if (not (string? x1339)) (syntax-violation (quote
syntax-violation) "invalid argument" x1339))) (scm-error (quote syntax-error)
(quote sc-expand) (string-append (if who1334 "~a: " "") "~a " (if (null?
subform1331) "in ~a" "in subform `~s' of `~s'")) (let ((tail1340 (cons
message1333 (map (lambda (x1341) (strip161 x1341 (quote (())))) (append
subform1331 (list form1332)))))) (if who1334 (cons who1334 tail1340) tail1340))
#f)))) (letrec ((match1346 (lambda (e1347 p1348 w1349 r1350 mod1351) (if (not
r1350) #f (if (eq? p1348 (quote any)) (cons (wrap142 e1347 w1349 mod1351)
r1350) (if (syntax-object?98 e1347) (match*1345 (let ((e1352
(syntax-object-expression99 e1347))) (if (annotation? e1352)
(annotation-expression e1352) e1352)) p1348 (join-wraps133 w1349
(syntax-object-wrap100 e1347)) r1350 (syntax-object-module101 e1347))
(match*1345 (let ((e1353 e1347)) (if (annotation? e1353) (annotation-expression
e1353) e1353)) p1348 w1349 r1350 mod1351)))))) (match*1345 (lambda (e1354 p1355
w1356 r1357 mod1358) (if (null? p1355) (if (null? e1354) r1357 #f) (if (pair?
p1355) (if (pair? e1354) (match1346 (car e1354) (car p1355) w1356 (match1346
(cdr e1354) (cdr p1355) w1356 r1357 mod1358) mod1358) #f) (if (eq? p1355 (quote
each-any)) (let ((l1359 (match-each-any1343 e1354 w1356 mod1358))) (if l1359
(cons l1359 r1357) #f)) (let ((atom-key1360 (vector-ref p1355 0))) (if (memv
atom-key1360 (quote (each))) (if (null? e1354) (match-empty1344 (vector-ref
p1355 1) r1357) (let ((l1361 (match-each1342 e1354 (vector-ref p1355 1) w1356
mod1358))) (if l1361 (letrec ((collect1362 (lambda (l1363) (if (null? (car
l1363)) r1357 (cons (map car l1363) (collect1362 (map cdr l1363)))))))
(collect1362 l1361)) #f))) (if (memv atom-key1360 (quote (free-id))) (if
(id?114 e1354) (if (free-id=?137 (wrap142 e1354 w1356 mod1358) (vector-ref
p1355 1)) r1357 #f) #f) (if (memv atom-key1360 (quote (atom))) (if (equal?
(vector-ref p1355 1) (strip161 e1354 w1356)) r1357 #f) (if (memv atom-key1360
(quote (vector))) (if (vector? e1354) (match1346 (vector->list e1354)
(vector-ref p1355 1) w1356 r1357 mod1358) #f))))))))))) (match-empty1344
(lambda (p1364 r1365) (if (null? p1364) r1365 (if (eq? p1364 (quote any)) (cons
(quote ()) r1365) (if (pair? p1364) (match-empty1344 (car p1364)
(match-empty1344 (cdr p1364) r1365)) (if (eq? p1364 (quote each-any)) (cons
(quote ()) r1365) (let ((atom-key1366 (vector-ref p1364 0))) (if (memv
atom-key1366 (quote (each))) (match-empty1344 (vector-ref p1364 1) r1365) (if
(memv atom-key1366 (quote (free-id atom))) r1365 (if (memv atom-key1366 (quote
(vector))) (match-empty1344 (vector-ref p1364 1) r1365)))))))))))
(match-each-any1343 (lambda (e1367 w1368 mod1369) (if (annotation? e1367)
(match-each-any1343 (annotation-expression e1367) w1368 mod1369) (if (pair?
e1367) (let ((l1370 (match-each-any1343 (cdr e1367) w1368 mod1369))) (if l1370
(cons (wrap142 (car e1367) w1368 mod1369) l1370) #f)) (if (null? e1367) (quote
()) (if (syntax-object?98 e1367) (match-each-any1343
(syntax-object-expression99 e1367) (join-wraps133 w1368 (syntax-object-wrap100
e1367)) mod1369) #f)))))) (match-each1342 (lambda (e1371 p1372 w1373 mod1374)
(if (annotation? e1371) (match-each1342 (annotation-expression e1371) p1372
w1373 mod1374) (if (pair? e1371) (let ((first1375 (match1346 (car e1371) p1372
w1373 (quote ()) mod1374))) (if first1375 (let ((rest1376 (match-each1342 (cdr
e1371) p1372 w1373 mod1374))) (if rest1376 (cons first1375 rest1376) #f)) #f))
(if (null? e1371) (quote ()) (if (syntax-object?98 e1371) (match-each1342
(syntax-object-expression99 e1371) p1372 (join-wraps133 w1373
(syntax-object-wrap100 e1371)) (syntax-object-module101 e1371)) #f))))))) (set!
$sc-dispatch (lambda (e1377 p1378) (if (eq? p1378 (quote any)) (list e1377) (if
(syntax-object?98 e1377) (match*1345 (let ((e1379 (syntax-object-expression99
e1377))) (if (annotation? e1379) (annotation-expression e1379) e1379)) p1378
(syntax-object-wrap100 e1377) (quote ()) (syntax-object-module101 e1377))
(match*1345 (let ((e1380 e1377)) (if (annotation? e1380) (annotation-expression
e1380) e1380)) p1378 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x1381) ((lambda
(tmp1382) ((lambda (tmp1383) (if tmp1383 (apply (lambda (_1384 e11385 e21386)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11385 e21386))) tmp1383) ((lambda (tmp1388) (if
tmp1388 (apply (lambda (_1389 out1390 in1391 e11392 e21393) (list (quote
#(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) in1391 (quote ()) (list out1390 (cons
(quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons e11392 e21393))))) tmp1388) ((lambda
(tmp1395) (if tmp1395 (apply (lambda (_1396 out1397 in1398 e11399 e21400) (list
(quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list
((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) in1398) (quote ()) (list out1397 (cons (quote #(syntax-object begin
((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (cons e11399 e21400))))) tmp1395) (syntax-violation #f "source
expression failed to match any pattern" tmp1382))) ($sc-dispatch tmp1382 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1382 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp1382 (quote (any () any .
each-any))))) x1381))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1404)
((lambda (tmp1405) ((lambda (tmp1406) (if tmp1406 (apply (lambda (_1407 k1408
keyword1409 pattern1410 template1411) (list (quote #(syntax-object lambda
((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top))
#("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k
keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern
template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote
#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons k1408 (map (lambda (tmp1414
tmp1413) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k
keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
tmp1413) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword
pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
tmp1414))) template1411 pattern1410)))))) tmp1406) (syntax-violation #f "source
expression failed to match any pattern" tmp1405))) ($sc-dispatch tmp1405 (quote
(any each-any . #(each ((any . any) any))))))) x1404))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x1415) ((lambda (tmp1416) ((lambda (tmp1417) (if
(if tmp1417 (apply (lambda (let*1418 x1419 v1420 e11421 e21422) (and-map
identifier? x1419)) tmp1417) #f) (apply (lambda (let*1424 x1425 v1426 e11427
e21428) (letrec ((f1429 (lambda (bindings1430) (if (null? bindings1430) (cons
(quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings)
#((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11427 e21428)))
((lambda (tmp1434) ((lambda (tmp1435) (if tmp1435 (apply (lambda (body1436
binding1437) (list (quote #(syntax-object let ((top) #(ribcage #(body binding)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top)
(top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (list binding1437) body1436)) tmp1435) (syntax-violation #f
"source expression failed to match any pattern" tmp1434))) ($sc-dispatch
tmp1434 (quote (any any))))) (list (f1429 (cdr bindings1430)) (car
bindings1430))))))) (f1429 (map list x1425 v1426)))) tmp1417) (syntax-violation
#f "source expression failed to match any pattern" tmp1416))) ($sc-dispatch
tmp1416 (quote (any #(each (any any)) any . each-any))))) x1415))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x1438) ((lambda (tmp1439) ((lambda (tmp1440)
(if tmp1440 (apply (lambda (_1441 var1442 init1443 step1444 e01445 e11446
c1447) ((lambda (tmp1448) ((lambda (tmp1449) (if tmp1449 (apply (lambda
(step1450) ((lambda (tmp1451) ((lambda (tmp1452) (if tmp1452 (apply (lambda ()
(list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i"))
#(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x)
#((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top)
#(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top)
(top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list
var1442 init1443) (list (quote #(syntax-object if ((top) #(ribcage #(step)
#((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var
init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i"
"i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")))
(hygiene guile))) e01445) (cons (quote #(syntax-object begin ((top) #(ribcage
#(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top)
(top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () ()
()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1447 (list
(cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i"))
#(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x)
#((top)) #("i"))) (hygiene guile))) step1450))))))) tmp1452) ((lambda (tmp1457)
(if tmp1457 (apply (lambda (e11458 e21459) (list (quote #(syntax-object let
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1442 init1443) (list
(quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i"))
#(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top)
(top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01445 (cons
(quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i"
"i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c)
#((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile)))
(cons e11458 e21459)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1
e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_
var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")))
(hygiene guile))) (append c1447 (list (cons (quote #(syntax-object doloop
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) step1450))))))) tmp1457)
(syntax-violation #f "source expression failed to match any pattern" tmp1451)))
($sc-dispatch tmp1451 (quote (any . each-any)))))) ($sc-dispatch tmp1451 (quote
())))) e11446)) tmp1449) (syntax-violation #f "source expression failed to
match any pattern" tmp1448))) ($sc-dispatch tmp1448 (quote each-any)))) (map
(lambda (v1466 s1467) ((lambda (tmp1468) ((lambda (tmp1469) (if tmp1469 (apply
(lambda () v1466) tmp1469) ((lambda (tmp1470) (if tmp1470 (apply (lambda
(e1471) e1471) tmp1470) ((lambda (_1472) (syntax-violation (quote do) "bad step
expression" orig-x1438 s1467)) tmp1468))) ($sc-dispatch tmp1468 (quote
(any)))))) ($sc-dispatch tmp1468 (quote ())))) s1467)) var1442 step1444)))
tmp1440) (syntax-violation #f "source expression failed to match any pattern"
tmp1439))) ($sc-dispatch tmp1439 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x1438))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons1475 (lambda (x1479 y1480)
((lambda (tmp1481) ((lambda (tmp1482) (if tmp1482 (apply (lambda (x1483 y1484)
((lambda (tmp1485) ((lambda (tmp1486) (if tmp1486 (apply (lambda (dy1487)
((lambda (tmp1488) ((lambda (tmp1489) (if tmp1489 (apply (lambda (dx1490) (list
(quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage
#(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) (cons dx1490 dy1487))) tmp1489) ((lambda
(_1491) (if (null? dy1487) (list (quote #(syntax-object list ((top) #(ribcage
#(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y)
#((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi)
#((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1483) (list
(quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage
#(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) x1483 y1484))) tmp1488))) ($sc-dispatch
tmp1488 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top))
#("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) any))))) x1483)) tmp1486) ((lambda (tmp1492) (if
tmp1492 (apply (lambda (stuff1493) (cons (quote #(syntax-object list ((top)
#(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i"
"i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top)
(top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1483 stuff1493))) tmp1492)
((lambda (else1494) (list (quote #(syntax-object cons ((top) #(ribcage #(else)
#((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) x1483 y1484)) tmp1485))) ($sc-dispatch tmp1485
(quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any))))))
($sc-dispatch tmp1485 (quote (#(free-id #(syntax-object quote ((top) #(ribcage
#(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any))))) y1484)) tmp1482) (syntax-violation #f "source expression
failed to match any pattern" tmp1481))) ($sc-dispatch tmp1481 (quote (any
any))))) (list x1479 y1480)))) (quasiappend1476 (lambda (x1495 y1496) ((lambda
(tmp1497) ((lambda (tmp1498) (if tmp1498 (apply (lambda (x1499 y1500) ((lambda
(tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda () x1499) tmp1502)
((lambda (_1503) (list (quote #(syntax-object append ((top) #(ribcage #(_)
#((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) x1499 y1500)) tmp1501))) ($sc-dispatch tmp1501
(quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1500))
tmp1498) (syntax-violation #f "source expression failed to match any pattern"
tmp1497))) ($sc-dispatch tmp1497 (quote (any any))))) (list x1495 y1496))))
(quasivector1477 (lambda (x1504) ((lambda (tmp1505) ((lambda (x1506) ((lambda
(tmp1507) ((lambda (tmp1508) (if tmp1508 (apply (lambda (x1509) (list (quote
#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x)
#((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector
x1509))) tmp1508) ((lambda (tmp1511) (if tmp1511 (apply (lambda (x1512) (cons
(quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage
#(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1512)) tmp1511)
((lambda (_1514) (list (quote #(syntax-object list->vector ((top) #(ribcage
#(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) x1506)) tmp1507))) ($sc-dispatch tmp1507 (quote (#(free-id
#(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) . each-any)))))) ($sc-dispatch tmp1507 (quote (#(free-id
#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) each-any))))) x1506)) tmp1505)) x1504))) (quasi1478 (lambda
(p1515 lev1516) ((lambda (tmp1517) ((lambda (tmp1518) (if tmp1518 (apply
(lambda (p1519) (if (= lev1516 0) p1519 (quasicons1475 (quote (#(syntax-object
quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p
lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector
quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))
#(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile)))) (quasi1478 (list p1519) (- lev1516 1))))) tmp1518) ((lambda
(tmp1520) (if (if tmp1520 (apply (lambda (args1521) (= lev1516 0)) tmp1520) #f)
(apply (lambda (args1522) (syntax-violation (quote unquote) "unquote takes
exactly one argument" p1515 (cons (quote #(syntax-object unquote ((top)
#(ribcage #(args) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev)
#((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi)
#((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1522)))
tmp1520) ((lambda (tmp1523) (if tmp1523 (apply (lambda (p1524 q1525) (if (=
lev1516 0) (quasiappend1476 p1524 (quasi1478 q1525 lev1516)) (quasicons1475
(quasicons1475 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i"
"i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top)
(top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing
((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ())
#(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile)))) (quasi1478 (list p1524) (- lev1516 1))) (quasi1478 q1525 lev1516))))
tmp1523) ((lambda (tmp1526) (if (if tmp1526 (apply (lambda (args1527 q1528) (=
lev1516 0)) tmp1526) #f) (apply (lambda (args1529 q1530) (syntax-violation
(quote unquote-splicing) "unquote-splicing takes exactly one argument" p1515
(cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args q)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) args1529))) tmp1526)
((lambda (tmp1531) (if tmp1531 (apply (lambda (p1532) (quasicons1475 (quote
(#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile)))) (quasi1478 (list p1532) (+ lev1516
1)))) tmp1531) ((lambda (tmp1533) (if tmp1533 (apply (lambda (p1534 q1535)
(quasicons1475 (quasi1478 p1534 lev1516) (quasi1478 q1535 lev1516))) tmp1533)
((lambda (tmp1536) (if tmp1536 (apply (lambda (x1537) (quasivector1477
(quasi1478 x1537 lev1516))) tmp1536) ((lambda (p1539) (list (quote
#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) p1539)) tmp1517))) ($sc-dispatch tmp1517 (quote #(vector
each-any)))))) ($sc-dispatch tmp1517 (quote (any . any)))))) ($sc-dispatch
tmp1517 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ())
#(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any)))))) ($sc-dispatch tmp1517 (quote ((#(free-id #(syntax-object
unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top))
#("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top)
(top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any) . any))))))
($sc-dispatch tmp1517 (quote ((#(free-id #(syntax-object unquote-splicing
((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp1517
(quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage
#(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) . any)))))) ($sc-dispatch tmp1517 (quote (#(free-id #(syntax-object
unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i"
"i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top)
(top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p1515)))) (lambda
(x1540) ((lambda (tmp1541) ((lambda (tmp1542) (if tmp1542 (apply (lambda (_1543
e1544) (quasi1478 e1544 0)) tmp1542) (syntax-violation #f "source expression
failed to match any pattern" tmp1541))) ($sc-dispatch tmp1541 (quote (any
any))))) x1540)))))
+(define include (make-syncase-macro (quote macro) (lambda (x1545) (letrec
((read-file1546 (lambda (fn1547 k1548) (let ((p1549 (open-input-file fn1547)))
(letrec ((f1550 (lambda (x1551) (if (eof-object? x1551) (begin
(close-input-port p1549) (quote ())) (cons (datum->syntax k1548 x1551) (f1550
(read p1549))))))) (f1550 (read p1549))))))) ((lambda (tmp1552) ((lambda
(tmp1553) (if tmp1553 (apply (lambda (k1554 filename1555) (let ((fn1556
(syntax->datum filename1555))) ((lambda (tmp1557) ((lambda (tmp1558) (if
tmp1558 (apply (lambda (exp1559) (cons (quote #(syntax-object begin ((top)
#(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i"
"i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) exp1559)) tmp1558) (syntax-violation #f "source expression
failed to match any pattern" tmp1557))) ($sc-dispatch tmp1557 (quote
each-any)))) (read-file1546 fn1556 k1554)))) tmp1553) (syntax-violation #f
"source expression failed to match any pattern" tmp1552))) ($sc-dispatch
tmp1552 (quote (any any))))) x1545)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x1561) ((lambda
(tmp1562) ((lambda (tmp1563) (if tmp1563 (apply (lambda (_1564 e1565)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x1561)) tmp1563) (syntax-violation #f "source expression failed to match any
pattern" tmp1562))) ($sc-dispatch tmp1562 (quote (any any))))) x1561))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1566)
((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569 e1570)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x1566)) tmp1568) (syntax-violation #f "source expression failed to
match any pattern" tmp1567))) ($sc-dispatch tmp1567 (quote (any any)))))
x1566))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x1571) ((lambda (tmp1572) ((lambda (tmp1573) (if
tmp1573 (apply (lambda (_1574 e1575 m11576 m21577) ((lambda (tmp1578) ((lambda
(body1579) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top))
#("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list
(list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1575)) body1579))
tmp1578)) (letrec ((f1580 (lambda (clause1581 clauses1582) (if (null?
clauses1582) ((lambda (tmp1584) ((lambda (tmp1585) (if tmp1585 (apply (lambda
(e11586 e21587) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11586 e21587))) tmp1585) ((lambda (tmp1589) (if
tmp1589 (apply (lambda (k1590 e11591 e21592) (list (quote #(syntax-object if
((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top))
#("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i"
"i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top)
(top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) k1590)) (cons (quote #(syntax-object begin ((top) #(ribcage
#(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2)
#((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons e11591 e21592)))) tmp1589)
((lambda (_1595) (syntax-violation (quote case) "bad clause" x1571 clause1581))
tmp1584))) ($sc-dispatch tmp1584 (quote (each-any any . each-any))))))
($sc-dispatch tmp1584 (quote (#(free-id #(syntax-object else ((top) #(ribcage
() () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any .
each-any))))) clause1581) ((lambda (tmp1596) ((lambda (rest1597) ((lambda
(tmp1598) ((lambda (tmp1599) (if tmp1599 (apply (lambda (k1600 e11601 e21602)
(list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
#(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object
memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
#(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top)
(top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i"
"i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f
clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2)
#((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) k1600)) (cons (quote #(syntax-object
begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause
clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top)
(top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons e11601 e21602)) rest1597)) tmp1599)
((lambda (_1605) (syntax-violation (quote case) "bad clause" x1571 clause1581))
tmp1598))) ($sc-dispatch tmp1598 (quote (each-any any . each-any)))))
clause1581)) tmp1596)) (f1580 (car clauses1582) (cdr clauses1582))))))) (f1580
m11576 m21577)))) tmp1573) (syntax-violation #f "source expression failed to
match any pattern" tmp1572))) ($sc-dispatch tmp1572 (quote (any any any .
each-any))))) x1571))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1606)
((lambda (tmp1607) ((lambda (tmp1608) (if tmp1608 (apply (lambda (_1609 e1610)
(list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list
(quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
e1610)) (list (cons _1609 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e1610 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)))))))))) tmp1608) (syntax-violation #f "source expression failed to
match any pattern" tmp1607))) ($sc-dispatch tmp1607 (quote (any any)))))
x1606))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 0ce74a7..dcbc32a 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -368,7 +368,9 @@
(case (fluid-ref *mode*)
((c) ((@ (language tree-il) make-conditional)
source test-exp then-exp else-exp))
- (else `(if ,test-exp ,then-exp ,else-exp)))))
+ (else (if (equal? else-exp '(if #f #f))
+ `(if ,test-exp ,then-exp)
+ `(if ,test-exp ,then-exp ,else-exp))))))
(define build-lexical-reference
(lambda (type source name var)
@@ -433,10 +435,23 @@
((c) ((@ (language tree-il) make-toplevel-set) source var exp))
(else `(set! ,var ,exp)))))))
+;; FIXME: there is a bug that prevents (set! ((@ (foo) bar) baz) quz)
+;; from working. Hack around it.
+(define (maybe-name-value! name val)
+ (cond
+ (((@ (language tree-il) lambda?) val)
+ (let ((meta ((@ (language tree-il) lambda-meta) val)))
+ (if (not (assq 'name meta))
+ ((setter (@ (language tree-il) lambda-meta))
+ val
+ (acons 'name name meta)))))))
+
(define build-global-definition
(lambda (source var exp)
(case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-toplevel-define) source var exp))
+ ((c)
+ (maybe-name-value! var exp)
+ ((@ (language tree-il) make-toplevel-define) source var exp))
(else `(define ,var ,exp)))))
(define build-lambda
@@ -478,7 +493,9 @@
(if (null? vars)
body-exp
(case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-let) src ids vars val-exps
body-exp))
+ ((c)
+ (for-each maybe-name-value! ids val-exps)
+ ((@ (language tree-il) make-let) src ids vars val-exps body-exp))
(else `(let ,(map list vars val-exps) ,body-exp))))))
(define build-named-let
@@ -488,12 +505,14 @@
(vars (cdr vars))
(ids (cdr ids)))
(case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-letrec) src
- (list f-name)
- (list f)
- (list (build-lambda src ids vars #f body-exp))
- (build-application src (build-lexical-reference 'fun src f-name
f)
- val-exps)))
+ ((c)
+ (let ((proc (build-lambda src ids vars #f body-exp)))
+ (maybe-name-value! f-name proc)
+ (for-each maybe-name-value! ids val-exps)
+ ((@ (language tree-il) make-letrec) src
+ (list f-name) (list f) (list proc)
+ (build-application src (build-lexical-reference 'fun src f-name f)
+ val-exps))))
(else `(let ,f ,(map list vars val-exps) ,body-exp))))))
(define build-letrec
@@ -501,7 +520,9 @@
(if (null? vars)
body-exp
(case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-letrec) src ids vars val-exps
body-exp))
+ ((c)
+ (for-each maybe-name-value! ids val-exps)
+ ((@ (language tree-il) make-letrec) src ids vars val-exps body-exp))
(else `(letrec ,(map list vars val-exps) ,body-exp))))))
;; FIXME: wingo: use make-lexical ?
@@ -1817,13 +1838,14 @@
(lambda (e r w s mod)
(syntax-case e ()
((_ ((id val) ...) e1 e2 ...)
+ (and-map id? (syntax (id ...)))
(chi-let e r w s mod
build-let
(syntax (id ...))
(syntax (val ...))
(syntax (e1 e2 ...))))
((_ f ((id val) ...) e1 e2 ...)
- (id? (syntax f))
+ (and (id? (syntax f)) (and-map id? (syntax (id ...))))
(chi-let e r w s mod
build-named-let
(syntax (f id ...))
@@ -1836,6 +1858,7 @@
(lambda (e r w s mod)
(syntax-case e ()
((_ ((id val) ...) e1 e2 ...)
+ (and-map id? (syntax (id ...)))
(let ((ids (syntax (id ...))))
(if (not (valid-bound-ids? ids))
(syntax-violation 'letrec "duplicate bound variable" e)
diff --git a/module/ice-9/threads.scm b/module/ice-9/threads.scm
index bd0f7b7..e07d766 100644
--- a/module/ice-9/threads.scm
+++ b/module/ice-9/threads.scm
@@ -32,21 +32,71 @@
;;; Code:
(define-module (ice-9 threads)
- :export (par-map
+ :export (begin-thread
+ parallel
+ letpar
+ make-thread
+ with-mutex
+ monitor
+
+ par-map
par-for-each
n-par-map
n-par-for-each
n-for-each-par-map
- %thread-handler)
- :export-syntax (begin-thread
- parallel
- letpar
- make-thread
- with-mutex
- monitor))
+ %thread-handler))
+;;; Macros first, so that the procedures expand correctly.
+
+(define-syntax begin-thread
+ (syntax-rules ()
+ ((_ e0 e1 ...)
+ (call-with-new-thread
+ (lambda () e0 e1 ...)
+ %thread-handler))))
+
+(define-syntax parallel
+ (lambda (x)
+ (syntax-case x ()
+ ((_ e0 ...)
+ (with-syntax (((tmp0 ...) (generate-temporaries (syntax (e0 ...)))))
+ (syntax
+ (let ((tmp0 (begin-thread e0))
+ ...)
+ (values (join-thread tmp0) ...))))))))
+
+(define-syntax letpar
+ (syntax-rules ()
+ ((_ ((v e) ...) b0 b1 ...)
+ (call-with-values
+ (lambda () (parallel e ...))
+ (lambda (v ...)
+ b0 b1 ...)))))
+
+(define-syntax make-thread
+ (syntax-rules ()
+ ((_ proc arg ...)
+ (call-with-new-thread
+ (lambda () (proc arg ...))
+ %thread-handler))))
+
+(define-syntax with-mutex
+ (syntax-rules ()
+ ((_ m e0 e1 ...)
+ (let ((x m))
+ (dynamic-wind
+ (lambda () (lock-mutex x))
+ (lambda () (begin e0 e1 ...))
+ (lambda () (unlock-mutex x)))))))
+
+(define-syntax monitor
+ (syntax-rules ()
+ ((_ first rest ...)
+ (with-mutex (make-mutex)
+ first rest ...))))
+
(define (par-mapper mapper)
(lambda (proc . arglists)
(mapper join-thread
@@ -171,52 +221,4 @@ of applying P-PROC on ARGLISTS."
;;; Set system thread handler
(define %thread-handler thread-handler)
-; --- MACROS -------------------------------------------------------
-
-(define-macro (begin-thread . forms)
- (if (null? forms)
- '(begin)
- `(call-with-new-thread
- (lambda ()
- ,@forms)
- %thread-handler)))
-
-(define-macro (parallel . forms)
- (cond ((null? forms) '(values))
- ((null? (cdr forms)) (car forms))
- (else
- (let ((vars (map (lambda (f)
- (make-symbol "f"))
- forms)))
- `((lambda ,vars
- (values ,@(map (lambda (v) `(join-thread ,v)) vars)))
- ,@(map (lambda (form) `(begin-thread ,form)) forms))))))
-
-(define-macro (letpar bindings . body)
- (cond ((or (null? bindings) (null? (cdr bindings)))
- `(let ,bindings ,@body))
- (else
- (let ((vars (map car bindings)))
- `((lambda ,vars
- ((lambda ,vars ,@body)
- ,@(map (lambda (v) `(join-thread ,v)) vars)))
- ,@(map (lambda (b) `(begin-thread ,(cadr b))) bindings))))))
-
-(define-macro (make-thread proc . args)
- `(call-with-new-thread
- (lambda ()
- (,proc ,@args))
- %thread-handler))
-
-(define-macro (with-mutex m . body)
- `(dynamic-wind
- (lambda () (lock-mutex ,m))
- (lambda () (begin ,@body))
- (lambda () (unlock-mutex ,m))))
-
-(define-macro (monitor first . rest)
- `(with-mutex ,(make-mutex)
- (begin
- ,first ,@rest)))
-
;;; threads.scm ends here
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index a89d8cf..a819477 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -215,7 +215,9 @@
`(,(tree-il->scheme proc) ,@(map tree-il->scheme args)))
((<conditional> test then else)
- `(if ,(tree-il->scheme test) ,(tree-il->scheme then)
,(tree-il->scheme else)))
+ (if (void? else)
+ `(if ,(tree-il->scheme test) ,(tree-il->scheme then))
+ `(if ,(tree-il->scheme test) ,(tree-il->scheme then)
,(tree-il->scheme else))))
((<primitive-ref> name)
name)
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index d476dde..94ace7e 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -129,7 +129,7 @@
;; write bindings and source debugging info
(emit-bindings #f ids vars allocation emit-code)
(if (lambda-src x)
- (emit-code (make-glil-src (lambda-src x))))
+ (emit-code #f (make-glil-source (lambda-src x))))
;; copy args to the heap if necessary
(let lp ((in vars) (n 0))
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 9176a3c..aa2e051 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -22,7 +22,7 @@
(define exception:generic-syncase-error
- (cons 'syntax-error "Source expression failed to match"))
+ (cons 'syntax-error "source expression failed to match"))
(define exception:unexpected-syntax
(cons 'syntax-error "unexpected syntax"))
@@ -34,22 +34,32 @@
(define exception:missing-expr
(cons 'syntax-error "Missing expression"))
(define exception:missing-body-expr
- (cons 'syntax-error "Missing body expression"))
+ (cons 'syntax-error "no expressions in body"))
(define exception:extra-expr
(cons 'syntax-error "Extra expression"))
(define exception:illegal-empty-combination
(cons 'syntax-error "Illegal empty combination"))
+(define exception:bad-lambda
+ '(syntax-error . "bad lambda"))
+(define exception:bad-let
+ '(syntax-error . "bad let "))
+(define exception:bad-letrec
+ '(syntax-error . "bad letrec "))
+(define exception:bad-set!
+ '(syntax-error . "bad set!"))
+(define exception:bad-quote
+ '(syntax-error . "quote: bad syntax"))
(define exception:bad-bindings
(cons 'syntax-error "Bad bindings"))
(define exception:bad-binding
(cons 'syntax-error "Bad binding"))
(define exception:duplicate-binding
- (cons 'syntax-error "Duplicate binding"))
+ (cons 'syntax-error "duplicate bound variable"))
(define exception:bad-body
(cons 'misc-error "^bad body"))
(define exception:bad-formals
- (cons 'syntax-error "Bad formals"))
+ '(syntax-error . "invalid parameter list"))
(define exception:bad-formal
(cons 'syntax-error "Bad formal"))
(define exception:duplicate-formal
@@ -111,8 +121,9 @@
(with-test-prefix "unquote-splicing"
(pass-if-exception "extra arguments"
- exception:missing/extra-expr
- (quasiquote ((unquote-splicing (list 1 2) (list 3 4)))))))
+ '(syntax-error . "unquote-splicing takes exactly one argument")
+ (eval '(quasiquote ((unquote-splicing (list 1 2) (list 3 4))))
+ (interaction-environment)))))
(with-test-prefix "begin"
@@ -121,17 +132,21 @@
(with-test-prefix "unmemoization"
+ ;; FIXME. I have no idea why, but the expander is filling in (if #f
+ ;; #f) as the second arm of the if, if the second arm is missing. I
+ ;; thought I made it not do that. But in the meantime, let's adapt,
+ ;; since that's not what we're testing.
+
(pass-if "normal begin"
- (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (+ 2))))))
- (foo) ; make sure, memoization has been performed
+ (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (+ 2)) #f))))
(equal? (procedure-source foo)
- '(lambda () (if (= 1 1) (begin (+ 1) (+ 2)))))))
+ '(lambda () (if (= 1 1) (begin (+ 1) (+ 2)) #f)))))
(pass-if "redundant nested begin"
- (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3)))))))
+ (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3)))
#f))))
(foo) ; make sure, memoization has been performed
(equal? (procedure-source foo)
- '(lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3))))))))
+ '(lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3)))
#f)))))
(pass-if "redundant begin at start of body"
(let ((foo (lambda () (begin (+ 1) (+ 2))))) ; should be optimized
@@ -139,40 +154,49 @@
(equal? (procedure-source foo)
'(lambda () (begin (+ 1) (+ 2)))))))
- (expect-fail-exception "illegal (begin)"
- exception:bad-body
+ (pass-if-exception "illegal (begin)"
+ exception:generic-syncase-error
(eval '(begin (if #t (begin)) #t) (interaction-environment))))
+(define-syntax matches?
+ (syntax-rules (_)
+ ((_ (op arg ...) pat) (let ((x (op arg ...)))
+ (matches? x pat)))
+ ((_ x ()) (null? x))
+ ((_ x (a . b)) (and (pair? x)
+ (matches? (car x) a)
+ (matches? (cdr x) b)))
+ ((_ x _) #t)
+ ((_ x pat) (equal? x 'pat))))
+
(with-test-prefix "lambda"
(with-test-prefix "unmemoization"
(pass-if "normal lambda"
(let ((foo (lambda () (lambda (x y) (+ x y)))))
- ((foo) 1 2) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (lambda (x y) (+ x y))))))
+ (matches? (procedure-source foo)
+ (lambda () (lambda (_ _) (+ _ _))))))
(pass-if "lambda with documentation"
(let ((foo (lambda () (lambda (x y) "docstring" (+ x y)))))
- ((foo) 1 2) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (lambda (x y) "docstring" (+ x y)))))))
+ (matches? (procedure-source foo)
+ (lambda () (lambda (_ _) "docstring" (+ _ _)))))))
(with-test-prefix "bad formals"
(pass-if-exception "(lambda)"
- exception:missing-expr
+ exception:bad-lambda
(eval '(lambda)
(interaction-environment)))
(pass-if-exception "(lambda . \"foo\")"
- exception:bad-expression
+ exception:bad-lambda
(eval '(lambda . "foo")
(interaction-environment)))
(pass-if-exception "(lambda \"foo\")"
- exception:missing-expr
+ exception:bad-lambda
(eval '(lambda "foo")
(interaction-environment)))
@@ -182,22 +206,22 @@
(interaction-environment)))
(pass-if-exception "(lambda (x 1) 2)"
- exception:bad-formal
+ exception:bad-formals
(eval '(lambda (x 1) 2)
(interaction-environment)))
(pass-if-exception "(lambda (1 x) 2)"
- exception:bad-formal
+ exception:bad-formals
(eval '(lambda (1 x) 2)
(interaction-environment)))
(pass-if-exception "(lambda (x \"a\") 2)"
- exception:bad-formal
+ exception:bad-formals
(eval '(lambda (x "a") 2)
(interaction-environment)))
(pass-if-exception "(lambda (\"a\" x) 2)"
- exception:bad-formal
+ exception:bad-formals
(eval '(lambda ("a" x) 2)
(interaction-environment))))
@@ -205,20 +229,20 @@
;; Fixed on 2001-3-3
(pass-if-exception "(lambda (x x) 1)"
- exception:duplicate-formal
+ exception:bad-formals
(eval '(lambda (x x) 1)
(interaction-environment)))
;; Fixed on 2001-3-3
(pass-if-exception "(lambda (x x x) 1)"
- exception:duplicate-formal
+ exception:bad-formals
(eval '(lambda (x x x) 1)
(interaction-environment))))
(with-test-prefix "bad body"
(pass-if-exception "(lambda ())"
- exception:missing-expr
+ exception:bad-lambda
(eval '(lambda ())
(interaction-environment)))))
@@ -228,9 +252,8 @@
(pass-if "normal let"
(let ((foo (lambda () (let ((i 1) (j 2)) (+ i j)))))
- (foo) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (let ((i 1) (j 2)) (+ i j)))))))
+ (matches? (procedure-source foo)
+ (lambda () (let ((_ 1) (_ 2)) (+ _ _)))))))
(with-test-prefix "bindings"
@@ -241,42 +264,42 @@
(with-test-prefix "bad bindings"
(pass-if-exception "(let)"
- exception:missing-expr
+ exception:bad-let
(eval '(let)
(interaction-environment)))
(pass-if-exception "(let 1)"
- exception:missing-expr
+ exception:bad-let
(eval '(let 1)
(interaction-environment)))
(pass-if-exception "(let (x))"
- exception:missing-expr
+ exception:bad-let
(eval '(let (x))
(interaction-environment)))
(pass-if-exception "(let ((x)))"
- exception:missing-expr
+ exception:bad-let
(eval '(let ((x)))
(interaction-environment)))
(pass-if-exception "(let (x) 1)"
- exception:bad-binding
+ exception:bad-let
(eval '(let (x) 1)
(interaction-environment)))
(pass-if-exception "(let ((x)) 3)"
- exception:bad-binding
+ exception:bad-let
(eval '(let ((x)) 3)
(interaction-environment)))
(pass-if-exception "(let ((x 1) y) x)"
- exception:bad-binding
+ exception:bad-let
(eval '(let ((x 1) y) x)
(interaction-environment)))
(pass-if-exception "(let ((1 2)) 3)"
- exception:bad-variable
+ exception:bad-let
(eval '(let ((1 2)) 3)
(interaction-environment))))
@@ -290,12 +313,12 @@
(with-test-prefix "bad body"
(pass-if-exception "(let ())"
- exception:missing-expr
+ exception:bad-let
(eval '(let ())
(interaction-environment)))
(pass-if-exception "(let ((x 1)))"
- exception:missing-expr
+ exception:bad-let
(eval '(let ((x 1)))
(interaction-environment)))))
@@ -310,19 +333,19 @@
(with-test-prefix "bad bindings"
(pass-if-exception "(let x (y))"
- exception:missing-expr
+ exception:bad-let
(eval '(let x (y))
(interaction-environment))))
(with-test-prefix "bad body"
(pass-if-exception "(let x ())"
- exception:missing-expr
+ exception:bad-let
(eval '(let x ())
(interaction-environment)))
(pass-if-exception "(let x ((y 1)))"
- exception:missing-expr
+ exception:bad-let
(eval '(let x ((y 1)))
(interaction-environment)))))
@@ -332,19 +355,16 @@
(pass-if "normal let*"
(let ((foo (lambda () (let* ((x 1) (y 2)) (+ x y)))))
- (foo) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (let* ((x 1) (y 2)) (+ x y))))))
+ (matches? (procedure-source foo)
+ (lambda () (let ((_ 1)) (let ((_ 2)) (+ _ _)))))))
(pass-if "let* without bindings"
(let ((foo (lambda () (let ((x 1) (y 2))
(let* ()
(and (= x 1) (= y 2)))))))
- (foo) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (let ((x 1) (y 2))
- (let* ()
- (and (= x 1) (= y 2)))))))))
+ (matches? (procedure-source foo)
+ (lambda () (let ((_ 1) (_ 2))
+ (if (= _ 1) (= _ 2) #f)))))))
(with-test-prefix "bindings"
@@ -364,59 +384,59 @@
(with-test-prefix "bad bindings"
(pass-if-exception "(let*)"
- exception:missing-expr
+ exception:generic-syncase-error
(eval '(let*)
(interaction-environment)))
(pass-if-exception "(let* 1)"
- exception:missing-expr
+ exception:generic-syncase-error
(eval '(let* 1)
(interaction-environment)))
(pass-if-exception "(let* (x))"
- exception:missing-expr
+ exception:generic-syncase-error
(eval '(let* (x))
(interaction-environment)))
(pass-if-exception "(let* (x) 1)"
- exception:bad-binding
+ exception:generic-syncase-error
(eval '(let* (x) 1)
(interaction-environment)))
(pass-if-exception "(let* ((x)) 3)"
- exception:bad-binding
+ exception:generic-syncase-error
(eval '(let* ((x)) 3)
(interaction-environment)))
(pass-if-exception "(let* ((x 1) y) x)"
- exception:bad-binding
+ exception:generic-syncase-error
(eval '(let* ((x 1) y) x)
(interaction-environment)))
(pass-if-exception "(let* x ())"
- exception:bad-bindings
+ exception:generic-syncase-error
(eval '(let* x ())
(interaction-environment)))
(pass-if-exception "(let* x (y))"
- exception:bad-bindings
+ exception:generic-syncase-error
(eval '(let* x (y))
(interaction-environment)))
(pass-if-exception "(let* ((1 2)) 3)"
- exception:bad-variable
+ exception:generic-syncase-error
(eval '(let* ((1 2)) 3)
(interaction-environment))))
(with-test-prefix "bad body"
(pass-if-exception "(let* ())"
- exception:missing-expr
+ exception:generic-syncase-error
(eval '(let* ())
(interaction-environment)))
(pass-if-exception "(let* ((x 1)))"
- exception:missing-expr
+ exception:generic-syncase-error
(eval '(let* ((x 1)))
(interaction-environment)))))
@@ -426,9 +446,8 @@
(pass-if "normal letrec"
(let ((foo (lambda () (letrec ((i 1) (j 2)) (+ i j)))))
- (foo) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (letrec ((i 1) (j 2)) (+ i j)))))))
+ (matches? (procedure-source foo)
+ (lambda () (letrec ((_ 1) (_ 2)) (+ _ _)))))))
(with-test-prefix "bindings"
@@ -440,47 +459,47 @@
(with-test-prefix "bad bindings"
(pass-if-exception "(letrec)"
- exception:missing-expr
+ exception:bad-letrec
(eval '(letrec)
(interaction-environment)))
(pass-if-exception "(letrec 1)"
- exception:missing-expr
+ exception:bad-letrec
(eval '(letrec 1)
(interaction-environment)))
(pass-if-exception "(letrec (x))"
- exception:missing-expr
+ exception:bad-letrec
(eval '(letrec (x))
(interaction-environment)))
(pass-if-exception "(letrec (x) 1)"
- exception:bad-binding
+ exception:bad-letrec
(eval '(letrec (x) 1)
(interaction-environment)))
(pass-if-exception "(letrec ((x)) 3)"
- exception:bad-binding
+ exception:bad-letrec
(eval '(letrec ((x)) 3)
(interaction-environment)))
(pass-if-exception "(letrec ((x 1) y) x)"
- exception:bad-binding
+ exception:bad-letrec
(eval '(letrec ((x 1) y) x)
(interaction-environment)))
(pass-if-exception "(letrec x ())"
- exception:bad-bindings
+ exception:bad-letrec
(eval '(letrec x ())
(interaction-environment)))
(pass-if-exception "(letrec x (y))"
- exception:bad-bindings
+ exception:bad-letrec
(eval '(letrec x (y))
(interaction-environment)))
(pass-if-exception "(letrec ((1 2)) 3)"
- exception:bad-variable
+ exception:bad-letrec
(eval '(letrec ((1 2)) 3)
(interaction-environment))))
@@ -494,12 +513,12 @@
(with-test-prefix "bad body"
(pass-if-exception "(letrec ())"
- exception:missing-expr
+ exception:bad-letrec
(eval '(letrec ())
(interaction-environment)))
(pass-if-exception "(letrec ((x 1)))"
- exception:missing-expr
+ exception:bad-letrec
(eval '(letrec ((x 1)))
(interaction-environment)))))
@@ -511,17 +530,17 @@
(let ((foo (lambda (x) (if x (+ 1) (+ 2)))))
(foo #t) ; make sure, memoization has been performed
(foo #f) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda (x) (if x (+ 1) (+ 2))))))
+ (matches? (procedure-source foo)
+ (lambda (_) (if _ (+ 1) (+ 2))))))
- (pass-if "if without else"
+ (expect-fail "if without else"
(let ((foo (lambda (x) (if x (+ 1)))))
(foo #t) ; make sure, memoization has been performed
(foo #f) ; make sure, memoization has been performed
(equal? (procedure-source foo)
'(lambda (x) (if x (+ 1))))))
- (pass-if "if #f without else"
+ (expect-fail "if #f without else"
(let ((foo (lambda () (if #f #f))))
(foo) ; make sure, memoization has been performed
(equal? (procedure-source foo)
@@ -530,12 +549,12 @@
(with-test-prefix "missing or extra expressions"
(pass-if-exception "(if)"
- exception:missing/extra-expr
+ exception:generic-syncase-error
(eval '(if)
(interaction-environment)))
(pass-if-exception "(if 1 2 3 4)"
- exception:missing/extra-expr
+ exception:generic-syncase-error
(eval '(if 1 2 3 4)
(interaction-environment)))))
@@ -597,78 +616,77 @@
(eq? 'ok (cond (#t identity =>) (else #f)))))
(pass-if-exception "missing recipient"
- '(syntax-error . "Missing recipient")
+ '(syntax-error . "cond: wrong number of receiver expressions")
(cond (#t identity =>)))
(pass-if-exception "extra recipient"
- '(syntax-error . "Extra expression")
+ '(syntax-error . "cond: wrong number of receiver expressions")
(cond (#t identity => identity identity))))
(with-test-prefix "unmemoization"
+ ;; FIXME: the (if #f #f) is a hack!
(pass-if "normal clauses"
- (let ((foo (lambda (x) (cond ((= x 1) 'bar) ((= x 2) 'baz)))))
- (foo 1) ; make sure, memoization has been performed
- (foo 2) ; make sure, memoization has been performed
+ (let ((foo (lambda () (cond ((= x 1) 'bar) ((= x 2) 'baz)))))
(equal? (procedure-source foo)
- '(lambda (x) (cond ((= x 1) 'bar) ((= x 2) 'baz))))))
+ '(lambda () (if (= x 1) 'bar (if (= x 2) 'baz (if #f #f)))))))
(pass-if "else"
(let ((foo (lambda () (cond (else 'bar)))))
- (foo) ; make sure, memoization has been performed
(equal? (procedure-source foo)
- '(lambda () (cond (else 'bar))))))
+ '(lambda () 'bar))))
+ ;; FIXME: the (if #f #f) is a hack!
(pass-if "=>"
(let ((foo (lambda () (cond (#t => identity)))))
- (foo) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (cond (#t => identity)))))))
+ (matches? (procedure-source foo)
+ (lambda () (let ((_ #t))
+ (if _ (identity _) (if #f #f))))))))
(with-test-prefix "bad or missing clauses"
(pass-if-exception "(cond)"
- exception:missing-clauses
+ exception:generic-syncase-error
(eval '(cond)
(interaction-environment)))
(pass-if-exception "(cond #t)"
- exception:bad-cond-clause
+ exception:generic-syncase-error
(eval '(cond #t)
(interaction-environment)))
(pass-if-exception "(cond 1)"
- exception:bad-cond-clause
+ exception:generic-syncase-error
(eval '(cond 1)
(interaction-environment)))
(pass-if-exception "(cond 1 2)"
- exception:bad-cond-clause
+ exception:generic-syncase-error
(eval '(cond 1 2)
(interaction-environment)))
(pass-if-exception "(cond 1 2 3)"
- exception:bad-cond-clause
+ exception:generic-syncase-error
(eval '(cond 1 2 3)
(interaction-environment)))
(pass-if-exception "(cond 1 2 3 4)"
- exception:bad-cond-clause
+ exception:generic-syncase-error
(eval '(cond 1 2 3 4)
(interaction-environment)))
(pass-if-exception "(cond ())"
- exception:bad-cond-clause
+ exception:generic-syncase-error
(eval '(cond ())
(interaction-environment)))
(pass-if-exception "(cond () 1)"
- exception:bad-cond-clause
+ exception:generic-syncase-error
(eval '(cond () 1)
(interaction-environment)))
(pass-if-exception "(cond (1) 1)"
- exception:bad-cond-clause
+ exception:generic-syncase-error
(eval '(cond (1) 1)
(interaction-environment))))
@@ -686,7 +704,7 @@
(with-test-prefix "case is hygienic"
(pass-if-exception "bound 'else is handled correctly"
- exception:bad-case-labels
+ exception:generic-syncase-error
(eval '(let ((else #f)) (case 1 (else #f)))
(interaction-environment))))
@@ -694,79 +712,83 @@
(pass-if "normal clauses"
(let ((foo (lambda (x) (case x ((1) 'bar) ((2) 'baz) (else 'foobar)))))
- (foo 1) ; make sure, memoization has been performed
- (foo 2) ; make sure, memoization has been performed
- (foo 3) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda (x) (case x ((1) 'bar) ((2) 'baz) (else 'foobar))))))
+ (matches? (procedure-source foo)
+ (lambda (_)
+ (if ((@@ (guile) memv) _ '(1))
+ 'bar
+ (if ((@@ (guile) memv) _ '(2))
+ 'baz
+ 'foobar))))))
(pass-if "empty labels"
(let ((foo (lambda (x) (case x ((1) 'bar) (() 'baz) (else 'foobar)))))
- (foo 1) ; make sure, memoization has been performed
- (foo 2) ; make sure, memoization has been performed
- (foo 3) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda (x) (case x ((1) 'bar) (() 'baz) (else 'foobar)))))))
+ (matches? (procedure-source foo)
+ (lambda (_)
+ (if ((@@ (guile) memv) _ '(1))
+ 'bar
+ (if ((@@ (guile) memv) _ '())
+ 'baz
+ 'foobar)))))))
(with-test-prefix "bad or missing clauses"
(pass-if-exception "(case)"
- exception:missing-clauses
+ exception:generic-syncase-error
(eval '(case)
(interaction-environment)))
(pass-if-exception "(case . \"foo\")"
- exception:bad-expression
+ exception:generic-syncase-error
(eval '(case . "foo")
(interaction-environment)))
(pass-if-exception "(case 1)"
- exception:missing-clauses
+ exception:generic-syncase-error
(eval '(case 1)
(interaction-environment)))
(pass-if-exception "(case 1 . \"foo\")"
- exception:bad-expression
+ exception:generic-syncase-error
(eval '(case 1 . "foo")
(interaction-environment)))
(pass-if-exception "(case 1 \"foo\")"
- exception:bad-case-clause
+ exception:generic-syncase-error
(eval '(case 1 "foo")
(interaction-environment)))
(pass-if-exception "(case 1 ())"
- exception:bad-case-clause
+ exception:generic-syncase-error
(eval '(case 1 ())
(interaction-environment)))
(pass-if-exception "(case 1 (\"foo\"))"
- exception:bad-case-clause
+ exception:generic-syncase-error
(eval '(case 1 ("foo"))
(interaction-environment)))
(pass-if-exception "(case 1 (\"foo\" \"bar\"))"
- exception:bad-case-labels
+ exception:generic-syncase-error
(eval '(case 1 ("foo" "bar"))
(interaction-environment)))
(pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")"
- exception:bad-expression
+ exception:generic-syncase-error
(eval '(case 1 ((2) "bar") . "foo")
(interaction-environment)))
(pass-if-exception "(case 1 ((2) \"bar\") (else))"
- exception:bad-case-clause
+ exception:generic-syncase-error
(eval '(case 1 ((2) "bar") (else))
(interaction-environment)))
(pass-if-exception "(case 1 (else #f) . \"foo\")"
- exception:bad-expression
+ exception:generic-syncase-error
(eval '(case 1 (else #f) . "foo")
(interaction-environment)))
(pass-if-exception "(case 1 (else #f) ((1) #t))"
- exception:misplaced-else-clause
+ exception:generic-syncase-error
(eval '(case 1 (else #f) ((1) #t))
(interaction-environment)))))
@@ -783,14 +805,6 @@
(eval '(define round round) m)
(eq? (module-ref m 'round) round)))
- (with-test-prefix "currying"
-
- (pass-if "(define ((foo)) #f)"
- (eval '(begin
- (define ((foo)) #t)
- ((foo)))
- (interaction-environment))))
-
(with-test-prefix "unmemoization"
(pass-if "definition unmemoized without prior execution"
@@ -812,7 +826,7 @@
(with-test-prefix "missing or extra expressions"
(pass-if-exception "(define)"
- exception:missing-expr
+ exception:generic-syncase-error
(eval '(define)
(interaction-environment)))))
@@ -889,34 +903,10 @@
'ok)
(bar))
(foo)
- (equal?
+ (matches?
(procedure-source foo)
- '(lambda () (letrec ((bar (lambda () (quote ok)))) (bar)))))
- (interaction-environment))))
-
-(with-test-prefix "do"
-
- (with-test-prefix "unmemoization"
-
- (pass-if "normal case"
- (let ((foo (lambda () (do ((i 1 (+ i 1)) (j 2))
- ((> i 9) (+ i j))
- (identity i)))))
- (foo) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (do ((i 1 (+ i 1)) (j 2))
- ((> i 9) (+ i j))
- (identity i))))))
-
- (pass-if "reduced case"
- (let ((foo (lambda () (do ((i 1 (+ i 1)) (j 2 j)) ; redundant step for j
- ((> i 9) (+ i j))
- (identity i)))))
- (foo) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda () (do ((i 1 (+ i 1)) (j 2)) ; no redundancy here
- ((> i 9) (+ i j))
- (identity i))))))))
+ (lambda () (letrec ((_ (lambda () (quote ok)))) (_)))))
+ (current-module))))
(with-test-prefix "set!"
@@ -925,50 +915,50 @@
(pass-if "normal set!"
(let ((foo (lambda (x) (set! x (+ 1 x)))))
(foo 1) ; make sure, memoization has been performed
- (equal? (procedure-source foo)
- '(lambda (x) (set! x (+ 1 x)))))))
+ (matches? (procedure-source foo)
+ (lambda (_) (set! _ (+ 1 _)))))))
(with-test-prefix "missing or extra expressions"
(pass-if-exception "(set!)"
- exception:missing/extra-expr
+ exception:bad-set!
(eval '(set!)
(interaction-environment)))
(pass-if-exception "(set! 1)"
- exception:missing/extra-expr
+ exception:bad-set!
(eval '(set! 1)
(interaction-environment)))
(pass-if-exception "(set! 1 2 3)"
- exception:missing/extra-expr
+ exception:bad-set!
(eval '(set! 1 2 3)
(interaction-environment))))
(with-test-prefix "bad variable"
(pass-if-exception "(set! \"\" #t)"
- exception:bad-variable
+ exception:bad-set!
(eval '(set! "" #t)
(interaction-environment)))
(pass-if-exception "(set! 1 #t)"
- exception:bad-variable
+ exception:bad-set!
(eval '(set! 1 #t)
(interaction-environment)))
(pass-if-exception "(set! #t #f)"
- exception:bad-variable
+ exception:bad-set!
(eval '(set! #t #f)
(interaction-environment)))
(pass-if-exception "(set! #f #t)"
- exception:bad-variable
+ exception:bad-set!
(eval '(set! #f #t)
(interaction-environment)))
(pass-if-exception "(set! #\\space #f)"
- exception:bad-variable
+ exception:bad-set!
(eval '(set! #\space #f)
(interaction-environment)))))
@@ -977,12 +967,12 @@
(with-test-prefix "missing or extra expression"
(pass-if-exception "(quote)"
- exception:missing/extra-expr
+ exception:bad-quote
(eval '(quote)
(interaction-environment)))
(pass-if-exception "(quote a b)"
- exception:missing/extra-expr
+ exception:bad-quote
(eval '(quote a b)
(interaction-environment)))))
@@ -1034,37 +1024,6 @@
(unreachable))
#t)
- (with-test-prefix "in empty environment"
-
- ;; an environment with no bindings at all
- (define empty-environment
- (make-module 1))
-
- ;; these tests are 'unresolved because to work with ice-9 syncase it was
- ;; necessary to drop the unquote from `do' in the implementation, and
- ;; unfortunately that makes `while' depend on its evaluation environment
-
- (pass-if "empty body"
- (throw 'unresolved)
- (eval `(,while #f)
- empty-environment)
- #t)
-
- (pass-if "initially false"
- (throw 'unresolved)
- (eval `(,while #f
- #f)
- empty-environment)
- #t)
-
- (pass-if "iterating"
- (throw 'unresolved)
- (let ((cond (make-iterations-cond 3)))
- (eval `(,while (,cond)
- 123 456)
- empty-environment))
- #t))
-
(with-test-prefix "iterations"
(do ((n 0 (1+ n)))
((> n 5))
@@ -1078,8 +1037,9 @@
(with-test-prefix "break"
(pass-if-exception "too many args" exception:wrong-num-args
- (while #t
- (break 1)))
+ (eval '(while #t
+ (break 1))
+ (interaction-environment)))
(with-test-prefix "from cond"
(pass-if "first"
@@ -1150,8 +1110,9 @@
(with-test-prefix "continue"
(pass-if-exception "too many args" exception:wrong-num-args
- (while #t
- (continue 1)))
+ (eval '(while #t
+ (continue 1))
+ (interaction-environment)))
(with-test-prefix "from cond"
(do ((n 0 (1+ n)))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index eb33ae7..18b67d6 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -24,10 +24,19 @@
#:use-module (language tree-il)
#:use-module (language glil))
+;; Of course, the GLIL that is emitted depends on the source info of the
+;; input. Here we're not concerned about that, so we strip source
+;; information from the incoming tree-il.
+
+(define (strip-source x)
+ (post-order! (lambda (x) (set! (tree-il-src x) #f))
+ x))
+
(define-syntax assert-scheme->glil
(syntax-rules ()
((_ in out)
- (let ((tree-il (compile 'in #:from 'scheme #:to 'tree-il)))
+ (let ((tree-il (strip-source
+ (compile 'in #:from 'scheme #:to 'tree-il))))
(pass-if 'in
(equal? (unparse-glil (compile tree-il #:from 'tree-il #:to
'glil))
'out))))))
@@ -36,7 +45,7 @@
(syntax-rules ()
((_ in out)
(pass-if 'in
- (let ((tree-il (parse-tree-il 'in)))
+ (let ((tree-il (strip-source (parse-tree-il 'in))))
(equal? (unparse-glil (compile tree-il #:from 'tree-il #:to
'glil))
'out))))))
@@ -46,13 +55,12 @@
(let ((exp 'in))
(pass-if 'in
(let ((glil (unparse-glil
- (compile (parse-tree-il exp)
+ (compile (strip-source (parse-tree-il exp))
#:from 'tree-il #:to 'glil))))
(pmatch glil
(pat (guard test ...) #t)
(else #f))))))))
-
(with-test-prefix "void"
(assert-tree-il->glil
(void)
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. e0c90f9084914956d90db73b21ef2ab32d1a477a,
Andy Wingo <=