[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. ad9b8c451b
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. ad9b8c451b82f74cf88c5a6207ed3ea72c86f93e |
|
Date: |
Wed, 20 May 2009 14:00:52 +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=ad9b8c451b82f74cf88c5a6207ed3ea72c86f93e
The branch, syncase-in-boot-9 has been updated
via ad9b8c451b82f74cf88c5a6207ed3ea72c86f93e (commit)
via c11f46afe113f50e34af33ad3055b3da66e4b71f (commit)
via 5af166bda2f1d89525add147a9e3d2d6867d03a5 (commit)
via e32a1792de84c20eaaae6ea7f33048b6eef2c9d8 (commit)
via a1a482e0e9518b5711bc2734aa014254f9207919 (commit)
from ce09ee19892d391f3b2ca13e0616d343929c2c14 (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 ad9b8c451b82f74cf88c5a6207ed3ea72c86f93e
Author: Andy Wingo <address@hidden>
Date: Wed May 20 13:59:42 2009 +0200
fix @slot-ref / @slot-set! compilation
* module/language/tree-il/compile-glil.scm: Add primcall compilers for
@slot-ref and @slot-set.
* module/language/tree-il/optimize.scm (add-interesting-primitive!): New
export. Creates an association between a variable in the current module
and a primitive name.
* module/oop/goops.scm: Rework compiler hooks to work with tree-il and
not ghil.
commit c11f46afe113f50e34af33ad3055b3da66e4b71f
Author: Andy Wingo <address@hidden>
Date: Wed May 20 13:33:44 2009 +0200
compile `list' and `vector' to their associated opcodes
* module/language/glil/compile-assembly.scm (glil->assembly): Check the
length when emitting calls to variable-argument stack instructions.
Allow two-byte lengths -- allows e.g. calls to `list' with more than
256 arguments.
* module/language/tree-il/compile-glil.scm: Add primcall associations for
`list' and `vector', with any number of arguments. Necessary because
syncase's quasiquote expansions will produce calls to `list' with many
arguments.
* module/language/tree-il/optimize.scm (*interesting-primitive-names*):
Add `list' and `vector' to the set of primitives to resolve.
commit 5af166bda2f1d89525add147a9e3d2d6867d03a5
Author: Andy Wingo <address@hidden>
Date: Wed May 20 12:46:23 2009 +0200
don't allocate too many locals for expansions of `or'
* module/language/tree-il/analyze.scm (analyze-lexicals): Add in a hack
to avoid allocating more locals than necessary for expansions of `or'.
Documented in the source.
* test-suite/tests/tree-il.test: Add a test case.
commit e32a1792de84c20eaaae6ea7f33048b6eef2c9d8
Author: Andy Wingo <address@hidden>
Date: Wed May 20 11:59:41 2009 +0200
a few fixups
* module/ice-9/psyntax.scm (chi-install-global, syntax-case): Fix a
couple of cases in which bare datums were passed to output
constructors.
* module/ice-9/psyntax-pp.scm: Regenerated.
* module/language/scheme/spec.scm (scheme): Clean up the #:compilers
list.
* module/language/tree-il/compile-glil.scm (flatten): Fix call to
`length' in call/cc compiler.
commit a1a482e0e9518b5711bc2734aa014254f9207919
Author: Andy Wingo <address@hidden>
Date: Wed May 20 11:15:22 2009 +0200
and, or, cond etc use syntax-rules, compile scheme through tree-il
* libguile/vm-i-system.c:
* libguile/vm-engine.h (ASSERT_BOUND): New assertion, that a value is
bound. Used by local-ref and external-ref in paranoid mode.
* module/ice-9/boot-9.scm (and, or, cond, case, do): Since we are
switching to use psyntax as the first pass of the compiler, and perhaps
soon of the interpreter too, we need to make sure it expands out all
forms to primitive expressions. So define expanders for these derived
syntax forms, as in the R5RS report.
* module/ice-9/psyntax-pp.scm: Regenerate, with core forms fully
expanded.
* module/ice-9/psyntax.scm (build-void): New constructor, for making
undefined values.
(build-primref): Add in a hack so that primitive refs in the boot
module expand out to toplevel refs, not module refs.
(chi-void): Use build-void.
(if): Define an expander for if that calls build-conditional.
* module/language/scheme/compile-tree-il.scm (compile-tree-il): Use let*
so as not to depend on binding order for the result of
(current-module).
* module/language/scheme/spec.scm (scheme): Switch over to tree-il as the
primary intermediate language. Not yet fully tested, but at least it
can compile psyntax-pp.scm.
* module/language/tree-il/analyze.scm (analyze-lexicals): Arguments don't
count towards a function's nlocs.
* module/language/tree-il/compile-glil.scm (*comp-module*, compile-glil):
Define a "compilation module" fluid.
(flatten-lambda): Fix a call to make-glil-argument. Fix bug in
heapifying arguments.
(flatten): Fix number of arguments passed to apply instruction. Add a
special case for `(values ...)'. If inlining primitive-refs fails,
try expanding into toplevel-refs if the comp-module's variable is the
same as the root variable.
* module/language/tree-il/optimize.scm (resolve-primitives!): Add missing
src variable for <module-ref>.
* test-suite/tests/tree-il.test ("lambda"): Fix nlocs counts. Add a
closure test case.
-----------------------------------------------------------------------
Summary of changes:
libguile/vm-engine.h | 4 ++
libguile/vm-i-system.c | 2 +
module/ice-9/boot-9.scm | 81 ++++++++++++++++++++++++++++
module/ice-9/psyntax-pp.scm | 22 ++++----
module/ice-9/psyntax.scm | 45 +++++++++++++---
module/language/glil/compile-assembly.scm | 7 ++-
module/language/scheme/compile-tree-il.scm | 6 +-
module/language/scheme/spec.scm | 4 +-
module/language/tree-il/analyze.scm | 58 ++++++++++++++++----
module/language/tree-il/compile-glil.scm | 69 +++++++++++++++++-------
module/language/tree-il/optimize.scm | 19 ++++---
module/oop/goops.scm | 27 +--------
test-suite/tests/tree-il.test | 65 +++++++++++++++++++---
13 files changed, 313 insertions(+), 96 deletions(-)
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 6bb2354..fbd2c6c 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -147,8 +147,12 @@
#ifdef VM_ENABLE_PARANOID_ASSERTIONS
#define CHECK_IP() \
do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
+#define ASSERT_BOUND(x) \
+ do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
+ } while (0)
#else
#define CHECK_IP()
+#define ASSERT_BOUND(x)
#endif
/* Get a local copy of the program's "object table" (i.e. the vector of
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 5468604..a6cb66d 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -230,6 +230,7 @@ VM_DEFINE_INSTRUCTION (21, object_ref, "object-ref", 1, 0,
1)
VM_DEFINE_INSTRUCTION (22, local_ref, "local-ref", 1, 0, 1)
{
PUSH (LOCAL_REF (FETCH ()));
+ ASSERT_BOUND (*sp);
NEXT;
}
@@ -244,6 +245,7 @@ VM_DEFINE_INSTRUCTION (23, external_ref, "external-ref", 1,
0, 1)
}
CHECK_EXTERNAL(e);
PUSH (SCM_CAR (e));
+ ASSERT_BOUND (*sp);
NEXT;
}
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 94a9a39..cdd840f 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -210,6 +210,87 @@
;; module system has booted up.
(define %pre-modules-transformer sc-expand)
+(define-syntax and
+ (syntax-rules ()
+ ((_) #t)
+ ((_ x) x)
+ ((_ x y ...) (if x (and y ...) #f))))
+
+(define-syntax or
+ (syntax-rules ()
+ ((_) #f)
+ ((_ x) x)
+ ((_ x y ...) (let ((t x)) (if t t (or y ...))))))
+
+(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 ...)))))
+
+(define-syntax case
+ (syntax-rules (else)
+ ((case (key ...)
+ clauses ...)
+ (let ((atom-key (key ...)))
+ (case atom-key clauses ...)))
+ ((case key
+ (else result1 result2 ...))
+ (begin result1 result2 ...))
+ ((case key
+ ((atoms ...) result1 result2 ...))
+ (if (memv key '(atoms ...))
+ (begin result1 result2 ...)))
+ ((case key
+ ((atoms ...) result1 result2 ...)
+ clause clauses ...)
+ (if (memv key '(atoms ...))
+ (begin result1 result2 ...)
+ (case key clause clauses ...)))))
+
+(define-syntax do
+ (syntax-rules ()
+ ((do ((var init step ...) ...)
+ (test expr ...)
+ command ...)
+ (letrec
+ ((loop
+ (lambda (var ...)
+ (if test
+ (begin
+ (if #f #f)
+ expr ...)
+ (begin
+ command
+ ...
+ (loop (do "step" var step ...)
+ ...))))))
+ (loop init ...)))
+ ((do "step" x)
+ x)
+ ((do "step" x y)
+ y)))
+
(define-syntax delay
(syntax-rules ()
((_ exp) (make-promise (lambda () exp)))))
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 55064ee..4476212 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) (or (null? first56) (if
(null? rest55) (letrec ((andmap58 (lambda (first59) (let ((x60 (car first59))
(first61 (cdr first59))) (if (null? first61) (f57 x60) (and (f57 x60) (andmap58
first61))))))) (andmap58 first56)) (letrec ((andmap62 (lambda (first63 rest64)
(let ((x65 (car first63)) (xr66 (map car rest64)) (first67 (cdr first63))
(rest68 (map cdr rest64))) (if (null? first67) (apply f57 (cons x65 xr66)) (and
(apply f57 (cons x65 xr66)) (andmap62 first67 rest68))))))) (andmap62 first56
rest55))))))) (letrec ((lambda-var-list160 (lambda (vars289) (letrec ((lvl290
(lambda (vars291 ls292 w293) (cond ((pair? vars291) (lvl290 (cdr vars291) (cons
(wrap139 (car vars291) w293 #f) ls292) w293)) ((id?111 vars291) (cons (wrap139
vars291 w293 #f) ls292)) ((null? vars291) ls292) ((syntax-object?95 vars291)
(lvl290 (syntax-object-expression96 vars291) ls292 (join-wraps130 w293
(syntax-object-wrap97 vars291)))) ((annotation? vars291) (lvl290
(annotation-expression vars291) ls292 w293)) (else (cons vars291 ls292))))))
(lvl290 vars289 (quote ()) (quote (())))))) (gen-var159 (lambda (id294) (let
((id295 (if (syntax-object?95 id294) (syntax-object-expression96 id294)
id294))) (if (annotation? id295) (gensym (symbol->string (annotation-expression
id295))) (gensym (symbol->string id295)))))) (strip158 (lambda (x296 w297) (if
(memq (quote top) (wrap-marks114 w297)) (if (or (annotation? x296) (and (pair?
x296) (annotation? (car x296)))) (strip-annotation157 x296 #f) x296) (letrec
((f298 (lambda (x299) (cond ((syntax-object?95 x299) (strip158
(syntax-object-expression96 x299) (syntax-object-wrap97 x299))) ((pair? x299)
(let ((a300 (f298 (car x299))) (d301 (f298 (cdr x299)))) (if (and (eq? a300
(car x299)) (eq? d301 (cdr x299))) x299 (cons a300 d301)))) ((vector? x299)
(let ((old302 (vector->list x299))) (let ((new303 (map f298 old302))) (if
(and-map*17 eq? old302 new303) x299 (list->vector new303))))) (else x299)))))
(f298 x296))))) (strip-annotation157 (lambda (x304 parent305) (cond ((pair?
x304) (let ((new306 (cons #f #f))) (begin (if parent305
(set-annotation-stripped! parent305 new306)) (set-car! new306
(strip-annotation157 (car x304) #f)) (set-cdr! new306 (strip-annotation157 (cdr
x304) #f)) new306))) ((annotation? x304) (or (annotation-stripped x304)
(strip-annotation157 (annotation-expression x304) x304))) ((vector? x304) (let
((new307 (make-vector (vector-length x304)))) (begin (if parent305
(set-annotation-stripped! parent305 new307)) (letrec ((loop308 (lambda (i309)
(unless (fx<74 i309 0) (vector-set! new307 i309 (strip-annotation157
(vector-ref x304 i309) #f)) (loop308 (fx-72 i309 1)))))) (loop308 (-
(vector-length x304) 1))) new307))) (else x304)))) (ellipsis?156 (lambda (x310)
(and (nonsymbol-id?110 x310) (free-id=?134 x310 (quote #(syntax-object ...
((top) #(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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))))))) (chi-void155 (lambda () (build-application79 #f
(build-primref88 #f (quote if)) (quote (#f #f))))) (eval-local-transformer154
(lambda (expanded311 mod312) (let ((p313 (local-eval-hook76 expanded311
mod312))) (if (procedure? p313) p313 (syntax-violation #f "nonprocedure
transformer" p313))))) (chi-local-syntax153 (lambda (rec?314 e315 r316 w317
s318 mod319 k320) ((lambda (tmp321) ((lambda (tmp322) (if tmp322 (apply (lambda
(_323 id324 val325 e1326 e2327) (let ((ids328 id324)) (if (not
(valid-bound-ids?136 ids328)) (syntax-violation #f "duplicate bound keyword"
e315) (let ((labels330 (gen-labels117 ids328))) (let ((new-w331
(make-binding-wrap128 ids328 labels330 w317))) (k320 (cons e1326 e2327)
(extend-env105 labels330 (let ((w333 (if rec?314 new-w331 w317)) (trans-r334
(macros-only-env107 r316))) (map (lambda (x335) (cons (quote macro)
(eval-local-transformer154 (chi147 x335 trans-r334 w333 mod319) mod319)))
val325)) r316) new-w331 s318 mod319)))))) tmp322) ((lambda (_337)
(syntax-violation #f "bad local syntax definition" (source-wrap140 e315 w317
s318 mod319))) tmp321))) ($sc-dispatch tmp321 (quote (any #(each (any any)) any
. each-any))))) e315))) (chi-lambda-clause152 (lambda (e338 docstring339 c340
r341 w342 mod343 k344) ((lambda (tmp345) ((lambda (tmp346) (if (if tmp346
(apply (lambda (args347 doc348 e1349 e2350) (and (string? (syntax->datum
doc348)) (not docstring339))) tmp346) #f) (apply (lambda (args351 doc352 e1353
e2354) (chi-lambda-clause152 e338 doc352 (cons args351 (cons e1353 e2354)) r341
w342 mod343 k344)) tmp346) ((lambda (tmp356) (if tmp356 (apply (lambda (id357
e1358 e2359) (let ((ids360 id357)) (if (not (valid-bound-ids?136 ids360))
(syntax-violation (quote lambda) "invalid parameter list" e338) (let
((labels362 (gen-labels117 ids360)) (new-vars363 (map gen-var159 ids360)))
(k344 (map syntax->datum ids360) new-vars363 docstring339 (chi-body151 (cons
e1358 e2359) e338 (extend-var-env106 labels362 new-vars363 r341)
(make-binding-wrap128 ids360 labels362 w342) mod343)))))) tmp356) ((lambda
(tmp365) (if tmp365 (apply (lambda (ids366 e1367 e2368) (let ((old-ids369
(lambda-var-list160 ids366))) (if (not (valid-bound-ids?136 old-ids369))
(syntax-violation (quote lambda) "invalid parameter list" e338) (let
((labels370 (gen-labels117 old-ids369)) (new-vars371 (map gen-var159
old-ids369))) (k344 (letrec ((f372 (lambda (ls1373 ls2374) (if (null? ls1373)
(syntax->datum ls2374) (f372 (cdr ls1373) (cons (syntax->datum (car ls1373))
ls2374)))))) (f372 (cdr old-ids369) (car old-ids369))) (letrec ((f375 (lambda
(ls1376 ls2377) (if (null? ls1376) ls2377 (f375 (cdr ls1376) (cons (car ls1376)
ls2377)))))) (f375 (cdr new-vars371) (car new-vars371))) docstring339
(chi-body151 (cons e1367 e2368) e338 (extend-var-env106 labels370 new-vars371
r341) (make-binding-wrap128 old-ids369 labels370 w342) mod343)))))) tmp365)
((lambda (_379) (syntax-violation (quote lambda) "bad lambda" e338)) tmp345)))
($sc-dispatch tmp345 (quote (any any . each-any)))))) ($sc-dispatch tmp345
(quote (each-any any . each-any)))))) ($sc-dispatch tmp345 (quote (any any any
. each-any))))) c340))) (chi-body151 (lambda (body380 outer-form381 r382 w383
mod384) (let ((r385 (cons (quote ("placeholder" placeholder)) r382))) (let
((ribcage386 (make-ribcage118 (quote ()) (quote ()) (quote ())))) (let ((w387
(make-wrap113 (wrap-marks114 w383) (cons ribcage386 (wrap-subst115 w383)))))
(letrec ((parse388 (lambda (body389 ids390 labels391 vars392 vals393
bindings394) (if (null? body389) (syntax-violation #f "no expressions in body"
outer-form381) (let ((e396 (cdar body389)) (er397 (caar body389)))
(call-with-values (lambda () (syntax-type145 e396 er397 (quote (())) #f
ribcage386 mod384)) (lambda (type398 value399 e400 w401 s402 mod403) (let
((t404 type398)) (if (memv t404 (quote (define-form))) (let ((id405 (wrap139
value399 w401 mod403)) (label406 (gen-label116))) (let ((var407 (gen-var159
id405))) (begin (extend-ribcage!127 ribcage386 id405 label406) (parse388 (cdr
body389) (cons id405 ids390) (cons label406 labels391) (cons var407 vars392)
(cons (cons er397 (wrap139 e400 w401 mod403)) vals393) (cons (cons (quote
lexical) var407) bindings394))))) (if (memv t404 (quote (define-syntax-form)))
(let ((id408 (wrap139 value399 w401 mod403)) (label409 (gen-label116))) (begin
(extend-ribcage!127 ribcage386 id408 label409) (parse388 (cdr body389) (cons
id408 ids390) (cons label409 labels391) vars392 vals393 (cons (cons (quote
macro) (cons er397 (wrap139 e400 w401 mod403))) bindings394)))) (if (memv t404
(quote (begin-form))) ((lambda (tmp410) ((lambda (tmp411) (if tmp411 (apply
(lambda (_412 e1413) (parse388 (letrec ((f414 (lambda (forms415) (if (null?
forms415) (cdr body389) (cons (cons er397 (wrap139 (car forms415) w401 mod403))
(f414 (cdr forms415))))))) (f414 e1413)) ids390 labels391 vars392 vals393
bindings394)) tmp411) (syntax-violation #f "source expression failed to match
any pattern" tmp410))) ($sc-dispatch tmp410 (quote (any . each-any))))) e400)
(if (memv t404 (quote (local-syntax-form))) (chi-local-syntax153 value399 e400
er397 w401 s402 mod403 (lambda (forms417 er418 w419 s420 mod421) (parse388
(letrec ((f422 (lambda (forms423) (if (null? forms423) (cdr body389) (cons
(cons er418 (wrap139 (car forms423) w419 mod421)) (f422 (cdr forms423)))))))
(f422 forms417)) ids390 labels391 vars392 vals393 bindings394))) (if (null?
ids390) (build-sequence90 #f (map (lambda (x424) (chi147 (cdr x424) (car x424)
(quote (())) mod403)) (cons (cons er397 (source-wrap140 e400 w401 s402 mod403))
(cdr body389)))) (begin (if (not (valid-bound-ids?136 ids390))
(syntax-violation #f "invalid or duplicate identifier in definition"
outer-form381)) (letrec ((loop425 (lambda (bs426 er-cache427 r-cache428) (if
(not (null? bs426)) (let ((b429 (car bs426))) (if (eq? (car b429) (quote
macro)) (let ((er430 (cadr b429))) (let ((r-cache431 (if (eq? er430
er-cache427) r-cache428 (macros-only-env107 er430)))) (begin (set-cdr! b429
(eval-local-transformer154 (chi147 (cddr b429) r-cache431 (quote (())) mod403)
mod403)) (loop425 (cdr bs426) er430 r-cache431)))) (loop425 (cdr bs426)
er-cache427 r-cache428))))))) (loop425 bindings394 #f #f)) (set-cdr! r385
(extend-env105 labels391 bindings394 (cdr r385))) (build-letrec93 #f (map
syntax->datum ids390) vars392 (map (lambda (x432) (chi147 (cdr x432) (car x432)
(quote (())) mod403)) vals393) (build-sequence90 #f (map (lambda (x433) (chi147
(cdr x433) (car x433) (quote (())) mod403)) (cons (cons er397 (source-wrap140
e400 w401 s402 mod403)) (cdr body389))))))))))))))))))) (parse388 (map (lambda
(x395) (cons r385 (wrap139 x395 w387 mod384))) body380) (quote ()) (quote ())
(quote ()) (quote ()) (quote ())))))))) (chi-macro150 (lambda (p434 e435 r436
w437 rib438 mod439) (letrec ((rebuild-macro-output440 (lambda (x441 m442) (cond
((pair? x441) (cons (rebuild-macro-output440 (car x441) m442)
(rebuild-macro-output440 (cdr x441) m442))) ((syntax-object?95 x441) (let
((w443 (syntax-object-wrap97 x441))) (let ((ms444 (wrap-marks114 w443)) (s445
(wrap-subst115 w443))) (if (and (pair? ms444) (eq? (car ms444) #f))
(make-syntax-object94 (syntax-object-expression96 x441) (make-wrap113 (cdr
ms444) (if rib438 (cons rib438 (cdr s445)) (cdr s445))) (syntax-object-module98
x441)) (make-syntax-object94 (syntax-object-expression96 x441) (make-wrap113
(cons m442 ms444) (if rib438 (cons rib438 (cons (quote shift) s445)) (cons
(quote shift) s445))) (let ((pmod446 (procedure-module p434))) (if pmod446
(cons (quote hygiene) (module-name pmod446)) (quote (hygiene guile)))))))))
((vector? x441) (let ((n447 (vector-length x441))) (let ((v448 (make-vector
n447))) (letrec ((doloop449 (lambda (i450) (if (fx=73 i450 n447) v448 (begin
(vector-set! v448 i450 (rebuild-macro-output440 (vector-ref x441 i450) m442))
(doloop449 (fx+71 i450 1))))))) (doloop449 0))))) ((symbol? x441)
(syntax-violation #f "encountered raw symbol in macro output" (source-wrap140
e435 w437 s mod439) x441)) (else x441))))) (rebuild-macro-output440 (p434
(wrap139 e435 (anti-mark126 w437) mod439)) (string #\m))))) (chi-application149
(lambda (x451 e452 r453 w454 s455 mod456) ((lambda (tmp457) ((lambda (tmp458)
(if tmp458 (apply (lambda (e0459 e1460) (build-application79 s455 x451 (map
(lambda (e461) (chi147 e461 r453 w454 mod456)) e1460))) tmp458)
(syntax-violation #f "source expression failed to match any pattern" tmp457)))
($sc-dispatch tmp457 (quote (any . each-any))))) e452))) (chi-expr148 (lambda
(type463 value464 e465 r466 w467 s468 mod469) (let ((t470 type463)) (if (memv
t470 (quote (lexical))) (build-lexical-reference81 (quote value) s468 e465
value464) (if (memv t470 (quote (core external-macro))) (value464 e465 r466
w467 s468 mod469) (if (memv t470 (quote (module-ref))) (call-with-values
(lambda () (value464 e465)) (lambda (id471 mod472) (build-global-reference84
s468 id471 mod472))) (if (memv t470 (quote (lexical-call))) (chi-application149
(build-lexical-reference81 (quote fun) (source-annotation102 (car e465)) (car
e465) value464) e465 r466 w467 s468 mod469) (if (memv t470 (quote
(global-call))) (chi-application149 (build-global-reference84
(source-annotation102 (car e465)) value464 (if (syntax-object?95 (car e465))
(syntax-object-module98 (car e465)) mod469)) e465 r466 w467 s468 mod469) (if
(memv t470 (quote (constant))) (build-data89 s468 (strip158 (source-wrap140
e465 w467 s468 mod469) (quote (())))) (if (memv t470 (quote (global)))
(build-global-reference84 s468 value464 mod469) (if (memv t470 (quote (call)))
(chi-application149 (chi147 (car e465) r466 w467 mod469) e465 r466 w467 s468
mod469) (if (memv t470 (quote (begin-form))) ((lambda (tmp473) ((lambda
(tmp474) (if tmp474 (apply (lambda (_475 e1476 e2477) (chi-sequence141 (cons
e1476 e2477) r466 w467 s468 mod469)) tmp474) (syntax-violation #f "source
expression failed to match any pattern" tmp473))) ($sc-dispatch tmp473 (quote
(any any . each-any))))) e465) (if (memv t470 (quote (local-syntax-form)))
(chi-local-syntax153 value464 e465 r466 w467 s468 mod469 chi-sequence141) (if
(memv t470 (quote (eval-when-form))) ((lambda (tmp479) ((lambda (tmp480) (if
tmp480 (apply (lambda (_481 x482 e1483 e2484) (let ((when-list485
(chi-when-list144 e465 x482 w467))) (if (memq (quote eval) when-list485)
(chi-sequence141 (cons e1483 e2484) r466 w467 s468 mod469) (chi-void155))))
tmp480) (syntax-violation #f "source expression failed to match any pattern"
tmp479))) ($sc-dispatch tmp479 (quote (any each-any any . each-any))))) e465)
(if (memv t470 (quote (define-form define-syntax-form))) (syntax-violation #f
"definition in expression context" e465 (wrap139 value464 w467 mod469)) (if
(memv t470 (quote (syntax))) (syntax-violation #f "reference to pattern
variable outside syntax form" (source-wrap140 e465 w467 s468 mod469)) (if (memv
t470 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier
outside its scope" (source-wrap140 e465 w467 s468 mod469)) (syntax-violation #f
"unexpected syntax" (source-wrap140 e465 w467 s468 mod469)))))))))))))))))))
(chi147 (lambda (e488 r489 w490 mod491) (call-with-values (lambda ()
(syntax-type145 e488 r489 w490 #f #f mod491)) (lambda (type492 value493 e494
w495 s496 mod497) (chi-expr148 type492 value493 e494 r489 w495 s496 mod497)))))
(chi-top146 (lambda (e498 r499 w500 m501 esew502 mod503) (call-with-values
(lambda () (syntax-type145 e498 r499 w500 #f #f mod503)) (lambda (type511
value512 e513 w514 s515 mod516) (let ((t517 type511)) (if (memv t517 (quote
(begin-form))) ((lambda (tmp518) ((lambda (tmp519) (if tmp519 (apply (lambda
(_520) (chi-void155)) tmp519) ((lambda (tmp521) (if tmp521 (apply (lambda (_522
e1523 e2524) (chi-top-sequence142 (cons e1523 e2524) r499 w514 s515 m501
esew502 mod516)) tmp521) (syntax-violation #f "source expression failed to
match any pattern" tmp518))) ($sc-dispatch tmp518 (quote (any any .
each-any)))))) ($sc-dispatch tmp518 (quote (any))))) e513) (if (memv t517
(quote (local-syntax-form))) (chi-local-syntax153 value512 e513 r499 w514 s515
mod516 (lambda (body526 r527 w528 s529 mod530) (chi-top-sequence142 body526
r527 w528 s529 m501 esew502 mod530))) (if (memv t517 (quote (eval-when-form)))
((lambda (tmp531) ((lambda (tmp532) (if tmp532 (apply (lambda (_533 x534 e1535
e2536) (let ((when-list537 (chi-when-list144 e513 x534 w514)) (body538 (cons
e1535 e2536))) (cond ((eq? m501 (quote e)) (if (memq (quote eval) when-list537)
(chi-top-sequence142 body538 r499 w514 s515 (quote e) (quote (eval)) mod516)
(chi-void155))) ((memq (quote load) when-list537) (if (or (memq (quote compile)
when-list537) (and (eq? m501 (quote c&e)) (memq (quote eval) when-list537)))
(chi-top-sequence142 body538 r499 w514 s515 (quote c&e) (quote (compile load))
mod516) (if (memq m501 (quote (c c&e))) (chi-top-sequence142 body538 r499 w514
s515 (quote c) (quote (load)) mod516) (chi-void155)))) ((or (memq (quote
compile) when-list537) (and (eq? m501 (quote c&e)) (memq (quote eval)
when-list537))) (top-level-eval-hook75 (chi-top-sequence142 body538 r499 w514
s515 (quote e) (quote (eval)) mod516) mod516) (chi-void155)) (else
(chi-void155))))) tmp532) (syntax-violation #f "source expression failed to
match any pattern" tmp531))) ($sc-dispatch tmp531 (quote (any each-any any .
each-any))))) e513) (if (memv t517 (quote (define-syntax-form))) (let ((n541
(id-var-name133 value512 w514)) (r542 (macros-only-env107 r499))) (let ((t543
m501)) (if (memv t543 (quote (c))) (if (memq (quote compile) esew502) (let
((e544 (chi-install-global143 n541 (chi147 e513 r542 w514 mod516)))) (begin
(top-level-eval-hook75 e544 mod516) (if (memq (quote load) esew502) e544
(chi-void155)))) (if (memq (quote load) esew502) (chi-install-global143 n541
(chi147 e513 r542 w514 mod516)) (chi-void155))) (if (memv t543 (quote (c&e)))
(let ((e545 (chi-install-global143 n541 (chi147 e513 r542 w514 mod516))))
(begin (top-level-eval-hook75 e545 mod516) e545)) (begin (if (memq (quote eval)
esew502) (top-level-eval-hook75 (chi-install-global143 n541 (chi147 e513 r542
w514 mod516)) mod516)) (chi-void155)))))) (if (memv t517 (quote (define-form)))
(let ((n546 (id-var-name133 value512 w514))) (let ((type547 (binding-type103
(lookup108 n546 r499 mod516)))) (let ((t548 type547)) (if (memv t548 (quote
(global core macro module-ref))) (let ((x549 (build-global-definition86 s515
n546 (chi147 e513 r499 w514 mod516)))) (begin (if (eq? m501 (quote c&e))
(top-level-eval-hook75 x549 mod516)) x549)) (if (memv t548 (quote
(displaced-lexical))) (syntax-violation #f "identifier out of context" e513
(wrap139 value512 w514 mod516)) (syntax-violation #f "cannot define keyword at
top level" e513 (wrap139 value512 w514 mod516))))))) (let ((x550 (chi-expr148
type511 value512 e513 r499 w514 s515 mod516))) (begin (if (eq? m501 (quote
c&e)) (top-level-eval-hook75 x550 mod516)) x550)))))))))))) (syntax-type145
(lambda (e551 r552 w553 s554 rib555 mod556) (cond ((symbol? e551) (let ((n557
(id-var-name133 e551 w553))) (let ((b558 (lookup108 n557 r552 mod556))) (let
((type559 (binding-type103 b558))) (let ((t560 type559)) (if (memv t560 (quote
(lexical))) (values type559 (binding-value104 b558) e551 w553 s554 mod556) (if
(memv t560 (quote (global))) (values type559 n557 e551 w553 s554 mod556) (if
(memv t560 (quote (macro))) (syntax-type145 (chi-macro150 (binding-value104
b558) e551 r552 w553 rib555 mod556) r552 (quote (())) s554 rib555 mod556)
(values type559 (binding-value104 b558) e551 w553 s554 mod556))))))))) ((pair?
e551) (let ((first561 (car e551))) (if (id?111 first561) (let ((n562
(id-var-name133 first561 w553))) (let ((b563 (lookup108 n562 r552 (or (and
(syntax-object?95 first561) (syntax-object-module98 first561)) mod556)))) (let
((type564 (binding-type103 b563))) (let ((t565 type564)) (if (memv t565 (quote
(lexical))) (values (quote lexical-call) (binding-value104 b563) e551 w553 s554
mod556) (if (memv t565 (quote (global))) (values (quote global-call) n562 e551
w553 s554 mod556) (if (memv t565 (quote (macro))) (syntax-type145 (chi-macro150
(binding-value104 b563) e551 r552 w553 rib555 mod556) r552 (quote (())) s554
rib555 mod556) (if (memv t565 (quote (core external-macro module-ref))) (values
type564 (binding-value104 b563) e551 w553 s554 mod556) (if (memv t565 (quote
(local-syntax))) (values (quote local-syntax-form) (binding-value104 b563) e551
w553 s554 mod556) (if (memv t565 (quote (begin))) (values (quote begin-form) #f
e551 w553 s554 mod556) (if (memv t565 (quote (eval-when))) (values (quote
eval-when-form) #f e551 w553 s554 mod556) (if (memv t565 (quote (define)))
((lambda (tmp566) ((lambda (tmp567) (if (if tmp567 (apply (lambda (_568 name569
val570) (id?111 name569)) tmp567) #f) (apply (lambda (_571 name572 val573)
(values (quote define-form) name572 val573 w553 s554 mod556)) tmp567) ((lambda
(tmp574) (if (if tmp574 (apply (lambda (_575 name576 args577 e1578 e2579) (and
(id?111 name576) (valid-bound-ids?136 (lambda-var-list160 args577)))) tmp574)
#f) (apply (lambda (_580 name581 args582 e1583 e2584) (values (quote
define-form) (wrap139 name581 w553 mod556) (cons (quote #(syntax-object lambda
((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i"
"i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("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 #(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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) (wrap139 (cons args582 (cons e1583 e2584)) w553
mod556)) (quote (())) s554 mod556)) tmp574) ((lambda (tmp586) (if (if tmp586
(apply (lambda (_587 name588) (id?111 name588)) tmp586) #f) (apply (lambda
(_589 name590) (values (quote define-form) (wrap139 name590 w553 mod556) (quote
(#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("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 #(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
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("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 #(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
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("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 #(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
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)))) (quote (())) s554 mod556)) 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))))) e551) (if (memv
t565 (quote (define-syntax))) ((lambda (tmp591) ((lambda (tmp592) (if (if
tmp592 (apply (lambda (_593 name594 val595) (id?111 name594)) tmp592) #f)
(apply (lambda (_596 name597 val598) (values (quote define-syntax-form) name597
val598 w553 s554 mod556)) tmp592) (syntax-violation #f "source expression
failed to match any pattern" tmp591))) ($sc-dispatch tmp591 (quote (any any
any))))) e551) (values (quote call) #f e551 w553 s554 mod556))))))))))))))
(values (quote call) #f e551 w553 s554 mod556)))) ((syntax-object?95 e551)
(syntax-type145 (syntax-object-expression96 e551) r552 (join-wraps130 w553
(syntax-object-wrap97 e551)) #f rib555 (or (syntax-object-module98 e551)
mod556))) ((annotation? e551) (syntax-type145 (annotation-expression e551) r552
w553 (annotation-source e551) rib555 mod556)) ((self-evaluating? e551) (values
(quote constant) #f e551 w553 s554 mod556)) (else (values (quote other) #f e551
w553 s554 mod556))))) (chi-when-list144 (lambda (e599 when-list600 w601)
(letrec ((f602 (lambda (when-list603 situations604) (if (null? when-list603)
situations604 (f602 (cdr when-list603) (cons (let ((x605 (car when-list603)))
(cond ((free-id=?134 x605 (quote #(syntax-object compile ((top) #(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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote compile)) ((free-id=?134 x605 (quote
#(syntax-object load ((top) #(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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote load)) ((free-id=?134 x605 (quote
#(syntax-object eval ((top) #(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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote
eval-when) "invalid situation" e599 (wrap139 x605 w601 #f)))))
situations604)))))) (f602 when-list600 (quote ()))))) (chi-install-global143
(lambda (name606 e607) (build-global-definition86 #f name606 (if (let ((v608
(module-variable (current-module) name606))) (and v608 (variable-bound? v608)
(macro? (variable-ref v608)) (not (eq? (macro-type (variable-ref v608)) (quote
syncase-macro))))) (build-application79 #f (build-primref88 #f (quote
make-extended-syncase-macro)) (list (build-application79 #f (build-primref88 #f
(quote module-ref)) (list (build-application79 #f (quote current-module) (quote
())) (build-data89 #f name606))) (build-data89 #f (quote macro)) e607))
(build-application79 #f (build-primref88 #f (quote make-syncase-macro)) (list
(build-data89 #f (quote macro)) e607)))))) (chi-top-sequence142 (lambda
(body609 r610 w611 s612 m613 esew614 mod615) (build-sequence90 s612 (letrec
((dobody616 (lambda (body617 r618 w619 m620 esew621 mod622) (if (null? body617)
(quote ()) (let ((first623 (chi-top146 (car body617) r618 w619 m620 esew621
mod622))) (cons first623 (dobody616 (cdr body617) r618 w619 m620 esew621
mod622))))))) (dobody616 body609 r610 w611 m613 esew614 mod615)))))
(chi-sequence141 (lambda (body624 r625 w626 s627 mod628) (build-sequence90 s627
(letrec ((dobody629 (lambda (body630 r631 w632 mod633) (if (null? body630)
(quote ()) (let ((first634 (chi147 (car body630) r631 w632 mod633))) (cons
first634 (dobody629 (cdr body630) r631 w632 mod633))))))) (dobody629 body624
r625 w626 mod628))))) (source-wrap140 (lambda (x635 w636 s637 defmod638)
(wrap139 (if s637 (make-annotation x635 s637 #f) x635) w636 defmod638)))
(wrap139 (lambda (x639 w640 defmod641) (cond ((and (null? (wrap-marks114 w640))
(null? (wrap-subst115 w640))) x639) ((syntax-object?95 x639)
(make-syntax-object94 (syntax-object-expression96 x639) (join-wraps130 w640
(syntax-object-wrap97 x639)) (syntax-object-module98 x639))) ((null? x639)
x639) (else (make-syntax-object94 x639 w640 defmod641))))) (bound-id-member?138
(lambda (x642 list643) (and (not (null? list643)) (or (bound-id=?135 x642 (car
list643)) (bound-id-member?138 x642 (cdr list643)))))) (distinct-bound-ids?137
(lambda (ids644) (letrec ((distinct?645 (lambda (ids646) (or (null? ids646)
(and (not (bound-id-member?138 (car ids646) (cdr ids646))) (distinct?645 (cdr
ids646))))))) (distinct?645 ids644)))) (valid-bound-ids?136 (lambda (ids647)
(and (letrec ((all-ids?648 (lambda (ids649) (or (null? ids649) (and (id?111
(car ids649)) (all-ids?648 (cdr ids649))))))) (all-ids?648 ids647))
(distinct-bound-ids?137 ids647)))) (bound-id=?135 (lambda (i650 j651) (if (and
(syntax-object?95 i650) (syntax-object?95 j651)) (and (eq? (let ((e652
(syntax-object-expression96 i650))) (if (annotation? e652)
(annotation-expression e652) e652)) (let ((e653 (syntax-object-expression96
j651))) (if (annotation? e653) (annotation-expression e653) e653)))
(same-marks?132 (wrap-marks114 (syntax-object-wrap97 i650)) (wrap-marks114
(syntax-object-wrap97 j651)))) (eq? (let ((e654 i650)) (if (annotation? e654)
(annotation-expression e654) e654)) (let ((e655 j651)) (if (annotation? e655)
(annotation-expression e655) e655)))))) (free-id=?134 (lambda (i656 j657) (and
(eq? (let ((x658 i656)) (let ((e659 (if (syntax-object?95 x658)
(syntax-object-expression96 x658) x658))) (if (annotation? e659)
(annotation-expression e659) e659))) (let ((x660 j657)) (let ((e661 (if
(syntax-object?95 x660) (syntax-object-expression96 x660) x660))) (if
(annotation? e661) (annotation-expression e661) e661)))) (eq? (id-var-name133
i656 (quote (()))) (id-var-name133 j657 (quote (()))))))) (id-var-name133
(lambda (id662 w663) (letrec ((search-vector-rib666 (lambda (sym672 subst673
marks674 symnames675 ribcage676) (let ((n677 (vector-length symnames675)))
(letrec ((f678 (lambda (i679) (cond ((fx=73 i679 n677) (search664 sym672 (cdr
subst673) marks674)) ((and (eq? (vector-ref symnames675 i679) sym672)
(same-marks?132 marks674 (vector-ref (ribcage-marks121 ribcage676) i679)))
(values (vector-ref (ribcage-labels122 ribcage676) i679) marks674)) (else (f678
(fx+71 i679 1))))))) (f678 0))))) (search-list-rib665 (lambda (sym680 subst681
marks682 symnames683 ribcage684) (letrec ((f685 (lambda (symnames686 i687)
(cond ((null? symnames686) (search664 sym680 (cdr subst681) marks682)) ((and
(eq? (car symnames686) sym680) (same-marks?132 marks682 (list-ref
(ribcage-marks121 ribcage684) i687))) (values (list-ref (ribcage-labels122
ribcage684) i687) marks682)) (else (f685 (cdr symnames686) (fx+71 i687 1)))))))
(f685 symnames683 0)))) (search664 (lambda (sym688 subst689 marks690) (if
(null? subst689) (values #f marks690) (let ((fst691 (car subst689))) (if (eq?
fst691 (quote shift)) (search664 sym688 (cdr subst689) (cdr marks690)) (let
((symnames692 (ribcage-symnames120 fst691))) (if (vector? symnames692)
(search-vector-rib666 sym688 subst689 marks690 symnames692 fst691)
(search-list-rib665 sym688 subst689 marks690 symnames692 fst691))))))))) (cond
((symbol? id662) (or (call-with-values (lambda () (search664 id662
(wrap-subst115 w663) (wrap-marks114 w663))) (lambda (x694 . ignore693) x694))
id662)) ((syntax-object?95 id662) (let ((id695 (let ((e697
(syntax-object-expression96 id662))) (if (annotation? e697)
(annotation-expression e697) e697))) (w1696 (syntax-object-wrap97 id662))) (let
((marks698 (join-marks131 (wrap-marks114 w663) (wrap-marks114 w1696))))
(call-with-values (lambda () (search664 id695 (wrap-subst115 w663) marks698))
(lambda (new-id699 marks700) (or new-id699 (call-with-values (lambda ()
(search664 id695 (wrap-subst115 w1696) marks700)) (lambda (x702 . ignore701)
x702)) id695)))))) ((annotation? id662) (let ((id703 (let ((e704 id662)) (if
(annotation? e704) (annotation-expression e704) e704)))) (or (call-with-values
(lambda () (search664 id703 (wrap-subst115 w663) (wrap-marks114 w663))) (lambda
(x706 . ignore705) x706)) id703))) (else (syntax-violation (quote id-var-name)
"invalid id" id662)))))) (same-marks?132 (lambda (x707 y708) (or (eq? x707
y708) (and (not (null? x707)) (not (null? y708)) (eq? (car x707) (car y708))
(same-marks?132 (cdr x707) (cdr y708)))))) (join-marks131 (lambda (m1709 m2710)
(smart-append129 m1709 m2710))) (join-wraps130 (lambda (w1711 w2712) (let
((m1713 (wrap-marks114 w1711)) (s1714 (wrap-subst115 w1711))) (if (null? m1713)
(if (null? s1714) w2712 (make-wrap113 (wrap-marks114 w2712) (smart-append129
s1714 (wrap-subst115 w2712)))) (make-wrap113 (smart-append129 m1713
(wrap-marks114 w2712)) (smart-append129 s1714 (wrap-subst115 w2712)))))))
(smart-append129 (lambda (m1715 m2716) (if (null? m2716) m1715 (append m1715
m2716)))) (make-binding-wrap128 (lambda (ids717 labels718 w719) (if (null?
ids717) w719 (make-wrap113 (wrap-marks114 w719) (cons (let ((labelvec720
(list->vector labels718))) (let ((n721 (vector-length labelvec720))) (let
((symnamevec722 (make-vector n721)) (marksvec723 (make-vector n721))) (begin
(letrec ((f724 (lambda (ids725 i726) (if (not (null? ids725)) (call-with-values
(lambda () (id-sym-name&marks112 (car ids725) w719)) (lambda (symname727
marks728) (begin (vector-set! symnamevec722 i726 symname727) (vector-set!
marksvec723 i726 marks728) (f724 (cdr ids725) (fx+71 i726 1))))))))) (f724
ids717 0)) (make-ribcage118 symnamevec722 marksvec723 labelvec720)))))
(wrap-subst115 w719)))))) (extend-ribcage!127 (lambda (ribcage729 id730
label731) (begin (set-ribcage-symnames!123 ribcage729 (cons (let ((e732
(syntax-object-expression96 id730))) (if (annotation? e732)
(annotation-expression e732) e732)) (ribcage-symnames120 ribcage729)))
(set-ribcage-marks!124 ribcage729 (cons (wrap-marks114 (syntax-object-wrap97
id730)) (ribcage-marks121 ribcage729))) (set-ribcage-labels!125 ribcage729
(cons label731 (ribcage-labels122 ribcage729)))))) (anti-mark126 (lambda (w733)
(make-wrap113 (cons #f (wrap-marks114 w733)) (cons (quote shift) (wrap-subst115
w733))))) (set-ribcage-labels!125 (lambda (x734 update735) (vector-set! x734 3
update735))) (set-ribcage-marks!124 (lambda (x736 update737) (vector-set! x736
2 update737))) (set-ribcage-symnames!123 (lambda (x738 update739) (vector-set!
x738 1 update739))) (ribcage-labels122 (lambda (x740) (vector-ref x740 3)))
(ribcage-marks121 (lambda (x741) (vector-ref x741 2))) (ribcage-symnames120
(lambda (x742) (vector-ref x742 1))) (ribcage?119 (lambda (x743) (and (vector?
x743) (= (vector-length x743) 4) (eq? (vector-ref x743 0) (quote ribcage)))))
(make-ribcage118 (lambda (symnames744 marks745 labels746) (vector (quote
ribcage) symnames744 marks745 labels746))) (gen-labels117 (lambda (ls747) (if
(null? ls747) (quote ()) (cons (gen-label116) (gen-labels117 (cdr ls747))))))
(gen-label116 (lambda () (string #\i))) (wrap-subst115 cdr) (wrap-marks114 car)
(make-wrap113 cons) (id-sym-name&marks112 (lambda (x748 w749) (if
(syntax-object?95 x748) (values (let ((e750 (syntax-object-expression96 x748)))
(if (annotation? e750) (annotation-expression e750) e750)) (join-marks131
(wrap-marks114 w749) (wrap-marks114 (syntax-object-wrap97 x748)))) (values (let
((e751 x748)) (if (annotation? e751) (annotation-expression e751) e751))
(wrap-marks114 w749))))) (id?111 (lambda (x752) (cond ((symbol? x752) #t)
((syntax-object?95 x752) (symbol? (let ((e753 (syntax-object-expression96
x752))) (if (annotation? e753) (annotation-expression e753) e753))))
((annotation? x752) (symbol? (annotation-expression x752))) (else #f))))
(nonsymbol-id?110 (lambda (x754) (and (syntax-object?95 x754) (symbol? (let
((e755 (syntax-object-expression96 x754))) (if (annotation? e755)
(annotation-expression e755) e755)))))) (global-extend109 (lambda (type756
sym757 val758) (put-global-definition-hook77 sym757 type756 val758)))
(lookup108 (lambda (x759 r760 mod761) (cond ((assq x759 r760) => cdr) ((symbol?
x759) (or (get-global-definition-hook78 x759 mod761) (quote (global)))) (else
(quote (displaced-lexical)))))) (macros-only-env107 (lambda (r762) (if (null?
r762) (quote ()) (let ((a763 (car r762))) (if (eq? (cadr a763) (quote macro))
(cons a763 (macros-only-env107 (cdr r762))) (macros-only-env107 (cdr
r762))))))) (extend-var-env106 (lambda (labels764 vars765 r766) (if (null?
labels764) r766 (extend-var-env106 (cdr labels764) (cdr vars765) (cons (cons
(car labels764) (cons (quote lexical) (car vars765))) r766))))) (extend-env105
(lambda (labels767 bindings768 r769) (if (null? labels767) r769 (extend-env105
(cdr labels767) (cdr bindings768) (cons (cons (car labels767) (car
bindings768)) r769))))) (binding-value104 cdr) (binding-type103 car)
(source-annotation102 (lambda (x770) (cond ((annotation? x770)
(annotation-source x770)) ((syntax-object?95 x770) (source-annotation102
(syntax-object-expression96 x770))) (else #f)))) (set-syntax-object-module!101
(lambda (x771 update772) (vector-set! x771 3 update772)))
(set-syntax-object-wrap!100 (lambda (x773 update774) (vector-set! x773 2
update774))) (set-syntax-object-expression!99 (lambda (x775 update776)
(vector-set! x775 1 update776))) (syntax-object-module98 (lambda (x777)
(vector-ref x777 3))) (syntax-object-wrap97 (lambda (x778) (vector-ref x778
2))) (syntax-object-expression96 (lambda (x779) (vector-ref x779 1)))
(syntax-object?95 (lambda (x780) (and (vector? x780) (= (vector-length x780) 4)
(eq? (vector-ref x780 0) (quote syntax-object))))) (make-syntax-object94
(lambda (expression781 wrap782 module783) (vector (quote syntax-object)
expression781 wrap782 module783))) (build-letrec93 (lambda (src784 ids785
vars786 val-exps787 body-exp788) (if (null? vars786) body-exp788 (let ((t789
(fluid-ref *mode*70))) (if (memv t789 (quote (c))) ((@ (language tree-il)
make-letrec) src784 ids785 vars786 val-exps787 body-exp788) (list (quote
letrec) (map list vars786 val-exps787) body-exp788)))))) (build-named-let92
(lambda (src790 ids791 vars792 val-exps793 body-exp794) (let ((f795 (car
vars792)) (f-name796 (car ids791)) (vars797 (cdr vars792)) (ids798 (cdr
ids791))) (let ((t799 (fluid-ref *mode*70))) (if (memv t799 (quote (c))) ((@
(language tree-il) make-letrec) src790 (list f-name796) (list f795) (list
(build-lambda87 src790 ids798 vars797 #f body-exp794)) (build-application79
src790 (build-lexical-reference81 (quote fun) src790 f-name796 f795)
val-exps793)) (list (quote let) f795 (map list vars797 val-exps793)
body-exp794)))))) (build-let91 (lambda (src800 ids801 vars802 val-exps803
body-exp804) (if (null? vars802) body-exp804 (let ((t805 (fluid-ref *mode*70)))
(if (memv t805 (quote (c))) ((@ (language tree-il) make-let) src800 ids801
vars802 val-exps803 body-exp804) (list (quote let) (map list vars802
val-exps803) body-exp804)))))) (build-sequence90 (lambda (src806 exps807) (if
(null? (cdr exps807)) (car exps807) (let ((t808 (fluid-ref *mode*70))) (if
(memv t808 (quote (c))) ((@ (language tree-il) make-sequence) src806 exps807)
(cons (quote begin) exps807)))))) (build-data89 (lambda (src809 exp810) (let
((t811 (fluid-ref *mode*70))) (if (memv t811 (quote (c))) ((@ (language
tree-il) make-const) src809 exp810) (if (and (self-evaluating? exp810) (not
(vector? exp810))) exp810 (list (quote quote) exp810)))))) (build-primref88
(lambda (src812 name813) (let ((t814 (fluid-ref *mode*70))) (if (memv t814
(quote (c))) ((@ (language tree-il) make-primitive-ref) src812 name813)
(build-global-reference84 src812 name813 (quote (hygiene guile)))))))
(build-lambda87 (lambda (src815 ids816 vars817 docstring818 exp819) (let ((t820
(fluid-ref *mode*70))) (if (memv t820 (quote (c))) ((@ (language tree-il)
make-lambda) src815 ids816 vars817 (if docstring818 (list (cons (quote
documentation) docstring818)) (quote ())) exp819) (cons (quote lambda) (cons
vars817 (append (if docstring818 (list docstring818) (quote ())) (list
exp819)))))))) (build-global-definition86 (lambda (source821 var822 exp823)
(let ((t824 (fluid-ref *mode*70))) (if (memv t824 (quote (c))) ((@ (language
tree-il) make-toplevel-define) source821 var822 exp823) (list (quote define)
var822 exp823))))) (build-global-assignment85 (lambda (source825 var826 exp827
mod828) (analyze-variable83 mod828 var826 (lambda (mod829 var830 public?831)
(let ((t832 (fluid-ref *mode*70))) (if (memv t832 (quote (c))) ((@ (language
tree-il) make-module-set) source825 mod829 var830 public?831 exp827) (list
(quote set!) (list (if public?831 (quote @) (quote @@)) mod829 var830)
exp827)))) (lambda (var833) (let ((t834 (fluid-ref *mode*70))) (if (memv t834
(quote (c))) ((@ (language tree-il) make-toplevel-set) source825 var833 exp827)
(list (quote set!) var833 exp827))))))) (build-global-reference84 (lambda
(source835 var836 mod837) (analyze-variable83 mod837 var836 (lambda (mod838
var839 public?840) (let ((t841 (fluid-ref *mode*70))) (if (memv t841 (quote
(c))) ((@ (language tree-il) make-module-ref) source835 mod838 var839
public?840) (list (if public?840 (quote @) (quote @@)) mod838 var839))))
(lambda (var842) (let ((t843 (fluid-ref *mode*70))) (if (memv t843 (quote (c)))
((@ (language tree-il) make-toplevel-ref) source835 var842) var842))))))
(analyze-variable83 (lambda (mod844 var845 modref-cont846 bare-cont847) (if
(not mod844) (bare-cont847 var845) (let ((kind848 (car mod844)) (mod849 (cdr
mod844))) (let ((t850 kind848)) (if (memv t850 (quote (public)))
(modref-cont846 mod849 var845 #t) (if (memv t850 (quote (private))) (if (not
(equal? mod849 (module-name (current-module)))) (modref-cont846 mod849 var845
#f) (bare-cont847 var845)) (if (memv t850 (quote (bare))) (bare-cont847 var845)
(if (memv t850 (quote (hygiene))) (if (and (not (equal? mod849 (module-name
(current-module)))) (module-variable (resolve-module mod849) var845))
(modref-cont846 mod849 var845 #f) (bare-cont847 var845)) (syntax-violation #f
"bad module kind" var845 mod849)))))))))) (build-lexical-assignment82 (lambda
(source851 name852 var853 exp854) (let ((t855 (fluid-ref *mode*70))) (if (memv
t855 (quote (c))) ((@ (language tree-il) make-lexical-set) source851 name852
var853 exp854) (list (quote set!) var853 exp854))))) (build-lexical-reference81
(lambda (type856 source857 name858 var859) (let ((t860 (fluid-ref *mode*70)))
(if (memv t860 (quote (c))) ((@ (language tree-il) make-lexical-ref) source857
name858 var859) var859)))) (build-conditional80 (lambda (source861 test-exp862
then-exp863 else-exp864) (let ((t865 (fluid-ref *mode*70))) (if (memv t865
(quote (c))) ((@ (language tree-il) make-conditional) source861 test-exp862
then-exp863 else-exp864) (list (quote if) test-exp862 then-exp863
else-exp864))))) (build-application79 (lambda (source866 fun-exp867
arg-exps868) (let ((t869 (fluid-ref *mode*70))) (if (memv t869 (quote (c))) ((@
(language tree-il) make-application) source866 fun-exp867 arg-exps868) (cons
fun-exp867 arg-exps868))))) (get-global-definition-hook78 (lambda (symbol870
module871) (begin (if (and (not module871) (current-module)) (warn "module
system is booted, we should have a module" symbol870)) (let ((v872
(module-variable (if module871 (resolve-module (cdr module871))
(current-module)) symbol870))) (and v872 (variable-bound? v872) (let ((val873
(variable-ref v872))) (and (macro? val873) (syncase-macro-type val873) (cons
(syncase-macro-type val873) (syncase-macro-binding val873)))))))))
(put-global-definition-hook77 (lambda (symbol874 type875 val876) (let
((existing877 (let ((v878 (module-variable (current-module) symbol874))) (and
v878 (variable-bound? v878) (let ((val879 (variable-ref v878))) (and (macro?
val879) (not (syncase-macro-type val879)) val879)))))) (module-define!
(current-module) symbol874 (if existing877 (make-extended-syncase-macro
existing877 type875 val876) (make-syncase-macro type875 val876))))))
(local-eval-hook76 (lambda (x880 mod881) (primitive-eval (list noexpand69 (let
((t882 (fluid-ref *mode*70))) (if (memv t882 (quote (c))) ((@ (language
tree-il) tree-il->scheme) x880) x880)))))) (top-level-eval-hook75 (lambda (x883
mod884) (primitive-eval (list noexpand69 (let ((t885 (fluid-ref *mode*70))) (if
(memv t885 (quote (c))) ((@ (language tree-il) tree-il->scheme) x883)
x883)))))) (fx<74 <) (fx=73 =) (fx-72 -) (fx+71 +) (*mode*70 (make-fluid))
(noexpand69 "noexpand")) (begin (global-extend109 (quote local-syntax) (quote
letrec-syntax) #t) (global-extend109 (quote local-syntax) (quote let-syntax)
#f) (global-extend109 (quote core) (quote fluid-let-syntax) (lambda (e886 r887
w888 s889 mod890) ((lambda (tmp891) ((lambda (tmp892) (if (if tmp892 (apply
(lambda (_893 var894 val895 e1896 e2897) (valid-bound-ids?136 var894)) tmp892)
#f) (apply (lambda (_899 var900 val901 e1902 e2903) (let ((names904 (map
(lambda (x905) (id-var-name133 x905 w888)) var900))) (begin (for-each (lambda
(id907 n908) (let ((t909 (binding-type103 (lookup108 n908 r887 mod890)))) (if
(memv t909 (quote (displaced-lexical))) (syntax-violation (quote
fluid-let-syntax) "identifier out of context" e886 (source-wrap140 id907 w888
s889 mod890))))) var900 names904) (chi-body151 (cons e1902 e2903)
(source-wrap140 e886 w888 s889 mod890) (extend-env105 names904 (let
((trans-r912 (macros-only-env107 r887))) (map (lambda (x913) (cons (quote
macro) (eval-local-transformer154 (chi147 x913 trans-r912 w888 mod890)
mod890))) val901)) r887) w888 mod890)))) tmp892) ((lambda (_915)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap140 e886
w888 s889 mod890))) tmp891))) ($sc-dispatch tmp891 (quote (any #(each (any
any)) any . each-any))))) e886))) (global-extend109 (quote core) (quote quote)
(lambda (e916 r917 w918 s919 mod920) ((lambda (tmp921) ((lambda (tmp922) (if
tmp922 (apply (lambda (_923 e924) (build-data89 s919 (strip158 e924 w918)))
tmp922) ((lambda (_925) (syntax-violation (quote quote) "bad syntax"
(source-wrap140 e916 w918 s919 mod920))) tmp921))) ($sc-dispatch tmp921 (quote
(any any))))) e916))) (global-extend109 (quote core) (quote syntax) (letrec
((regen933 (lambda (x934) (let ((t935 (car x934))) (if (memv t935 (quote
(ref))) (build-lexical-reference81 (quote value) #f (cadr x934) (cadr x934))
(if (memv t935 (quote (primitive))) (build-primref88 #f (cadr x934)) (if (memv
t935 (quote (quote))) (build-data89 #f (cadr x934)) (if (memv t935 (quote
(lambda))) (build-lambda87 #f (cadr x934) (cadr x934) #f (regen933 (caddr
x934))) (if (memv t935 (quote (map))) (let ((ls936 (map regen933 (cdr x934))))
(build-application79 #f (build-primref88 #f (quote map)) ls936))
(build-application79 #f (build-primref88 #f (car x934)) (map regen933 (cdr
x934))))))))))) (gen-vector932 (lambda (x937) (cond ((eq? (car x937) (quote
list)) (cons (quote vector) (cdr x937))) ((eq? (car x937) (quote quote)) (list
(quote quote) (list->vector (cadr x937)))) (else (list (quote list->vector)
x937))))) (gen-append931 (lambda (x938 y939) (if (equal? y939 (quote (quote
()))) x938 (list (quote append) x938 y939)))) (gen-cons930 (lambda (x940 y941)
(let ((t942 (car y941))) (if (memv t942 (quote (quote))) (if (eq? (car x940)
(quote quote)) (list (quote quote) (cons (cadr x940) (cadr y941))) (if (eq?
(cadr y941) (quote ())) (list (quote list) x940) (list (quote cons) x940
y941))) (if (memv t942 (quote (list))) (cons (quote list) (cons x940 (cdr
y941))) (list (quote cons) x940 y941)))))) (gen-map929 (lambda (e943
map-env944) (let ((formals945 (map cdr map-env944)) (actuals946 (map (lambda
(x947) (list (quote ref) (car x947))) map-env944))) (cond ((eq? (car e943)
(quote ref)) (car actuals946)) ((and-map (lambda (x948) (and (eq? (car x948)
(quote ref)) (memq (cadr x948) formals945))) (cdr e943)) (cons (quote map)
(cons (list (quote primitive) (car e943)) (map (let ((r949 (map cons formals945
actuals946))) (lambda (x950) (cdr (assq (cadr x950) r949)))) (cdr e943)))))
(else (cons (quote map) (cons (list (quote lambda) formals945 e943)
actuals946))))))) (gen-mappend928 (lambda (e951 map-env952) (list (quote apply)
(quote (primitive append)) (gen-map929 e951 map-env952)))) (gen-ref927 (lambda
(src953 var954 level955 maps956) (if (fx=73 level955 0) (values var954 maps956)
(if (null? maps956) (syntax-violation (quote syntax) "missing ellipsis" src953)
(call-with-values (lambda () (gen-ref927 src953 var954 (fx-72 level955 1) (cdr
maps956))) (lambda (outer-var957 outer-maps958) (let ((b959 (assq outer-var957
(car maps956)))) (if b959 (values (cdr b959) maps956) (let ((inner-var960
(gen-var159 (quote tmp)))) (values inner-var960 (cons (cons (cons outer-var957
inner-var960) (car maps956)) outer-maps958))))))))))) (gen-syntax926 (lambda
(src961 e962 r963 maps964 ellipsis?965 mod966) (if (id?111 e962) (let
((label967 (id-var-name133 e962 (quote (()))))) (let ((b968 (lookup108 label967
r963 mod966))) (if (eq? (binding-type103 b968) (quote syntax))
(call-with-values (lambda () (let ((var.lev969 (binding-value104 b968)))
(gen-ref927 src961 (car var.lev969) (cdr var.lev969) maps964))) (lambda (var970
maps971) (values (list (quote ref) var970) maps971))) (if (ellipsis?965 e962)
(syntax-violation (quote syntax) "misplaced ellipsis" src961) (values (list
(quote quote) e962) maps964))))) ((lambda (tmp972) ((lambda (tmp973) (if (if
tmp973 (apply (lambda (dots974 e975) (ellipsis?965 dots974)) tmp973) #f) (apply
(lambda (dots976 e977) (gen-syntax926 src961 e977 r963 maps964 (lambda (x978)
#f) mod966)) tmp973) ((lambda (tmp979) (if (if tmp979 (apply (lambda (x980
dots981 y982) (ellipsis?965 dots981)) tmp979) #f) (apply (lambda (x983 dots984
y985) (letrec ((f986 (lambda (y987 k988) ((lambda (tmp992) ((lambda (tmp993)
(if (if tmp993 (apply (lambda (dots994 y995) (ellipsis?965 dots994)) tmp993)
#f) (apply (lambda (dots996 y997) (f986 y997 (lambda (maps998)
(call-with-values (lambda () (k988 (cons (quote ()) maps998))) (lambda (x999
maps1000) (if (null? (car maps1000)) (syntax-violation (quote syntax) "extra
ellipsis" src961) (values (gen-mappend928 x999 (car maps1000)) (cdr
maps1000)))))))) tmp993) ((lambda (_1001) (call-with-values (lambda ()
(gen-syntax926 src961 y987 r963 maps964 ellipsis?965 mod966)) (lambda (y1002
maps1003) (call-with-values (lambda () (k988 maps1003)) (lambda (x1004
maps1005) (values (gen-append931 x1004 y1002) maps1005)))))) tmp992)))
($sc-dispatch tmp992 (quote (any . any))))) y987)))) (f986 y985 (lambda
(maps989) (call-with-values (lambda () (gen-syntax926 src961 x983 r963 (cons
(quote ()) maps989) ellipsis?965 mod966)) (lambda (x990 maps991) (if (null?
(car maps991)) (syntax-violation (quote syntax) "extra ellipsis" src961)
(values (gen-map929 x990 (car maps991)) (cdr maps991))))))))) tmp979) ((lambda
(tmp1006) (if tmp1006 (apply (lambda (x1007 y1008) (call-with-values (lambda ()
(gen-syntax926 src961 x1007 r963 maps964 ellipsis?965 mod966)) (lambda (x1009
maps1010) (call-with-values (lambda () (gen-syntax926 src961 y1008 r963
maps1010 ellipsis?965 mod966)) (lambda (y1011 maps1012) (values (gen-cons930
x1009 y1011) maps1012)))))) tmp1006) ((lambda (tmp1013) (if tmp1013 (apply
(lambda (e11014 e21015) (call-with-values (lambda () (gen-syntax926 src961
(cons e11014 e21015) r963 maps964 ellipsis?965 mod966)) (lambda (e1017
maps1018) (values (gen-vector932 e1017) maps1018)))) tmp1013) ((lambda (_1019)
(values (list (quote quote) e962) maps964)) tmp972))) ($sc-dispatch tmp972
(quote #(vector (any . each-any))))))) ($sc-dispatch tmp972 (quote (any .
any)))))) ($sc-dispatch tmp972 (quote (any any . any)))))) ($sc-dispatch tmp972
(quote (any any))))) e962))))) (lambda (e1020 r1021 w1022 s1023 mod1024) (let
((e1025 (source-wrap140 e1020 w1022 s1023 mod1024))) ((lambda (tmp1026)
((lambda (tmp1027) (if tmp1027 (apply (lambda (_1028 x1029) (call-with-values
(lambda () (gen-syntax926 e1025 x1029 r1021 (quote ()) ellipsis?156 mod1024))
(lambda (e1030 maps1031) (regen933 e1030)))) tmp1027) ((lambda (_1032)
(syntax-violation (quote syntax) "bad `syntax' form" e1025)) tmp1026)))
($sc-dispatch tmp1026 (quote (any any))))) e1025))))) (global-extend109 (quote
core) (quote lambda) (lambda (e1033 r1034 w1035 s1036 mod1037) ((lambda
(tmp1038) ((lambda (tmp1039) (if tmp1039 (apply (lambda (_1040 c1041)
(chi-lambda-clause152 (source-wrap140 e1033 w1035 s1036 mod1037) #f c1041 r1034
w1035 mod1037 (lambda (names1042 vars1043 docstring1044 body1045)
(build-lambda87 s1036 names1042 vars1043 docstring1044 body1045)))) tmp1039)
(syntax-violation #f "source expression failed to match any pattern" tmp1038)))
($sc-dispatch tmp1038 (quote (any . any))))) e1033))) (global-extend109 (quote
core) (quote let) (letrec ((chi-let1046 (lambda (e1047 r1048 w1049 s1050
mod1051 constructor1052 ids1053 vals1054 exps1055) (if (not
(valid-bound-ids?136 ids1053)) (syntax-violation (quote let) "duplicate bound
variable" e1047) (let ((labels1056 (gen-labels117 ids1053)) (new-vars1057 (map
gen-var159 ids1053))) (let ((nw1058 (make-binding-wrap128 ids1053 labels1056
w1049)) (nr1059 (extend-var-env106 labels1056 new-vars1057 r1048)))
(constructor1052 s1050 (map syntax->datum ids1053) new-vars1057 (map (lambda
(x1060) (chi147 x1060 r1048 w1049 mod1051)) vals1054) (chi-body151 exps1055
(source-wrap140 e1047 nw1058 s1050 mod1051) nr1059 nw1058 mod1051))))))))
(lambda (e1061 r1062 w1063 s1064 mod1065) ((lambda (tmp1066) ((lambda (tmp1067)
(if tmp1067 (apply (lambda (_1068 id1069 val1070 e11071 e21072) (chi-let1046
e1061 r1062 w1063 s1064 mod1065 build-let91 id1069 val1070 (cons e11071
e21072))) tmp1067) ((lambda (tmp1076) (if (if tmp1076 (apply (lambda (_1077
f1078 id1079 val1080 e11081 e21082) (id?111 f1078)) tmp1076) #f) (apply (lambda
(_1083 f1084 id1085 val1086 e11087 e21088) (chi-let1046 e1061 r1062 w1063 s1064
mod1065 build-named-let92 (cons f1084 id1085) val1086 (cons e11087 e21088)))
tmp1076) ((lambda (_1092) (syntax-violation (quote let) "bad let"
(source-wrap140 e1061 w1063 s1064 mod1065))) tmp1066))) ($sc-dispatch tmp1066
(quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1066
(quote (any #(each (any any)) any . each-any))))) e1061)))) (global-extend109
(quote core) (quote letrec) (lambda (e1093 r1094 w1095 s1096 mod1097) ((lambda
(tmp1098) ((lambda (tmp1099) (if tmp1099 (apply (lambda (_1100 id1101 val1102
e11103 e21104) (let ((ids1105 id1101)) (if (not (valid-bound-ids?136 ids1105))
(syntax-violation (quote letrec) "duplicate bound variable" e1093) (let
((labels1107 (gen-labels117 ids1105)) (new-vars1108 (map gen-var159 ids1105)))
(let ((w1109 (make-binding-wrap128 ids1105 labels1107 w1095)) (r1110
(extend-var-env106 labels1107 new-vars1108 r1094))) (build-letrec93 s1096 (map
syntax->datum ids1105) new-vars1108 (map (lambda (x1111) (chi147 x1111 r1110
w1109 mod1097)) val1102) (chi-body151 (cons e11103 e21104) (source-wrap140
e1093 w1109 s1096 mod1097) r1110 w1109 mod1097))))))) tmp1099) ((lambda (_1114)
(syntax-violation (quote letrec) "bad letrec" (source-wrap140 e1093 w1095 s1096
mod1097))) tmp1098))) ($sc-dispatch tmp1098 (quote (any #(each (any any)) any .
each-any))))) e1093))) (global-extend109 (quote core) (quote set!) (lambda
(e1115 r1116 w1117 s1118 mod1119) ((lambda (tmp1120) ((lambda (tmp1121) (if (if
tmp1121 (apply (lambda (_1122 id1123 val1124) (id?111 id1123)) tmp1121) #f)
(apply (lambda (_1125 id1126 val1127) (let ((val1128 (chi147 val1127 r1116
w1117 mod1119)) (n1129 (id-var-name133 id1126 w1117))) (let ((b1130 (lookup108
n1129 r1116 mod1119))) (let ((t1131 (binding-type103 b1130))) (if (memv t1131
(quote (lexical))) (build-lexical-assignment82 s1118 (syntax->datum id1126)
(binding-value104 b1130) val1128) (if (memv t1131 (quote (global)))
(build-global-assignment85 s1118 n1129 val1128 mod1119) (if (memv t1131 (quote
(displaced-lexical))) (syntax-violation (quote set!) "identifier out of
context" (wrap139 id1126 w1117 mod1119)) (syntax-violation (quote set!) "bad
set!" (source-wrap140 e1115 w1117 s1118 mod1119))))))))) tmp1121) ((lambda
(tmp1132) (if tmp1132 (apply (lambda (_1133 head1134 tail1135 val1136)
(call-with-values (lambda () (syntax-type145 head1134 r1116 (quote (())) #f #f
mod1119)) (lambda (type1137 value1138 ee1139 ww1140 ss1141 modmod1142) (let
((t1143 type1137)) (if (memv t1143 (quote (module-ref))) (let ((val1144 (chi147
val1136 r1116 w1117 mod1119))) (call-with-values (lambda () (value1138 (cons
head1134 tail1135))) (lambda (id1146 mod1147) (build-global-assignment85 s1118
id1146 val1144 mod1147)))) (build-application79 s1118 (chi147 (list (quote
#(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top))
#("i")) #(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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) head1134) r1116 w1117 mod1119) (map (lambda (e1148)
(chi147 e1148 r1116 w1117 mod1119)) (append tail1135 (list val1136)))))))))
tmp1132) ((lambda (_1150) (syntax-violation (quote set!) "bad set!"
(source-wrap140 e1115 w1117 s1118 mod1119))) tmp1120))) ($sc-dispatch tmp1120
(quote (any (any . each-any) any)))))) ($sc-dispatch tmp1120 (quote (any any
any))))) e1115))) (global-extend109 (quote module-ref) (quote @) (lambda
(e1151) ((lambda (tmp1152) ((lambda (tmp1153) (if (if tmp1153 (apply (lambda
(_1154 mod1155 id1156) (and (and-map id?111 mod1155) (id?111 id1156))) tmp1153)
#f) (apply (lambda (_1158 mod1159 id1160) (values (syntax->datum id1160)
(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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) mod1159)))) tmp1153) (syntax-violation #f "source
expression failed to match any pattern" tmp1152))) ($sc-dispatch tmp1152 (quote
(any each-any any))))) e1151))) (global-extend109 (quote module-ref) (quote @@)
(lambda (e1162) ((lambda (tmp1163) ((lambda (tmp1164) (if (if tmp1164 (apply
(lambda (_1165 mod1166 id1167) (and (and-map id?111 mod1166) (id?111 id1167)))
tmp1164) #f) (apply (lambda (_1169 mod1170 id1171) (values (syntax->datum
id1171) (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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) mod1170)))) tmp1164) (syntax-violation #f "source
expression failed to match any pattern" tmp1163))) ($sc-dispatch tmp1163 (quote
(any each-any any))))) e1162))) (global-extend109 (quote begin) (quote begin)
(quote ())) (global-extend109 (quote define) (quote define) (quote ()))
(global-extend109 (quote define-syntax) (quote define-syntax) (quote ()))
(global-extend109 (quote eval-when) (quote eval-when) (quote ()))
(global-extend109 (quote core) (quote syntax-case) (letrec
((gen-syntax-case1176 (lambda (x1177 keys1178 clauses1179 r1180 mod1181) (if
(null? clauses1179) (build-application79 #f (build-primref88 #f (quote
syntax-violation)) (list #f "source expression failed to match any pattern"
x1177)) ((lambda (tmp1182) ((lambda (tmp1183) (if tmp1183 (apply (lambda
(pat1184 exp1185) (if (and (id?111 pat1184) (and-map (lambda (x1186) (not
(free-id=?134 pat1184 x1186))) (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 get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) keys1178))) (let ((labels1187 (list (gen-label116)))
(var1188 (gen-var159 pat1184))) (build-application79 #f (build-lambda87 #f
(list (syntax->datum pat1184)) (list var1188) #f (chi147 exp1185 (extend-env105
labels1187 (list (cons (quote syntax) (cons var1188 0))) r1180)
(make-binding-wrap128 (list pat1184) labels1187 (quote (()))) mod1181)) (list
x1177))) (gen-clause1175 x1177 keys1178 (cdr clauses1179) r1180 pat1184 #t
exp1185 mod1181))) tmp1183) ((lambda (tmp1189) (if tmp1189 (apply (lambda
(pat1190 fender1191 exp1192) (gen-clause1175 x1177 keys1178 (cdr clauses1179)
r1180 pat1190 fender1191 exp1192 mod1181)) tmp1189) ((lambda (_1193)
(syntax-violation (quote syntax-case) "invalid clause" (car clauses1179)))
tmp1182))) ($sc-dispatch tmp1182 (quote (any any any)))))) ($sc-dispatch
tmp1182 (quote (any any))))) (car clauses1179))))) (gen-clause1175 (lambda
(x1194 keys1195 clauses1196 r1197 pat1198 fender1199 exp1200 mod1201)
(call-with-values (lambda () (convert-pattern1173 pat1198 keys1195)) (lambda
(p1202 pvars1203) (cond ((not (distinct-bound-ids?137 (map car pvars1203)))
(syntax-violation (quote syntax-case) "duplicate pattern variable" pat1198))
((not (and-map (lambda (x1204) (not (ellipsis?156 (car x1204)))) pvars1203))
(syntax-violation (quote syntax-case) "misplaced ellipsis" pat1198)) (else (let
((y1205 (gen-var159 (quote tmp)))) (build-application79 #f (build-lambda87 #f
(list (quote tmp)) (list y1205) #f (let ((y1206 (build-lexical-reference81
(quote value) #f (quote tmp) y1205))) (build-conditional80 #f ((lambda
(tmp1207) ((lambda (tmp1208) (if tmp1208 (apply (lambda () y1206) tmp1208)
((lambda (_1209) (build-conditional80 #f y1206 (build-dispatch-call1174
pvars1203 fender1199 y1206 r1197 mod1201) (build-data89 #f #f))) tmp1207)))
($sc-dispatch tmp1207 (quote #(atom #t))))) fender1199)
(build-dispatch-call1174 pvars1203 exp1200 y1206 r1197 mod1201)
(gen-syntax-case1176 x1194 keys1195 clauses1196 r1197 mod1201)))) (list (if
(eq? p1202 (quote any)) (build-application79 #f (build-primref88 #f (quote
list)) (list x1194)) (build-application79 #f (build-primref88 #f (quote
$sc-dispatch)) (list x1194 (build-data89 #f p1202)))))))))))))
(build-dispatch-call1174 (lambda (pvars1210 exp1211 y1212 r1213 mod1214) (let
((ids1215 (map car pvars1210)) (levels1216 (map cdr pvars1210))) (let
((labels1217 (gen-labels117 ids1215)) (new-vars1218 (map gen-var159 ids1215)))
(build-application79 #f (build-primref88 #f (quote apply)) (list
(build-lambda87 #f (map syntax->datum ids1215) new-vars1218 #f (chi147 exp1211
(extend-env105 labels1217 (map (lambda (var1219 level1220) (cons (quote syntax)
(cons var1219 level1220))) new-vars1218 (map cdr pvars1210)) r1213)
(make-binding-wrap128 ids1215 labels1217 (quote (()))) mod1214)) y1212))))))
(convert-pattern1173 (lambda (pattern1221 keys1222) (letrec ((cvt1223 (lambda
(p1224 n1225 ids1226) (if (id?111 p1224) (if (bound-id-member?138 p1224
keys1222) (values (vector (quote free-id) p1224) ids1226) (values (quote any)
(cons (cons p1224 n1225) ids1226))) ((lambda (tmp1227) ((lambda (tmp1228) (if
(if tmp1228 (apply (lambda (x1229 dots1230) (ellipsis?156 dots1230)) tmp1228)
#f) (apply (lambda (x1231 dots1232) (call-with-values (lambda () (cvt1223 x1231
(fx+71 n1225 1) ids1226)) (lambda (p1233 ids1234) (values (if (eq? p1233 (quote
any)) (quote each-any) (vector (quote each) p1233)) ids1234)))) tmp1228)
((lambda (tmp1235) (if tmp1235 (apply (lambda (x1236 y1237) (call-with-values
(lambda () (cvt1223 y1237 n1225 ids1226)) (lambda (y1238 ids1239)
(call-with-values (lambda () (cvt1223 x1236 n1225 ids1239)) (lambda (x1240
ids1241) (values (cons x1240 y1238) ids1241)))))) tmp1235) ((lambda (tmp1242)
(if tmp1242 (apply (lambda () (values (quote ()) ids1226)) tmp1242) ((lambda
(tmp1243) (if tmp1243 (apply (lambda (x1244) (call-with-values (lambda ()
(cvt1223 x1244 n1225 ids1226)) (lambda (p1246 ids1247) (values (vector (quote
vector) p1246) ids1247)))) tmp1243) ((lambda (x1248) (values (vector (quote
atom) (strip158 p1224 (quote (())))) ids1226)) tmp1227))) ($sc-dispatch tmp1227
(quote #(vector each-any)))))) ($sc-dispatch tmp1227 (quote ())))))
($sc-dispatch tmp1227 (quote (any . any)))))) ($sc-dispatch tmp1227 (quote (any
any))))) p1224))))) (cvt1223 pattern1221 0 (quote ())))))) (lambda (e1249 r1250
w1251 s1252 mod1253) (let ((e1254 (source-wrap140 e1249 w1251 s1252 mod1253)))
((lambda (tmp1255) ((lambda (tmp1256) (if tmp1256 (apply (lambda (_1257 val1258
key1259 m1260) (if (and-map (lambda (x1261) (and (id?111 x1261) (not
(ellipsis?156 x1261)))) key1259) (let ((x1263 (gen-var159 (quote tmp))))
(build-application79 s1252 (build-lambda87 #f (list (quote tmp)) (list x1263)
#f (gen-syntax-case1176 (build-lexical-reference81 (quote value) #f (quote tmp)
x1263) key1259 m1260 r1250 mod1253)) (list (chi147 val1258 r1250 (quote (()))
mod1253)))) (syntax-violation (quote syntax-case) "invalid literals list"
e1254))) tmp1256) (syntax-violation #f "source expression failed to match any
pattern" tmp1255))) ($sc-dispatch tmp1255 (quote (any any each-any .
each-any))))) e1254))))) (set! sc-expand (lambda (x1267 . rest1266) (if (and
(pair? x1267) (equal? (car x1267) noexpand69)) (cadr x1267) (let ((m1268 (if
(null? rest1266) (quote e) (car rest1266))) (esew1269 (if (or (null? rest1266)
(null? (cdr rest1266))) (quote (eval)) (cadr rest1266)))) (with-fluid* *mode*70
m1268 (lambda () (chi-top146 x1267 (quote ()) (quote ((top))) m1268 esew1269
(cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier?
(lambda (x1270) (nonsymbol-id?110 x1270))) (set! datum->syntax (lambda (id1271
datum1272) (make-syntax-object94 datum1272 (syntax-object-wrap97 id1271) #f)))
(set! syntax->datum (lambda (x1273) (strip158 x1273 (quote (()))))) (set!
generate-temporaries (lambda (ls1274) (begin (let ((x1275 ls1274)) (if (not
(list? x1275)) (syntax-violation (quote generate-temporaries) "invalid
argument" x1275))) (map (lambda (x1276) (wrap139 (gensym) (quote ((top))) #f))
ls1274)))) (set! free-identifier=? (lambda (x1277 y1278) (begin (let ((x1279
x1277)) (if (not (nonsymbol-id?110 x1279)) (syntax-violation (quote
free-identifier=?) "invalid argument" x1279))) (let ((x1280 y1278)) (if (not
(nonsymbol-id?110 x1280)) (syntax-violation (quote free-identifier=?) "invalid
argument" x1280))) (free-id=?134 x1277 y1278)))) (set! bound-identifier=?
(lambda (x1281 y1282) (begin (let ((x1283 x1281)) (if (not (nonsymbol-id?110
x1283)) (syntax-violation (quote bound-identifier=?) "invalid argument"
x1283))) (let ((x1284 y1282)) (if (not (nonsymbol-id?110 x1284))
(syntax-violation (quote bound-identifier=?) "invalid argument" x1284)))
(bound-id=?135 x1281 y1282)))) (set! syntax-violation (lambda (who1288
message1287 form1286 . subform1285) (begin (let ((x1289 who1288)) (if (not
((lambda (x1290) (or (not x1290) (string? x1290) (symbol? x1290))) x1289))
(syntax-violation (quote syntax-violation) "invalid argument" x1289))) (let
((x1291 message1287)) (if (not (string? x1291)) (syntax-violation (quote
syntax-violation) "invalid argument" x1291))) (scm-error (quote syntax-error)
(quote sc-expand) (string-append (if who1288 "~a: " "") "~a " (if (null?
subform1285) "in ~a" "in subform `~s' of `~s'")) (let ((tail1292 (cons
message1287 (map (lambda (x1293) (strip158 x1293 (quote (())))) (append
subform1285 (list form1286)))))) (if who1288 (cons who1288 tail1292) tail1292))
#f)))) (letrec ((match1298 (lambda (e1299 p1300 w1301 r1302 mod1303) (cond
((not r1302) #f) ((eq? p1300 (quote any)) (cons (wrap139 e1299 w1301 mod1303)
r1302)) ((syntax-object?95 e1299) (match*1297 (let ((e1304
(syntax-object-expression96 e1299))) (if (annotation? e1304)
(annotation-expression e1304) e1304)) p1300 (join-wraps130 w1301
(syntax-object-wrap97 e1299)) r1302 (syntax-object-module98 e1299))) (else
(match*1297 (let ((e1305 e1299)) (if (annotation? e1305) (annotation-expression
e1305) e1305)) p1300 w1301 r1302 mod1303))))) (match*1297 (lambda (e1306 p1307
w1308 r1309 mod1310) (cond ((null? p1307) (and (null? e1306) r1309)) ((pair?
p1307) (and (pair? e1306) (match1298 (car e1306) (car p1307) w1308 (match1298
(cdr e1306) (cdr p1307) w1308 r1309 mod1310) mod1310))) ((eq? p1307 (quote
each-any)) (let ((l1311 (match-each-any1295 e1306 w1308 mod1310))) (and l1311
(cons l1311 r1309)))) (else (let ((t1312 (vector-ref p1307 0))) (if (memv t1312
(quote (each))) (if (null? e1306) (match-empty1296 (vector-ref p1307 1) r1309)
(let ((l1313 (match-each1294 e1306 (vector-ref p1307 1) w1308 mod1310))) (and
l1313 (letrec ((collect1314 (lambda (l1315) (if (null? (car l1315)) r1309 (cons
(map car l1315) (collect1314 (map cdr l1315))))))) (collect1314 l1313))))) (if
(memv t1312 (quote (free-id))) (and (id?111 e1306) (free-id=?134 (wrap139 e1306
w1308 mod1310) (vector-ref p1307 1)) r1309) (if (memv t1312 (quote (atom)))
(and (equal? (vector-ref p1307 1) (strip158 e1306 w1308)) r1309) (if (memv
t1312 (quote (vector))) (and (vector? e1306) (match1298 (vector->list e1306)
(vector-ref p1307 1) w1308 r1309 mod1310))))))))))) (match-empty1296 (lambda
(p1316 r1317) (cond ((null? p1316) r1317) ((eq? p1316 (quote any)) (cons (quote
()) r1317)) ((pair? p1316) (match-empty1296 (car p1316) (match-empty1296 (cdr
p1316) r1317))) ((eq? p1316 (quote each-any)) (cons (quote ()) r1317)) (else
(let ((t1318 (vector-ref p1316 0))) (if (memv t1318 (quote (each)))
(match-empty1296 (vector-ref p1316 1) r1317) (if (memv t1318 (quote (free-id
atom))) r1317 (if (memv t1318 (quote (vector))) (match-empty1296 (vector-ref
p1316 1) r1317))))))))) (match-each-any1295 (lambda (e1319 w1320 mod1321) (cond
((annotation? e1319) (match-each-any1295 (annotation-expression e1319) w1320
mod1321)) ((pair? e1319) (let ((l1322 (match-each-any1295 (cdr e1319) w1320
mod1321))) (and l1322 (cons (wrap139 (car e1319) w1320 mod1321) l1322))))
((null? e1319) (quote ())) ((syntax-object?95 e1319) (match-each-any1295
(syntax-object-expression96 e1319) (join-wraps130 w1320 (syntax-object-wrap97
e1319)) mod1321)) (else #f)))) (match-each1294 (lambda (e1323 p1324 w1325
mod1326) (cond ((annotation? e1323) (match-each1294 (annotation-expression
e1323) p1324 w1325 mod1326)) ((pair? e1323) (let ((first1327 (match1298 (car
e1323) p1324 w1325 (quote ()) mod1326))) (and first1327 (let ((rest1328
(match-each1294 (cdr e1323) p1324 w1325 mod1326))) (and rest1328 (cons
first1327 rest1328)))))) ((null? e1323) (quote ())) ((syntax-object?95 e1323)
(match-each1294 (syntax-object-expression96 e1323) p1324 (join-wraps130 w1325
(syntax-object-wrap97 e1323)) (syntax-object-module98 e1323))) (else #f)))))
(set! $sc-dispatch (lambda (e1329 p1330) (cond ((eq? p1330 (quote any)) (list
e1329)) ((syntax-object?95 e1329) (match*1297 (let ((e1331
(syntax-object-expression96 e1329))) (if (annotation? e1331)
(annotation-expression e1331) e1331)) p1330 (syntax-object-wrap97 e1329) (quote
()) (syntax-object-module98 e1329))) (else (match*1297 (let ((e1332 e1329)) (if
(annotation? e1332) (annotation-expression e1332) e1332)) p1330 (quote (()))
(quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x1333) ((lambda
(tmp1334) ((lambda (tmp1335) (if tmp1335 (apply (lambda (_1336 e11337 e21338)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11337 e21338))) tmp1335) ((lambda (tmp1340) (if
tmp1340 (apply (lambda (_1341 out1342 in1343 e11344 e21345) (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))) in1343 (quote ()) (list out1342 (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 e11344 e21345))))) tmp1340) ((lambda
(tmp1347) (if tmp1347 (apply (lambda (_1348 out1349 in1350 e11351 e21352) (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))) in1350) (quote ()) (list out1349 (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 e11351 e21352))))) tmp1347) (syntax-violation #f "source
expression failed to match any pattern" tmp1334))) ($sc-dispatch tmp1334 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1334 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp1334 (quote (any () any .
each-any))))) x1333))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1356)
((lambda (tmp1357) ((lambda (tmp1358) (if tmp1358 (apply (lambda (_1359 k1360
keyword1361 pattern1362 template1363) (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 k1360 (map (lambda (tmp1366
tmp1365) (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)))
tmp1365) (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)))
tmp1366))) template1363 pattern1362)))))) tmp1358) (syntax-violation #f "source
expression failed to match any pattern" tmp1357))) ($sc-dispatch tmp1357 (quote
(any each-any . #(each ((any . any) any))))))) x1356))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x1367) ((lambda (tmp1368) ((lambda (tmp1369) (if
(if tmp1369 (apply (lambda (let*1370 x1371 v1372 e11373 e21374) (and-map
identifier? x1371)) tmp1369) #f) (apply (lambda (let*1376 x1377 v1378 e11379
e21380) (letrec ((f1381 (lambda (bindings1382) (if (null? bindings1382) (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 e11379 e21380)))
((lambda (tmp1386) ((lambda (tmp1387) (if tmp1387 (apply (lambda (body1388
binding1389) (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 binding1389) body1388)) tmp1387) (syntax-violation #f
"source expression failed to match any pattern" tmp1386))) ($sc-dispatch
tmp1386 (quote (any any))))) (list (f1381 (cdr bindings1382)) (car
bindings1382))))))) (f1381 (map list x1377 v1378)))) tmp1369) (syntax-violation
#f "source expression failed to match any pattern" tmp1368))) ($sc-dispatch
tmp1368 (quote (any #(each (any any)) any . each-any))))) x1367))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x1390) ((lambda (tmp1391) ((lambda (tmp1392)
(if tmp1392 (apply (lambda (_1393 var1394 init1395 step1396 e01397 e11398
c1399) ((lambda (tmp1400) ((lambda (tmp1401) (if tmp1401 (apply (lambda
(step1402) ((lambda (tmp1403) ((lambda (tmp1404) (if tmp1404 (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
var1394 init1395) (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))) e01397) (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 c1399 (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))) step1402))))))) tmp1404) ((lambda (tmp1409)
(if tmp1409 (apply (lambda (e11410 e21411) (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 var1394 init1395) (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))) e01397 (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 e11410 e21411)) (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 c1399 (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))) step1402))))))) tmp1409)
(syntax-violation #f "source expression failed to match any pattern" tmp1403)))
($sc-dispatch tmp1403 (quote (any . each-any)))))) ($sc-dispatch tmp1403 (quote
())))) e11398)) tmp1401) (syntax-violation #f "source expression failed to
match any pattern" tmp1400))) ($sc-dispatch tmp1400 (quote each-any)))) (map
(lambda (v1418 s1419) ((lambda (tmp1420) ((lambda (tmp1421) (if tmp1421 (apply
(lambda () v1418) tmp1421) ((lambda (tmp1422) (if tmp1422 (apply (lambda
(e1423) e1423) tmp1422) ((lambda (_1424) (syntax-violation (quote do) "bad step
expression" orig-x1390 s1419)) tmp1420))) ($sc-dispatch tmp1420 (quote
(any)))))) ($sc-dispatch tmp1420 (quote ())))) s1419)) var1394 step1396)))
tmp1392) (syntax-violation #f "source expression failed to match any pattern"
tmp1391))) ($sc-dispatch tmp1391 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x1390))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons1427 (lambda (x1431 y1432)
((lambda (tmp1433) ((lambda (tmp1434) (if tmp1434 (apply (lambda (x1435 y1436)
((lambda (tmp1437) ((lambda (tmp1438) (if tmp1438 (apply (lambda (dy1439)
((lambda (tmp1440) ((lambda (tmp1441) (if tmp1441 (apply (lambda (dx1442) (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 dx1442 dy1439))) tmp1441) ((lambda
(_1443) (if (null? dy1439) (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))) x1435) (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))) x1435 y1436))) tmp1440))) ($sc-dispatch
tmp1440 (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))))) x1435)) tmp1438) ((lambda (tmp1444) (if
tmp1444 (apply (lambda (stuff1445) (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 x1435 stuff1445))) tmp1444)
((lambda (else1446) (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))) x1435 y1436)) tmp1437))) ($sc-dispatch tmp1437
(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 tmp1437 (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))))) y1436)) tmp1434) (syntax-violation #f "source expression
failed to match any pattern" tmp1433))) ($sc-dispatch tmp1433 (quote (any
any))))) (list x1431 y1432)))) (quasiappend1428 (lambda (x1447 y1448) ((lambda
(tmp1449) ((lambda (tmp1450) (if tmp1450 (apply (lambda (x1451 y1452) ((lambda
(tmp1453) ((lambda (tmp1454) (if tmp1454 (apply (lambda () x1451) tmp1454)
((lambda (_1455) (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))) x1451 y1452)) tmp1453))) ($sc-dispatch tmp1453
(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))) ()))))) y1452))
tmp1450) (syntax-violation #f "source expression failed to match any pattern"
tmp1449))) ($sc-dispatch tmp1449 (quote (any any))))) (list x1447 y1448))))
(quasivector1429 (lambda (x1456) ((lambda (tmp1457) ((lambda (x1458) ((lambda
(tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (x1461) (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
x1461))) tmp1460) ((lambda (tmp1463) (if tmp1463 (apply (lambda (x1464) (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))) x1464)) tmp1463)
((lambda (_1466) (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))) x1458)) tmp1459))) ($sc-dispatch tmp1459 (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 tmp1459 (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))))) x1458)) tmp1457)) x1456))) (quasi1430 (lambda
(p1467 lev1468) ((lambda (tmp1469) ((lambda (tmp1470) (if tmp1470 (apply
(lambda (p1471) (if (= lev1468 0) p1471 (quasicons1427 (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)))) (quasi1430 (list p1471) (- lev1468 1))))) tmp1470) ((lambda
(tmp1472) (if tmp1472 (apply (lambda (p1473 q1474) (if (= lev1468 0)
(quasiappend1428 p1473 (quasi1430 q1474 lev1468)) (quasicons1427 (quasicons1427
(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))))
(quasi1430 (list p1473) (- lev1468 1))) (quasi1430 q1474 lev1468)))) tmp1472)
((lambda (tmp1475) (if tmp1475 (apply (lambda (p1476) (quasicons1427 (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)))) (quasi1430 (list p1476) (+ lev1468
1)))) tmp1475) ((lambda (tmp1477) (if tmp1477 (apply (lambda (p1478 q1479)
(quasicons1427 (quasi1430 p1478 lev1468) (quasi1430 q1479 lev1468))) tmp1477)
((lambda (tmp1480) (if tmp1480 (apply (lambda (x1481) (quasivector1429
(quasi1430 x1481 lev1468))) tmp1480) ((lambda (p1483) (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))) p1483)) tmp1469))) ($sc-dispatch tmp1469 (quote #(vector
each-any)))))) ($sc-dispatch tmp1469 (quote (any . any)))))) ($sc-dispatch
tmp1469 (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 tmp1469 (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 tmp1469 (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))))) p1467)))) (lambda (x1484) ((lambda
(tmp1485) ((lambda (tmp1486) (if tmp1486 (apply (lambda (_1487 e1488)
(quasi1430 e1488 0)) tmp1486) (syntax-violation #f "source expression failed to
match any pattern" tmp1485))) ($sc-dispatch tmp1485 (quote (any any)))))
x1484)))))
-(define include (make-syncase-macro (quote macro) (lambda (x1489) (letrec
((read-file1490 (lambda (fn1491 k1492) (let ((p1493 (open-input-file fn1491)))
(letrec ((f1494 (lambda (x1495) (if (eof-object? x1495) (begin
(close-input-port p1493) (quote ())) (cons (datum->syntax k1492 x1495) (f1494
(read p1493))))))) (f1494 (read p1493))))))) ((lambda (tmp1496) ((lambda
(tmp1497) (if tmp1497 (apply (lambda (k1498 filename1499) (let ((fn1500
(syntax->datum filename1499))) ((lambda (tmp1501) ((lambda (tmp1502) (if
tmp1502 (apply (lambda (exp1503) (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))) exp1503)) tmp1502) (syntax-violation #f "source expression
failed to match any pattern" tmp1501))) ($sc-dispatch tmp1501 (quote
each-any)))) (read-file1490 fn1500 k1498)))) tmp1497) (syntax-violation #f
"source expression failed to match any pattern" tmp1496))) ($sc-dispatch
tmp1496 (quote (any any))))) x1489)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x1505) ((lambda
(tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (_1508 e1509)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x1505)) tmp1507) (syntax-violation #f "source expression failed to match any
pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any any))))) x1505))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1510)
((lambda (tmp1511) ((lambda (tmp1512) (if tmp1512 (apply (lambda (_1513 e1514)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x1510)) tmp1512) (syntax-violation #f "source expression failed to
match any pattern" tmp1511))) ($sc-dispatch tmp1511 (quote (any any)))))
x1510))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x1515) ((lambda (tmp1516) ((lambda (tmp1517) (if
tmp1517 (apply (lambda (_1518 e1519 m11520 m21521) ((lambda (tmp1522) ((lambda
(body1523) (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))) e1519)) body1523))
tmp1522)) (letrec ((f1524 (lambda (clause1525 clauses1526) (if (null?
clauses1526) ((lambda (tmp1528) ((lambda (tmp1529) (if tmp1529 (apply (lambda
(e11530 e21531) (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 e11530 e21531))) tmp1529) ((lambda (tmp1533) (if
tmp1533 (apply (lambda (k1534 e11535 e21536) (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))) k1534)) (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 e11535 e21536)))) tmp1533)
((lambda (_1539) (syntax-violation (quote case) "bad clause" x1515 clause1525))
tmp1528))) ($sc-dispatch tmp1528 (quote (each-any any . each-any))))))
($sc-dispatch tmp1528 (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))))) clause1525) ((lambda (tmp1540) ((lambda (rest1541) ((lambda
(tmp1542) ((lambda (tmp1543) (if tmp1543 (apply (lambda (k1544 e11545 e21546)
(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))) k1544)) (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 e11545 e21546)) rest1541)) tmp1543)
((lambda (_1549) (syntax-violation (quote case) "bad clause" x1515 clause1525))
tmp1542))) ($sc-dispatch tmp1542 (quote (each-any any . each-any)))))
clause1525)) tmp1540)) (f1524 (car clauses1526) (cdr clauses1526))))))) (f1524
m11520 m21521)))) tmp1517) (syntax-violation #f "source expression failed to
match any pattern" tmp1516))) ($sc-dispatch tmp1516 (quote (any any any .
each-any))))) x1515))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1550)
((lambda (tmp1551) ((lambda (tmp1552) (if tmp1552 (apply (lambda (_1553 e1554)
(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)))
e1554)) (list (cons _1553 (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 e1554 (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)))))))))) tmp1552) (syntax-violation #f "source expression failed to
match any pattern" tmp1551))) ($sc-dispatch tmp1551 (quote (any any)))))
x1550))))
+(letrec ((and-map*2008 (lambda (f2048 first2047 . rest2046) (let ((t2049
(null? first2047))) (if t2049 t2049 (if (null? rest2046) (letrec ((andmap2050
(lambda (first2051) (let ((x2052 (car first2051)) (first2053 (cdr first2051)))
(if (null? first2053) (f2048 x2052) (if (f2048 x2052) (andmap2050 first2053)
#f)))))) (andmap2050 first2047)) (letrec ((andmap2054 (lambda (first2055
rest2056) (let ((x2057 (car first2055)) (xr2058 (map car rest2056)) (first2059
(cdr first2055)) (rest2060 (map cdr rest2056))) (if (null? first2059) (apply
f2048 (cons x2057 xr2058)) (if (apply f2048 (cons x2057 xr2058)) (andmap2054
first2059 rest2060) #f)))))) (andmap2054 first2047 rest2046)))))))) (letrec
((lambda-var-list2153 (lambda (vars2282) (letrec ((lvl2283 (lambda (vars2284
ls2285 w2286) (if (pair? vars2284) (lvl2283 (cdr vars2284) (cons (wrap2132 (car
vars2284) w2286 #f) ls2285) w2286) (if (id?2104 vars2284) (cons (wrap2132
vars2284 w2286 #f) ls2285) (if (null? vars2284) ls2285 (if (syntax-object?2088
vars2284) (lvl2283 (syntax-object-expression2089 vars2284) ls2285
(join-wraps2123 w2286 (syntax-object-wrap2090 vars2284))) (if (annotation?
vars2284) (lvl2283 (annotation-expression vars2284) ls2285 w2286) (cons
vars2284 ls2285))))))))) (lvl2283 vars2282 (quote ()) (quote (()))))))
(gen-var2152 (lambda (id2287) (let ((id2288 (if (syntax-object?2088 id2287)
(syntax-object-expression2089 id2287) id2287))) (if (annotation? id2288)
(gensym (symbol->string (annotation-expression id2288))) (gensym
(symbol->string id2288)))))) (strip2151 (lambda (x2289 w2290) (if (memq (quote
top) (wrap-marks2107 w2290)) (if (let ((t2291 (annotation? x2289))) (if t2291
t2291 (if (pair? x2289) (annotation? (car x2289)) #f))) (strip-annotation2150
x2289 #f) x2289) (letrec ((f2292 (lambda (x2293) (if (syntax-object?2088 x2293)
(strip2151 (syntax-object-expression2089 x2293) (syntax-object-wrap2090 x2293))
(if (pair? x2293) (let ((a2294 (f2292 (car x2293))) (d2295 (f2292 (cdr
x2293)))) (if (if (eq? a2294 (car x2293)) (eq? d2295 (cdr x2293)) #f) x2293
(cons a2294 d2295))) (if (vector? x2293) (let ((old2296 (vector->list x2293)))
(let ((new2297 (map f2292 old2296))) (if (and-map*2008 eq? old2296 new2297)
x2293 (list->vector new2297)))) x2293)))))) (f2292 x2289)))))
(strip-annotation2150 (lambda (x2298 parent2299) (if (pair? x2298) (let
((new2300 (cons #f #f))) (begin (if parent2299 (set-annotation-stripped!
parent2299 new2300) (if #f #f)) (set-car! new2300 (strip-annotation2150 (car
x2298) #f)) (set-cdr! new2300 (strip-annotation2150 (cdr x2298) #f)) new2300))
(if (annotation? x2298) (let ((t2301 (annotation-stripped x2298))) (if t2301
t2301 (strip-annotation2150 (annotation-expression x2298) x2298))) (if (vector?
x2298) (let ((new2302 (make-vector (vector-length x2298)))) (begin (if
parent2299 (set-annotation-stripped! parent2299 new2302) (if #f #f)) (letrec
((loop2303 (lambda (i2304) (unless (fx<2066 i2304 0) (vector-set! new2302 i2304
(strip-annotation2150 (vector-ref x2298 i2304) #f)) (loop2303 (fx-2064 i2304
1)))))) (loop2303 (- (vector-length x2298) 1))) new2302)) x2298)))))
(ellipsis?2149 (lambda (x2305) (if (nonsymbol-id?2103 x2305) (free-id=?2127
x2305 (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-void2148 (lambda () (build-void2071 #f))) (eval-local-transformer2147
(lambda (expanded2306 mod2307) (let ((p2308 (local-eval-hook2068 expanded2306
mod2307))) (if (procedure? p2308) p2308 (syntax-violation #f "nonprocedure
transformer" p2308))))) (chi-local-syntax2146 (lambda (rec?2309 e2310 r2311
w2312 s2313 mod2314 k2315) ((lambda (tmp2316) ((lambda (tmp2317) (if tmp2317
(apply (lambda (_2318 id2319 val2320 e12321 e22322) (let ((ids2323 id2319)) (if
(not (valid-bound-ids?2129 ids2323)) (syntax-violation #f "duplicate bound
keyword" e2310) (let ((labels2325 (gen-labels2110 ids2323))) (let ((new-w2326
(make-binding-wrap2121 ids2323 labels2325 w2312))) (k2315 (cons e12321 e22322)
(extend-env2098 labels2325 (let ((w2328 (if rec?2309 new-w2326 w2312))
(trans-r2329 (macros-only-env2100 r2311))) (map (lambda (x2330) (cons (quote
macro) (eval-local-transformer2147 (chi2140 x2330 trans-r2329 w2328 mod2314)
mod2314))) val2320)) r2311) new-w2326 s2313 mod2314)))))) tmp2317) ((lambda
(_2332) (syntax-violation #f "bad local syntax definition" (source-wrap2133
e2310 w2312 s2313 mod2314))) tmp2316))) ($sc-dispatch tmp2316 (quote (any
#(each (any any)) any . each-any))))) e2310))) (chi-lambda-clause2145 (lambda
(e2333 docstring2334 c2335 r2336 w2337 mod2338 k2339) ((lambda (tmp2340)
((lambda (tmp2341) (if (if tmp2341 (apply (lambda (args2342 doc2343 e12344
e22345) (if (string? (syntax->datum doc2343)) (not docstring2334) #f)) tmp2341)
#f) (apply (lambda (args2346 doc2347 e12348 e22349) (chi-lambda-clause2145
e2333 doc2347 (cons args2346 (cons e12348 e22349)) r2336 w2337 mod2338 k2339))
tmp2341) ((lambda (tmp2351) (if tmp2351 (apply (lambda (id2352 e12353 e22354)
(let ((ids2355 id2352)) (if (not (valid-bound-ids?2129 ids2355))
(syntax-violation (quote lambda) "invalid parameter list" e2333) (let
((labels2357 (gen-labels2110 ids2355)) (new-vars2358 (map gen-var2152
ids2355))) (k2339 (map syntax->datum ids2355) new-vars2358 docstring2334
(chi-body2144 (cons e12353 e22354) e2333 (extend-var-env2099 labels2357
new-vars2358 r2336) (make-binding-wrap2121 ids2355 labels2357 w2337)
mod2338)))))) tmp2351) ((lambda (tmp2360) (if tmp2360 (apply (lambda (ids2361
e12362 e22363) (let ((old-ids2364 (lambda-var-list2153 ids2361))) (if (not
(valid-bound-ids?2129 old-ids2364)) (syntax-violation (quote lambda) "invalid
parameter list" e2333) (let ((labels2365 (gen-labels2110 old-ids2364))
(new-vars2366 (map gen-var2152 old-ids2364))) (k2339 (letrec ((f2367 (lambda
(ls12368 ls22369) (if (null? ls12368) (syntax->datum ls22369) (f2367 (cdr
ls12368) (cons (syntax->datum (car ls12368)) ls22369)))))) (f2367 (cdr
old-ids2364) (car old-ids2364))) (letrec ((f2370 (lambda (ls12371 ls22372) (if
(null? ls12371) ls22372 (f2370 (cdr ls12371) (cons (car ls12371) ls22372))))))
(f2370 (cdr new-vars2366) (car new-vars2366))) docstring2334 (chi-body2144
(cons e12362 e22363) e2333 (extend-var-env2099 labels2365 new-vars2366 r2336)
(make-binding-wrap2121 old-ids2364 labels2365 w2337) mod2338)))))) tmp2360)
((lambda (_2374) (syntax-violation (quote lambda) "bad lambda" e2333))
tmp2340))) ($sc-dispatch tmp2340 (quote (any any . each-any)))))) ($sc-dispatch
tmp2340 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2340 (quote (any
any any . each-any))))) c2335))) (chi-body2144 (lambda (body2375 outer-form2376
r2377 w2378 mod2379) (let ((r2380 (cons (quote ("placeholder" placeholder))
r2377))) (let ((ribcage2381 (make-ribcage2111 (quote ()) (quote ()) (quote
())))) (let ((w2382 (make-wrap2106 (wrap-marks2107 w2378) (cons ribcage2381
(wrap-subst2108 w2378))))) (letrec ((parse2383 (lambda (body2384 ids2385
labels2386 vars2387 vals2388 bindings2389) (if (null? body2384)
(syntax-violation #f "no expressions in body" outer-form2376) (let ((e2391
(cdar body2384)) (er2392 (caar body2384))) (call-with-values (lambda ()
(syntax-type2138 e2391 er2392 (quote (())) #f ribcage2381 mod2379)) (lambda
(type2393 value2394 e2395 w2396 s2397 mod2398) (if (memv type2393 (quote
(define-form))) (let ((id2399 (wrap2132 value2394 w2396 mod2398)) (label2400
(gen-label2109))) (let ((var2401 (gen-var2152 id2399))) (begin
(extend-ribcage!2120 ribcage2381 id2399 label2400) (parse2383 (cdr body2384)
(cons id2399 ids2385) (cons label2400 labels2386) (cons var2401 vars2387) (cons
(cons er2392 (wrap2132 e2395 w2396 mod2398)) vals2388) (cons (cons (quote
lexical) var2401) bindings2389))))) (if (memv type2393 (quote
(define-syntax-form))) (let ((id2402 (wrap2132 value2394 w2396 mod2398))
(label2403 (gen-label2109))) (begin (extend-ribcage!2120 ribcage2381 id2402
label2403) (parse2383 (cdr body2384) (cons id2402 ids2385) (cons label2403
labels2386) vars2387 vals2388 (cons (cons (quote macro) (cons er2392 (wrap2132
e2395 w2396 mod2398))) bindings2389)))) (if (memv type2393 (quote
(begin-form))) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda
(_2406 e12407) (parse2383 (letrec ((f2408 (lambda (forms2409) (if (null?
forms2409) (cdr body2384) (cons (cons er2392 (wrap2132 (car forms2409) w2396
mod2398)) (f2408 (cdr forms2409))))))) (f2408 e12407)) ids2385 labels2386
vars2387 vals2388 bindings2389)) tmp2405) (syntax-violation #f "source
expression failed to match any pattern" tmp2404))) ($sc-dispatch tmp2404 (quote
(any . each-any))))) e2395) (if (memv type2393 (quote (local-syntax-form)))
(chi-local-syntax2146 value2394 e2395 er2392 w2396 s2397 mod2398 (lambda
(forms2411 er2412 w2413 s2414 mod2415) (parse2383 (letrec ((f2416 (lambda
(forms2417) (if (null? forms2417) (cdr body2384) (cons (cons er2412 (wrap2132
(car forms2417) w2413 mod2415)) (f2416 (cdr forms2417))))))) (f2416 forms2411))
ids2385 labels2386 vars2387 vals2388 bindings2389))) (if (null? ids2385)
(build-sequence2083 #f (map (lambda (x2418) (chi2140 (cdr x2418) (car x2418)
(quote (())) mod2398)) (cons (cons er2392 (source-wrap2133 e2395 w2396 s2397
mod2398)) (cdr body2384)))) (begin (if (not (valid-bound-ids?2129 ids2385))
(syntax-violation #f "invalid or duplicate identifier in definition"
outer-form2376) (if #f #f)) (letrec ((loop2419 (lambda (bs2420 er-cache2421
r-cache2422) (if (not (null? bs2420)) (let ((b2423 (car bs2420))) (if (eq? (car
b2423) (quote macro)) (let ((er2424 (cadr b2423))) (let ((r-cache2425 (if (eq?
er2424 er-cache2421) r-cache2422 (macros-only-env2100 er2424)))) (begin
(set-cdr! b2423 (eval-local-transformer2147 (chi2140 (cddr b2423) r-cache2425
(quote (())) mod2398) mod2398)) (loop2419 (cdr bs2420) er2424 r-cache2425))))
(loop2419 (cdr bs2420) er-cache2421 r-cache2422))) (if #f #f))))) (loop2419
bindings2389 #f #f)) (set-cdr! r2380 (extend-env2098 labels2386 bindings2389
(cdr r2380))) (build-letrec2086 #f (map syntax->datum ids2385) vars2387 (map
(lambda (x2426) (chi2140 (cdr x2426) (car x2426) (quote (())) mod2398))
vals2388) (build-sequence2083 #f (map (lambda (x2427) (chi2140 (cdr x2427) (car
x2427) (quote (())) mod2398)) (cons (cons er2392 (source-wrap2133 e2395 w2396
s2397 mod2398)) (cdr body2384)))))))))))))))))) (parse2383 (map (lambda (x2390)
(cons r2380 (wrap2132 x2390 w2382 mod2379))) body2375) (quote ()) (quote ())
(quote ()) (quote ()) (quote ())))))))) (chi-macro2143 (lambda (p2428 e2429
r2430 w2431 rib2432 mod2433) (letrec ((rebuild-macro-output2434 (lambda (x2435
m2436) (if (pair? x2435) (cons (rebuild-macro-output2434 (car x2435) m2436)
(rebuild-macro-output2434 (cdr x2435) m2436)) (if (syntax-object?2088 x2435)
(let ((w2437 (syntax-object-wrap2090 x2435))) (let ((ms2438 (wrap-marks2107
w2437)) (s2439 (wrap-subst2108 w2437))) (if (if (pair? ms2438) (eq? (car
ms2438) #f) #f) (make-syntax-object2087 (syntax-object-expression2089 x2435)
(make-wrap2106 (cdr ms2438) (if rib2432 (cons rib2432 (cdr s2439)) (cdr
s2439))) (syntax-object-module2091 x2435)) (make-syntax-object2087
(syntax-object-expression2089 x2435) (make-wrap2106 (cons m2436 ms2438) (if
rib2432 (cons rib2432 (cons (quote shift) s2439)) (cons (quote shift) s2439)))
(let ((pmod2440 (procedure-module p2428))) (if pmod2440 (cons (quote hygiene)
(module-name pmod2440)) (quote (hygiene guile)))))))) (if (vector? x2435) (let
((n2441 (vector-length x2435))) (let ((v2442 (make-vector n2441))) (letrec
((loop2443 (lambda (i2444) (if (fx=2065 i2444 n2441) (begin (if #f #f (if #f
#f)) v2442) (begin (vector-set! v2442 i2444 (rebuild-macro-output2434
(vector-ref x2435 i2444) m2436)) (loop2443 (fx+2063 i2444 1))))))) (loop2443
0)))) (if (symbol? x2435) (syntax-violation #f "encountered raw symbol in macro
output" (source-wrap2133 e2429 w2431 s mod2433) x2435) x2435)))))))
(rebuild-macro-output2434 (p2428 (wrap2132 e2429 (anti-mark2119 w2431)
mod2433)) (string #\m))))) (chi-application2142 (lambda (x2445 e2446 r2447
w2448 s2449 mod2450) ((lambda (tmp2451) ((lambda (tmp2452) (if tmp2452 (apply
(lambda (e02453 e12454) (build-application2072 s2449 x2445 (map (lambda (e2455)
(chi2140 e2455 r2447 w2448 mod2450)) e12454))) tmp2452) (syntax-violation #f
"source expression failed to match any pattern" tmp2451))) ($sc-dispatch
tmp2451 (quote (any . each-any))))) e2446))) (chi-expr2141 (lambda (type2457
value2458 e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote
(lexical))) (build-lexical-reference2074 (quote value) s2462 e2459 value2458)
(if (memv type2457 (quote (core external-macro))) (value2458 e2459 r2460 w2461
s2462 mod2463) (if (memv type2457 (quote (module-ref))) (call-with-values
(lambda () (value2458 e2459)) (lambda (id2464 mod2465)
(build-global-reference2077 s2462 id2464 mod2465))) (if (memv type2457 (quote
(lexical-call))) (chi-application2142 (build-lexical-reference2074 (quote fun)
(source-annotation2095 (car e2459)) (car e2459) value2458) e2459 r2460 w2461
s2462 mod2463) (if (memv type2457 (quote (global-call))) (chi-application2142
(build-global-reference2077 (source-annotation2095 (car e2459)) value2458 (if
(syntax-object?2088 (car e2459)) (syntax-object-module2091 (car e2459))
mod2463)) e2459 r2460 w2461 s2462 mod2463) (if (memv type2457 (quote
(constant))) (build-data2082 s2462 (strip2151 (source-wrap2133 e2459 w2461
s2462 mod2463) (quote (())))) (if (memv type2457 (quote (global)))
(build-global-reference2077 s2462 value2458 mod2463) (if (memv type2457 (quote
(call))) (chi-application2142 (chi2140 (car e2459) r2460 w2461 mod2463) e2459
r2460 w2461 s2462 mod2463) (if (memv type2457 (quote (begin-form))) ((lambda
(tmp2466) ((lambda (tmp2467) (if tmp2467 (apply (lambda (_2468 e12469 e22470)
(chi-sequence2134 (cons e12469 e22470) r2460 w2461 s2462 mod2463)) tmp2467)
(syntax-violation #f "source expression failed to match any pattern" tmp2466)))
($sc-dispatch tmp2466 (quote (any any . each-any))))) e2459) (if (memv type2457
(quote (local-syntax-form))) (chi-local-syntax2146 value2458 e2459 r2460 w2461
s2462 mod2463 chi-sequence2134) (if (memv type2457 (quote (eval-when-form)))
((lambda (tmp2472) ((lambda (tmp2473) (if tmp2473 (apply (lambda (_2474 x2475
e12476 e22477) (let ((when-list2478 (chi-when-list2137 e2459 x2475 w2461))) (if
(memq (quote eval) when-list2478) (chi-sequence2134 (cons e12476 e22477) r2460
w2461 s2462 mod2463) (chi-void2148)))) tmp2473) (syntax-violation #f "source
expression failed to match any pattern" tmp2472))) ($sc-dispatch tmp2472 (quote
(any each-any any . each-any))))) e2459) (if (memv type2457 (quote (define-form
define-syntax-form))) (syntax-violation #f "definition in expression context"
e2459 (wrap2132 value2458 w2461 mod2463)) (if (memv type2457 (quote (syntax)))
(syntax-violation #f "reference to pattern variable outside syntax form"
(source-wrap2133 e2459 w2461 s2462 mod2463)) (if (memv type2457 (quote
(displaced-lexical))) (syntax-violation #f "reference to identifier outside its
scope" (source-wrap2133 e2459 w2461 s2462 mod2463)) (syntax-violation #f
"unexpected syntax" (source-wrap2133 e2459 w2461 s2462
mod2463)))))))))))))))))) (chi2140 (lambda (e2481 r2482 w2483 mod2484)
(call-with-values (lambda () (syntax-type2138 e2481 r2482 w2483 #f #f mod2484))
(lambda (type2485 value2486 e2487 w2488 s2489 mod2490) (chi-expr2141 type2485
value2486 e2487 r2482 w2488 s2489 mod2490))))) (chi-top2139 (lambda (e2491
r2492 w2493 m2494 esew2495 mod2496) (call-with-values (lambda ()
(syntax-type2138 e2491 r2492 w2493 #f #f mod2496)) (lambda (type2504 value2505
e2506 w2507 s2508 mod2509) (if (memv type2504 (quote (begin-form))) ((lambda
(tmp2510) ((lambda (tmp2511) (if tmp2511 (apply (lambda (_2512) (chi-void2148))
tmp2511) ((lambda (tmp2513) (if tmp2513 (apply (lambda (_2514 e12515 e22516)
(chi-top-sequence2135 (cons e12515 e22516) r2492 w2507 s2508 m2494 esew2495
mod2509)) tmp2513) (syntax-violation #f "source expression failed to match any
pattern" tmp2510))) ($sc-dispatch tmp2510 (quote (any any . each-any))))))
($sc-dispatch tmp2510 (quote (any))))) e2506) (if (memv type2504 (quote
(local-syntax-form))) (chi-local-syntax2146 value2505 e2506 r2492 w2507 s2508
mod2509 (lambda (body2518 r2519 w2520 s2521 mod2522) (chi-top-sequence2135
body2518 r2519 w2520 s2521 m2494 esew2495 mod2522))) (if (memv type2504 (quote
(eval-when-form))) ((lambda (tmp2523) ((lambda (tmp2524) (if tmp2524 (apply
(lambda (_2525 x2526 e12527 e22528) (let ((when-list2529 (chi-when-list2137
e2506 x2526 w2507)) (body2530 (cons e12527 e22528))) (if (eq? m2494 (quote e))
(if (memq (quote eval) when-list2529) (chi-top-sequence2135 body2530 r2492
w2507 s2508 (quote e) (quote (eval)) mod2509) (chi-void2148)) (if (memq (quote
load) when-list2529) (if (let ((t2533 (memq (quote compile) when-list2529)))
(if t2533 t2533 (if (eq? m2494 (quote c&e)) (memq (quote eval) when-list2529)
#f))) (chi-top-sequence2135 body2530 r2492 w2507 s2508 (quote c&e) (quote
(compile load)) mod2509) (if (memq m2494 (quote (c c&e))) (chi-top-sequence2135
body2530 r2492 w2507 s2508 (quote c) (quote (load)) mod2509) (chi-void2148)))
(if (let ((t2534 (memq (quote compile) when-list2529))) (if t2534 t2534 (if
(eq? m2494 (quote c&e)) (memq (quote eval) when-list2529) #f))) (begin
(top-level-eval-hook2067 (chi-top-sequence2135 body2530 r2492 w2507 s2508
(quote e) (quote (eval)) mod2509) mod2509) (chi-void2148)) (chi-void2148))))))
tmp2524) (syntax-violation #f "source expression failed to match any pattern"
tmp2523))) ($sc-dispatch tmp2523 (quote (any each-any any . each-any)))))
e2506) (if (memv type2504 (quote (define-syntax-form))) (let ((n2535
(id-var-name2126 value2505 w2507)) (r2536 (macros-only-env2100 r2492))) (if
(memv m2494 (quote (c))) (if (memq (quote compile) esew2495) (let ((e2537
(chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)))) (begin
(top-level-eval-hook2067 e2537 mod2509) (if (memq (quote load) esew2495) e2537
(chi-void2148)))) (if (memq (quote load) esew2495) (chi-install-global2136
n2535 (chi2140 e2506 r2536 w2507 mod2509)) (chi-void2148))) (if (memv m2494
(quote (c&e))) (let ((e2538 (chi-install-global2136 n2535 (chi2140 e2506 r2536
w2507 mod2509)))) (begin (top-level-eval-hook2067 e2538 mod2509) e2538)) (begin
(if (memq (quote eval) esew2495) (top-level-eval-hook2067
(chi-install-global2136 n2535 (chi2140 e2506 r2536 w2507 mod2509)) mod2509) (if
#f #f)) (chi-void2148))))) (if (memv type2504 (quote (define-form))) (let
((n2539 (id-var-name2126 value2505 w2507))) (let ((type2540 (binding-type2096
(lookup2101 n2539 r2492 mod2509)))) (if (memv type2540 (quote (global core
macro module-ref))) (let ((x2541 (build-global-definition2079 s2508 n2539
(chi2140 e2506 r2492 w2507 mod2509)))) (begin (if (eq? m2494 (quote c&e))
(top-level-eval-hook2067 x2541 mod2509) (if #f #f)) x2541)) (if (memv type2540
(quote (displaced-lexical))) (syntax-violation #f "identifier out of context"
e2506 (wrap2132 value2505 w2507 mod2509)) (syntax-violation #f "cannot define
keyword at top level" e2506 (wrap2132 value2505 w2507 mod2509)))))) (let
((x2542 (chi-expr2141 type2504 value2505 e2506 r2492 w2507 s2508 mod2509)))
(begin (if (eq? m2494 (quote c&e)) (top-level-eval-hook2067 x2542 mod2509) (if
#f #f)) x2542))))))))))) (syntax-type2138 (lambda (e2543 r2544 w2545 s2546
rib2547 mod2548) (if (symbol? e2543) (let ((n2549 (id-var-name2126 e2543
w2545))) (let ((b2550 (lookup2101 n2549 r2544 mod2548))) (let ((type2551
(binding-type2096 b2550))) (if (memv type2551 (quote (lexical))) (values
type2551 (binding-value2097 b2550) e2543 w2545 s2546 mod2548) (if (memv
type2551 (quote (global))) (values type2551 n2549 e2543 w2545 s2546 mod2548)
(if (memv type2551 (quote (macro))) (syntax-type2138 (chi-macro2143
(binding-value2097 b2550) e2543 r2544 w2545 rib2547 mod2548) r2544 (quote (()))
s2546 rib2547 mod2548) (values type2551 (binding-value2097 b2550) e2543 w2545
s2546 mod2548))))))) (if (pair? e2543) (let ((first2552 (car e2543))) (if
(id?2104 first2552) (let ((n2553 (id-var-name2126 first2552 w2545))) (let
((b2554 (lookup2101 n2553 r2544 (let ((t2555 (if (syntax-object?2088 first2552)
(syntax-object-module2091 first2552) #f))) (if t2555 t2555 mod2548))))) (let
((type2556 (binding-type2096 b2554))) (if (memv type2556 (quote (lexical)))
(values (quote lexical-call) (binding-value2097 b2554) e2543 w2545 s2546
mod2548) (if (memv type2556 (quote (global))) (values (quote global-call) n2553
e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (macro))) (syntax-type2138
(chi-macro2143 (binding-value2097 b2554) e2543 r2544 w2545 rib2547 mod2548)
r2544 (quote (())) s2546 rib2547 mod2548) (if (memv type2556 (quote (core
external-macro module-ref))) (values type2556 (binding-value2097 b2554) e2543
w2545 s2546 mod2548) (if (memv type2556 (quote (local-syntax))) (values (quote
local-syntax-form) (binding-value2097 b2554) e2543 w2545 s2546 mod2548) (if
(memv type2556 (quote (begin))) (values (quote begin-form) #f e2543 w2545 s2546
mod2548) (if (memv type2556 (quote (eval-when))) (values (quote eval-when-form)
#f e2543 w2545 s2546 mod2548) (if (memv type2556 (quote (define))) ((lambda
(tmp2557) ((lambda (tmp2558) (if (if tmp2558 (apply (lambda (_2559 name2560
val2561) (id?2104 name2560)) tmp2558) #f) (apply (lambda (_2562 name2563
val2564) (values (quote define-form) name2563 val2564 w2545 s2546 mod2548))
tmp2558) ((lambda (tmp2565) (if (if tmp2565 (apply (lambda (_2566 name2567
args2568 e12569 e22570) (if (id?2104 name2567) (valid-bound-ids?2129
(lambda-var-list2153 args2568)) #f)) tmp2565) #f) (apply (lambda (_2571
name2572 args2573 e12574 e22575) (values (quote define-form) (wrap2132 name2572
w2545 mod2548) (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)))
(wrap2132 (cons args2573 (cons e12574 e22575)) w2545 mod2548)) (quote (()))
s2546 mod2548)) tmp2565) ((lambda (tmp2577) (if (if tmp2577 (apply (lambda
(_2578 name2579) (id?2104 name2579)) tmp2577) #f) (apply (lambda (_2580
name2581) (values (quote define-form) (wrap2132 name2581 w2545 mod2548) (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
(())) s2546 mod2548)) tmp2577) (syntax-violation #f "source expression failed
to match any pattern" tmp2557))) ($sc-dispatch tmp2557 (quote (any any))))))
($sc-dispatch tmp2557 (quote (any (any . any) any . each-any))))))
($sc-dispatch tmp2557 (quote (any any any))))) e2543) (if (memv type2556 (quote
(define-syntax))) ((lambda (tmp2582) ((lambda (tmp2583) (if (if tmp2583 (apply
(lambda (_2584 name2585 val2586) (id?2104 name2585)) tmp2583) #f) (apply
(lambda (_2587 name2588 val2589) (values (quote define-syntax-form) name2588
val2589 w2545 s2546 mod2548)) tmp2583) (syntax-violation #f "source expression
failed to match any pattern" tmp2582))) ($sc-dispatch tmp2582 (quote (any any
any))))) e2543) (values (quote call) #f e2543 w2545 s2546 mod2548)))))))))))))
(values (quote call) #f e2543 w2545 s2546 mod2548))) (if (syntax-object?2088
e2543) (syntax-type2138 (syntax-object-expression2089 e2543) r2544
(join-wraps2123 w2545 (syntax-object-wrap2090 e2543)) #f rib2547 (let ((t2590
(syntax-object-module2091 e2543))) (if t2590 t2590 mod2548))) (if (annotation?
e2543) (syntax-type2138 (annotation-expression e2543) r2544 w2545
(annotation-source e2543) rib2547 mod2548) (if (self-evaluating? e2543) (values
(quote constant) #f e2543 w2545 s2546 mod2548) (values (quote other) #f e2543
w2545 s2546 mod2548)))))))) (chi-when-list2137 (lambda (e2591 when-list2592
w2593) (letrec ((f2594 (lambda (when-list2595 situations2596) (if (null?
when-list2595) situations2596 (f2594 (cdr when-list2595) (cons (let ((x2597
(car when-list2595))) (if (free-id=?2127 x2597 (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=?2127 x2597 (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=?2127 x2597 (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" e2591 (wrap2132
x2597 w2593 #f)))))) situations2596)))))) (f2594 when-list2592 (quote ())))))
(chi-install-global2136 (lambda (name2598 e2599) (build-global-definition2079
#f name2598 (if (let ((v2600 (module-variable (current-module) name2598))) (if
v2600 (if (variable-bound? v2600) (if (macro? (variable-ref v2600)) (not (eq?
(macro-type (variable-ref v2600)) (quote syncase-macro))) #f) #f) #f))
(build-application2072 #f (build-primref2081 #f (quote
make-extended-syncase-macro)) (list (build-application2072 #f
(build-primref2081 #f (quote module-ref)) (list (build-application2072 #f
(build-primref2081 #f (quote current-module)) (quote ())) (build-data2082 #f
name2598))) (build-data2082 #f (quote macro)) e2599)) (build-application2072 #f
(build-primref2081 #f (quote make-syncase-macro)) (list (build-data2082 #f
(quote macro)) e2599)))))) (chi-top-sequence2135 (lambda (body2601 r2602 w2603
s2604 m2605 esew2606 mod2607) (build-sequence2083 s2604 (letrec ((dobody2608
(lambda (body2609 r2610 w2611 m2612 esew2613 mod2614) (if (null? body2609)
(quote ()) (let ((first2615 (chi-top2139 (car body2609) r2610 w2611 m2612
esew2613 mod2614))) (cons first2615 (dobody2608 (cdr body2609) r2610 w2611
m2612 esew2613 mod2614))))))) (dobody2608 body2601 r2602 w2603 m2605 esew2606
mod2607))))) (chi-sequence2134 (lambda (body2616 r2617 w2618 s2619 mod2620)
(build-sequence2083 s2619 (letrec ((dobody2621 (lambda (body2622 r2623 w2624
mod2625) (if (null? body2622) (quote ()) (let ((first2626 (chi2140 (car
body2622) r2623 w2624 mod2625))) (cons first2626 (dobody2621 (cdr body2622)
r2623 w2624 mod2625))))))) (dobody2621 body2616 r2617 w2618 mod2620)))))
(source-wrap2133 (lambda (x2627 w2628 s2629 defmod2630) (wrap2132 (if s2629
(make-annotation x2627 s2629 #f) x2627) w2628 defmod2630))) (wrap2132 (lambda
(x2631 w2632 defmod2633) (if (if (null? (wrap-marks2107 w2632)) (null?
(wrap-subst2108 w2632)) #f) x2631 (if (syntax-object?2088 x2631)
(make-syntax-object2087 (syntax-object-expression2089 x2631) (join-wraps2123
w2632 (syntax-object-wrap2090 x2631)) (syntax-object-module2091 x2631)) (if
(null? x2631) x2631 (make-syntax-object2087 x2631 w2632 defmod2633))))))
(bound-id-member?2131 (lambda (x2634 list2635) (if (not (null? list2635)) (let
((t2636 (bound-id=?2128 x2634 (car list2635)))) (if t2636 t2636
(bound-id-member?2131 x2634 (cdr list2635)))) #f))) (distinct-bound-ids?2130
(lambda (ids2637) (letrec ((distinct?2638 (lambda (ids2639) (let ((t2640 (null?
ids2639))) (if t2640 t2640 (if (not (bound-id-member?2131 (car ids2639) (cdr
ids2639))) (distinct?2638 (cdr ids2639)) #f)))))) (distinct?2638 ids2637))))
(valid-bound-ids?2129 (lambda (ids2641) (if (letrec ((all-ids?2642 (lambda
(ids2643) (let ((t2644 (null? ids2643))) (if t2644 t2644 (if (id?2104 (car
ids2643)) (all-ids?2642 (cdr ids2643)) #f)))))) (all-ids?2642 ids2641))
(distinct-bound-ids?2130 ids2641) #f))) (bound-id=?2128 (lambda (i2645 j2646)
(if (if (syntax-object?2088 i2645) (syntax-object?2088 j2646) #f) (if (eq? (let
((e2647 (syntax-object-expression2089 i2645))) (if (annotation? e2647)
(annotation-expression e2647) e2647)) (let ((e2648
(syntax-object-expression2089 j2646))) (if (annotation? e2648)
(annotation-expression e2648) e2648))) (same-marks?2125 (wrap-marks2107
(syntax-object-wrap2090 i2645)) (wrap-marks2107 (syntax-object-wrap2090
j2646))) #f) (eq? (let ((e2649 i2645)) (if (annotation? e2649)
(annotation-expression e2649) e2649)) (let ((e2650 j2646)) (if (annotation?
e2650) (annotation-expression e2650) e2650)))))) (free-id=?2127 (lambda (i2651
j2652) (if (eq? (let ((x2653 i2651)) (let ((e2654 (if (syntax-object?2088
x2653) (syntax-object-expression2089 x2653) x2653))) (if (annotation? e2654)
(annotation-expression e2654) e2654))) (let ((x2655 j2652)) (let ((e2656 (if
(syntax-object?2088 x2655) (syntax-object-expression2089 x2655) x2655))) (if
(annotation? e2656) (annotation-expression e2656) e2656)))) (eq?
(id-var-name2126 i2651 (quote (()))) (id-var-name2126 j2652 (quote (()))))
#f))) (id-var-name2126 (lambda (id2657 w2658) (letrec ((search-vector-rib2661
(lambda (sym2667 subst2668 marks2669 symnames2670 ribcage2671) (let ((n2672
(vector-length symnames2670))) (letrec ((f2673 (lambda (i2674) (if (fx=2065
i2674 n2672) (search2659 sym2667 (cdr subst2668) marks2669) (if (if (eq?
(vector-ref symnames2670 i2674) sym2667) (same-marks?2125 marks2669 (vector-ref
(ribcage-marks2114 ribcage2671) i2674)) #f) (values (vector-ref
(ribcage-labels2115 ribcage2671) i2674) marks2669) (f2673 (fx+2063 i2674
1))))))) (f2673 0))))) (search-list-rib2660 (lambda (sym2675 subst2676
marks2677 symnames2678 ribcage2679) (letrec ((f2680 (lambda (symnames2681
i2682) (if (null? symnames2681) (search2659 sym2675 (cdr subst2676) marks2677)
(if (if (eq? (car symnames2681) sym2675) (same-marks?2125 marks2677 (list-ref
(ribcage-marks2114 ribcage2679) i2682)) #f) (values (list-ref
(ribcage-labels2115 ribcage2679) i2682) marks2677) (f2680 (cdr symnames2681)
(fx+2063 i2682 1))))))) (f2680 symnames2678 0)))) (search2659 (lambda (sym2683
subst2684 marks2685) (if (null? subst2684) (values #f marks2685) (let ((fst2686
(car subst2684))) (if (eq? fst2686 (quote shift)) (search2659 sym2683 (cdr
subst2684) (cdr marks2685)) (let ((symnames2687 (ribcage-symnames2113
fst2686))) (if (vector? symnames2687) (search-vector-rib2661 sym2683 subst2684
marks2685 symnames2687 fst2686) (search-list-rib2660 sym2683 subst2684
marks2685 symnames2687 fst2686))))))))) (if (symbol? id2657) (let ((t2688
(call-with-values (lambda () (search2659 id2657 (wrap-subst2108 w2658)
(wrap-marks2107 w2658))) (lambda (x2690 . ignore2689) x2690)))) (if t2688 t2688
id2657)) (if (syntax-object?2088 id2657) (let ((id2691 (let ((e2693
(syntax-object-expression2089 id2657))) (if (annotation? e2693)
(annotation-expression e2693) e2693))) (w12692 (syntax-object-wrap2090
id2657))) (let ((marks2694 (join-marks2124 (wrap-marks2107 w2658)
(wrap-marks2107 w12692)))) (call-with-values (lambda () (search2659 id2691
(wrap-subst2108 w2658) marks2694)) (lambda (new-id2695 marks2696) (let ((t2697
new-id2695)) (if t2697 t2697 (let ((t2698 (call-with-values (lambda ()
(search2659 id2691 (wrap-subst2108 w12692) marks2696)) (lambda (x2700 .
ignore2699) x2700)))) (if t2698 t2698 id2691)))))))) (if (annotation? id2657)
(let ((id2701 (let ((e2702 id2657)) (if (annotation? e2702)
(annotation-expression e2702) e2702)))) (let ((t2703 (call-with-values (lambda
() (search2659 id2701 (wrap-subst2108 w2658) (wrap-marks2107 w2658))) (lambda
(x2705 . ignore2704) x2705)))) (if t2703 t2703 id2701))) (syntax-violation
(quote id-var-name) "invalid id" id2657))))))) (same-marks?2125 (lambda (x2706
y2707) (let ((t2708 (eq? x2706 y2707))) (if t2708 t2708 (if (not (null? x2706))
(if (not (null? y2707)) (if (eq? (car x2706) (car y2707)) (same-marks?2125 (cdr
x2706) (cdr y2707)) #f) #f) #f))))) (join-marks2124 (lambda (m12709 m22710)
(smart-append2122 m12709 m22710))) (join-wraps2123 (lambda (w12711 w22712) (let
((m12713 (wrap-marks2107 w12711)) (s12714 (wrap-subst2108 w12711))) (if (null?
m12713) (if (null? s12714) w22712 (make-wrap2106 (wrap-marks2107 w22712)
(smart-append2122 s12714 (wrap-subst2108 w22712)))) (make-wrap2106
(smart-append2122 m12713 (wrap-marks2107 w22712)) (smart-append2122 s12714
(wrap-subst2108 w22712))))))) (smart-append2122 (lambda (m12715 m22716) (if
(null? m22716) m12715 (append m12715 m22716)))) (make-binding-wrap2121 (lambda
(ids2717 labels2718 w2719) (if (null? ids2717) w2719 (make-wrap2106
(wrap-marks2107 w2719) (cons (let ((labelvec2720 (list->vector labels2718)))
(let ((n2721 (vector-length labelvec2720))) (let ((symnamevec2722 (make-vector
n2721)) (marksvec2723 (make-vector n2721))) (begin (letrec ((f2724 (lambda
(ids2725 i2726) (if (not (null? ids2725)) (call-with-values (lambda ()
(id-sym-name&marks2105 (car ids2725) w2719)) (lambda (symname2727 marks2728)
(begin (vector-set! symnamevec2722 i2726 symname2727) (vector-set! marksvec2723
i2726 marks2728) (f2724 (cdr ids2725) (fx+2063 i2726 1))))) (if #f #f)))))
(f2724 ids2717 0)) (make-ribcage2111 symnamevec2722 marksvec2723
labelvec2720))))) (wrap-subst2108 w2719)))))) (extend-ribcage!2120 (lambda
(ribcage2729 id2730 label2731) (begin (set-ribcage-symnames!2116 ribcage2729
(cons (let ((e2732 (syntax-object-expression2089 id2730))) (if (annotation?
e2732) (annotation-expression e2732) e2732)) (ribcage-symnames2113
ribcage2729))) (set-ribcage-marks!2117 ribcage2729 (cons (wrap-marks2107
(syntax-object-wrap2090 id2730)) (ribcage-marks2114 ribcage2729)))
(set-ribcage-labels!2118 ribcage2729 (cons label2731 (ribcage-labels2115
ribcage2729)))))) (anti-mark2119 (lambda (w2733) (make-wrap2106 (cons #f
(wrap-marks2107 w2733)) (cons (quote shift) (wrap-subst2108 w2733)))))
(set-ribcage-labels!2118 (lambda (x2734 update2735) (vector-set! x2734 3
update2735))) (set-ribcage-marks!2117 (lambda (x2736 update2737) (vector-set!
x2736 2 update2737))) (set-ribcage-symnames!2116 (lambda (x2738 update2739)
(vector-set! x2738 1 update2739))) (ribcage-labels2115 (lambda (x2740)
(vector-ref x2740 3))) (ribcage-marks2114 (lambda (x2741) (vector-ref x2741
2))) (ribcage-symnames2113 (lambda (x2742) (vector-ref x2742 1))) (ribcage?2112
(lambda (x2743) (if (vector? x2743) (if (= (vector-length x2743) 4) (eq?
(vector-ref x2743 0) (quote ribcage)) #f) #f))) (make-ribcage2111 (lambda
(symnames2744 marks2745 labels2746) (vector (quote ribcage) symnames2744
marks2745 labels2746))) (gen-labels2110 (lambda (ls2747) (if (null? ls2747)
(quote ()) (cons (gen-label2109) (gen-labels2110 (cdr ls2747))))))
(gen-label2109 (lambda () (string #\i))) (wrap-subst2108 cdr) (wrap-marks2107
car) (make-wrap2106 cons) (id-sym-name&marks2105 (lambda (x2748 w2749) (if
(syntax-object?2088 x2748) (values (let ((e2750 (syntax-object-expression2089
x2748))) (if (annotation? e2750) (annotation-expression e2750) e2750))
(join-marks2124 (wrap-marks2107 w2749) (wrap-marks2107 (syntax-object-wrap2090
x2748)))) (values (let ((e2751 x2748)) (if (annotation? e2751)
(annotation-expression e2751) e2751)) (wrap-marks2107 w2749))))) (id?2104
(lambda (x2752) (if (symbol? x2752) #t (if (syntax-object?2088 x2752) (symbol?
(let ((e2753 (syntax-object-expression2089 x2752))) (if (annotation? e2753)
(annotation-expression e2753) e2753))) (if (annotation? x2752) (symbol?
(annotation-expression x2752)) #f))))) (nonsymbol-id?2103 (lambda (x2754) (if
(syntax-object?2088 x2754) (symbol? (let ((e2755 (syntax-object-expression2089
x2754))) (if (annotation? e2755) (annotation-expression e2755) e2755))) #f)))
(global-extend2102 (lambda (type2756 sym2757 val2758)
(put-global-definition-hook2069 sym2757 type2756 val2758))) (lookup2101 (lambda
(x2759 r2760 mod2761) (let ((temp2762 (assq x2759 r2760))) (if temp2762 (cdr
temp2762) (if (symbol? x2759) (let ((t2763 (get-global-definition-hook2070
x2759 mod2761))) (if t2763 t2763 (quote (global)))) (quote
(displaced-lexical))))))) (macros-only-env2100 (lambda (r2764) (if (null?
r2764) (quote ()) (let ((a2765 (car r2764))) (if (eq? (cadr a2765) (quote
macro)) (cons a2765 (macros-only-env2100 (cdr r2764))) (macros-only-env2100
(cdr r2764))))))) (extend-var-env2099 (lambda (labels2766 vars2767 r2768) (if
(null? labels2766) r2768 (extend-var-env2099 (cdr labels2766) (cdr vars2767)
(cons (cons (car labels2766) (cons (quote lexical) (car vars2767))) r2768)))))
(extend-env2098 (lambda (labels2769 bindings2770 r2771) (if (null? labels2769)
r2771 (extend-env2098 (cdr labels2769) (cdr bindings2770) (cons (cons (car
labels2769) (car bindings2770)) r2771))))) (binding-value2097 cdr)
(binding-type2096 car) (source-annotation2095 (lambda (x2772) (if (annotation?
x2772) (annotation-source x2772) (if (syntax-object?2088 x2772)
(source-annotation2095 (syntax-object-expression2089 x2772)) #f))))
(set-syntax-object-module!2094 (lambda (x2773 update2774) (vector-set! x2773 3
update2774))) (set-syntax-object-wrap!2093 (lambda (x2775 update2776)
(vector-set! x2775 2 update2776))) (set-syntax-object-expression!2092 (lambda
(x2777 update2778) (vector-set! x2777 1 update2778))) (syntax-object-module2091
(lambda (x2779) (vector-ref x2779 3))) (syntax-object-wrap2090 (lambda (x2780)
(vector-ref x2780 2))) (syntax-object-expression2089 (lambda (x2781)
(vector-ref x2781 1))) (syntax-object?2088 (lambda (x2782) (if (vector? x2782)
(if (= (vector-length x2782) 4) (eq? (vector-ref x2782 0) (quote
syntax-object)) #f) #f))) (make-syntax-object2087 (lambda (expression2783
wrap2784 module2785) (vector (quote syntax-object) expression2783 wrap2784
module2785))) (build-letrec2086 (lambda (src2786 ids2787 vars2788 val-exps2789
body-exp2790) (if (null? vars2788) body-exp2790 (let ((atom-key2791 (fluid-ref
*mode*2062))) (if (memv atom-key2791 (quote (c))) ((@ (language tree-il)
make-letrec) src2786 ids2787 vars2788 val-exps2789 body-exp2790) (list (quote
letrec) (map list vars2788 val-exps2789) body-exp2790))))))
(build-named-let2085 (lambda (src2792 ids2793 vars2794 val-exps2795
body-exp2796) (let ((f2797 (car vars2794)) (f-name2798 (car ids2793)) (vars2799
(cdr vars2794)) (ids2800 (cdr ids2793))) (let ((atom-key2801 (fluid-ref
*mode*2062))) (if (memv atom-key2801 (quote (c))) ((@ (language tree-il)
make-letrec) src2792 (list f-name2798) (list f2797) (list (build-lambda2080
src2792 ids2800 vars2799 #f body-exp2796)) (build-application2072 src2792
(build-lexical-reference2074 (quote fun) src2792 f-name2798 f2797)
val-exps2795)) (list (quote let) f2797 (map list vars2799 val-exps2795)
body-exp2796)))))) (build-let2084 (lambda (src2802 ids2803 vars2804
val-exps2805 body-exp2806) (if (null? vars2804) body-exp2806 (let
((atom-key2807 (fluid-ref *mode*2062))) (if (memv atom-key2807 (quote (c))) ((@
(language tree-il) make-let) src2802 ids2803 vars2804 val-exps2805
body-exp2806) (list (quote let) (map list vars2804 val-exps2805)
body-exp2806)))))) (build-sequence2083 (lambda (src2808 exps2809) (if (null?
(cdr exps2809)) (car exps2809) (let ((atom-key2810 (fluid-ref *mode*2062))) (if
(memv atom-key2810 (quote (c))) ((@ (language tree-il) make-sequence) src2808
exps2809) (cons (quote begin) exps2809)))))) (build-data2082 (lambda (src2811
exp2812) (let ((atom-key2813 (fluid-ref *mode*2062))) (if (memv atom-key2813
(quote (c))) ((@ (language tree-il) make-const) src2811 exp2812) (if (if
(self-evaluating? exp2812) (not (vector? exp2812)) #f) exp2812 (list (quote
quote) exp2812)))))) (build-primref2081 (lambda (src2814 name2815) (if (equal?
(module-name (current-module)) (quote (guile))) (let ((atom-key2816 (fluid-ref
*mode*2062))) (if (memv atom-key2816 (quote (c))) ((@ (language tree-il)
make-toplevel-ref) src2814 name2815) name2815)) (let ((atom-key2817 (fluid-ref
*mode*2062))) (if (memv atom-key2817 (quote (c))) ((@ (language tree-il)
make-module-ref) src2814 (quote (guile)) name2815 #f) (list (quote @@) (quote
(guile)) name2815)))))) (build-lambda2080 (lambda (src2818 ids2819 vars2820
docstring2821 exp2822) (let ((atom-key2823 (fluid-ref *mode*2062))) (if (memv
atom-key2823 (quote (c))) ((@ (language tree-il) make-lambda) src2818 ids2819
vars2820 (if docstring2821 (list (cons (quote documentation) docstring2821))
(quote ())) exp2822) (cons (quote lambda) (cons vars2820 (append (if
docstring2821 (list docstring2821) (quote ())) (list exp2822))))))))
(build-global-definition2079 (lambda (source2824 var2825 exp2826) (let
((atom-key2827 (fluid-ref *mode*2062))) (if (memv atom-key2827 (quote (c))) ((@
(language tree-il) make-toplevel-define) source2824 var2825 exp2826) (list
(quote define) var2825 exp2826))))) (build-global-assignment2078 (lambda
(source2828 var2829 exp2830 mod2831) (analyze-variable2076 mod2831 var2829
(lambda (mod2832 var2833 public?2834) (let ((atom-key2835 (fluid-ref
*mode*2062))) (if (memv atom-key2835 (quote (c))) ((@ (language tree-il)
make-module-set) source2828 mod2832 var2833 public?2834 exp2830) (list (quote
set!) (list (if public?2834 (quote @) (quote @@)) mod2832 var2833) exp2830))))
(lambda (var2836) (let ((atom-key2837 (fluid-ref *mode*2062))) (if (memv
atom-key2837 (quote (c))) ((@ (language tree-il) make-toplevel-set) source2828
var2836 exp2830) (list (quote set!) var2836 exp2830)))))))
(build-global-reference2077 (lambda (source2838 var2839 mod2840)
(analyze-variable2076 mod2840 var2839 (lambda (mod2841 var2842 public?2843)
(let ((atom-key2844 (fluid-ref *mode*2062))) (if (memv atom-key2844 (quote
(c))) ((@ (language tree-il) make-module-ref) source2838 mod2841 var2842
public?2843) (list (if public?2843 (quote @) (quote @@)) mod2841 var2842))))
(lambda (var2845) (let ((atom-key2846 (fluid-ref *mode*2062))) (if (memv
atom-key2846 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source2838
var2845) var2845)))))) (analyze-variable2076 (lambda (mod2847 var2848
modref-cont2849 bare-cont2850) (if (not mod2847) (bare-cont2850 var2848) (let
((kind2851 (car mod2847)) (mod2852 (cdr mod2847))) (if (memv kind2851 (quote
(public))) (modref-cont2849 mod2852 var2848 #t) (if (memv kind2851 (quote
(private))) (if (not (equal? mod2852 (module-name (current-module))))
(modref-cont2849 mod2852 var2848 #f) (bare-cont2850 var2848)) (if (memv
kind2851 (quote (bare))) (bare-cont2850 var2848) (if (memv kind2851 (quote
(hygiene))) (if (if (not (equal? mod2852 (module-name (current-module))))
(module-variable (resolve-module mod2852) var2848) #f) (modref-cont2849 mod2852
var2848 #f) (bare-cont2850 var2848)) (syntax-violation #f "bad module kind"
var2848 mod2852))))))))) (build-lexical-assignment2075 (lambda (source2853
name2854 var2855 exp2856) (let ((atom-key2857 (fluid-ref *mode*2062))) (if
(memv atom-key2857 (quote (c))) ((@ (language tree-il) make-lexical-set)
source2853 name2854 var2855 exp2856) (list (quote set!) var2855 exp2856)))))
(build-lexical-reference2074 (lambda (type2858 source2859 name2860 var2861)
(let ((atom-key2862 (fluid-ref *mode*2062))) (if (memv atom-key2862 (quote
(c))) ((@ (language tree-il) make-lexical-ref) source2859 name2860 var2861)
var2861)))) (build-conditional2073 (lambda (source2863 test-exp2864
then-exp2865 else-exp2866) (let ((atom-key2867 (fluid-ref *mode*2062))) (if
(memv atom-key2867 (quote (c))) ((@ (language tree-il) make-conditional)
source2863 test-exp2864 then-exp2865 else-exp2866) (list (quote if)
test-exp2864 then-exp2865 else-exp2866))))) (build-application2072 (lambda
(source2868 fun-exp2869 arg-exps2870) (let ((atom-key2871 (fluid-ref
*mode*2062))) (if (memv atom-key2871 (quote (c))) ((@ (language tree-il)
make-application) source2868 fun-exp2869 arg-exps2870) (cons fun-exp2869
arg-exps2870))))) (build-void2071 (lambda (source2872) (let ((atom-key2873
(fluid-ref *mode*2062))) (if (memv atom-key2873 (quote (c))) ((@ (language
tree-il) make-void) source2872) (quote (if #f #f))))))
(get-global-definition-hook2070 (lambda (symbol2874 module2875) (begin (if (if
(not module2875) (current-module) #f) (warn "module system is booted, we should
have a module" symbol2874) (if #f #f)) (let ((v2876 (module-variable (if
module2875 (resolve-module (cdr module2875)) (current-module)) symbol2874)))
(if v2876 (if (variable-bound? v2876) (let ((val2877 (variable-ref v2876))) (if
(macro? val2877) (if (syncase-macro-type val2877) (cons (syncase-macro-type
val2877) (syncase-macro-binding val2877)) #f) #f)) #f) #f)))))
(put-global-definition-hook2069 (lambda (symbol2878 type2879 val2880) (let
((existing2881 (let ((v2882 (module-variable (current-module) symbol2878))) (if
v2882 (if (variable-bound? v2882) (let ((val2883 (variable-ref v2882))) (if
(macro? val2883) (if (not (syncase-macro-type val2883)) val2883 #f) #f)) #f)
#f)))) (module-define! (current-module) symbol2878 (if existing2881
(make-extended-syncase-macro existing2881 type2879 val2880) (make-syncase-macro
type2879 val2880)))))) (local-eval-hook2068 (lambda (x2884 mod2885)
(primitive-eval (list noexpand2061 (let ((atom-key2886 (fluid-ref *mode*2062)))
(if (memv atom-key2886 (quote (c))) ((@ (language tree-il) tree-il->scheme)
x2884) x2884)))))) (top-level-eval-hook2067 (lambda (x2887 mod2888)
(primitive-eval (list noexpand2061 (let ((atom-key2889 (fluid-ref *mode*2062)))
(if (memv atom-key2889 (quote (c))) ((@ (language tree-il) tree-il->scheme)
x2887) x2887)))))) (fx<2066 <) (fx=2065 =) (fx-2064 -) (fx+2063 +) (*mode*2062
(make-fluid)) (noexpand2061 "noexpand")) (begin (global-extend2102 (quote
local-syntax) (quote letrec-syntax) #t) (global-extend2102 (quote local-syntax)
(quote let-syntax) #f) (global-extend2102 (quote core) (quote fluid-let-syntax)
(lambda (e2890 r2891 w2892 s2893 mod2894) ((lambda (tmp2895) ((lambda (tmp2896)
(if (if tmp2896 (apply (lambda (_2897 var2898 val2899 e12900 e22901)
(valid-bound-ids?2129 var2898)) tmp2896) #f) (apply (lambda (_2903 var2904
val2905 e12906 e22907) (let ((names2908 (map (lambda (x2909) (id-var-name2126
x2909 w2892)) var2904))) (begin (for-each (lambda (id2911 n2912) (let
((atom-key2913 (binding-type2096 (lookup2101 n2912 r2891 mod2894)))) (if (memv
atom-key2913 (quote (displaced-lexical))) (syntax-violation (quote
fluid-let-syntax) "identifier out of context" e2890 (source-wrap2133 id2911
w2892 s2893 mod2894)) (if #f #f)))) var2904 names2908) (chi-body2144 (cons
e12906 e22907) (source-wrap2133 e2890 w2892 s2893 mod2894) (extend-env2098
names2908 (let ((trans-r2916 (macros-only-env2100 r2891))) (map (lambda (x2917)
(cons (quote macro) (eval-local-transformer2147 (chi2140 x2917 trans-r2916
w2892 mod2894) mod2894))) val2905)) r2891) w2892 mod2894)))) tmp2896) ((lambda
(_2919) (syntax-violation (quote fluid-let-syntax) "bad syntax"
(source-wrap2133 e2890 w2892 s2893 mod2894))) tmp2895))) ($sc-dispatch tmp2895
(quote (any #(each (any any)) any . each-any))))) e2890))) (global-extend2102
(quote core) (quote quote) (lambda (e2920 r2921 w2922 s2923 mod2924) ((lambda
(tmp2925) ((lambda (tmp2926) (if tmp2926 (apply (lambda (_2927 e2928)
(build-data2082 s2923 (strip2151 e2928 w2922))) tmp2926) ((lambda (_2929)
(syntax-violation (quote quote) "bad syntax" (source-wrap2133 e2920 w2922 s2923
mod2924))) tmp2925))) ($sc-dispatch tmp2925 (quote (any any))))) e2920)))
(global-extend2102 (quote core) (quote syntax) (letrec ((regen2937 (lambda
(x2938) (let ((atom-key2939 (car x2938))) (if (memv atom-key2939 (quote (ref)))
(build-lexical-reference2074 (quote value) #f (cadr x2938) (cadr x2938)) (if
(memv atom-key2939 (quote (primitive))) (build-primref2081 #f (cadr x2938)) (if
(memv atom-key2939 (quote (quote))) (build-data2082 #f (cadr x2938)) (if (memv
atom-key2939 (quote (lambda))) (build-lambda2080 #f (cadr x2938) (cadr x2938)
#f (regen2937 (caddr x2938))) (if (memv atom-key2939 (quote (map))) (let
((ls2940 (map regen2937 (cdr x2938)))) (build-application2072 #f
(build-primref2081 #f (quote map)) ls2940)) (build-application2072 #f
(build-primref2081 #f (car x2938)) (map regen2937 (cdr x2938)))))))))))
(gen-vector2936 (lambda (x2941) (if (eq? (car x2941) (quote list)) (cons (quote
vector) (cdr x2941)) (if (eq? (car x2941) (quote quote)) (list (quote quote)
(list->vector (cadr x2941))) (list (quote list->vector) x2941)))))
(gen-append2935 (lambda (x2942 y2943) (if (equal? y2943 (quote (quote ())))
x2942 (list (quote append) x2942 y2943)))) (gen-cons2934 (lambda (x2944 y2945)
(let ((atom-key2946 (car y2945))) (if (memv atom-key2946 (quote (quote))) (if
(eq? (car x2944) (quote quote)) (list (quote quote) (cons (cadr x2944) (cadr
y2945))) (if (eq? (cadr y2945) (quote ())) (list (quote list) x2944) (list
(quote cons) x2944 y2945))) (if (memv atom-key2946 (quote (list))) (cons (quote
list) (cons x2944 (cdr y2945))) (list (quote cons) x2944 y2945))))))
(gen-map2933 (lambda (e2947 map-env2948) (let ((formals2949 (map cdr
map-env2948)) (actuals2950 (map (lambda (x2951) (list (quote ref) (car x2951)))
map-env2948))) (if (eq? (car e2947) (quote ref)) (car actuals2950) (if (and-map
(lambda (x2952) (if (eq? (car x2952) (quote ref)) (memq (cadr x2952)
formals2949) #f)) (cdr e2947)) (cons (quote map) (cons (list (quote primitive)
(car e2947)) (map (let ((r2953 (map cons formals2949 actuals2950))) (lambda
(x2954) (cdr (assq (cadr x2954) r2953)))) (cdr e2947)))) (cons (quote map)
(cons (list (quote lambda) formals2949 e2947) actuals2950)))))))
(gen-mappend2932 (lambda (e2955 map-env2956) (list (quote apply) (quote
(primitive append)) (gen-map2933 e2955 map-env2956)))) (gen-ref2931 (lambda
(src2957 var2958 level2959 maps2960) (if (fx=2065 level2959 0) (values var2958
maps2960) (if (null? maps2960) (syntax-violation (quote syntax) "missing
ellipsis" src2957) (call-with-values (lambda () (gen-ref2931 src2957 var2958
(fx-2064 level2959 1) (cdr maps2960))) (lambda (outer-var2961 outer-maps2962)
(let ((b2963 (assq outer-var2961 (car maps2960)))) (if b2963 (values (cdr
b2963) maps2960) (let ((inner-var2964 (gen-var2152 (quote tmp)))) (values
inner-var2964 (cons (cons (cons outer-var2961 inner-var2964) (car maps2960))
outer-maps2962))))))))))) (gen-syntax2930 (lambda (src2965 e2966 r2967 maps2968
ellipsis?2969 mod2970) (if (id?2104 e2966) (let ((label2971 (id-var-name2126
e2966 (quote (()))))) (let ((b2972 (lookup2101 label2971 r2967 mod2970))) (if
(eq? (binding-type2096 b2972) (quote syntax)) (call-with-values (lambda () (let
((var.lev2973 (binding-value2097 b2972))) (gen-ref2931 src2965 (car
var.lev2973) (cdr var.lev2973) maps2968))) (lambda (var2974 maps2975) (values
(list (quote ref) var2974) maps2975))) (if (ellipsis?2969 e2966)
(syntax-violation (quote syntax) "misplaced ellipsis" src2965) (values (list
(quote quote) e2966) maps2968))))) ((lambda (tmp2976) ((lambda (tmp2977) (if
(if tmp2977 (apply (lambda (dots2978 e2979) (ellipsis?2969 dots2978)) tmp2977)
#f) (apply (lambda (dots2980 e2981) (gen-syntax2930 src2965 e2981 r2967
maps2968 (lambda (x2982) #f) mod2970)) tmp2977) ((lambda (tmp2983) (if (if
tmp2983 (apply (lambda (x2984 dots2985 y2986) (ellipsis?2969 dots2985))
tmp2983) #f) (apply (lambda (x2987 dots2988 y2989) (letrec ((f2990 (lambda
(y2991 k2992) ((lambda (tmp2996) ((lambda (tmp2997) (if (if tmp2997 (apply
(lambda (dots2998 y2999) (ellipsis?2969 dots2998)) tmp2997) #f) (apply (lambda
(dots3000 y3001) (f2990 y3001 (lambda (maps3002) (call-with-values (lambda ()
(k2992 (cons (quote ()) maps3002))) (lambda (x3003 maps3004) (if (null? (car
maps3004)) (syntax-violation (quote syntax) "extra ellipsis" src2965) (values
(gen-mappend2932 x3003 (car maps3004)) (cdr maps3004)))))))) tmp2997) ((lambda
(_3005) (call-with-values (lambda () (gen-syntax2930 src2965 y2991 r2967
maps2968 ellipsis?2969 mod2970)) (lambda (y3006 maps3007) (call-with-values
(lambda () (k2992 maps3007)) (lambda (x3008 maps3009) (values (gen-append2935
x3008 y3006) maps3009)))))) tmp2996))) ($sc-dispatch tmp2996 (quote (any .
any))))) y2991)))) (f2990 y2989 (lambda (maps2993) (call-with-values (lambda ()
(gen-syntax2930 src2965 x2987 r2967 (cons (quote ()) maps2993) ellipsis?2969
mod2970)) (lambda (x2994 maps2995) (if (null? (car maps2995)) (syntax-violation
(quote syntax) "extra ellipsis" src2965) (values (gen-map2933 x2994 (car
maps2995)) (cdr maps2995))))))))) tmp2983) ((lambda (tmp3010) (if tmp3010
(apply (lambda (x3011 y3012) (call-with-values (lambda () (gen-syntax2930
src2965 x3011 r2967 maps2968 ellipsis?2969 mod2970)) (lambda (x3013 maps3014)
(call-with-values (lambda () (gen-syntax2930 src2965 y3012 r2967 maps3014
ellipsis?2969 mod2970)) (lambda (y3015 maps3016) (values (gen-cons2934 x3013
y3015) maps3016)))))) tmp3010) ((lambda (tmp3017) (if tmp3017 (apply (lambda
(e13018 e23019) (call-with-values (lambda () (gen-syntax2930 src2965 (cons
e13018 e23019) r2967 maps2968 ellipsis?2969 mod2970)) (lambda (e3021 maps3022)
(values (gen-vector2936 e3021) maps3022)))) tmp3017) ((lambda (_3023) (values
(list (quote quote) e2966) maps2968)) tmp2976))) ($sc-dispatch tmp2976 (quote
#(vector (any . each-any))))))) ($sc-dispatch tmp2976 (quote (any . any))))))
($sc-dispatch tmp2976 (quote (any any . any)))))) ($sc-dispatch tmp2976 (quote
(any any))))) e2966))))) (lambda (e3024 r3025 w3026 s3027 mod3028) (let ((e3029
(source-wrap2133 e3024 w3026 s3027 mod3028))) ((lambda (tmp3030) ((lambda
(tmp3031) (if tmp3031 (apply (lambda (_3032 x3033) (call-with-values (lambda ()
(gen-syntax2930 e3029 x3033 r3025 (quote ()) ellipsis?2149 mod3028)) (lambda
(e3034 maps3035) (regen2937 e3034)))) tmp3031) ((lambda (_3036)
(syntax-violation (quote syntax) "bad `syntax' form" e3029)) tmp3030)))
($sc-dispatch tmp3030 (quote (any any))))) e3029))))) (global-extend2102 (quote
core) (quote lambda) (lambda (e3037 r3038 w3039 s3040 mod3041) ((lambda
(tmp3042) ((lambda (tmp3043) (if tmp3043 (apply (lambda (_3044 c3045)
(chi-lambda-clause2145 (source-wrap2133 e3037 w3039 s3040 mod3041) #f c3045
r3038 w3039 mod3041 (lambda (names3046 vars3047 docstring3048 body3049)
(build-lambda2080 s3040 names3046 vars3047 docstring3048 body3049)))) tmp3043)
(syntax-violation #f "source expression failed to match any pattern" tmp3042)))
($sc-dispatch tmp3042 (quote (any . any))))) e3037))) (global-extend2102 (quote
core) (quote let) (letrec ((chi-let3050 (lambda (e3051 r3052 w3053 s3054
mod3055 constructor3056 ids3057 vals3058 exps3059) (if (not
(valid-bound-ids?2129 ids3057)) (syntax-violation (quote let) "duplicate bound
variable" e3051) (let ((labels3060 (gen-labels2110 ids3057)) (new-vars3061 (map
gen-var2152 ids3057))) (let ((nw3062 (make-binding-wrap2121 ids3057 labels3060
w3053)) (nr3063 (extend-var-env2099 labels3060 new-vars3061 r3052)))
(constructor3056 s3054 (map syntax->datum ids3057) new-vars3061 (map (lambda
(x3064) (chi2140 x3064 r3052 w3053 mod3055)) vals3058) (chi-body2144 exps3059
(source-wrap2133 e3051 nw3062 s3054 mod3055) nr3063 nw3062 mod3055))))))))
(lambda (e3065 r3066 w3067 s3068 mod3069) ((lambda (tmp3070) ((lambda (tmp3071)
(if tmp3071 (apply (lambda (_3072 id3073 val3074 e13075 e23076) (chi-let3050
e3065 r3066 w3067 s3068 mod3069 build-let2084 id3073 val3074 (cons e13075
e23076))) tmp3071) ((lambda (tmp3080) (if (if tmp3080 (apply (lambda (_3081
f3082 id3083 val3084 e13085 e23086) (id?2104 f3082)) tmp3080) #f) (apply
(lambda (_3087 f3088 id3089 val3090 e13091 e23092) (chi-let3050 e3065 r3066
w3067 s3068 mod3069 build-named-let2085 (cons f3088 id3089) val3090 (cons
e13091 e23092))) tmp3080) ((lambda (_3096) (syntax-violation (quote let) "bad
let" (source-wrap2133 e3065 w3067 s3068 mod3069))) tmp3070))) ($sc-dispatch
tmp3070 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch
tmp3070 (quote (any #(each (any any)) any . each-any))))) e3065))))
(global-extend2102 (quote core) (quote letrec) (lambda (e3097 r3098 w3099 s3100
mod3101) ((lambda (tmp3102) ((lambda (tmp3103) (if tmp3103 (apply (lambda
(_3104 id3105 val3106 e13107 e23108) (let ((ids3109 id3105)) (if (not
(valid-bound-ids?2129 ids3109)) (syntax-violation (quote letrec) "duplicate
bound variable" e3097) (let ((labels3111 (gen-labels2110 ids3109))
(new-vars3112 (map gen-var2152 ids3109))) (let ((w3113 (make-binding-wrap2121
ids3109 labels3111 w3099)) (r3114 (extend-var-env2099 labels3111 new-vars3112
r3098))) (build-letrec2086 s3100 (map syntax->datum ids3109) new-vars3112 (map
(lambda (x3115) (chi2140 x3115 r3114 w3113 mod3101)) val3106) (chi-body2144
(cons e13107 e23108) (source-wrap2133 e3097 w3113 s3100 mod3101) r3114 w3113
mod3101))))))) tmp3103) ((lambda (_3118) (syntax-violation (quote letrec) "bad
letrec" (source-wrap2133 e3097 w3099 s3100 mod3101))) tmp3102))) ($sc-dispatch
tmp3102 (quote (any #(each (any any)) any . each-any))))) e3097)))
(global-extend2102 (quote core) (quote set!) (lambda (e3119 r3120 w3121 s3122
mod3123) ((lambda (tmp3124) ((lambda (tmp3125) (if (if tmp3125 (apply (lambda
(_3126 id3127 val3128) (id?2104 id3127)) tmp3125) #f) (apply (lambda (_3129
id3130 val3131) (let ((val3132 (chi2140 val3131 r3120 w3121 mod3123)) (n3133
(id-var-name2126 id3130 w3121))) (let ((b3134 (lookup2101 n3133 r3120
mod3123))) (let ((atom-key3135 (binding-type2096 b3134))) (if (memv
atom-key3135 (quote (lexical))) (build-lexical-assignment2075 s3122
(syntax->datum id3130) (binding-value2097 b3134) val3132) (if (memv
atom-key3135 (quote (global))) (build-global-assignment2078 s3122 n3133 val3132
mod3123) (if (memv atom-key3135 (quote (displaced-lexical))) (syntax-violation
(quote set!) "identifier out of context" (wrap2132 id3130 w3121 mod3123))
(syntax-violation (quote set!) "bad set!" (source-wrap2133 e3119 w3121 s3122
mod3123))))))))) tmp3125) ((lambda (tmp3136) (if tmp3136 (apply (lambda (_3137
head3138 tail3139 val3140) (call-with-values (lambda () (syntax-type2138
head3138 r3120 (quote (())) #f #f mod3123)) (lambda (type3141 value3142 ee3143
ww3144 ss3145 modmod3146) (if (memv type3141 (quote (module-ref))) (let
((val3147 (chi2140 val3140 r3120 w3121 mod3123))) (call-with-values (lambda ()
(value3142 (cons head3138 tail3139))) (lambda (id3149 mod3150)
(build-global-assignment2078 s3122 id3149 val3147 mod3150))))
(build-application2072 s3122 (chi2140 (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)))
head3138) r3120 w3121 mod3123) (map (lambda (e3151) (chi2140 e3151 r3120 w3121
mod3123)) (append tail3139 (list val3140)))))))) tmp3136) ((lambda (_3153)
(syntax-violation (quote set!) "bad set!" (source-wrap2133 e3119 w3121 s3122
mod3123))) tmp3124))) ($sc-dispatch tmp3124 (quote (any (any . each-any)
any)))))) ($sc-dispatch tmp3124 (quote (any any any))))) e3119)))
(global-extend2102 (quote module-ref) (quote @) (lambda (e3154) ((lambda
(tmp3155) ((lambda (tmp3156) (if (if tmp3156 (apply (lambda (_3157 mod3158
id3159) (if (and-map id?2104 mod3158) (id?2104 id3159) #f)) tmp3156) #f) (apply
(lambda (_3161 mod3162 id3163) (values (syntax->datum id3163) (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)))
mod3162)))) tmp3156) (syntax-violation #f "source expression failed to match
any pattern" tmp3155))) ($sc-dispatch tmp3155 (quote (any each-any any)))))
e3154))) (global-extend2102 (quote module-ref) (quote @@) (lambda (e3165)
((lambda (tmp3166) ((lambda (tmp3167) (if (if tmp3167 (apply (lambda (_3168
mod3169 id3170) (if (and-map id?2104 mod3169) (id?2104 id3170) #f)) tmp3167)
#f) (apply (lambda (_3172 mod3173 id3174) (values (syntax->datum id3174)
(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)))
mod3173)))) tmp3167) (syntax-violation #f "source expression failed to match
any pattern" tmp3166))) ($sc-dispatch tmp3166 (quote (any each-any any)))))
e3165))) (global-extend2102 (quote core) (quote if) (lambda (e3176 r3177 w3178
s3179 mod3180) ((lambda (tmp3181) ((lambda (tmp3182) (if tmp3182 (apply (lambda
(_3183 test3184 then3185) (build-conditional2073 s3179 (chi2140 test3184 r3177
w3178 mod3180) (chi2140 then3185 r3177 w3178 mod3180) (build-void2071 #f)))
tmp3182) ((lambda (tmp3186) (if tmp3186 (apply (lambda (_3187 test3188 then3189
else3190) (build-conditional2073 s3179 (chi2140 test3188 r3177 w3178 mod3180)
(chi2140 then3189 r3177 w3178 mod3180) (chi2140 else3190 r3177 w3178 mod3180)))
tmp3186) (syntax-violation #f "source expression failed to match any pattern"
tmp3181))) ($sc-dispatch tmp3181 (quote (any any any any)))))) ($sc-dispatch
tmp3181 (quote (any any any))))) e3176))) (global-extend2102 (quote begin)
(quote begin) (quote ())) (global-extend2102 (quote define) (quote define)
(quote ())) (global-extend2102 (quote define-syntax) (quote define-syntax)
(quote ())) (global-extend2102 (quote eval-when) (quote eval-when) (quote ()))
(global-extend2102 (quote core) (quote syntax-case) (letrec
((gen-syntax-case3194 (lambda (x3195 keys3196 clauses3197 r3198 mod3199) (if
(null? clauses3197) (build-application2072 #f (build-primref2081 #f (quote
syntax-violation)) (list (build-data2082 #f #f) (build-data2082 #f "source
expression failed to match any pattern") x3195)) ((lambda (tmp3200) ((lambda
(tmp3201) (if tmp3201 (apply (lambda (pat3202 exp3203) (if (if (id?2104
pat3202) (and-map (lambda (x3204) (not (free-id=?2127 pat3202 x3204))) (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)))
keys3196)) #f) (let ((labels3205 (list (gen-label2109))) (var3206 (gen-var2152
pat3202))) (build-application2072 #f (build-lambda2080 #f (list (syntax->datum
pat3202)) (list var3206) #f (chi2140 exp3203 (extend-env2098 labels3205 (list
(cons (quote syntax) (cons var3206 0))) r3198) (make-binding-wrap2121 (list
pat3202) labels3205 (quote (()))) mod3199)) (list x3195))) (gen-clause3193
x3195 keys3196 (cdr clauses3197) r3198 pat3202 #t exp3203 mod3199))) tmp3201)
((lambda (tmp3207) (if tmp3207 (apply (lambda (pat3208 fender3209 exp3210)
(gen-clause3193 x3195 keys3196 (cdr clauses3197) r3198 pat3208 fender3209
exp3210 mod3199)) tmp3207) ((lambda (_3211) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses3197))) tmp3200))) ($sc-dispatch
tmp3200 (quote (any any any)))))) ($sc-dispatch tmp3200 (quote (any any)))))
(car clauses3197))))) (gen-clause3193 (lambda (x3212 keys3213 clauses3214 r3215
pat3216 fender3217 exp3218 mod3219) (call-with-values (lambda ()
(convert-pattern3191 pat3216 keys3213)) (lambda (p3220 pvars3221) (if (not
(distinct-bound-ids?2130 (map car pvars3221))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat3216) (if (not (and-map (lambda
(x3222) (not (ellipsis?2149 (car x3222)))) pvars3221)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat3216) (let ((y3223 (gen-var2152 (quote
tmp)))) (build-application2072 #f (build-lambda2080 #f (list (quote tmp)) (list
y3223) #f (let ((y3224 (build-lexical-reference2074 (quote value) #f (quote
tmp) y3223))) (build-conditional2073 #f ((lambda (tmp3225) ((lambda (tmp3226)
(if tmp3226 (apply (lambda () y3224) tmp3226) ((lambda (_3227)
(build-conditional2073 #f y3224 (build-dispatch-call3192 pvars3221 fender3217
y3224 r3215 mod3219) (build-data2082 #f #f))) tmp3225))) ($sc-dispatch tmp3225
(quote #(atom #t))))) fender3217) (build-dispatch-call3192 pvars3221 exp3218
y3224 r3215 mod3219) (gen-syntax-case3194 x3212 keys3213 clauses3214 r3215
mod3219)))) (list (if (eq? p3220 (quote any)) (build-application2072 #f
(build-primref2081 #f (quote list)) (list x3212)) (build-application2072 #f
(build-primref2081 #f (quote $sc-dispatch)) (list x3212 (build-data2082 #f
p3220))))))))))))) (build-dispatch-call3192 (lambda (pvars3228 exp3229 y3230
r3231 mod3232) (let ((ids3233 (map car pvars3228)) (levels3234 (map cdr
pvars3228))) (let ((labels3235 (gen-labels2110 ids3233)) (new-vars3236 (map
gen-var2152 ids3233))) (build-application2072 #f (build-primref2081 #f (quote
apply)) (list (build-lambda2080 #f (map syntax->datum ids3233) new-vars3236 #f
(chi2140 exp3229 (extend-env2098 labels3235 (map (lambda (var3237 level3238)
(cons (quote syntax) (cons var3237 level3238))) new-vars3236 (map cdr
pvars3228)) r3231) (make-binding-wrap2121 ids3233 labels3235 (quote (())))
mod3232)) y3230)))))) (convert-pattern3191 (lambda (pattern3239 keys3240)
(letrec ((cvt3241 (lambda (p3242 n3243 ids3244) (if (id?2104 p3242) (if
(bound-id-member?2131 p3242 keys3240) (values (vector (quote free-id) p3242)
ids3244) (values (quote any) (cons (cons p3242 n3243) ids3244))) ((lambda
(tmp3245) ((lambda (tmp3246) (if (if tmp3246 (apply (lambda (x3247 dots3248)
(ellipsis?2149 dots3248)) tmp3246) #f) (apply (lambda (x3249 dots3250)
(call-with-values (lambda () (cvt3241 x3249 (fx+2063 n3243 1) ids3244)) (lambda
(p3251 ids3252) (values (if (eq? p3251 (quote any)) (quote each-any) (vector
(quote each) p3251)) ids3252)))) tmp3246) ((lambda (tmp3253) (if tmp3253 (apply
(lambda (x3254 y3255) (call-with-values (lambda () (cvt3241 y3255 n3243
ids3244)) (lambda (y3256 ids3257) (call-with-values (lambda () (cvt3241 x3254
n3243 ids3257)) (lambda (x3258 ids3259) (values (cons x3258 y3256)
ids3259)))))) tmp3253) ((lambda (tmp3260) (if tmp3260 (apply (lambda () (values
(quote ()) ids3244)) tmp3260) ((lambda (tmp3261) (if tmp3261 (apply (lambda
(x3262) (call-with-values (lambda () (cvt3241 x3262 n3243 ids3244)) (lambda
(p3264 ids3265) (values (vector (quote vector) p3264) ids3265)))) tmp3261)
((lambda (x3266) (values (vector (quote atom) (strip2151 p3242 (quote (()))))
ids3244)) tmp3245))) ($sc-dispatch tmp3245 (quote #(vector each-any))))))
($sc-dispatch tmp3245 (quote ()))))) ($sc-dispatch tmp3245 (quote (any .
any)))))) ($sc-dispatch tmp3245 (quote (any any))))) p3242))))) (cvt3241
pattern3239 0 (quote ())))))) (lambda (e3267 r3268 w3269 s3270 mod3271) (let
((e3272 (source-wrap2133 e3267 w3269 s3270 mod3271))) ((lambda (tmp3273)
((lambda (tmp3274) (if tmp3274 (apply (lambda (_3275 val3276 key3277 m3278) (if
(and-map (lambda (x3279) (if (id?2104 x3279) (not (ellipsis?2149 x3279)) #f))
key3277) (let ((x3281 (gen-var2152 (quote tmp)))) (build-application2072 s3270
(build-lambda2080 #f (list (quote tmp)) (list x3281) #f (gen-syntax-case3194
(build-lexical-reference2074 (quote value) #f (quote tmp) x3281) key3277 m3278
r3268 mod3271)) (list (chi2140 val3276 r3268 (quote (())) mod3271))))
(syntax-violation (quote syntax-case) "invalid literals list" e3272))) tmp3274)
(syntax-violation #f "source expression failed to match any pattern" tmp3273)))
($sc-dispatch tmp3273 (quote (any any each-any . each-any))))) e3272))))) (set!
sc-expand (lambda (x3285 . rest3284) (if (if (pair? x3285) (equal? (car x3285)
noexpand2061) #f) (cadr x3285) (let ((m3286 (if (null? rest3284) (quote e) (car
rest3284))) (esew3287 (if (let ((t3288 (null? rest3284))) (if t3288 t3288
(null? (cdr rest3284)))) (quote (eval)) (cadr rest3284)))) (with-fluid*
*mode*2062 m3286 (lambda () (chi-top2139 x3285 (quote ()) (quote ((top))) m3286
esew3287 (cons (quote hygiene) (module-name (current-module)))))))))) (set!
identifier? (lambda (x3289) (nonsymbol-id?2103 x3289))) (set! datum->syntax
(lambda (id3290 datum3291) (make-syntax-object2087 datum3291
(syntax-object-wrap2090 id3290) #f))) (set! syntax->datum (lambda (x3292)
(strip2151 x3292 (quote (()))))) (set! generate-temporaries (lambda (ls3293)
(begin (let ((x3294 ls3293)) (if (not (list? x3294)) (syntax-violation (quote
generate-temporaries) "invalid argument" x3294) (if #f #f))) (map (lambda
(x3295) (wrap2132 (gensym) (quote ((top))) #f)) ls3293)))) (set!
free-identifier=? (lambda (x3296 y3297) (begin (let ((x3298 x3296)) (if (not
(nonsymbol-id?2103 x3298)) (syntax-violation (quote free-identifier=?) "invalid
argument" x3298) (if #f #f))) (let ((x3299 y3297)) (if (not (nonsymbol-id?2103
x3299)) (syntax-violation (quote free-identifier=?) "invalid argument" x3299)
(if #f #f))) (free-id=?2127 x3296 y3297)))) (set! bound-identifier=? (lambda
(x3300 y3301) (begin (let ((x3302 x3300)) (if (not (nonsymbol-id?2103 x3302))
(syntax-violation (quote bound-identifier=?) "invalid argument" x3302) (if #f
#f))) (let ((x3303 y3301)) (if (not (nonsymbol-id?2103 x3303))
(syntax-violation (quote bound-identifier=?) "invalid argument" x3303) (if #f
#f))) (bound-id=?2128 x3300 y3301)))) (set! syntax-violation (lambda (who3307
message3306 form3305 . subform3304) (begin (let ((x3308 who3307)) (if (not
((lambda (x3309) (let ((t3310 (not x3309))) (if t3310 t3310 (let ((t3311
(string? x3309))) (if t3311 t3311 (symbol? x3309)))))) x3308))
(syntax-violation (quote syntax-violation) "invalid argument" x3308) (if #f
#f))) (let ((x3312 message3306)) (if (not (string? x3312)) (syntax-violation
(quote syntax-violation) "invalid argument" x3312) (if #f #f))) (scm-error
(quote syntax-error) (quote sc-expand) (string-append (if who3307 "~a: " "")
"~a " (if (null? subform3304) "in ~a" "in subform `~s' of `~s'")) (let
((tail3313 (cons message3306 (map (lambda (x3314) (strip2151 x3314 (quote
(())))) (append subform3304 (list form3305)))))) (if who3307 (cons who3307
tail3313) tail3313)) #f)))) (letrec ((match3319 (lambda (e3320 p3321 w3322
r3323 mod3324) (if (not r3323) #f (if (eq? p3321 (quote any)) (cons (wrap2132
e3320 w3322 mod3324) r3323) (if (syntax-object?2088 e3320) (match*3318 (let
((e3325 (syntax-object-expression2089 e3320))) (if (annotation? e3325)
(annotation-expression e3325) e3325)) p3321 (join-wraps2123 w3322
(syntax-object-wrap2090 e3320)) r3323 (syntax-object-module2091 e3320))
(match*3318 (let ((e3326 e3320)) (if (annotation? e3326) (annotation-expression
e3326) e3326)) p3321 w3322 r3323 mod3324)))))) (match*3318 (lambda (e3327 p3328
w3329 r3330 mod3331) (if (null? p3328) (if (null? e3327) r3330 #f) (if (pair?
p3328) (if (pair? e3327) (match3319 (car e3327) (car p3328) w3329 (match3319
(cdr e3327) (cdr p3328) w3329 r3330 mod3331) mod3331) #f) (if (eq? p3328 (quote
each-any)) (let ((l3332 (match-each-any3316 e3327 w3329 mod3331))) (if l3332
(cons l3332 r3330) #f)) (let ((atom-key3333 (vector-ref p3328 0))) (if (memv
atom-key3333 (quote (each))) (if (null? e3327) (match-empty3317 (vector-ref
p3328 1) r3330) (let ((l3334 (match-each3315 e3327 (vector-ref p3328 1) w3329
mod3331))) (if l3334 (letrec ((collect3335 (lambda (l3336) (if (null? (car
l3336)) r3330 (cons (map car l3336) (collect3335 (map cdr l3336)))))))
(collect3335 l3334)) #f))) (if (memv atom-key3333 (quote (free-id))) (if
(id?2104 e3327) (if (free-id=?2127 (wrap2132 e3327 w3329 mod3331) (vector-ref
p3328 1)) r3330 #f) #f) (if (memv atom-key3333 (quote (atom))) (if (equal?
(vector-ref p3328 1) (strip2151 e3327 w3329)) r3330 #f) (if (memv atom-key3333
(quote (vector))) (if (vector? e3327) (match3319 (vector->list e3327)
(vector-ref p3328 1) w3329 r3330 mod3331) #f) (if #f #f)))))))))))
(match-empty3317 (lambda (p3337 r3338) (if (null? p3337) r3338 (if (eq? p3337
(quote any)) (cons (quote ()) r3338) (if (pair? p3337) (match-empty3317 (car
p3337) (match-empty3317 (cdr p3337) r3338)) (if (eq? p3337 (quote each-any))
(cons (quote ()) r3338) (let ((atom-key3339 (vector-ref p3337 0))) (if (memv
atom-key3339 (quote (each))) (match-empty3317 (vector-ref p3337 1) r3338) (if
(memv atom-key3339 (quote (free-id atom))) r3338 (if (memv atom-key3339 (quote
(vector))) (match-empty3317 (vector-ref p3337 1) r3338) (if #f #f)))))))))))
(match-each-any3316 (lambda (e3340 w3341 mod3342) (if (annotation? e3340)
(match-each-any3316 (annotation-expression e3340) w3341 mod3342) (if (pair?
e3340) (let ((l3343 (match-each-any3316 (cdr e3340) w3341 mod3342))) (if l3343
(cons (wrap2132 (car e3340) w3341 mod3342) l3343) #f)) (if (null? e3340) (quote
()) (if (syntax-object?2088 e3340) (match-each-any3316
(syntax-object-expression2089 e3340) (join-wraps2123 w3341
(syntax-object-wrap2090 e3340)) mod3342) #f)))))) (match-each3315 (lambda
(e3344 p3345 w3346 mod3347) (if (annotation? e3344) (match-each3315
(annotation-expression e3344) p3345 w3346 mod3347) (if (pair? e3344) (let
((first3348 (match3319 (car e3344) p3345 w3346 (quote ()) mod3347))) (if
first3348 (let ((rest3349 (match-each3315 (cdr e3344) p3345 w3346 mod3347)))
(if rest3349 (cons first3348 rest3349) #f)) #f)) (if (null? e3344) (quote ())
(if (syntax-object?2088 e3344) (match-each3315 (syntax-object-expression2089
e3344) p3345 (join-wraps2123 w3346 (syntax-object-wrap2090 e3344))
(syntax-object-module2091 e3344)) #f))))))) (set! $sc-dispatch (lambda (e3350
p3351) (if (eq? p3351 (quote any)) (list e3350) (if (syntax-object?2088 e3350)
(match*3318 (let ((e3352 (syntax-object-expression2089 e3350))) (if
(annotation? e3352) (annotation-expression e3352) e3352)) p3351
(syntax-object-wrap2090 e3350) (quote ()) (syntax-object-module2091 e3350))
(match*3318 (let ((e3353 e3350)) (if (annotation? e3353) (annotation-expression
e3353) e3353)) p3351 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x3354) ((lambda
(tmp3355) ((lambda (tmp3356) (if tmp3356 (apply (lambda (_3357 e13358 e23359)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e13358 e23359))) tmp3356) ((lambda (tmp3361) (if
tmp3361 (apply (lambda (_3362 out3363 in3364 e13365 e23366) (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))) in3364 (quote ()) (list out3363 (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 e13365 e23366))))) tmp3361) ((lambda
(tmp3368) (if tmp3368 (apply (lambda (_3369 out3370 in3371 e13372 e23373) (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))) in3371) (quote ()) (list out3370 (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 e13372 e23373))))) tmp3368) (syntax-violation #f "source
expression failed to match any pattern" tmp3355))) ($sc-dispatch tmp3355 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp3355 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp3355 (quote (any () any .
each-any))))) x3354))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x3377)
((lambda (tmp3378) ((lambda (tmp3379) (if tmp3379 (apply (lambda (_3380 k3381
keyword3382 pattern3383 template3384) (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 k3381 (map (lambda (tmp3387
tmp3386) (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)))
tmp3386) (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)))
tmp3387))) template3384 pattern3383)))))) tmp3379) (syntax-violation #f "source
expression failed to match any pattern" tmp3378))) ($sc-dispatch tmp3378 (quote
(any each-any . #(each ((any . any) any))))))) x3377))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x3388) ((lambda (tmp3389) ((lambda (tmp3390) (if
(if tmp3390 (apply (lambda (let*3391 x3392 v3393 e13394 e23395) (and-map
identifier? x3392)) tmp3390) #f) (apply (lambda (let*3397 x3398 v3399 e13400
e23401) (letrec ((f3402 (lambda (bindings3403) (if (null? bindings3403) (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 e13400 e23401)))
((lambda (tmp3407) ((lambda (tmp3408) (if tmp3408 (apply (lambda (body3409
binding3410) (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 binding3410) body3409)) tmp3408) (syntax-violation #f
"source expression failed to match any pattern" tmp3407))) ($sc-dispatch
tmp3407 (quote (any any))))) (list (f3402 (cdr bindings3403)) (car
bindings3403))))))) (f3402 (map list x3398 v3399)))) tmp3390) (syntax-violation
#f "source expression failed to match any pattern" tmp3389))) ($sc-dispatch
tmp3389 (quote (any #(each (any any)) any . each-any))))) x3388))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x3411) ((lambda (tmp3412) ((lambda (tmp3413)
(if tmp3413 (apply (lambda (_3414 var3415 init3416 step3417 e03418 e13419
c3420) ((lambda (tmp3421) ((lambda (tmp3422) (if tmp3422 (apply (lambda
(step3423) ((lambda (tmp3424) ((lambda (tmp3425) (if tmp3425 (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
var3415 init3416) (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))) e03418) (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 c3420 (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))) step3423))))))) tmp3425) ((lambda (tmp3430)
(if tmp3430 (apply (lambda (e13431 e23432) (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 var3415 init3416) (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))) e03418 (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 e13431 e23432)) (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 c3420 (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))) step3423))))))) tmp3430)
(syntax-violation #f "source expression failed to match any pattern" tmp3424)))
($sc-dispatch tmp3424 (quote (any . each-any)))))) ($sc-dispatch tmp3424 (quote
())))) e13419)) tmp3422) (syntax-violation #f "source expression failed to
match any pattern" tmp3421))) ($sc-dispatch tmp3421 (quote each-any)))) (map
(lambda (v3439 s3440) ((lambda (tmp3441) ((lambda (tmp3442) (if tmp3442 (apply
(lambda () v3439) tmp3442) ((lambda (tmp3443) (if tmp3443 (apply (lambda
(e3444) e3444) tmp3443) ((lambda (_3445) (syntax-violation (quote do) "bad step
expression" orig-x3411 s3440)) tmp3441))) ($sc-dispatch tmp3441 (quote
(any)))))) ($sc-dispatch tmp3441 (quote ())))) s3440)) var3415 step3417)))
tmp3413) (syntax-violation #f "source expression failed to match any pattern"
tmp3412))) ($sc-dispatch tmp3412 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x3411))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons3448 (lambda (x3452 y3453)
((lambda (tmp3454) ((lambda (tmp3455) (if tmp3455 (apply (lambda (x3456 y3457)
((lambda (tmp3458) ((lambda (tmp3459) (if tmp3459 (apply (lambda (dy3460)
((lambda (tmp3461) ((lambda (tmp3462) (if tmp3462 (apply (lambda (dx3463) (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 dx3463 dy3460))) tmp3462) ((lambda
(_3464) (if (null? dy3460) (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))) x3456) (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))) x3456 y3457))) tmp3461))) ($sc-dispatch
tmp3461 (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))))) x3456)) tmp3459) ((lambda (tmp3465) (if
tmp3465 (apply (lambda (stuff3466) (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 x3456 stuff3466))) tmp3465)
((lambda (else3467) (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))) x3456 y3457)) tmp3458))) ($sc-dispatch tmp3458
(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 tmp3458 (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))))) y3457)) tmp3455) (syntax-violation #f "source expression
failed to match any pattern" tmp3454))) ($sc-dispatch tmp3454 (quote (any
any))))) (list x3452 y3453)))) (quasiappend3449 (lambda (x3468 y3469) ((lambda
(tmp3470) ((lambda (tmp3471) (if tmp3471 (apply (lambda (x3472 y3473) ((lambda
(tmp3474) ((lambda (tmp3475) (if tmp3475 (apply (lambda () x3472) tmp3475)
((lambda (_3476) (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))) x3472 y3473)) tmp3474))) ($sc-dispatch tmp3474
(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))) ()))))) y3473))
tmp3471) (syntax-violation #f "source expression failed to match any pattern"
tmp3470))) ($sc-dispatch tmp3470 (quote (any any))))) (list x3468 y3469))))
(quasivector3450 (lambda (x3477) ((lambda (tmp3478) ((lambda (x3479) ((lambda
(tmp3480) ((lambda (tmp3481) (if tmp3481 (apply (lambda (x3482) (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
x3482))) tmp3481) ((lambda (tmp3484) (if tmp3484 (apply (lambda (x3485) (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))) x3485)) tmp3484)
((lambda (_3487) (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))) x3479)) tmp3480))) ($sc-dispatch tmp3480 (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 tmp3480 (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))))) x3479)) tmp3478)) x3477))) (quasi3451 (lambda
(p3488 lev3489) ((lambda (tmp3490) ((lambda (tmp3491) (if tmp3491 (apply
(lambda (p3492) (if (= lev3489 0) p3492 (quasicons3448 (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)))) (quasi3451 (list p3492) (- lev3489 1))))) tmp3491) ((lambda
(tmp3493) (if tmp3493 (apply (lambda (p3494 q3495) (if (= lev3489 0)
(quasiappend3449 p3494 (quasi3451 q3495 lev3489)) (quasicons3448 (quasicons3448
(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))))
(quasi3451 (list p3494) (- lev3489 1))) (quasi3451 q3495 lev3489)))) tmp3493)
((lambda (tmp3496) (if tmp3496 (apply (lambda (p3497) (quasicons3448 (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)))) (quasi3451 (list p3497) (+ lev3489
1)))) tmp3496) ((lambda (tmp3498) (if tmp3498 (apply (lambda (p3499 q3500)
(quasicons3448 (quasi3451 p3499 lev3489) (quasi3451 q3500 lev3489))) tmp3498)
((lambda (tmp3501) (if tmp3501 (apply (lambda (x3502) (quasivector3450
(quasi3451 x3502 lev3489))) tmp3501) ((lambda (p3504) (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))) p3504)) tmp3490))) ($sc-dispatch tmp3490 (quote #(vector
each-any)))))) ($sc-dispatch tmp3490 (quote (any . any)))))) ($sc-dispatch
tmp3490 (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 tmp3490 (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 tmp3490 (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))))) p3488)))) (lambda (x3505) ((lambda
(tmp3506) ((lambda (tmp3507) (if tmp3507 (apply (lambda (_3508 e3509)
(quasi3451 e3509 0)) tmp3507) (syntax-violation #f "source expression failed to
match any pattern" tmp3506))) ($sc-dispatch tmp3506 (quote (any any)))))
x3505)))))
+(define include (make-syncase-macro (quote macro) (lambda (x3510) (letrec
((read-file3511 (lambda (fn3512 k3513) (let ((p3514 (open-input-file fn3512)))
(letrec ((f3515 (lambda (x3516) (if (eof-object? x3516) (begin
(close-input-port p3514) (quote ())) (cons (datum->syntax k3513 x3516) (f3515
(read p3514))))))) (f3515 (read p3514))))))) ((lambda (tmp3517) ((lambda
(tmp3518) (if tmp3518 (apply (lambda (k3519 filename3520) (let ((fn3521
(syntax->datum filename3520))) ((lambda (tmp3522) ((lambda (tmp3523) (if
tmp3523 (apply (lambda (exp3524) (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))) exp3524)) tmp3523) (syntax-violation #f "source expression
failed to match any pattern" tmp3522))) ($sc-dispatch tmp3522 (quote
each-any)))) (read-file3511 fn3521 k3519)))) tmp3518) (syntax-violation #f
"source expression failed to match any pattern" tmp3517))) ($sc-dispatch
tmp3517 (quote (any any))))) x3510)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x3526) ((lambda
(tmp3527) ((lambda (tmp3528) (if tmp3528 (apply (lambda (_3529 e3530)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x3526)) tmp3528) (syntax-violation #f "source expression failed to match any
pattern" tmp3527))) ($sc-dispatch tmp3527 (quote (any any))))) x3526))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x3531)
((lambda (tmp3532) ((lambda (tmp3533) (if tmp3533 (apply (lambda (_3534 e3535)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x3531)) tmp3533) (syntax-violation #f "source expression failed to
match any pattern" tmp3532))) ($sc-dispatch tmp3532 (quote (any any)))))
x3531))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x3536) ((lambda (tmp3537) ((lambda (tmp3538) (if
tmp3538 (apply (lambda (_3539 e3540 m13541 m23542) ((lambda (tmp3543) ((lambda
(body3544) (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))) e3540)) body3544))
tmp3543)) (letrec ((f3545 (lambda (clause3546 clauses3547) (if (null?
clauses3547) ((lambda (tmp3549) ((lambda (tmp3550) (if tmp3550 (apply (lambda
(e13551 e23552) (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 e13551 e23552))) tmp3550) ((lambda (tmp3554) (if
tmp3554 (apply (lambda (k3555 e13556 e23557) (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))) k3555)) (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 e13556 e23557)))) tmp3554)
((lambda (_3560) (syntax-violation (quote case) "bad clause" x3536 clause3546))
tmp3549))) ($sc-dispatch tmp3549 (quote (each-any any . each-any))))))
($sc-dispatch tmp3549 (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))))) clause3546) ((lambda (tmp3561) ((lambda (rest3562) ((lambda
(tmp3563) ((lambda (tmp3564) (if tmp3564 (apply (lambda (k3565 e13566 e23567)
(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))) k3565)) (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 e13566 e23567)) rest3562)) tmp3564)
((lambda (_3570) (syntax-violation (quote case) "bad clause" x3536 clause3546))
tmp3563))) ($sc-dispatch tmp3563 (quote (each-any any . each-any)))))
clause3546)) tmp3561)) (f3545 (car clauses3547) (cdr clauses3547))))))) (f3545
m13541 m23542)))) tmp3538) (syntax-violation #f "source expression failed to
match any pattern" tmp3537))) ($sc-dispatch tmp3537 (quote (any any any .
each-any))))) x3536))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x3571)
((lambda (tmp3572) ((lambda (tmp3573) (if tmp3573 (apply (lambda (_3574 e3575)
(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)))
e3575)) (list (cons _3574 (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 e3575 (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)))))))))) tmp3573) (syntax-violation #f "source expression failed to
match any pattern" tmp3572))) ($sc-dispatch tmp3572 (quote (any any)))))
x3571))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index fd7ad59..bc3937c 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -351,6 +351,12 @@
;;; output constructors
+(define build-void
+ (lambda (source)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-void) source))
+ (else '(if #f #f)))))
+
(define build-application
(lambda (source fun-exp arg-exps)
(case (fluid-ref *mode*)
@@ -444,10 +450,13 @@
(define build-primref
(lambda (src name)
- (case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-primitive-ref) src name))
- ;; hygiene guile is a hack
- (else (build-global-reference src name '(hygiene guile))))))
+ (if (equal? (module-name (current-module)) '(guile))
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-toplevel-ref) src name))
+ (else name))
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-module-ref) src '(guile) name #f))
+ (else `(@@ (guile) ,name))))))
(define (build-data src exp)
(case (fluid-ref *mode*)
@@ -952,7 +961,10 @@
(list (build-application
no-source
(build-primref no-source 'module-ref)
- (list (build-application no-source 'current-module '())
+ (list (build-application
+ no-source
+ (build-primref no-source 'current-module)
+ '())
(build-data no-source name)))
(build-data no-source 'macro)
e))
@@ -1483,7 +1495,7 @@
(define chi-void
(lambda ()
- (build-application no-source (build-primref no-source 'if) '(#f #f))))
+ (build-void no-source)))
(define ellipsis?
(lambda (x)
@@ -1895,6 +1907,22 @@
(syntax->datum
(syntax (private mod ...))))))))
+(global-extend 'core 'if
+ (lambda (e r w s mod)
+ (syntax-case e ()
+ ((_ test then)
+ (build-conditional
+ s
+ (chi (syntax test) r w mod)
+ (chi (syntax then) r w mod)
+ (build-void no-source)))
+ ((_ test then else)
+ (build-conditional
+ s
+ (chi (syntax test) r w mod)
+ (chi (syntax then) r w mod)
+ (chi (syntax else) r w mod))))))
+
(global-extend 'begin 'begin '())
(global-extend 'define 'define '())
@@ -1995,7 +2023,10 @@
(if (null? clauses)
(build-application no-source
(build-primref no-source 'syntax-violation)
- (list #f "source expression failed to match any pattern" x))
+ (list (build-data no-source #f)
+ (build-data no-source
+ "source expression failed to match any
pattern")
+ x))
(syntax-case (car clauses) ()
((pat exp)
(if (and (id? (syntax pat))
diff --git a/module/language/glil/compile-assembly.scm
b/module/language/glil/compile-assembly.scm
index 73b2cd1..4c92e0f 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -312,7 +312,12 @@
(error "Unknown instruction:" inst))
(let ((pops (instruction-pops inst)))
(cond ((< pops 0)
- (emit-code `((,inst ,nargs))))
+ (case (instruction-length inst)
+ ((1) (emit-code `((,inst ,nargs))))
+ ((2) (emit-code `((,inst ,(quotient nargs 256)
+ ,(modulo nargs 256)))))
+ (else (error "Unknown length for variable-arg instruction:"
+ inst (instruction-length inst)))))
((= pops nargs)
(emit-code `((,inst))))
(else
diff --git a/module/language/scheme/compile-tree-il.scm
b/module/language/scheme/compile-tree-il.scm
index 553a3fd..4635abc 100644
--- a/module/language/scheme/compile-tree-il.scm
+++ b/module/language/scheme/compile-tree-il.scm
@@ -58,7 +58,7 @@
(save-module-excursion
(lambda ()
(and=> (cenv-module e) set-current-module)
- (let ((x (sc-expand x 'c '(compile load eval)))
- (cenv (make-cenv (current-module)
- (cenv-lexicals e) (cenv-externals e))))
+ (let* ((x (sc-expand x 'c '(compile load eval)))
+ (cenv (make-cenv (current-module)
+ (cenv-lexicals e) (cenv-externals e))))
(values x cenv cenv)))))
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
index 70085e8..4564fb9 100644
--- a/module/language/scheme/spec.scm
+++ b/module/language/scheme/spec.scm
@@ -47,8 +47,8 @@
#:version "0.5"
#:reader read
#:read-file read-file
- #:compilers `((ghil . ,compile-ghil)
- (tree-il . ,compile-tree-il))
+ #:compilers `((tree-il . ,compile-tree-il)
+ (ghil . ,compile-ghil))
#:decompilers `((tree-il . ,decompile-tree-il))
#:evaluator (lambda (x module) (primitive-eval x))
#:printer write
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index 1bd8d15..477f1fc 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -34,6 +34,21 @@
;; (let (2 3 4) ...))
;; etc.
;;
+;; This algorithm has the problem that variables are only allocated
+;; indices at the end of the binding path. If variables bound early in
+;; the path are not used in later portions of the path, their indices
+;; will not be recycled. This problem is particularly egregious in the
+;; expansion of `or':
+;;
+;; (or x y z)
+;; -> (let ((a x)) (if a a (let ((b y)) (if b b z))))
+;;
+;; As you can see, the `a' binding is only used in the ephemeral `then'
+;; clause of the first `if', but its index would be reserved for the
+;; whole of the `or' expansion. So we have a hack for this specific
+;; case. A proper solution would be some sort of liveness analysis, and
+;; not our linear allocation algorithm.
+;;
;; allocation:
;; sym -> (local . index) | (heap level . index)
;; lambda -> (nlocs . nexts)
@@ -48,6 +63,8 @@
;; when looking for closed-over vars.
;; heaps: sym -> lambda
;; allows us to heapify vars in an O(1) fashion
+ ;; refcounts: sym -> count
+ ;; allows us to detect the or-expansion an O(1) time
(define (find-heap sym parent)
;; fixme: check displaced lexicals here?
@@ -66,6 +83,7 @@
(step test) (step then) (step else))
((<lexical-ref> name gensym)
+ (hashq-set! refcounts gensym (1+ (hashq-ref refcounts gensym 0)))
(if (and (not (memq gensym (hashq-ref bindings parent)))
(not (hashq-ref heaps gensym)))
(hashq-set! heaps gensym (find-heap gensym parent))))
@@ -144,7 +162,7 @@
(let lp ((vars vars) (n 0))
(if (null? vars)
(hashq-set! allocation x
- (let ((nlocs (allocate! body (1+ level) n)))
+ (let ((nlocs (- (allocate! body (1+ level) n) n)))
(cons nlocs (1+ (hashq-ref heap-indexes x -1)))))
(let ((v (if (pair? vars) (car vars) vars)))
(let ((binder (hashq-ref heaps v)))
@@ -158,17 +176,32 @@
((<let> vars vals exp)
(let ((nmax (apply max (map recur vals))))
- (let lp ((vars vars) (n n))
- (if (null? vars)
- (max nmax (allocate! exp level n))
- (let ((v (car vars)))
- (let ((binder (hashq-ref heaps v)))
- (hashq-set!
- allocation v
- (if binder
- (cons* 'heap level (allocate-heap! binder))
- (cons 'stack n)))
- (lp (cdr vars) (if binder n (1+ n)))))))))
+ (cond
+ ;; the `or' hack
+ ((and (conditional? exp)
+ (= (length vars) 1)
+ (let ((v (car vars)))
+ (and (not (hashq-ref heaps v))
+ (= (hashq-ref refcounts v 0) 2)
+ (lexical-ref? (conditional-test exp))
+ (eq? (lexical-ref-gensym (conditional-test exp)) v)
+ (lexical-ref? (conditional-then exp))
+ (eq? (lexical-ref-gensym (conditional-then exp)) v))))
+ (hashq-set! allocation (car vars) (cons 'stack n))
+ ;; the 1+ for this var
+ (max nmax (1+ n) (allocate! (conditional-else exp) level n)))
+ (else
+ (let lp ((vars vars) (n n))
+ (if (null? vars)
+ (max nmax (allocate! exp level n))
+ (let ((v (car vars)))
+ (let ((binder (hashq-ref heaps v)))
+ (hashq-set!
+ allocation v
+ (if binder
+ (cons* 'heap level (allocate-heap! binder))
+ (cons 'stack n)))
+ (lp (cdr vars) (if binder n (1+ n)))))))))))
((<letrec> vars vals exp)
(let lp ((vars vars) (n n))
@@ -192,6 +225,7 @@
(define parents (make-hash-table))
(define bindings (make-hash-table))
(define heaps (make-hash-table))
+ (define refcounts (make-hash-table))
(define allocation (make-hash-table))
(define heap-indexes (make-hash-table))
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index b617bd8..c1e4cd8 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -32,20 +32,23 @@
;;
;; call-with-values -> mv-bind
;; compile-time-environment
-;; GOOPS' @slot-ref, @slot-set
;; basic degenerate-case reduction
;; allocation:
;; sym -> (local . index) | (heap level . index)
;; lambda -> (nlocs . nexts)
+(define *comp-module* (make-fluid))
+
(define (compile-glil x e opts)
(let* ((x (make-lambda (tree-il-src x) '() '() '() x))
(x (optimize! x e opts))
(allocation (analyze-lexicals x)))
- (values (flatten-lambda x -1 allocation)
- (and e (cons (car e) (cddr e)))
- e)))
+ (with-fluid* *comp-module* (or (and e (car e)) (current-module))
+ (lambda ()
+ (values (flatten-lambda x -1 allocation)
+ (and e (cons (car e) (cddr e)))
+ e)))))
@@ -75,7 +78,11 @@
((set-car! . 2) . set-car!)
((set-cdr! . 2) . set-cdr!)
((null? . 1) . null?)
- ((list? . 1) . list?)))
+ ((list? . 1) . list?)
+ (list . list)
+ (vector . vector)
+ ((@slot-ref . 2) . slot-ref)
+ ((@slot-set! . 3) . slot-set)))
(define (make-label) (gensym ":L"))
@@ -128,11 +135,11 @@
;; copy args to the heap if necessary
(let lp ((in vars) (n 0))
(if (not (null? in))
- (let ((loc (hashq-ref allocation (car vars))))
+ (let ((loc (hashq-ref allocation (car in))))
(case (car loc)
((heap)
- (emit-code (make-glil-argument 'ref n))
- (emit-code (make-glil-external 'set 0 (cddr loc)))))
+ (emit-code #f (make-glil-local 'ref n))
+ (emit-code #f (make-glil-external 'set 0 (cddr loc)))))
(lp (cdr in) (1+ n)))))
;; and here, here, dear reader: we compile.
@@ -197,11 +204,21 @@
(comp-push proc)
(for-each comp-push args)
(case context
- ((drop) (emit-code src (make-glil-call 'apply (length args)))
+ ((drop) (emit-code src (make-glil-call 'apply (1+ (length
args))))
(emit-code src (make-glil-call 'drop 1)))
- ((tail) (emit-code src (make-glil-call 'goto/apply (length
args))))
- ((push) (emit-code src (make-glil-call 'apply (length
args)))))))))
-
+ ((tail) (emit-code src (make-glil-call 'goto/apply (1+ (length
args)))))
+ ((push) (emit-code src (make-glil-call 'apply (1+ (length
args))))))))))
+
+ ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
+ (not (eq? context 'push)))
+ ;; tail: (lambda () (values '(1 2)))
+ ;; drop: (lambda () (values '(1 2)) 3)
+ ;; push: (lambda () (list (values '(10 12)) 1))
+ (case context
+ ((drop) (for-each comp-drop args))
+ ((tail)
+ (for-each comp-push args)
+ (emit-code src (make-glil-call 'return/values (length args))))))
((and (primitive-ref? proc)
(eq? (primitive-ref-name proc) '@call-with-values)
(= (length args) 2))
@@ -231,7 +248,7 @@
((and (primitive-ref? proc)
(eq? (primitive-ref-name proc) '@call-with-current-continuation)
- (= (length args 1)))
+ (= (length args) 1))
(comp-push (car args))
(case context
((tail) (emit-code src (make-glil-call 'goto/cc 1)))
@@ -240,8 +257,9 @@
(emit-code src (make-glil-call 'drop 1)))))
((and (primitive-ref? proc)
- (hash-ref *primcall-ops*
- (cons (primitive-ref-name proc) (length args))))
+ (or (hash-ref *primcall-ops*
+ (cons (primitive-ref-name proc) (length args)))
+ (hash-ref *primcall-ops* (primitive-ref-name proc))))
=> (lambda (op)
(for-each comp-push args)
(emit-code src (make-glil-call op (length args)))
@@ -277,12 +295,23 @@
(emit-label L2))))
((<primitive-ref> src name)
- (case context
- ((push)
- (emit-code src (make-glil-module 'ref '(guile) name #f)))
- ((tail)
- (emit-code src (make-glil-module 'ref '(guile) name #f))
- (emit-code #f (make-glil-call 'return 1)))))
+ (cond
+ ((eq? (module-variable (fluid-ref *comp-module*) name)
+ (module-variable the-root-module name))
+ (case context
+ ((push)
+ (emit-code src (make-glil-toplevel 'ref name)))
+ ((tail)
+ (emit-code src (make-glil-toplevel 'ref name))
+ (emit-code #f (make-glil-call 'return 1)))))
+ (else
+ (pk 'ew-the-badness x (current-module) (fluid-ref *comp-module*))
+ (case context
+ ((push)
+ (emit-code src (make-glil-module 'ref '(guile) name #f)))
+ ((tail)
+ (emit-code src (make-glil-module 'ref '(guile) name #f))
+ (emit-code #f (make-glil-call 'return 1)))))))
((<lexical-ref> src name gensym)
(case context
diff --git a/module/language/tree-il/optimize.scm
b/module/language/tree-il/optimize.scm
index e4e4996..c8c23c6 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -23,7 +23,7 @@
#:use-module (system base syntax)
#:use-module (language tree-il)
#:use-module (language tree-il inline)
- #:export (optimize!))
+ #:export (optimize! add-interesting-primitive!))
(define (env-module e)
(if e (car e) (current-module)))
@@ -53,6 +53,8 @@
not
pair? null? list? acons cons cons*
+ list vector
+
car cdr
set-car! set-cdr!
@@ -63,12 +65,13 @@
caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr))
-(define *interesting-primitive-vars*
- (let ((h (make-hash-table)))
- (for-each (lambda (x)
- (hashq-set! h (module-variable the-root-module x) x))
- *interesting-primitive-names*)
- h))
+(define (add-interesting-primitive! name)
+ (hashq-set! *interesting-primitive-vars*
+ (module-variable (current-module) name) name))
+
+(define *interesting-primitive-vars* (make-hash-table))
+
+(for-each add-interesting-primitive! *interesting-primitive-names*)
(define (resolve-primitives! x mod)
(post-order!
@@ -78,7 +81,7 @@
(and (hashq-ref *interesting-primitive-vars*
(module-variable mod name))
(make-primitive-ref src name)))
- ((<module-ref> mod name public?)
+ ((<module-ref> src mod name public?)
;; for the moment, we're disabling primitive resolution for
;; public refs because resolve-interface can raise errors.
(let ((m (and (not public?) (resolve-module mod))))
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index f84af33..d7220d4 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1061,31 +1061,10 @@
;; the idea is to compile the index into the procedure, for fastest
;; lookup. Also, @slot-ref and @slot-set! have their own bytecodes.
-;; separate expression so that we affect the expansion of the subsequent
-;; expression
(eval-when (compile)
- (use-modules ((language scheme compile-ghil) :select
(define-scheme-translator))
- ((language ghil) :select (make-ghil-inline make-ghil-call))
- (system base pmatch)))
-
-(eval-when (compile)
- ;; unfortunately, can't use define-inline because these are primitive
- ;; syntaxen.
- (define-scheme-translator @slot-ref
- ((,obj ,index) (guard (integer? index)
- (>= index 0) (< index max-fixnum))
- (make-ghil-inline #f #f 'slot-ref
- (list (retrans obj) (retrans index))))
- (else
- (make-ghil-call e l (retrans (car exp)) (map retrans (cdr exp)))))
-
- (define-scheme-translator @slot-set!
- ((,obj ,index ,val) (guard (integer? index)
- (>= index 0) (< index max-fixnum))
- (make-ghil-inline #f #f 'slot-set
- (list (retrans obj) (retrans index) (retrans val))))
- (else
- (make-ghil-call e l (retrans (car exp)) (map retrans (cdr exp))))))
+ (use-modules ((language tree-il optimize) :select
(add-interesting-primitive!)))
+ (add-interesting-primitive! '@slot-ref)
+ (add-interesting-primitive! '@slot-set!))
(eval-when (eval load compile)
(define num-standard-pre-cache 20))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index a92ba92..873051f 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -102,7 +102,7 @@
(with-test-prefix "primitive-ref"
(assert-tree-il->glil
(primitive +)
- (program 0 0 0 0 () (module private ref (guile) +) (call return 1)))
+ (program 0 0 0 0 () (toplevel ref +) (call return 1)))
(assert-tree-il->glil
(begin (primitive +) (const #f))
@@ -110,7 +110,7 @@
(assert-tree-il->glil
(apply (primitive null?) (primitive +))
- (program 0 0 0 0 () (module private ref (guile) +) (call null? 1)
+ (program 0 0 0 0 () (toplevel ref +) (call null? 1)
(call return 1))))
(with-test-prefix "lexical refs"
@@ -309,7 +309,7 @@
(assert-tree-il->glil
(lambda (x) (y) () (const 2))
(program 0 0 0 0 ()
- (program 1 0 1 0 ()
+ (program 1 0 0 0 ()
(bind (x local 0))
(const 2) (call return 1))
(call return 1)))
@@ -317,7 +317,7 @@
(assert-tree-il->glil
(lambda (x x1) (y y1) () (const 2))
(program 0 0 0 0 ()
- (program 2 0 2 0 ()
+ (program 2 0 0 0 ()
(bind (x local 0) (x1 local 1))
(const 2) (call return 1))
(call return 1)))
@@ -325,7 +325,7 @@
(assert-tree-il->glil
(lambda x y () (const 2))
(program 0 0 0 0 ()
- (program 1 1 1 0 ()
+ (program 1 1 0 0 ()
(bind (x local 0))
(const 2) (call return 1))
(call return 1)))
@@ -333,7 +333,7 @@
(assert-tree-il->glil
(lambda (x . x1) (y . y1) () (const 2))
(program 0 0 0 0 ()
- (program 2 1 2 0 ()
+ (program 2 1 0 0 ()
(bind (x local 0) (x1 local 1))
(const 2) (call return 1))
(call return 1)))
@@ -341,7 +341,7 @@
(assert-tree-il->glil
(lambda (x . x1) (y . y1) () (lexical x y))
(program 0 0 0 0 ()
- (program 2 1 2 0 ()
+ (program 2 1 0 0 ()
(bind (x local 0) (x1 local 1))
(local ref 0) (call return 1))
(call return 1)))
@@ -349,9 +349,21 @@
(assert-tree-il->glil
(lambda (x . x1) (y . y1) () (lexical x1 y1))
(program 0 0 0 0 ()
- (program 2 1 2 0 ()
+ (program 2 1 0 0 ()
(bind (x local 0) (x1 local 1))
(local ref 1) (call return 1))
+ (call return 1)))
+
+ (assert-tree-il->glil
+ (lambda (x) (x1) () (lambda (y) (y1) () (lexical x x1)))
+ (program 0 0 0 0 ()
+ (program 1 0 0 1 ()
+ (bind (x external 0))
+ (local ref 0) (external set 0 0)
+ (program 1 0 0 0 ()
+ (bind (y local 0))
+ (external ref 1 0) (call return 1))
+ (call return 1))
(call return 1))))
(with-test-prefix "sequence"
@@ -364,3 +376,40 @@
(apply (primitive null?) (begin (const #f) (const 2)))
(program 0 0 0 0 ()
(const 2) (call null? 1) (call return 1))))
+
+;; FIXME: binding info for or-hacked locals might bork the disassembler,
+;; and could be tightened in any case
+(with-test-prefix "the or hack"
+ (assert-tree-il->glil/pmatch
+ (let (x) (y) ((const 1))
+ (if (lexical x y)
+ (lexical x y)
+ (let (a) (b) ((const 2))
+ (lexical a b))))
+ (program 0 0 1 0 ()
+ (const 1) (bind (x local 0)) (local set 0)
+ (local ref 0) (branch br-if-not ,l1)
+ (local ref 0) (call return 1)
+ (label ,l2)
+ (const 2) (bind (a local 0)) (local set 0)
+ (local ref 0) (call return 1)
+ (unbind)
+ (unbind))
+ (eq? l1 l2))
+
+ (assert-tree-il->glil/pmatch
+ (let (x) (y) ((const 1))
+ (if (lexical x y)
+ (lexical x y)
+ (let (a) (b) ((const 2))
+ (lexical x y))))
+ (program 0 0 2 0 ()
+ (const 1) (bind (x local 0)) (local set 0)
+ (local ref 0) (branch br-if-not ,l1)
+ (local ref 0) (call return 1)
+ (label ,l2)
+ (const 2) (bind (a local 1)) (local set 1)
+ (local ref 0) (call return 1)
+ (unbind)
+ (unbind))
+ (eq? l1 l2)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. ad9b8c451b82f74cf88c5a6207ed3ea72c86f93e,
Andy Wingo <=