[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. bac0272216
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. bac0272216e89fa93bc935952befe0e7973625f7 |
|
Date: |
Sun, 26 Apr 2009 18:57:56 +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=bac0272216e89fa93bc935952befe0e7973625f7
The branch, syncase-in-boot-9 has been updated
via bac0272216e89fa93bc935952befe0e7973625f7 (commit)
via 22225fc113e716ec20712825e71191fedf3eecd8 (commit)
via e4721dde312fb2e00963e826441edcc71ee840be (commit)
via 165a7596ee62a2871de8569e3d41ef7f7c925594 (commit)
via 00bbb89e9694faac612ecf2e234291df086ebd11 (commit)
via f176c584d0513f4dea82329011f81f114f3a8ec9 (commit)
from 39f30ea29df55eda3f92d0cf68f1f89282a1418e (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 bac0272216e89fa93bc935952befe0e7973625f7
Author: Andy Wingo <address@hidden>
Date: Sun Apr 26 20:57:51 2009 +0200
build ecmascript stuff last
* module/Makefile.am: Wait to build ecmascript until the compiler has
bootstrapped.
commit 22225fc113e716ec20712825e71191fedf3eecd8
Author: Andy Wingo <address@hidden>
Date: Sun Apr 26 20:56:24 2009 +0200
syntax-object->datum => syntax->datum, likewise datum->syntax
* module/ice-9/boot-9.scm (datum->syntax, syntax->datum): Rename from
datum->syntax-object and syntax-object->datum, following r6rs. Change
all callers. Reorder some of the other exports from psyntax.
* module/ice-9/psyntax.scm: Change datum->syntax and syntax->datum
definitions and callers.
* module/ice-9/psyntax-pp.scm: Regenerated.
* module/oop/goops.scm (define-class-pre-definition): Update for changes.
commit e4721dde312fb2e00963e826441edcc71ee840be
Author: Andy Wingo <address@hidden>
Date: Sun Apr 26 20:36:58 2009 +0200
replace psyntax's syntax-error with r6rs' syntax-violation
* module/ice-9/boot-9.scm (syntax-violation): Well, as long as we have to
have a function for indicating syntax errors, let's let it be a
well-thought-out one -- syntax-violation from r6rs. No more
syntax-error.
* module/ice-9/psyntax-pp.scm: Regenerated.
* module/ice-9/psyntax.scm: Replace instances of syntax-error with
syntax-violation. Implement as a scm-error to 'syntax-error, with some
nice arguments.
commit 165a7596ee62a2871de8569e3d41ef7f7c925594
Author: Andy Wingo <address@hidden>
Date: Sun Apr 26 13:10:30 2009 +0200
add module-{define-keyword!,undefine-keyword!,lookup-keyword}
* libguile/modules.c (scm_module_local_variable): Allow this to be called
before modules are booted with #f as the module.
* module/ice-9/boot-9.scm (module-define-keyword!)
(module-lookup-keyword, module-undefine-keyword!): Well, if syncase
forces us to allow the keyword bindings to be partitioned from value
bindings, let's go ahead and do that in boot-9 instead of in
psyntax. A step on the way to removing `install-global-transformer'.
(sc-chi): Remove.
* module/ice-9/psyntax.scm (put-global-definition-hook):
(remove-global-definition-hook, get-global-definition-hook): Use our
new module-* functions.
(sc-chi): Remove, no longer needed.
* module/ice-9/psyntax-pp.scm: Regenerated.
commit 00bbb89e9694faac612ecf2e234291df086ebd11
Author: Andy Wingo <address@hidden>
Date: Sun Apr 26 11:48:29 2009 +0200
remove sc-macro definition
* module/ice-9/boot-9.scm (sc-macro): Remove sc-macro definition, yay.
commit f176c584d0513f4dea82329011f81f114f3a8ec9
Author: Andy Wingo <address@hidden>
Date: Sun Apr 26 11:35:23 2009 +0200
fix module-bound?, start compiling srfi-18.scm
* module/Makefile.am (SRFI_SOURCES): Let's finally start compiling
srfi-18.scm, what the hell.
* module/ice-9/boot-9.scm (module-bound?): module-bound? was returning
true if (not (variable-bound? (module-local-variable m v))), but
(variable-bound? (module-variable m v)). Fix to cut out on the first
variable it finds. This bug has been there for a while now.
-----------------------------------------------------------------------
Summary of changes:
libguile/modules.c | 4 +-
module/Makefile.am | 7 +-
module/ice-9/boot-9.scm | 53 +++++++++---
module/ice-9/psyntax-pp.scm | 22 +++---
module/ice-9/psyntax.scm | 199 ++++++++++++++++++++++---------------------
module/oop/goops.scm | 6 +-
6 files changed, 161 insertions(+), 130 deletions(-)
diff --git a/libguile/modules.c b/libguile/modules.c
index 2cb8a76..689510c 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -412,13 +412,13 @@ SCM_DEFINE (scm_module_local_variable,
"module-local-variable", 2, 0, 0,
register SCM b;
- /* SCM_MODULE_TAG is not initialized yet when `boot-9.scm' is being
- evaluated. */
if (scm_module_system_booted_p)
SCM_VALIDATE_MODULE (1, module);
SCM_VALIDATE_SYMBOL (2, sym);
+ if (scm_is_false (module))
+ return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
/* 1. Check module obarray */
b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
diff --git a/module/Makefile.am b/module/Makefile.am
index 28372c7..9cda51a 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -37,7 +37,7 @@ SOURCES =
\
\
language/ghil.scm language/glil.scm language/assembly.scm \
\
- $(SCHEME_LANG_SOURCES) $(ECMASCRIPT_LANG_SOURCES) \
+ $(SCHEME_LANG_SOURCES) \
$(GHIL_LANG_SOURCES) $(GLIL_LANG_SOURCES) \
$(ASSEMBLY_LANG_SOURCES) $(BYTECODE_LANG_SOURCES) \
$(OBJCODE_LANG_SOURCES) $(VALUE_LANG_SOURCES)
\
@@ -46,6 +46,7 @@ SOURCES =
\
$(SRFI_SOURCES) \
$(OOP_SOURCES) \
$(SYSTEM_SOURCES) \
+ $(ECMASCRIPT_LANG_SOURCES) \
$(SCRIPTS_SOURCES)
## test.scm is not currently installed.
@@ -189,6 +190,7 @@ SRFI_SOURCES = \
srfi/srfi-14.scm \
srfi/srfi-16.scm \
srfi/srfi-17.scm \
+ srfi/srfi-18.scm \
srfi/srfi-19.scm \
srfi/srfi-26.scm \
srfi/srfi-31.scm \
@@ -243,5 +245,4 @@ NOCOMP_SOURCES = \
ice-9/debugging/steps.scm \
ice-9/debugging/trace.scm \
ice-9/debugging/traps.scm \
- ice-9/debugging/trc.scm \
- srfi/srfi-18.scm
+ ice-9/debugging/trc.scm
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index b9484b7..b2b1f65 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -140,7 +140,6 @@
'(guile))
(define (module-add! module sym var)
(hashq-set! (%get-pre-modules-obarray) sym var))
-(define sc-macro 'sc-macro)
(define (make-module-ref mod var kind)
(case kind
((public) (if mod `(@ ,mod ,var) var))
@@ -157,20 +156,44 @@
(define (resolve-module . args)
#f)
+;;; Here we use "keyword" in the sense that R6RS uses it, as in "a
+;;; definition may be a keyword definition or a variable definition".
+;;; Keywords are syntactic bindings; variables are value bindings.
+(define (module-define-keyword! mod sym type val)
+ (let ((v (or (module-local-variable mod sym)
+ (let ((v (make-variable val)))
+ (module-add! mod sym v)
+ v))))
+ (if (or (not (variable-bound? v))
+ (not (macro? (variable-ref v))))
+ (variable-set! v val))
+ (set-object-property! v '*sc-expander* (cons type val))))
+
+(define (module-lookup-keyword mod sym)
+ (let ((v (module-variable mod sym)))
+ (and v (object-property v '*sc-expander*))))
+
+(define (module-undefine-keyword! mod sym)
+ (let ((v (module-local-variable mod sym)))
+ (if v
+ (let ((p (assq '*sc-expander* (object-properties v))))
+ ;; probably should unbind the variable too
+ (set-object-properties! v (delq p (object-properties v)))))))
+
(define sc-expand #f)
(define sc-expand3 #f)
-(define sc-chi #f)
(define install-global-transformer #f)
(define syntax-dispatch #f)
-(define syntax-error #f)
+(define syntax-violation #f)
(define (annotation? x) #f)
+(define datum->syntax #f)
+(define syntax->datum #f)
+
+(define identifier? #f)
+(define generate-temporaries #f)
(define bound-identifier=? #f)
-(define datum->syntax-object #f)
(define free-identifier=? #f)
-(define generate-temporaries #f)
-(define identifier? #f)
-(define syntax-object->datum #f)
(define andmap
(lambda (f first . rest)
@@ -212,28 +235,28 @@
"Define a defmacro."
(syntax-case x ()
((_ (macro . args) doc body1 body ...)
- (string? (syntax-object->datum (syntax doc)))
+ (string? (syntax->datum (syntax doc)))
(syntax (define-macro macro doc (lambda args body1 body ...))))
((_ (macro . args) body ...)
(syntax (define-macro macro #f (lambda args body ...))))
((_ macro doc transformer)
- (or (string? (syntax-object->datum (syntax doc)))
- (not (syntax-object->datum (syntax doc))))
+ (or (string? (syntax->datum (syntax doc)))
+ (not (syntax->datum (syntax doc))))
(syntax
(define-syntax macro
(lambda (y)
doc
(syntax-case y ()
((_ . args)
- (let ((v (syntax-object->datum (syntax args))))
- (datum->syntax-object y (apply transformer v))))))))))))
+ (let ((v (syntax->datum (syntax args))))
+ (datum->syntax y (apply transformer v))))))))))))
(define-syntax defmacro
(lambda (x)
"Define a defmacro, with the old lispy defun syntax."
(syntax-case x ()
((_ macro args doc body1 body ...)
- (string? (syntax-object->datum (syntax doc)))
+ (string? (syntax->datum (syntax doc)))
(syntax (define-macro macro doc (lambda args body1 body ...))))
((_ macro args body ...)
(syntax (define-macro macro #f (lambda args body ...)))))))
@@ -1405,7 +1428,9 @@
;; or its uses?
;;
(define (module-bound? m v)
- (module-search module-locally-bound? m v))
+ (let ((var (module-variable m v)))
+ (and var
+ (variable-bound? var))))
;;; {Is a symbol interned in a module?}
;;;
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 37b02c4..f178234 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)))))
(void)
-(letrec ((lambda-var-list1165 (lambda (vars1370) (let lvl1371 ((vars1372
vars1370) (ls1373 (quote ())) (w1374 (quote (())))) (cond ((pair? vars1372)
(lvl1371 (cdr vars1372) (cons (wrap1144 (car vars1372) w1374 #f) ls1373)
w1374)) ((id?1116 vars1372) (cons (wrap1144 vars1372 w1374 #f) ls1373)) ((null?
vars1372) ls1373) ((syntax-object?1100 vars1372) (lvl1371
(syntax-object-expression1101 vars1372) ls1373 (join-wraps1135 w1374
(syntax-object-wrap1102 vars1372)))) ((annotation? vars1372) (lvl1371
(annotation-expression vars1372) ls1373 w1374)) (else (cons vars1372
ls1373)))))) (gen-var1164 (lambda (id1375) (let ((id1376 (if
(syntax-object?1100 id1375) (syntax-object-expression1101 id1375) id1375))) (if
(annotation? id1376) (build-annotated1093 (annotation-source id1376) (gensym
(symbol->string (annotation-expression id1376)))) (build-annotated1093 #f
(gensym (symbol->string id1376))))))) (strip1163 (lambda (x1377 w1378) (if
(memq (quote top) (wrap-marks1119 w1378)) (if (or (annotation? x1377) (and
(pair? x1377) (annotation? (car x1377)))) (strip-annotation1162 x1377 #f)
x1377) (let f1379 ((x1380 x1377)) (cond ((syntax-object?1100 x1380) (strip1163
(syntax-object-expression1101 x1380) (syntax-object-wrap1102 x1380))) ((pair?
x1380) (let ((a1381 (f1379 (car x1380))) (d1382 (f1379 (cdr x1380)))) (if (and
(eq? a1381 (car x1380)) (eq? d1382 (cdr x1380))) x1380 (cons a1381 d1382))))
((vector? x1380) (let ((old1383 (vector->list x1380))) (let ((new1384 (map
f1379 old1383))) (if (andmap eq? old1383 new1384) x1380 (list->vector
new1384))))) (else x1380)))))) (strip-annotation1162 (lambda (x1385 parent1386)
(cond ((pair? x1385) (let ((new1387 (cons #f #f))) (begin (if parent1386
(set-annotation-stripped! parent1386 new1387)) (set-car! new1387
(strip-annotation1162 (car x1385) #f)) (set-cdr! new1387 (strip-annotation1162
(cdr x1385) #f)) new1387))) ((annotation? x1385) (or (annotation-stripped
x1385) (strip-annotation1162 (annotation-expression x1385) x1385))) ((vector?
x1385) (let ((new1388 (make-vector (vector-length x1385)))) (begin (if
parent1386 (set-annotation-stripped! parent1386 new1388)) (let loop1389 ((i1390
(- (vector-length x1385) 1))) (unless (fx<1086 i1390 0) (vector-set! new1388
i1390 (strip-annotation1162 (vector-ref x1385 i1390) #f)) (loop1389 (fx-1084
i1390 1)))) new1388))) (else x1385)))) (ellipsis?1161 (lambda (x1391) (and
(nonsymbol-id?1115 x1391) (free-id=?1139 x1391 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))))))) (chi-void1160 (lambda
() (build-annotated1093 #f (list (build-annotated1093 #f (quote void))))))
(eval-local-transformer1159 (lambda (expanded1392 mod1393) (let ((p1394
(local-eval-hook1088 expanded1392 mod1393))) (if (procedure? p1394) p1394
(syntax-error p1394 "nonprocedure transformer"))))) (chi-local-syntax1158
(lambda (rec?1395 e1396 r1397 w1398 s1399 mod1400 k1401) ((lambda (tmp1402)
((lambda (tmp1403) (if tmp1403 (apply (lambda (_1404 id1405 val1406 e11407
e21408) (let ((ids1409 id1405)) (if (not (valid-bound-ids?1141 ids1409))
(syntax-error e1396 "duplicate bound keyword in") (let ((labels1411
(gen-labels1122 ids1409))) (let ((new-w1412 (make-binding-wrap1133 ids1409
labels1411 w1398))) (k1401 (cons e11407 e21408) (extend-env1110 labels1411 (let
((w1414 (if rec?1395 new-w1412 w1398)) (trans-r1415 (macros-only-env1112
r1397))) (map (lambda (x1416) (cons (quote macro) (eval-local-transformer1159
(chi1152 x1416 trans-r1415 w1414 mod1400) mod1400))) val1406)) r1397) new-w1412
s1399 mod1400)))))) tmp1403) ((lambda (_1418) (syntax-error (source-wrap1145
e1396 w1398 s1399 mod1400))) tmp1402))) (syntax-dispatch tmp1402 (quote (any
#(each (any any)) any . each-any))))) e1396))) (chi-lambda-clause1157 (lambda
(e1419 docstring1420 c1421 r1422 w1423 mod1424 k1425) ((lambda (tmp1426)
((lambda (tmp1427) (if (if tmp1427 (apply (lambda (args1428 doc1429 e11430
e21431) (and (string? (syntax-object->datum doc1429)) (not docstring1420)))
tmp1427) #f) (apply (lambda (args1432 doc1433 e11434 e21435)
(chi-lambda-clause1157 e1419 doc1433 (cons args1432 (cons e11434 e21435)) r1422
w1423 mod1424 k1425)) tmp1427) ((lambda (tmp1437) (if tmp1437 (apply (lambda
(id1438 e11439 e21440) (let ((ids1441 id1438)) (if (not (valid-bound-ids?1141
ids1441)) (syntax-error e1419 "invalid parameter list in") (let ((labels1443
(gen-labels1122 ids1441)) (new-vars1444 (map gen-var1164 ids1441))) (k1425
new-vars1444 docstring1420 (chi-body1156 (cons e11439 e21440) e1419
(extend-var-env1111 labels1443 new-vars1444 r1422) (make-binding-wrap1133
ids1441 labels1443 w1423) mod1424)))))) tmp1437) ((lambda (tmp1446) (if tmp1446
(apply (lambda (ids1447 e11448 e21449) (let ((old-ids1450 (lambda-var-list1165
ids1447))) (if (not (valid-bound-ids?1141 old-ids1450)) (syntax-error e1419
"invalid parameter list in") (let ((labels1451 (gen-labels1122 old-ids1450))
(new-vars1452 (map gen-var1164 old-ids1450))) (k1425 (let f1453 ((ls11454 (cdr
new-vars1452)) (ls21455 (car new-vars1452))) (if (null? ls11454) ls21455 (f1453
(cdr ls11454) (cons (car ls11454) ls21455)))) docstring1420 (chi-body1156 (cons
e11448 e21449) e1419 (extend-var-env1111 labels1451 new-vars1452 r1422)
(make-binding-wrap1133 old-ids1450 labels1451 w1423) mod1424)))))) tmp1446)
((lambda (_1457) (syntax-error e1419)) tmp1426))) (syntax-dispatch tmp1426
(quote (any any . each-any)))))) (syntax-dispatch tmp1426 (quote (each-any any
. each-any)))))) (syntax-dispatch tmp1426 (quote (any any any . each-any)))))
c1421))) (chi-body1156 (lambda (body1458 outer-form1459 r1460 w1461 mod1462)
(let ((r1463 (cons (quote ("placeholder" placeholder)) r1460))) (let
((ribcage1464 (make-ribcage1123 (quote ()) (quote ()) (quote ())))) (let
((w1465 (make-wrap1118 (wrap-marks1119 w1461) (cons ribcage1464 (wrap-subst1120
w1461))))) (let parse1466 ((body1467 (map (lambda (x1473) (cons r1463 (wrap1144
x1473 w1465 mod1462))) body1458)) (ids1468 (quote ())) (labels1469 (quote ()))
(vars1470 (quote ())) (vals1471 (quote ())) (bindings1472 (quote ()))) (if
(null? body1467) (syntax-error outer-form1459 "no expressions in body") (let
((e1474 (cdar body1467)) (er1475 (caar body1467))) (call-with-values (lambda ()
(syntax-type1150 e1474 er1475 (quote (())) #f ribcage1464 mod1462)) (lambda
(type1476 value1477 e1478 w1479 s1480 mod1481) (let ((t1482 type1476)) (if
(memv t1482 (quote (define-form))) (let ((id1483 (wrap1144 value1477 w1479
mod1481)) (label1484 (gen-label1121))) (let ((var1485 (gen-var1164 id1483)))
(begin (extend-ribcage!1132 ribcage1464 id1483 label1484) (parse1466 (cdr
body1467) (cons id1483 ids1468) (cons label1484 labels1469) (cons var1485
vars1470) (cons (cons er1475 (wrap1144 e1478 w1479 mod1481)) vals1471) (cons
(cons (quote lexical) var1485) bindings1472))))) (if (memv t1482 (quote
(define-syntax-form))) (let ((id1486 (wrap1144 value1477 w1479 mod1481))
(label1487 (gen-label1121))) (begin (extend-ribcage!1132 ribcage1464 id1486
label1487) (parse1466 (cdr body1467) (cons id1486 ids1468) (cons label1487
labels1469) vars1470 vals1471 (cons (cons (quote macro) (cons er1475 (wrap1144
e1478 w1479 mod1481))) bindings1472)))) (if (memv t1482 (quote (begin-form)))
((lambda (tmp1488) ((lambda (tmp1489) (if tmp1489 (apply (lambda (_1490 e11491)
(parse1466 (let f1492 ((forms1493 e11491)) (if (null? forms1493) (cdr body1467)
(cons (cons er1475 (wrap1144 (car forms1493) w1479 mod1481)) (f1492 (cdr
forms1493))))) ids1468 labels1469 vars1470 vals1471 bindings1472)) tmp1489)
(syntax-error tmp1488))) (syntax-dispatch tmp1488 (quote (any . each-any)))))
e1478) (if (memv t1482 (quote (local-syntax-form))) (chi-local-syntax1158
value1477 e1478 er1475 w1479 s1480 mod1481 (lambda (forms1495 er1496 w1497
s1498 mod1499) (parse1466 (let f1500 ((forms1501 forms1495)) (if (null?
forms1501) (cdr body1467) (cons (cons er1496 (wrap1144 (car forms1501) w1497
mod1499)) (f1500 (cdr forms1501))))) ids1468 labels1469 vars1470 vals1471
bindings1472))) (if (null? ids1468) (build-sequence1095 #f (map (lambda (x1502)
(chi1152 (cdr x1502) (car x1502) (quote (())) mod1481)) (cons (cons er1475
(source-wrap1145 e1478 w1479 s1480 mod1481)) (cdr body1467)))) (begin (if (not
(valid-bound-ids?1141 ids1468)) (syntax-error outer-form1459 "invalid or
duplicate identifier in definition")) (let loop1503 ((bs1504 bindings1472)
(er-cache1505 #f) (r-cache1506 #f)) (if (not (null? bs1504)) (let ((b1507 (car
bs1504))) (if (eq? (car b1507) (quote macro)) (let ((er1508 (cadr b1507))) (let
((r-cache1509 (if (eq? er1508 er-cache1505) r-cache1506 (macros-only-env1112
er1508)))) (begin (set-cdr! b1507 (eval-local-transformer1159 (chi1152 (cddr
b1507) r-cache1509 (quote (())) mod1481) mod1481)) (loop1503 (cdr bs1504)
er1508 r-cache1509)))) (loop1503 (cdr bs1504) er-cache1505 r-cache1506)))))
(set-cdr! r1463 (extend-env1110 labels1469 bindings1472 (cdr r1463)))
(build-letrec1098 #f vars1470 (map (lambda (x1510) (chi1152 (cdr x1510) (car
x1510) (quote (())) mod1481)) vals1471) (build-sequence1095 #f (map (lambda
(x1511) (chi1152 (cdr x1511) (car x1511) (quote (())) mod1481)) (cons (cons
er1475 (source-wrap1145 e1478 w1479 s1480 mod1481)) (cdr
body1467)))))))))))))))))))))) (chi-macro1155 (lambda (p1512 e1513 r1514 w1515
rib1516 mod1517) (letrec ((rebuild-macro-output1518 (lambda (x1519 m1520) (cond
((pair? x1519) (cons (rebuild-macro-output1518 (car x1519) m1520)
(rebuild-macro-output1518 (cdr x1519) m1520))) ((syntax-object?1100 x1519) (let
((w1521 (syntax-object-wrap1102 x1519))) (let ((ms1522 (wrap-marks1119 w1521))
(s1523 (wrap-subst1120 w1521))) (if (and (pair? ms1522) (eq? (car ms1522) #f))
(make-syntax-object1099 (syntax-object-expression1101 x1519) (make-wrap1118
(cdr ms1522) (if rib1516 (cons rib1516 (cdr s1523)) (cdr s1523)))
(syntax-object-module1103 x1519)) (make-syntax-object1099
(syntax-object-expression1101 x1519) (make-wrap1118 (cons m1520 ms1522) (if
rib1516 (cons rib1516 (cons (quote shift) s1523)) (cons (quote shift) s1523)))
(let ((pmod1524 (procedure-module p1512))) (if pmod1524 (cons (quote hygiene)
(module-name pmod1524)) (quote (hygiene guile))))))))) ((vector? x1519) (let
((n1525 (vector-length x1519))) (let ((v1526 (make-vector n1525))) (let
doloop1527 ((i1528 0)) (if (fx=1085 i1528 n1525) v1526 (begin (vector-set!
v1526 i1528 (rebuild-macro-output1518 (vector-ref x1519 i1528) m1520))
(doloop1527 (fx+1083 i1528 1)))))))) ((symbol? x1519) (syntax-error x1519
"encountered raw symbol in macro output")) (else x1519)))))
(rebuild-macro-output1518 (p1512 (wrap1144 e1513 (anti-mark1131 w1515)
mod1517)) (string #\m))))) (chi-application1154 (lambda (x1529 e1530 r1531
w1532 s1533 mod1534) ((lambda (tmp1535) ((lambda (tmp1536) (if tmp1536 (apply
(lambda (e01537 e11538) (build-annotated1093 s1533 (cons x1529 (map (lambda
(e1539) (chi1152 e1539 r1531 w1532 mod1534)) e11538)))) tmp1536) (syntax-error
tmp1535))) (syntax-dispatch tmp1535 (quote (any . each-any))))) e1530)))
(chi-expr1153 (lambda (type1541 value1542 e1543 r1544 w1545 s1546 mod1547) (let
((t1548 type1541)) (if (memv t1548 (quote (lexical))) (build-annotated1093
s1546 value1542) (if (memv t1548 (quote (core external-macro))) (value1542
e1543 r1544 w1545 s1546 mod1547) (if (memv t1548 (quote (module-ref)))
(call-with-values (lambda () (value1542 e1543)) (lambda (id1549 mod1550)
(build-annotated1093 s1546 (if mod1550 (make-module-ref (cdr mod1550) id1549
(car mod1550)) (make-module-ref mod1550 id1549 (quote bare)))))) (if (memv
t1548 (quote (lexical-call))) (chi-application1154 (build-annotated1093
(source-annotation1107 (car e1543)) value1542) e1543 r1544 w1545 s1546 mod1547)
(if (memv t1548 (quote (global-call))) (chi-application1154
(build-annotated1093 (source-annotation1107 (car e1543)) (if (if
(syntax-object?1100 (car e1543)) (syntax-object-module1103 (car e1543))
mod1547) (make-module-ref (cdr (if (syntax-object?1100 (car e1543))
(syntax-object-module1103 (car e1543)) mod1547)) value1542 (car (if
(syntax-object?1100 (car e1543)) (syntax-object-module1103 (car e1543))
mod1547))) (make-module-ref (if (syntax-object?1100 (car e1543))
(syntax-object-module1103 (car e1543)) mod1547) value1542 (quote bare)))) e1543
r1544 w1545 s1546 mod1547) (if (memv t1548 (quote (constant))) (build-data1094
s1546 (strip1163 (source-wrap1145 e1543 w1545 s1546 mod1547) (quote (())))) (if
(memv t1548 (quote (global))) (build-annotated1093 s1546 (if mod1547
(make-module-ref (cdr mod1547) value1542 (car mod1547)) (make-module-ref
mod1547 value1542 (quote bare)))) (if (memv t1548 (quote (call)))
(chi-application1154 (chi1152 (car e1543) r1544 w1545 mod1547) e1543 r1544
w1545 s1546 mod1547) (if (memv t1548 (quote (begin-form))) ((lambda (tmp1551)
((lambda (tmp1552) (if tmp1552 (apply (lambda (_1553 e11554 e21555)
(chi-sequence1146 (cons e11554 e21555) r1544 w1545 s1546 mod1547)) tmp1552)
(syntax-error tmp1551))) (syntax-dispatch tmp1551 (quote (any any .
each-any))))) e1543) (if (memv t1548 (quote (local-syntax-form)))
(chi-local-syntax1158 value1542 e1543 r1544 w1545 s1546 mod1547
chi-sequence1146) (if (memv t1548 (quote (eval-when-form))) ((lambda (tmp1557)
((lambda (tmp1558) (if tmp1558 (apply (lambda (_1559 x1560 e11561 e21562) (let
((when-list1563 (chi-when-list1149 e1543 x1560 w1545))) (if (memq (quote eval)
when-list1563) (chi-sequence1146 (cons e11561 e21562) r1544 w1545 s1546
mod1547) (chi-void1160)))) tmp1558) (syntax-error tmp1557))) (syntax-dispatch
tmp1557 (quote (any each-any any . each-any))))) e1543) (if (memv t1548 (quote
(define-form define-syntax-form))) (syntax-error (wrap1144 value1542 w1545
mod1547) "invalid context for definition of") (if (memv t1548 (quote (syntax)))
(syntax-error (source-wrap1145 e1543 w1545 s1546 mod1547) "reference to pattern
variable outside syntax form") (if (memv t1548 (quote (displaced-lexical)))
(syntax-error (source-wrap1145 e1543 w1545 s1546 mod1547) "reference to
identifier outside its scope") (syntax-error (source-wrap1145 e1543 w1545 s1546
mod1547))))))))))))))))))) (chi1152 (lambda (e1566 r1567 w1568 mod1569)
(call-with-values (lambda () (syntax-type1150 e1566 r1567 w1568 #f #f mod1569))
(lambda (type1570 value1571 e1572 w1573 s1574 mod1575) (chi-expr1153 type1570
value1571 e1572 r1567 w1573 s1574 mod1575))))) (chi-top1151 (lambda (e1576
r1577 w1578 m1579 esew1580 mod1581) (call-with-values (lambda ()
(syntax-type1150 e1576 r1577 w1578 #f #f mod1581)) (lambda (type1589 value1590
e1591 w1592 s1593 mod1594) (let ((t1595 type1589)) (if (memv t1595 (quote
(begin-form))) ((lambda (tmp1596) ((lambda (tmp1597) (if tmp1597 (apply (lambda
(_1598) (chi-void1160)) tmp1597) ((lambda (tmp1599) (if tmp1599 (apply (lambda
(_1600 e11601 e21602) (chi-top-sequence1147 (cons e11601 e21602) r1577 w1592
s1593 m1579 esew1580 mod1594)) tmp1599) (syntax-error tmp1596)))
(syntax-dispatch tmp1596 (quote (any any . each-any)))))) (syntax-dispatch
tmp1596 (quote (any))))) e1591) (if (memv t1595 (quote (local-syntax-form)))
(chi-local-syntax1158 value1590 e1591 r1577 w1592 s1593 mod1594 (lambda
(body1604 r1605 w1606 s1607 mod1608) (chi-top-sequence1147 body1604 r1605 w1606
s1607 m1579 esew1580 mod1608))) (if (memv t1595 (quote (eval-when-form)))
((lambda (tmp1609) ((lambda (tmp1610) (if tmp1610 (apply (lambda (_1611 x1612
e11613 e21614) (let ((when-list1615 (chi-when-list1149 e1591 x1612 w1592))
(body1616 (cons e11613 e21614))) (cond ((eq? m1579 (quote e)) (if (memq (quote
eval) when-list1615) (chi-top-sequence1147 body1616 r1577 w1592 s1593 (quote e)
(quote (eval)) mod1594) (chi-void1160))) ((memq (quote load) when-list1615) (if
(or (memq (quote compile) when-list1615) (and (eq? m1579 (quote c&e)) (memq
(quote eval) when-list1615))) (chi-top-sequence1147 body1616 r1577 w1592 s1593
(quote c&e) (quote (compile load)) mod1594) (if (memq m1579 (quote (c c&e)))
(chi-top-sequence1147 body1616 r1577 w1592 s1593 (quote c) (quote (load))
mod1594) (chi-void1160)))) ((or (memq (quote compile) when-list1615) (and (eq?
m1579 (quote c&e)) (memq (quote eval) when-list1615))) (top-level-eval-hook1087
(chi-top-sequence1147 body1616 r1577 w1592 s1593 (quote e) (quote (eval))
mod1594) mod1594) (chi-void1160)) (else (chi-void1160))))) tmp1610)
(syntax-error tmp1609))) (syntax-dispatch tmp1609 (quote (any each-any any .
each-any))))) e1591) (if (memv t1595 (quote (define-syntax-form))) (let ((n1619
(id-var-name1138 value1590 w1592)) (r1620 (macros-only-env1112 r1577))) (let
((t1621 m1579)) (if (memv t1621 (quote (c))) (if (memq (quote compile)
esew1580) (let ((e1622 (chi-install-global1148 n1619 (chi1152 e1591 r1620 w1592
mod1594)))) (begin (top-level-eval-hook1087 e1622 mod1594) (if (memq (quote
load) esew1580) e1622 (chi-void1160)))) (if (memq (quote load) esew1580)
(chi-install-global1148 n1619 (chi1152 e1591 r1620 w1592 mod1594))
(chi-void1160))) (if (memv t1621 (quote (c&e))) (let ((e1623
(chi-install-global1148 n1619 (chi1152 e1591 r1620 w1592 mod1594)))) (begin
(top-level-eval-hook1087 e1623 mod1594) e1623)) (begin (if (memq (quote eval)
esew1580) (top-level-eval-hook1087 (chi-install-global1148 n1619 (chi1152 e1591
r1620 w1592 mod1594)) mod1594)) (chi-void1160)))))) (if (memv t1595 (quote
(define-form))) (let ((n1624 (id-var-name1138 value1590 w1592))) (let
((type1625 (binding-type1108 (lookup1113 n1624 r1577 mod1594)))) (let ((t1626
type1625)) (if (memv t1626 (quote (global))) (let ((x1627 (build-annotated1093
s1593 (list (quote define) n1624 (chi1152 e1591 r1577 w1592 mod1594))))) (begin
(if (eq? m1579 (quote c&e)) (top-level-eval-hook1087 x1627 mod1594)) x1627))
(if (memv t1626 (quote (displaced-lexical))) (syntax-error (wrap1144 value1590
w1592 mod1594) "identifier out of context") (if (memv t1626 (quote (core macro
module-ref))) (begin (remove-global-definition-hook1091 n1624) (let ((x1628
(build-annotated1093 s1593 (list (quote define) n1624 (chi1152 e1591 r1577
w1592 mod1594))))) (begin (if (eq? m1579 (quote c&e)) (top-level-eval-hook1087
x1628 mod1594)) x1628))) (syntax-error (wrap1144 value1590 w1592 mod1594)
"cannot define keyword at top level"))))))) (let ((x1629 (chi-expr1153 type1589
value1590 e1591 r1577 w1592 s1593 mod1594))) (begin (if (eq? m1579 (quote c&e))
(top-level-eval-hook1087 x1629 mod1594)) x1629)))))))))))) (syntax-type1150
(lambda (e1630 r1631 w1632 s1633 rib1634 mod1635) (cond ((symbol? e1630) (let
((n1636 (id-var-name1138 e1630 w1632))) (let ((b1637 (lookup1113 n1636 r1631
mod1635))) (let ((type1638 (binding-type1108 b1637))) (let ((t1639 type1638))
(if (memv t1639 (quote (lexical))) (values type1638 (binding-value1109 b1637)
e1630 w1632 s1633 mod1635) (if (memv t1639 (quote (global))) (values type1638
n1636 e1630 w1632 s1633 mod1635) (if (memv t1639 (quote (macro)))
(syntax-type1150 (chi-macro1155 (binding-value1109 b1637) e1630 r1631 w1632
rib1634 mod1635) r1631 (quote (())) s1633 rib1634 mod1635) (values type1638
(binding-value1109 b1637) e1630 w1632 s1633 mod1635))))))))) ((pair? e1630)
(let ((first1640 (car e1630))) (if (id?1116 first1640) (let ((n1641
(id-var-name1138 first1640 w1632))) (let ((b1642 (lookup1113 n1641 r1631 (or
(and (syntax-object?1100 first1640) (syntax-object-module1103 first1640))
mod1635)))) (let ((type1643 (binding-type1108 b1642))) (let ((t1644 type1643))
(if (memv t1644 (quote (lexical))) (values (quote lexical-call)
(binding-value1109 b1642) e1630 w1632 s1633 mod1635) (if (memv t1644 (quote
(global))) (values (quote global-call) n1641 e1630 w1632 s1633 mod1635) (if
(memv t1644 (quote (macro))) (syntax-type1150 (chi-macro1155 (binding-value1109
b1642) e1630 r1631 w1632 rib1634 mod1635) r1631 (quote (())) s1633 rib1634
mod1635) (if (memv t1644 (quote (core external-macro module-ref))) (values
type1643 (binding-value1109 b1642) e1630 w1632 s1633 mod1635) (if (memv t1644
(quote (local-syntax))) (values (quote local-syntax-form) (binding-value1109
b1642) e1630 w1632 s1633 mod1635) (if (memv t1644 (quote (begin))) (values
(quote begin-form) #f e1630 w1632 s1633 mod1635) (if (memv t1644 (quote
(eval-when))) (values (quote eval-when-form) #f e1630 w1632 s1633 mod1635) (if
(memv t1644 (quote (define))) ((lambda (tmp1645) ((lambda (tmp1646) (if (if
tmp1646 (apply (lambda (_1647 name1648 val1649) (id?1116 name1648)) tmp1646)
#f) (apply (lambda (_1650 name1651 val1652) (values (quote define-form)
name1651 val1652 w1632 s1633 mod1635)) tmp1646) ((lambda (tmp1653) (if (if
tmp1653 (apply (lambda (_1654 name1655 args1656 e11657 e21658) (and (id?1116
name1655) (valid-bound-ids?1141 (lambda-var-list1165 args1656)))) tmp1653) #f)
(apply (lambda (_1659 name1660 args1661 e11662 e21663) (values (quote
define-form) (wrap1144 name1660 w1632 mod1635) (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) (wrap1144 (cons args1661
(cons e11662 e21663)) w1632 mod1635)) (quote (())) s1633 mod1635)) tmp1653)
((lambda (tmp1665) (if (if tmp1665 (apply (lambda (_1666 name1667) (id?1116
name1667)) tmp1665) #f) (apply (lambda (_1668 name1669) (values (quote
define-form) (wrap1144 name1669 w1632 mod1635) (quote (#(syntax-object void
((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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1633
mod1635)) tmp1665) (syntax-error tmp1645))) (syntax-dispatch tmp1645 (quote
(any any)))))) (syntax-dispatch tmp1645 (quote (any (any . any) any .
each-any)))))) (syntax-dispatch tmp1645 (quote (any any any))))) e1630) (if
(memv t1644 (quote (define-syntax))) ((lambda (tmp1670) ((lambda (tmp1671) (if
(if tmp1671 (apply (lambda (_1672 name1673 val1674) (id?1116 name1673))
tmp1671) #f) (apply (lambda (_1675 name1676 val1677) (values (quote
define-syntax-form) name1676 val1677 w1632 s1633 mod1635)) tmp1671)
(syntax-error tmp1670))) (syntax-dispatch tmp1670 (quote (any any any)))))
e1630) (values (quote call) #f e1630 w1632 s1633 mod1635)))))))))))))) (values
(quote call) #f e1630 w1632 s1633 mod1635)))) ((syntax-object?1100 e1630)
(syntax-type1150 (syntax-object-expression1101 e1630) r1631 (join-wraps1135
w1632 (syntax-object-wrap1102 e1630)) #f rib1634 (or (syntax-object-module1103
e1630) mod1635))) ((annotation? e1630) (syntax-type1150 (annotation-expression
e1630) r1631 w1632 (annotation-source e1630) rib1634 mod1635))
((self-evaluating? e1630) (values (quote constant) #f e1630 w1632 s1633
mod1635)) (else (values (quote other) #f e1630 w1632 s1633 mod1635)))))
(chi-when-list1149 (lambda (e1678 when-list1679 w1680) (let f1681
((when-list1682 when-list1679) (situations1683 (quote ()))) (if (null?
when-list1682) situations1683 (f1681 (cdr when-list1682) (cons (let ((x1684
(car when-list1682))) (cond ((free-id=?1139 x1684 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile)))) (quote compile))
((free-id=?1139 x1684 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile)))) (quote load))
((free-id=?1139 x1684 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else
(syntax-error (wrap1144 x1684 w1680 #f) "invalid eval-when situation"))))
situations1683)))))) (chi-install-global1148 (lambda (name1685 e1686)
(build-annotated1093 #f (list (build-annotated1093 #f (quote
install-global-transformer)) (build-data1094 #f name1685) e1686))))
(chi-top-sequence1147 (lambda (body1687 r1688 w1689 s1690 m1691 esew1692
mod1693) (build-sequence1095 s1690 (let dobody1694 ((body1695 body1687) (r1696
r1688) (w1697 w1689) (m1698 m1691) (esew1699 esew1692) (mod1700 mod1693)) (if
(null? body1695) (quote ()) (let ((first1701 (chi-top1151 (car body1695) r1696
w1697 m1698 esew1699 mod1700))) (cons first1701 (dobody1694 (cdr body1695)
r1696 w1697 m1698 esew1699 mod1700)))))))) (chi-sequence1146 (lambda (body1702
r1703 w1704 s1705 mod1706) (build-sequence1095 s1705 (let dobody1707 ((body1708
body1702) (r1709 r1703) (w1710 w1704) (mod1711 mod1706)) (if (null? body1708)
(quote ()) (let ((first1712 (chi1152 (car body1708) r1709 w1710 mod1711)))
(cons first1712 (dobody1707 (cdr body1708) r1709 w1710 mod1711))))))))
(source-wrap1145 (lambda (x1713 w1714 s1715 defmod1716) (wrap1144 (if s1715
(make-annotation x1713 s1715 #f) x1713) w1714 defmod1716))) (wrap1144 (lambda
(x1717 w1718 defmod1719) (cond ((and (null? (wrap-marks1119 w1718)) (null?
(wrap-subst1120 w1718))) x1717) ((syntax-object?1100 x1717)
(make-syntax-object1099 (syntax-object-expression1101 x1717) (join-wraps1135
w1718 (syntax-object-wrap1102 x1717)) (syntax-object-module1103 x1717)))
((null? x1717) x1717) (else (make-syntax-object1099 x1717 w1718 defmod1719)))))
(bound-id-member?1143 (lambda (x1720 list1721) (and (not (null? list1721)) (or
(bound-id=?1140 x1720 (car list1721)) (bound-id-member?1143 x1720 (cdr
list1721)))))) (distinct-bound-ids?1142 (lambda (ids1722) (let distinct?1723
((ids1724 ids1722)) (or (null? ids1724) (and (not (bound-id-member?1143 (car
ids1724) (cdr ids1724))) (distinct?1723 (cdr ids1724)))))))
(valid-bound-ids?1141 (lambda (ids1725) (and (let all-ids?1726 ((ids1727
ids1725)) (or (null? ids1727) (and (id?1116 (car ids1727)) (all-ids?1726 (cdr
ids1727))))) (distinct-bound-ids?1142 ids1725)))) (bound-id=?1140 (lambda
(i1728 j1729) (if (and (syntax-object?1100 i1728) (syntax-object?1100 j1729))
(and (eq? (let ((e1730 (syntax-object-expression1101 i1728))) (if (annotation?
e1730) (annotation-expression e1730) e1730)) (let ((e1731
(syntax-object-expression1101 j1729))) (if (annotation? e1731)
(annotation-expression e1731) e1731))) (same-marks?1137 (wrap-marks1119
(syntax-object-wrap1102 i1728)) (wrap-marks1119 (syntax-object-wrap1102
j1729)))) (eq? (let ((e1732 i1728)) (if (annotation? e1732)
(annotation-expression e1732) e1732)) (let ((e1733 j1729)) (if (annotation?
e1733) (annotation-expression e1733) e1733)))))) (free-id=?1139 (lambda (i1734
j1735) (and (eq? (let ((x1736 i1734)) (let ((e1737 (if (syntax-object?1100
x1736) (syntax-object-expression1101 x1736) x1736))) (if (annotation? e1737)
(annotation-expression e1737) e1737))) (let ((x1738 j1735)) (let ((e1739 (if
(syntax-object?1100 x1738) (syntax-object-expression1101 x1738) x1738))) (if
(annotation? e1739) (annotation-expression e1739) e1739)))) (eq?
(id-var-name1138 i1734 (quote (()))) (id-var-name1138 j1735 (quote (())))))))
(id-var-name1138 (lambda (id1740 w1741) (letrec ((search-vector-rib1744 (lambda
(sym1750 subst1751 marks1752 symnames1753 ribcage1754) (let ((n1755
(vector-length symnames1753))) (let f1756 ((i1757 0)) (cond ((fx=1085 i1757
n1755) (search1742 sym1750 (cdr subst1751) marks1752)) ((and (eq? (vector-ref
symnames1753 i1757) sym1750) (same-marks?1137 marks1752 (vector-ref
(ribcage-marks1126 ribcage1754) i1757))) (values (vector-ref
(ribcage-labels1127 ribcage1754) i1757) marks1752)) (else (f1756 (fx+1083 i1757
1)))))))) (search-list-rib1743 (lambda (sym1758 subst1759 marks1760
symnames1761 ribcage1762) (let f1763 ((symnames1764 symnames1761) (i1765 0))
(cond ((null? symnames1764) (search1742 sym1758 (cdr subst1759) marks1760))
((and (eq? (car symnames1764) sym1758) (same-marks?1137 marks1760 (list-ref
(ribcage-marks1126 ribcage1762) i1765))) (values (list-ref (ribcage-labels1127
ribcage1762) i1765) marks1760)) (else (f1763 (cdr symnames1764) (fx+1083 i1765
1))))))) (search1742 (lambda (sym1766 subst1767 marks1768) (if (null?
subst1767) (values #f marks1768) (let ((fst1769 (car subst1767))) (if (eq?
fst1769 (quote shift)) (search1742 sym1766 (cdr subst1767) (cdr marks1768))
(let ((symnames1770 (ribcage-symnames1125 fst1769))) (if (vector? symnames1770)
(search-vector-rib1744 sym1766 subst1767 marks1768 symnames1770 fst1769)
(search-list-rib1743 sym1766 subst1767 marks1768 symnames1770 fst1769)))))))))
(cond ((symbol? id1740) (or (call-with-values (lambda () (search1742 id1740
(wrap-subst1120 w1741) (wrap-marks1119 w1741))) (lambda (x1772 . ignore1771)
x1772)) id1740)) ((syntax-object?1100 id1740) (let ((id1773 (let ((e1775
(syntax-object-expression1101 id1740))) (if (annotation? e1775)
(annotation-expression e1775) e1775))) (w11774 (syntax-object-wrap1102
id1740))) (let ((marks1776 (join-marks1136 (wrap-marks1119 w1741)
(wrap-marks1119 w11774)))) (call-with-values (lambda () (search1742 id1773
(wrap-subst1120 w1741) marks1776)) (lambda (new-id1777 marks1778) (or
new-id1777 (call-with-values (lambda () (search1742 id1773 (wrap-subst1120
w11774) marks1778)) (lambda (x1780 . ignore1779) x1780)) id1773))))))
((annotation? id1740) (let ((id1781 (let ((e1782 id1740)) (if (annotation?
e1782) (annotation-expression e1782) e1782)))) (or (call-with-values (lambda ()
(search1742 id1781 (wrap-subst1120 w1741) (wrap-marks1119 w1741))) (lambda
(x1784 . ignore1783) x1784)) id1781))) (else (error-hook1089 (quote
id-var-name) "invalid id" id1740)))))) (same-marks?1137 (lambda (x1785 y1786)
(or (eq? x1785 y1786) (and (not (null? x1785)) (not (null? y1786)) (eq? (car
x1785) (car y1786)) (same-marks?1137 (cdr x1785) (cdr y1786))))))
(join-marks1136 (lambda (m11787 m21788) (smart-append1134 m11787 m21788)))
(join-wraps1135 (lambda (w11789 w21790) (let ((m11791 (wrap-marks1119 w11789))
(s11792 (wrap-subst1120 w11789))) (if (null? m11791) (if (null? s11792) w21790
(make-wrap1118 (wrap-marks1119 w21790) (smart-append1134 s11792 (wrap-subst1120
w21790)))) (make-wrap1118 (smart-append1134 m11791 (wrap-marks1119 w21790))
(smart-append1134 s11792 (wrap-subst1120 w21790))))))) (smart-append1134
(lambda (m11793 m21794) (if (null? m21794) m11793 (append m11793 m21794))))
(make-binding-wrap1133 (lambda (ids1795 labels1796 w1797) (if (null? ids1795)
w1797 (make-wrap1118 (wrap-marks1119 w1797) (cons (let ((labelvec1798
(list->vector labels1796))) (let ((n1799 (vector-length labelvec1798))) (let
((symnamevec1800 (make-vector n1799)) (marksvec1801 (make-vector n1799)))
(begin (let f1802 ((ids1803 ids1795) (i1804 0)) (if (not (null? ids1803))
(call-with-values (lambda () (id-sym-name&marks1117 (car ids1803) w1797))
(lambda (symname1805 marks1806) (begin (vector-set! symnamevec1800 i1804
symname1805) (vector-set! marksvec1801 i1804 marks1806) (f1802 (cdr ids1803)
(fx+1083 i1804 1))))))) (make-ribcage1123 symnamevec1800 marksvec1801
labelvec1798))))) (wrap-subst1120 w1797)))))) (extend-ribcage!1132 (lambda
(ribcage1807 id1808 label1809) (begin (set-ribcage-symnames!1128 ribcage1807
(cons (let ((e1810 (syntax-object-expression1101 id1808))) (if (annotation?
e1810) (annotation-expression e1810) e1810)) (ribcage-symnames1125
ribcage1807))) (set-ribcage-marks!1129 ribcage1807 (cons (wrap-marks1119
(syntax-object-wrap1102 id1808)) (ribcage-marks1126 ribcage1807)))
(set-ribcage-labels!1130 ribcage1807 (cons label1809 (ribcage-labels1127
ribcage1807)))))) (anti-mark1131 (lambda (w1811) (make-wrap1118 (cons #f
(wrap-marks1119 w1811)) (cons (quote shift) (wrap-subst1120 w1811)))))
(set-ribcage-labels!1130 (lambda (x1812 update1813) (vector-set! x1812 3
update1813))) (set-ribcage-marks!1129 (lambda (x1814 update1815) (vector-set!
x1814 2 update1815))) (set-ribcage-symnames!1128 (lambda (x1816 update1817)
(vector-set! x1816 1 update1817))) (ribcage-labels1127 (lambda (x1818)
(vector-ref x1818 3))) (ribcage-marks1126 (lambda (x1819) (vector-ref x1819
2))) (ribcage-symnames1125 (lambda (x1820) (vector-ref x1820 1))) (ribcage?1124
(lambda (x1821) (and (vector? x1821) (= (vector-length x1821) 4) (eq?
(vector-ref x1821 0) (quote ribcage))))) (make-ribcage1123 (lambda
(symnames1822 marks1823 labels1824) (vector (quote ribcage) symnames1822
marks1823 labels1824))) (gen-labels1122 (lambda (ls1825) (if (null? ls1825)
(quote ()) (cons (gen-label1121) (gen-labels1122 (cdr ls1825))))))
(gen-label1121 (lambda () (string #\i))) (wrap-subst1120 cdr) (wrap-marks1119
car) (make-wrap1118 cons) (id-sym-name&marks1117 (lambda (x1826 w1827) (if
(syntax-object?1100 x1826) (values (let ((e1828 (syntax-object-expression1101
x1826))) (if (annotation? e1828) (annotation-expression e1828) e1828))
(join-marks1136 (wrap-marks1119 w1827) (wrap-marks1119 (syntax-object-wrap1102
x1826)))) (values (let ((e1829 x1826)) (if (annotation? e1829)
(annotation-expression e1829) e1829)) (wrap-marks1119 w1827))))) (id?1116
(lambda (x1830) (cond ((symbol? x1830) #t) ((syntax-object?1100 x1830) (symbol?
(let ((e1831 (syntax-object-expression1101 x1830))) (if (annotation? e1831)
(annotation-expression e1831) e1831)))) ((annotation? x1830) (symbol?
(annotation-expression x1830))) (else #f)))) (nonsymbol-id?1115 (lambda (x1832)
(and (syntax-object?1100 x1832) (symbol? (let ((e1833
(syntax-object-expression1101 x1832))) (if (annotation? e1833)
(annotation-expression e1833) e1833)))))) (global-extend1114 (lambda (type1834
sym1835 val1836) (put-global-definition-hook1090 sym1835 type1834 val1836)))
(lookup1113 (lambda (x1837 r1838 mod1839) (cond ((assq x1837 r1838) => cdr)
((symbol? x1837) (or (get-global-definition-hook1092 x1837 mod1839) (quote
(global)))) (else (quote (displaced-lexical)))))) (macros-only-env1112 (lambda
(r1840) (if (null? r1840) (quote ()) (let ((a1841 (car r1840))) (if (eq? (cadr
a1841) (quote macro)) (cons a1841 (macros-only-env1112 (cdr r1840)))
(macros-only-env1112 (cdr r1840))))))) (extend-var-env1111 (lambda (labels1842
vars1843 r1844) (if (null? labels1842) r1844 (extend-var-env1111 (cdr
labels1842) (cdr vars1843) (cons (cons (car labels1842) (cons (quote lexical)
(car vars1843))) r1844))))) (extend-env1110 (lambda (labels1845 bindings1846
r1847) (if (null? labels1845) r1847 (extend-env1110 (cdr labels1845) (cdr
bindings1846) (cons (cons (car labels1845) (car bindings1846)) r1847)))))
(binding-value1109 cdr) (binding-type1108 car) (source-annotation1107 (lambda
(x1848) (cond ((annotation? x1848) (annotation-source x1848))
((syntax-object?1100 x1848) (source-annotation1107
(syntax-object-expression1101 x1848))) (else #f))))
(set-syntax-object-module!1106 (lambda (x1849 update1850) (vector-set! x1849 3
update1850))) (set-syntax-object-wrap!1105 (lambda (x1851 update1852)
(vector-set! x1851 2 update1852))) (set-syntax-object-expression!1104 (lambda
(x1853 update1854) (vector-set! x1853 1 update1854))) (syntax-object-module1103
(lambda (x1855) (vector-ref x1855 3))) (syntax-object-wrap1102 (lambda (x1856)
(vector-ref x1856 2))) (syntax-object-expression1101 (lambda (x1857)
(vector-ref x1857 1))) (syntax-object?1100 (lambda (x1858) (and (vector? x1858)
(= (vector-length x1858) 4) (eq? (vector-ref x1858 0) (quote syntax-object)))))
(make-syntax-object1099 (lambda (expression1859 wrap1860 module1861) (vector
(quote syntax-object) expression1859 wrap1860 module1861))) (build-letrec1098
(lambda (src1862 vars1863 val-exps1864 body-exp1865) (if (null? vars1863)
(build-annotated1093 src1862 body-exp1865) (build-annotated1093 src1862 (list
(quote letrec) (map list vars1863 val-exps1864) body-exp1865)))))
(build-named-let1097 (lambda (src1866 vars1867 val-exps1868 body-exp1869) (if
(null? vars1867) (build-annotated1093 src1866 body-exp1869)
(build-annotated1093 src1866 (list (quote let) (car vars1867) (map list (cdr
vars1867) val-exps1868) body-exp1869))))) (build-let1096 (lambda (src1870
vars1871 val-exps1872 body-exp1873) (if (null? vars1871) (build-annotated1093
src1870 body-exp1873) (build-annotated1093 src1870 (list (quote let) (map list
vars1871 val-exps1872) body-exp1873))))) (build-sequence1095 (lambda (src1874
exps1875) (if (null? (cdr exps1875)) (build-annotated1093 src1874 (car
exps1875)) (build-annotated1093 src1874 (cons (quote begin) exps1875)))))
(build-data1094 (lambda (src1876 exp1877) (if (and (self-evaluating? exp1877)
(not (vector? exp1877))) (build-annotated1093 src1876 exp1877)
(build-annotated1093 src1876 (list (quote quote) exp1877)))))
(build-annotated1093 (lambda (src1878 exp1879) (if (and src1878 (not
(annotation? exp1879))) (make-annotation exp1879 src1878 #t) exp1879)))
(get-global-definition-hook1092 (lambda (symbol1880 module1881) (let
((module1882 (if module1881 (resolve-module (cdr module1881)) (let ((mod1883
(current-module))) (begin (if mod1883 (warn "wha" symbol1880)) mod1883)))))
(let ((v1884 (module-variable module1882 symbol1880))) (and v1884
(object-property v1884 (quote *sc-expander*)))))))
(remove-global-definition-hook1091 (lambda (symbol1885) (let ((module1886
(current-module))) (let ((v1887 (module-local-variable module1886 symbol1885)))
(if v1887 (let ((p1888 (assq (quote *sc-expander*) (object-properties v1887))))
(set-object-properties! v1887 (delq p1888 (object-properties v1887)))))))))
(put-global-definition-hook1090 (lambda (symbol1889 type1890 val1891) (let
((module1892 (current-module))) (let ((v1893 (or (module-variable module1892
symbol1889) (let ((v1894 (make-variable val1891))) (begin (module-add!
module1892 symbol1889 v1894) v1894))))) (begin (if (not (variable-bound?
v1893)) (variable-set! v1893 val1891)) (set-object-property! v1893 (quote
*sc-expander*) (cons type1890 val1891))))))) (error-hook1089 (lambda (who1895
why1896 what1897) (error who1895 "~a ~s" why1896 what1897)))
(local-eval-hook1088 (lambda (x1898 mod1899) (primitive-eval (list noexpand1082
x1898)))) (top-level-eval-hook1087 (lambda (x1900 mod1901) (primitive-eval
(list noexpand1082 x1900)))) (fx<1086 <) (fx=1085 =) (fx-1084 -) (fx+1083 +)
(noexpand1082 "noexpand")) (begin (global-extend1114 (quote local-syntax)
(quote letrec-syntax) #t) (global-extend1114 (quote local-syntax) (quote
let-syntax) #f) (global-extend1114 (quote core) (quote fluid-let-syntax)
(lambda (e1902 r1903 w1904 s1905 mod1906) ((lambda (tmp1907) ((lambda (tmp1908)
(if (if tmp1908 (apply (lambda (_1909 var1910 val1911 e11912 e21913)
(valid-bound-ids?1141 var1910)) tmp1908) #f) (apply (lambda (_1915 var1916
val1917 e11918 e21919) (let ((names1920 (map (lambda (x1921) (id-var-name1138
x1921 w1904)) var1916))) (begin (for-each (lambda (id1923 n1924) (let ((t1925
(binding-type1108 (lookup1113 n1924 r1903 mod1906)))) (if (memv t1925 (quote
(displaced-lexical))) (syntax-error (source-wrap1145 id1923 w1904 s1905
mod1906) "identifier out of context")))) var1916 names1920) (chi-body1156 (cons
e11918 e21919) (source-wrap1145 e1902 w1904 s1905 mod1906) (extend-env1110
names1920 (let ((trans-r1928 (macros-only-env1112 r1903))) (map (lambda (x1929)
(cons (quote macro) (eval-local-transformer1159 (chi1152 x1929 trans-r1928
w1904 mod1906) mod1906))) val1917)) r1903) w1904 mod1906)))) tmp1908) ((lambda
(_1931) (syntax-error (source-wrap1145 e1902 w1904 s1905 mod1906))) tmp1907)))
(syntax-dispatch tmp1907 (quote (any #(each (any any)) any . each-any)))))
e1902))) (global-extend1114 (quote core) (quote quote) (lambda (e1932 r1933
w1934 s1935 mod1936) ((lambda (tmp1937) ((lambda (tmp1938) (if tmp1938 (apply
(lambda (_1939 e1940) (build-data1094 s1935 (strip1163 e1940 w1934))) tmp1938)
((lambda (_1941) (syntax-error (source-wrap1145 e1932 w1934 s1935 mod1936)))
tmp1937))) (syntax-dispatch tmp1937 (quote (any any))))) e1932)))
(global-extend1114 (quote core) (quote syntax) (letrec ((regen1949 (lambda
(x1950) (let ((t1951 (car x1950))) (if (memv t1951 (quote (ref)))
(build-annotated1093 #f (cadr x1950)) (if (memv t1951 (quote (primitive)))
(build-annotated1093 #f (cadr x1950)) (if (memv t1951 (quote (quote)))
(build-data1094 #f (cadr x1950)) (if (memv t1951 (quote (lambda)))
(build-annotated1093 #f (list (quote lambda) (cadr x1950) (regen1949 (caddr
x1950)))) (if (memv t1951 (quote (map))) (let ((ls1952 (map regen1949 (cdr
x1950)))) (build-annotated1093 #f (cons (if (fx=1085 (length ls1952) 2)
(build-annotated1093 #f (quote map)) (build-annotated1093 #f (quote map)))
ls1952))) (build-annotated1093 #f (cons (build-annotated1093 #f (car x1950))
(map regen1949 (cdr x1950)))))))))))) (gen-vector1948 (lambda (x1953) (cond
((eq? (car x1953) (quote list)) (cons (quote vector) (cdr x1953))) ((eq? (car
x1953) (quote quote)) (list (quote quote) (list->vector (cadr x1953)))) (else
(list (quote list->vector) x1953))))) (gen-append1947 (lambda (x1954 y1955) (if
(equal? y1955 (quote (quote ()))) x1954 (list (quote append) x1954 y1955))))
(gen-cons1946 (lambda (x1956 y1957) (let ((t1958 (car y1957))) (if (memv t1958
(quote (quote))) (if (eq? (car x1956) (quote quote)) (list (quote quote) (cons
(cadr x1956) (cadr y1957))) (if (eq? (cadr y1957) (quote ())) (list (quote
list) x1956) (list (quote cons) x1956 y1957))) (if (memv t1958 (quote (list)))
(cons (quote list) (cons x1956 (cdr y1957))) (list (quote cons) x1956
y1957)))))) (gen-map1945 (lambda (e1959 map-env1960) (let ((formals1961 (map
cdr map-env1960)) (actuals1962 (map (lambda (x1963) (list (quote ref) (car
x1963))) map-env1960))) (cond ((eq? (car e1959) (quote ref)) (car actuals1962))
((andmap (lambda (x1964) (and (eq? (car x1964) (quote ref)) (memq (cadr x1964)
formals1961))) (cdr e1959)) (cons (quote map) (cons (list (quote primitive)
(car e1959)) (map (let ((r1965 (map cons formals1961 actuals1962))) (lambda
(x1966) (cdr (assq (cadr x1966) r1965)))) (cdr e1959))))) (else (cons (quote
map) (cons (list (quote lambda) formals1961 e1959) actuals1962)))))))
(gen-mappend1944 (lambda (e1967 map-env1968) (list (quote apply) (quote
(primitive append)) (gen-map1945 e1967 map-env1968)))) (gen-ref1943 (lambda
(src1969 var1970 level1971 maps1972) (if (fx=1085 level1971 0) (values var1970
maps1972) (if (null? maps1972) (syntax-error src1969 "missing ellipsis in
syntax form") (call-with-values (lambda () (gen-ref1943 src1969 var1970
(fx-1084 level1971 1) (cdr maps1972))) (lambda (outer-var1973 outer-maps1974)
(let ((b1975 (assq outer-var1973 (car maps1972)))) (if b1975 (values (cdr
b1975) maps1972) (let ((inner-var1976 (gen-var1164 (quote tmp)))) (values
inner-var1976 (cons (cons (cons outer-var1973 inner-var1976) (car maps1972))
outer-maps1974))))))))))) (gen-syntax1942 (lambda (src1977 e1978 r1979 maps1980
ellipsis?1981 mod1982) (if (id?1116 e1978) (let ((label1983 (id-var-name1138
e1978 (quote (()))))) (let ((b1984 (lookup1113 label1983 r1979 mod1982))) (if
(eq? (binding-type1108 b1984) (quote syntax)) (call-with-values (lambda () (let
((var.lev1985 (binding-value1109 b1984))) (gen-ref1943 src1977 (car
var.lev1985) (cdr var.lev1985) maps1980))) (lambda (var1986 maps1987) (values
(list (quote ref) var1986) maps1987))) (if (ellipsis?1981 e1978) (syntax-error
src1977 "misplaced ellipsis in syntax form") (values (list (quote quote) e1978)
maps1980))))) ((lambda (tmp1988) ((lambda (tmp1989) (if (if tmp1989 (apply
(lambda (dots1990 e1991) (ellipsis?1981 dots1990)) tmp1989) #f) (apply (lambda
(dots1992 e1993) (gen-syntax1942 src1977 e1993 r1979 maps1980 (lambda (x1994)
#f) mod1982)) tmp1989) ((lambda (tmp1995) (if (if tmp1995 (apply (lambda (x1996
dots1997 y1998) (ellipsis?1981 dots1997)) tmp1995) #f) (apply (lambda (x1999
dots2000 y2001) (let f2002 ((y2003 y2001) (k2004 (lambda (maps2005)
(call-with-values (lambda () (gen-syntax1942 src1977 x1999 r1979 (cons (quote
()) maps2005) ellipsis?1981 mod1982)) (lambda (x2006 maps2007) (if (null? (car
maps2007)) (syntax-error src1977 "extra ellipsis in syntax form") (values
(gen-map1945 x2006 (car maps2007)) (cdr maps2007)))))))) ((lambda (tmp2008)
((lambda (tmp2009) (if (if tmp2009 (apply (lambda (dots2010 y2011)
(ellipsis?1981 dots2010)) tmp2009) #f) (apply (lambda (dots2012 y2013) (f2002
y2013 (lambda (maps2014) (call-with-values (lambda () (k2004 (cons (quote ())
maps2014))) (lambda (x2015 maps2016) (if (null? (car maps2016)) (syntax-error
src1977 "extra ellipsis in syntax form") (values (gen-mappend1944 x2015 (car
maps2016)) (cdr maps2016)))))))) tmp2009) ((lambda (_2017) (call-with-values
(lambda () (gen-syntax1942 src1977 y2003 r1979 maps1980 ellipsis?1981 mod1982))
(lambda (y2018 maps2019) (call-with-values (lambda () (k2004 maps2019)) (lambda
(x2020 maps2021) (values (gen-append1947 x2020 y2018) maps2021)))))) tmp2008)))
(syntax-dispatch tmp2008 (quote (any . any))))) y2003))) tmp1995) ((lambda
(tmp2022) (if tmp2022 (apply (lambda (x2023 y2024) (call-with-values (lambda ()
(gen-syntax1942 src1977 x2023 r1979 maps1980 ellipsis?1981 mod1982)) (lambda
(x2025 maps2026) (call-with-values (lambda () (gen-syntax1942 src1977 y2024
r1979 maps2026 ellipsis?1981 mod1982)) (lambda (y2027 maps2028) (values
(gen-cons1946 x2025 y2027) maps2028)))))) tmp2022) ((lambda (tmp2029) (if
tmp2029 (apply (lambda (e12030 e22031) (call-with-values (lambda ()
(gen-syntax1942 src1977 (cons e12030 e22031) r1979 maps1980 ellipsis?1981
mod1982)) (lambda (e2033 maps2034) (values (gen-vector1948 e2033) maps2034))))
tmp2029) ((lambda (_2035) (values (list (quote quote) e1978) maps1980))
tmp1988))) (syntax-dispatch tmp1988 (quote #(vector (any . each-any)))))))
(syntax-dispatch tmp1988 (quote (any . any)))))) (syntax-dispatch tmp1988
(quote (any any . any)))))) (syntax-dispatch tmp1988 (quote (any any)))))
e1978))))) (lambda (e2036 r2037 w2038 s2039 mod2040) (let ((e2041
(source-wrap1145 e2036 w2038 s2039 mod2040))) ((lambda (tmp2042) ((lambda
(tmp2043) (if tmp2043 (apply (lambda (_2044 x2045) (call-with-values (lambda ()
(gen-syntax1942 e2041 x2045 r2037 (quote ()) ellipsis?1161 mod2040)) (lambda
(e2046 maps2047) (regen1949 e2046)))) tmp2043) ((lambda (_2048) (syntax-error
e2041)) tmp2042))) (syntax-dispatch tmp2042 (quote (any any))))) e2041)))))
(global-extend1114 (quote core) (quote lambda) (lambda (e2049 r2050 w2051 s2052
mod2053) ((lambda (tmp2054) ((lambda (tmp2055) (if tmp2055 (apply (lambda
(_2056 c2057) (chi-lambda-clause1157 (source-wrap1145 e2049 w2051 s2052
mod2053) #f c2057 r2050 w2051 mod2053 (lambda (vars2058 docstring2059 body2060)
(build-annotated1093 s2052 (cons (quote lambda) (cons vars2058 (append (if
docstring2059 (list docstring2059) (quote ())) (list body2060)))))))) tmp2055)
(syntax-error tmp2054))) (syntax-dispatch tmp2054 (quote (any . any)))))
e2049))) (global-extend1114 (quote core) (quote let) (letrec ((chi-let2061
(lambda (e2062 r2063 w2064 s2065 mod2066 constructor2067 ids2068 vals2069
exps2070) (if (not (valid-bound-ids?1141 ids2068)) (syntax-error e2062
"duplicate bound variable in") (let ((labels2071 (gen-labels1122 ids2068))
(new-vars2072 (map gen-var1164 ids2068))) (let ((nw2073 (make-binding-wrap1133
ids2068 labels2071 w2064)) (nr2074 (extend-var-env1111 labels2071 new-vars2072
r2063))) (constructor2067 s2065 new-vars2072 (map (lambda (x2075) (chi1152
x2075 r2063 w2064 mod2066)) vals2069) (chi-body1156 exps2070 (source-wrap1145
e2062 nw2073 s2065 mod2066) nr2074 nw2073 mod2066)))))))) (lambda (e2076 r2077
w2078 s2079 mod2080) ((lambda (tmp2081) ((lambda (tmp2082) (if tmp2082 (apply
(lambda (_2083 id2084 val2085 e12086 e22087) (chi-let2061 e2076 r2077 w2078
s2079 mod2080 build-let1096 id2084 val2085 (cons e12086 e22087))) tmp2082)
((lambda (tmp2091) (if (if tmp2091 (apply (lambda (_2092 f2093 id2094 val2095
e12096 e22097) (id?1116 f2093)) tmp2091) #f) (apply (lambda (_2098 f2099 id2100
val2101 e12102 e22103) (chi-let2061 e2076 r2077 w2078 s2079 mod2080
build-named-let1097 (cons f2099 id2100) val2101 (cons e12102 e22103))) tmp2091)
((lambda (_2107) (syntax-error (source-wrap1145 e2076 w2078 s2079 mod2080)))
tmp2081))) (syntax-dispatch tmp2081 (quote (any any #(each (any any)) any .
each-any)))))) (syntax-dispatch tmp2081 (quote (any #(each (any any)) any .
each-any))))) e2076)))) (global-extend1114 (quote core) (quote letrec) (lambda
(e2108 r2109 w2110 s2111 mod2112) ((lambda (tmp2113) ((lambda (tmp2114) (if
tmp2114 (apply (lambda (_2115 id2116 val2117 e12118 e22119) (let ((ids2120
id2116)) (if (not (valid-bound-ids?1141 ids2120)) (syntax-error e2108
"duplicate bound variable in") (let ((labels2122 (gen-labels1122 ids2120))
(new-vars2123 (map gen-var1164 ids2120))) (let ((w2124 (make-binding-wrap1133
ids2120 labels2122 w2110)) (r2125 (extend-var-env1111 labels2122 new-vars2123
r2109))) (build-letrec1098 s2111 new-vars2123 (map (lambda (x2126) (chi1152
x2126 r2125 w2124 mod2112)) val2117) (chi-body1156 (cons e12118 e22119)
(source-wrap1145 e2108 w2124 s2111 mod2112) r2125 w2124 mod2112))))))) tmp2114)
((lambda (_2129) (syntax-error (source-wrap1145 e2108 w2110 s2111 mod2112)))
tmp2113))) (syntax-dispatch tmp2113 (quote (any #(each (any any)) any .
each-any))))) e2108))) (global-extend1114 (quote core) (quote set!) (lambda
(e2130 r2131 w2132 s2133 mod2134) ((lambda (tmp2135) ((lambda (tmp2136) (if (if
tmp2136 (apply (lambda (_2137 id2138 val2139) (id?1116 id2138)) tmp2136) #f)
(apply (lambda (_2140 id2141 val2142) (let ((val2143 (chi1152 val2142 r2131
w2132 mod2134)) (n2144 (id-var-name1138 id2141 w2132))) (let ((b2145
(lookup1113 n2144 r2131 mod2134))) (let ((t2146 (binding-type1108 b2145))) (if
(memv t2146 (quote (lexical))) (build-annotated1093 s2133 (list (quote set!)
(binding-value1109 b2145) val2143)) (if (memv t2146 (quote (global)))
(build-annotated1093 s2133 (list (quote set!) (if mod2134 (make-module-ref (cdr
mod2134) n2144 (car mod2134)) (make-module-ref mod2134 n2144 (quote bare)))
val2143)) (if (memv t2146 (quote (displaced-lexical))) (syntax-error (wrap1144
id2141 w2132 mod2134) "identifier out of context") (syntax-error
(source-wrap1145 e2130 w2132 s2133 mod2134))))))))) tmp2136) ((lambda (tmp2147)
(if tmp2147 (apply (lambda (_2148 head2149 tail2150 val2151) (call-with-values
(lambda () (syntax-type1150 head2149 r2131 (quote (())) #f #f mod2134)) (lambda
(type2152 value2153 ee2154 ww2155 ss2156 modmod2157) (let ((t2158 type2152))
(if (memv t2158 (quote (module-ref))) (let ((val2159 (chi1152 val2151 r2131
w2132 mod2134))) (call-with-values (lambda () (value2153 (cons head2149
tail2150))) (lambda (id2161 mod2162) (build-annotated1093 s2133 (list (quote
set!) (if mod2162 (make-module-ref (cdr mod2162) id2161 (car mod2162))
(make-module-ref mod2162 id2161 (quote bare))) val2159)))))
(build-annotated1093 s2133 (cons (chi1152 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) head2149) r2131 w2132
mod2134) (map (lambda (e2163) (chi1152 e2163 r2131 w2132 mod2134)) (append
tail2150 (list val2151)))))))))) tmp2147) ((lambda (_2165) (syntax-error
(source-wrap1145 e2130 w2132 s2133 mod2134))) tmp2135))) (syntax-dispatch
tmp2135 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2135 (quote
(any any any))))) e2130))) (global-extend1114 (quote module-ref) (quote @)
(lambda (e2166) ((lambda (tmp2167) ((lambda (tmp2168) (if (if tmp2168 (apply
(lambda (_2169 mod2170 id2171) (and (andmap id?1116 mod2170) (id?1116 id2171)))
tmp2168) #f) (apply (lambda (_2173 mod2174 id2175) (values
(syntax-object->datum id2175) (syntax-object->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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) mod2174)))) tmp2168)
(syntax-error tmp2167))) (syntax-dispatch tmp2167 (quote (any each-any any)))))
e2166))) (global-extend1114 (quote module-ref) (quote @@) (lambda (e2177)
((lambda (tmp2178) ((lambda (tmp2179) (if (if tmp2179 (apply (lambda (_2180
mod2181 id2182) (and (andmap id?1116 mod2181) (id?1116 id2182))) tmp2179) #f)
(apply (lambda (_2184 mod2185 id2186) (values (syntax-object->datum id2186)
(syntax-object->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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) mod2185)))) tmp2179)
(syntax-error tmp2178))) (syntax-dispatch tmp2178 (quote (any each-any any)))))
e2177))) (global-extend1114 (quote begin) (quote begin) (quote ()))
(global-extend1114 (quote define) (quote define) (quote ())) (global-extend1114
(quote define-syntax) (quote define-syntax) (quote ())) (global-extend1114
(quote eval-when) (quote eval-when) (quote ())) (global-extend1114 (quote core)
(quote syntax-case) (letrec ((gen-syntax-case2191 (lambda (x2192 keys2193
clauses2194 r2195 mod2196) (if (null? clauses2194) (build-annotated1093 #f
(list (build-annotated1093 #f (quote syntax-error)) x2192)) ((lambda (tmp2197)
((lambda (tmp2198) (if tmp2198 (apply (lambda (pat2199 exp2200) (if (and
(id?1116 pat2199) (andmap (lambda (x2201) (not (free-id=?1139 pat2199 x2201)))
(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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) keys2193))) (let
((labels2202 (list (gen-label1121))) (var2203 (gen-var1164 pat2199)))
(build-annotated1093 #f (list (build-annotated1093 #f (list (quote lambda)
(list var2203) (chi1152 exp2200 (extend-env1110 labels2202 (list (cons (quote
syntax) (cons var2203 0))) r2195) (make-binding-wrap1133 (list pat2199)
labels2202 (quote (()))) mod2196))) x2192))) (gen-clause2190 x2192 keys2193
(cdr clauses2194) r2195 pat2199 #t exp2200 mod2196))) tmp2198) ((lambda
(tmp2204) (if tmp2204 (apply (lambda (pat2205 fender2206 exp2207)
(gen-clause2190 x2192 keys2193 (cdr clauses2194) r2195 pat2205 fender2206
exp2207 mod2196)) tmp2204) ((lambda (_2208) (syntax-error (car clauses2194)
"invalid syntax-case clause")) tmp2197))) (syntax-dispatch tmp2197 (quote (any
any any)))))) (syntax-dispatch tmp2197 (quote (any any))))) (car
clauses2194))))) (gen-clause2190 (lambda (x2209 keys2210 clauses2211 r2212
pat2213 fender2214 exp2215 mod2216) (call-with-values (lambda ()
(convert-pattern2188 pat2213 keys2210)) (lambda (p2217 pvars2218) (cond ((not
(distinct-bound-ids?1142 (map car pvars2218))) (syntax-error pat2213 "duplicate
pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2219) (not
(ellipsis?1161 (car x2219)))) pvars2218)) (syntax-error pat2213 "misplaced
ellipsis in syntax-case pattern")) (else (let ((y2220 (gen-var1164 (quote
tmp)))) (build-annotated1093 #f (list (build-annotated1093 #f (list (quote
lambda) (list y2220) (let ((y2221 (build-annotated1093 #f y2220)))
(build-annotated1093 #f (list (quote if) ((lambda (tmp2222) ((lambda (tmp2223)
(if tmp2223 (apply (lambda () y2221) tmp2223) ((lambda (_2224)
(build-annotated1093 #f (list (quote if) y2221 (build-dispatch-call2189
pvars2218 fender2214 y2221 r2212 mod2216) (build-data1094 #f #f)))) tmp2222)))
(syntax-dispatch tmp2222 (quote #(atom #t))))) fender2214)
(build-dispatch-call2189 pvars2218 exp2215 y2221 r2212 mod2216)
(gen-syntax-case2191 x2209 keys2210 clauses2211 r2212 mod2216)))))) (if (eq?
p2217 (quote any)) (build-annotated1093 #f (list (build-annotated1093 #f (quote
list)) x2209)) (build-annotated1093 #f (list (build-annotated1093 #f (quote
syntax-dispatch)) x2209 (build-data1094 #f p2217)))))))))))))
(build-dispatch-call2189 (lambda (pvars2225 exp2226 y2227 r2228 mod2229) (let
((ids2230 (map car pvars2225)) (levels2231 (map cdr pvars2225))) (let
((labels2232 (gen-labels1122 ids2230)) (new-vars2233 (map gen-var1164
ids2230))) (build-annotated1093 #f (list (build-annotated1093 #f (quote apply))
(build-annotated1093 #f (list (quote lambda) new-vars2233 (chi1152 exp2226
(extend-env1110 labels2232 (map (lambda (var2234 level2235) (cons (quote
syntax) (cons var2234 level2235))) new-vars2233 (map cdr pvars2225)) r2228)
(make-binding-wrap1133 ids2230 labels2232 (quote (()))) mod2229))) y2227))))))
(convert-pattern2188 (lambda (pattern2236 keys2237) (let cvt2238 ((p2239
pattern2236) (n2240 0) (ids2241 (quote ()))) (if (id?1116 p2239) (if
(bound-id-member?1143 p2239 keys2237) (values (vector (quote free-id) p2239)
ids2241) (values (quote any) (cons (cons p2239 n2240) ids2241))) ((lambda
(tmp2242) ((lambda (tmp2243) (if (if tmp2243 (apply (lambda (x2244 dots2245)
(ellipsis?1161 dots2245)) tmp2243) #f) (apply (lambda (x2246 dots2247)
(call-with-values (lambda () (cvt2238 x2246 (fx+1083 n2240 1) ids2241)) (lambda
(p2248 ids2249) (values (if (eq? p2248 (quote any)) (quote each-any) (vector
(quote each) p2248)) ids2249)))) tmp2243) ((lambda (tmp2250) (if tmp2250 (apply
(lambda (x2251 y2252) (call-with-values (lambda () (cvt2238 y2252 n2240
ids2241)) (lambda (y2253 ids2254) (call-with-values (lambda () (cvt2238 x2251
n2240 ids2254)) (lambda (x2255 ids2256) (values (cons x2255 y2253)
ids2256)))))) tmp2250) ((lambda (tmp2257) (if tmp2257 (apply (lambda () (values
(quote ()) ids2241)) tmp2257) ((lambda (tmp2258) (if tmp2258 (apply (lambda
(x2259) (call-with-values (lambda () (cvt2238 x2259 n2240 ids2241)) (lambda
(p2261 ids2262) (values (vector (quote vector) p2261) ids2262)))) tmp2258)
((lambda (x2263) (values (vector (quote atom) (strip1163 p2239 (quote (()))))
ids2241)) tmp2242))) (syntax-dispatch tmp2242 (quote #(vector each-any))))))
(syntax-dispatch tmp2242 (quote ()))))) (syntax-dispatch tmp2242 (quote (any .
any)))))) (syntax-dispatch tmp2242 (quote (any any))))) p2239)))))) (lambda
(e2264 r2265 w2266 s2267 mod2268) (let ((e2269 (source-wrap1145 e2264 w2266
s2267 mod2268))) ((lambda (tmp2270) ((lambda (tmp2271) (if tmp2271 (apply
(lambda (_2272 val2273 key2274 m2275) (if (andmap (lambda (x2276) (and (id?1116
x2276) (not (ellipsis?1161 x2276)))) key2274) (let ((x2278 (gen-var1164 (quote
tmp)))) (build-annotated1093 s2267 (list (build-annotated1093 #f (list (quote
lambda) (list x2278) (gen-syntax-case2191 (build-annotated1093 #f x2278)
key2274 m2275 r2265 mod2268))) (chi1152 val2273 r2265 (quote (())) mod2268))))
(syntax-error e2269 "invalid literals list in"))) tmp2271) (syntax-error
tmp2270))) (syntax-dispatch tmp2270 (quote (any any each-any . each-any)))))
e2269))))) (set! sc-expand (let ((m2281 (quote e)) (esew2282 (quote (eval))))
(lambda (x2283) (if (and (pair? x2283) (equal? (car x2283) noexpand1082)) (cadr
x2283) (chi-top1151 x2283 (quote ()) (quote ((top))) m2281 esew2282 (cons
(quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let
((m2284 (quote e)) (esew2285 (quote (eval)))) (lambda (x2287 . rest2286) (if
(and (pair? x2287) (equal? (car x2287) noexpand1082)) (cadr x2287) (chi-top1151
x2287 (quote ()) (quote ((top))) (if (null? rest2286) m2284 (car rest2286)) (if
(or (null? rest2286) (null? (cdr rest2286))) esew2285 (cadr rest2286)) (cons
(quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda
(x2288) (nonsymbol-id?1115 x2288))) (set! datum->syntax-object (lambda (id2289
datum2290) (make-syntax-object1099 datum2290 (syntax-object-wrap1102 id2289)
#f))) (set! syntax-object->datum (lambda (x2291) (strip1163 x2291 (quote
(()))))) (set! generate-temporaries (lambda (ls2292) (begin (let ((x2293
ls2292)) (if (not (list? x2293)) (error-hook1089 (quote generate-temporaries)
"invalid argument" x2293))) (map (lambda (x2294) (wrap1144 (gensym) (quote
((top))) #f)) ls2292)))) (set! free-identifier=? (lambda (x2295 y2296) (begin
(let ((x2297 x2295)) (if (not (nonsymbol-id?1115 x2297)) (error-hook1089 (quote
free-identifier=?) "invalid argument" x2297))) (let ((x2298 y2296)) (if (not
(nonsymbol-id?1115 x2298)) (error-hook1089 (quote free-identifier=?) "invalid
argument" x2298))) (free-id=?1139 x2295 y2296)))) (set! bound-identifier=?
(lambda (x2299 y2300) (begin (let ((x2301 x2299)) (if (not (nonsymbol-id?1115
x2301)) (error-hook1089 (quote bound-identifier=?) "invalid argument" x2301)))
(let ((x2302 y2300)) (if (not (nonsymbol-id?1115 x2302)) (error-hook1089 (quote
bound-identifier=?) "invalid argument" x2302))) (bound-id=?1140 x2299 y2300))))
(set! syntax-error (lambda (object2304 . messages2303) (begin (for-each (lambda
(x2305) (let ((x2306 x2305)) (if (not (string? x2306)) (error-hook1089 (quote
syntax-error) "invalid argument" x2306)))) messages2303) (let ((message2307 (if
(null? messages2303) "invalid syntax" (apply string-append messages2303))))
(error-hook1089 #f message2307 (strip1163 object2304 (quote (())))))))) (set!
install-global-transformer (lambda (sym2308 v2309) (begin (let ((x2310
sym2308)) (if (not (symbol? x2310)) (error-hook1089 (quote define-syntax)
"invalid argument" x2310))) (let ((x2311 v2309)) (if (not (procedure? x2311))
(error-hook1089 (quote define-syntax) "invalid argument" x2311)))
(global-extend1114 (quote macro) sym2308 v2309)))) (letrec ((match2316 (lambda
(e2317 p2318 w2319 r2320 mod2321) (cond ((not r2320) #f) ((eq? p2318 (quote
any)) (cons (wrap1144 e2317 w2319 mod2321) r2320)) ((syntax-object?1100 e2317)
(match*2315 (let ((e2322 (syntax-object-expression1101 e2317))) (if
(annotation? e2322) (annotation-expression e2322) e2322)) p2318 (join-wraps1135
w2319 (syntax-object-wrap1102 e2317)) r2320 (syntax-object-module1103 e2317)))
(else (match*2315 (let ((e2323 e2317)) (if (annotation? e2323)
(annotation-expression e2323) e2323)) p2318 w2319 r2320 mod2321)))))
(match*2315 (lambda (e2324 p2325 w2326 r2327 mod2328) (cond ((null? p2325) (and
(null? e2324) r2327)) ((pair? p2325) (and (pair? e2324) (match2316 (car e2324)
(car p2325) w2326 (match2316 (cdr e2324) (cdr p2325) w2326 r2327 mod2328)
mod2328))) ((eq? p2325 (quote each-any)) (let ((l2329 (match-each-any2313 e2324
w2326 mod2328))) (and l2329 (cons l2329 r2327)))) (else (let ((t2330
(vector-ref p2325 0))) (if (memv t2330 (quote (each))) (if (null? e2324)
(match-empty2314 (vector-ref p2325 1) r2327) (let ((l2331 (match-each2312 e2324
(vector-ref p2325 1) w2326 mod2328))) (and l2331 (let collect2332 ((l2333
l2331)) (if (null? (car l2333)) r2327 (cons (map car l2333) (collect2332 (map
cdr l2333)))))))) (if (memv t2330 (quote (free-id))) (and (id?1116 e2324)
(free-id=?1139 (wrap1144 e2324 w2326 mod2328) (vector-ref p2325 1)) r2327) (if
(memv t2330 (quote (atom))) (and (equal? (vector-ref p2325 1) (strip1163 e2324
w2326)) r2327) (if (memv t2330 (quote (vector))) (and (vector? e2324)
(match2316 (vector->list e2324) (vector-ref p2325 1) w2326 r2327
mod2328))))))))))) (match-empty2314 (lambda (p2334 r2335) (cond ((null? p2334)
r2335) ((eq? p2334 (quote any)) (cons (quote ()) r2335)) ((pair? p2334)
(match-empty2314 (car p2334) (match-empty2314 (cdr p2334) r2335))) ((eq? p2334
(quote each-any)) (cons (quote ()) r2335)) (else (let ((t2336 (vector-ref p2334
0))) (if (memv t2336 (quote (each))) (match-empty2314 (vector-ref p2334 1)
r2335) (if (memv t2336 (quote (free-id atom))) r2335 (if (memv t2336 (quote
(vector))) (match-empty2314 (vector-ref p2334 1) r2335)))))))))
(match-each-any2313 (lambda (e2337 w2338 mod2339) (cond ((annotation? e2337)
(match-each-any2313 (annotation-expression e2337) w2338 mod2339)) ((pair?
e2337) (let ((l2340 (match-each-any2313 (cdr e2337) w2338 mod2339))) (and l2340
(cons (wrap1144 (car e2337) w2338 mod2339) l2340)))) ((null? e2337) (quote ()))
((syntax-object?1100 e2337) (match-each-any2313 (syntax-object-expression1101
e2337) (join-wraps1135 w2338 (syntax-object-wrap1102 e2337)) mod2339)) (else
#f)))) (match-each2312 (lambda (e2341 p2342 w2343 mod2344) (cond ((annotation?
e2341) (match-each2312 (annotation-expression e2341) p2342 w2343 mod2344))
((pair? e2341) (let ((first2345 (match2316 (car e2341) p2342 w2343 (quote ())
mod2344))) (and first2345 (let ((rest2346 (match-each2312 (cdr e2341) p2342
w2343 mod2344))) (and rest2346 (cons first2345 rest2346)))))) ((null? e2341)
(quote ())) ((syntax-object?1100 e2341) (match-each2312
(syntax-object-expression1101 e2341) p2342 (join-wraps1135 w2343
(syntax-object-wrap1102 e2341)) (syntax-object-module1103 e2341))) (else
#f))))) (begin (set! syntax-dispatch (lambda (e2347 p2348) (cond ((eq? p2348
(quote any)) (list e2347)) ((syntax-object?1100 e2347) (match*2315 (let ((e2349
(syntax-object-expression1101 e2347))) (if (annotation? e2349)
(annotation-expression e2349) e2349)) p2348 (syntax-object-wrap1102 e2347)
(quote ()) (syntax-object-module1103 e2347))) (else (match*2315 (let ((e2350
e2347)) (if (annotation? e2350) (annotation-expression e2350) e2350)) p2348
(quote (())) (quote ()) #f))))) (set! sc-chi chi1152)))))
-(install-global-transformer (quote with-syntax) (lambda (x2351) ((lambda
(tmp2352) ((lambda (tmp2353) (if tmp2353 (apply (lambda (_2354 e12355 e22356)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e12355 e22356))) tmp2353) ((lambda (tmp2358) (if
tmp2358 (apply (lambda (_2359 out2360 in2361 e12362 e22363) (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))) in2361 (quote ()) (list out2360 (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 e12362 e22363))))) tmp2358) ((lambda
(tmp2365) (if tmp2365 (apply (lambda (_2366 out2367 in2368 e12369 e22370) (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))) in2368) (quote ()) (list out2367 (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 e12369 e22370))))) tmp2365) (syntax-error tmp2352)))
(syntax-dispatch tmp2352 (quote (any #(each (any any)) any . each-any))))))
(syntax-dispatch tmp2352 (quote (any ((any any)) any . each-any))))))
(syntax-dispatch tmp2352 (quote (any () any . each-any))))) x2351)))
-(install-global-transformer (quote syntax-rules) (lambda (x2374) ((lambda
(tmp2375) ((lambda (tmp2376) (if tmp2376 (apply (lambda (_2377 k2378
keyword2379 pattern2380 template2381) (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 k2378 (map (lambda (tmp2384
tmp2383) (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)))
tmp2383) (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)))
tmp2384))) template2381 pattern2380)))))) tmp2376) (syntax-error tmp2375)))
(syntax-dispatch tmp2375 (quote (any each-any . #(each ((any . any) any)))))))
x2374)))
-(install-global-transformer (quote let*) (lambda (x2385) ((lambda (tmp2386)
((lambda (tmp2387) (if (if tmp2387 (apply (lambda (let*2388 x2389 v2390 e12391
e22392) (andmap identifier? x2389)) tmp2387) #f) (apply (lambda (let*2394 x2395
v2396 e12397 e22398) (let f2399 ((bindings2400 (map list x2395 v2396))) (if
(null? bindings2400) (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
e12397 e22398))) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply
(lambda (body2406 binding2407) (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 binding2407)
body2406)) tmp2405) (syntax-error tmp2404))) (syntax-dispatch tmp2404 (quote
(any any))))) (list (f2399 (cdr bindings2400)) (car bindings2400)))))) tmp2387)
(syntax-error tmp2386))) (syntax-dispatch tmp2386 (quote (any #(each (any any))
any . each-any))))) x2385)))
-(install-global-transformer (quote do) (lambda (orig-x2408) ((lambda (tmp2409)
((lambda (tmp2410) (if tmp2410 (apply (lambda (_2411 var2412 init2413 step2414
e02415 e12416 c2417) ((lambda (tmp2418) ((lambda (tmp2419) (if tmp2419 (apply
(lambda (step2420) ((lambda (tmp2421) ((lambda (tmp2422) (if tmp2422 (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 var2412 init2413) (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))) e02415) (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 c2417 (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))) step2420))))))) tmp2422) ((lambda (tmp2427)
(if tmp2427 (apply (lambda (e12428 e22429) (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 var2412 init2413) (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))) e02415 (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 e12428 e22429)) (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 c2417 (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))) step2420))))))) tmp2427)
(syntax-error tmp2421))) (syntax-dispatch tmp2421 (quote (any . each-any))))))
(syntax-dispatch tmp2421 (quote ())))) e12416)) tmp2419) (syntax-error
tmp2418))) (syntax-dispatch tmp2418 (quote each-any)))) (map (lambda (v2436
s2437) ((lambda (tmp2438) ((lambda (tmp2439) (if tmp2439 (apply (lambda ()
v2436) tmp2439) ((lambda (tmp2440) (if tmp2440 (apply (lambda (e2441) e2441)
tmp2440) ((lambda (_2442) (syntax-error orig-x2408)) tmp2438)))
(syntax-dispatch tmp2438 (quote (any)))))) (syntax-dispatch tmp2438 (quote
())))) s2437)) var2412 step2414))) tmp2410) (syntax-error tmp2409)))
(syntax-dispatch tmp2409 (quote (any #(each (any any . any)) (any . each-any) .
each-any))))) orig-x2408)))
-(install-global-transformer (quote quasiquote) (letrec ((quasicons2445 (lambda
(x2449 y2450) ((lambda (tmp2451) ((lambda (tmp2452) (if tmp2452 (apply (lambda
(x2453 y2454) ((lambda (tmp2455) ((lambda (tmp2456) (if tmp2456 (apply (lambda
(dy2457) ((lambda (tmp2458) ((lambda (tmp2459) (if tmp2459 (apply (lambda
(dx2460) (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 dx2460 dy2457)))
tmp2459) ((lambda (_2461) (if (null? dy2457) (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))) x2453) (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))) x2453
y2454))) tmp2458))) (syntax-dispatch tmp2458 (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))))) x2453))
tmp2456) ((lambda (tmp2462) (if tmp2462 (apply (lambda (stuff2463) (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
x2453 stuff2463))) tmp2462) ((lambda (else2464) (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))) x2453 y2454))
tmp2455))) (syntax-dispatch tmp2455 (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)))))) (syntax-dispatch tmp2455 (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))))) y2454)) tmp2452)
(syntax-error tmp2451))) (syntax-dispatch tmp2451 (quote (any any))))) (list
x2449 y2450)))) (quasiappend2446 (lambda (x2465 y2466) ((lambda (tmp2467)
((lambda (tmp2468) (if tmp2468 (apply (lambda (x2469 y2470) ((lambda (tmp2471)
((lambda (tmp2472) (if tmp2472 (apply (lambda () x2469) tmp2472) ((lambda
(_2473) (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))) x2469 y2470)) tmp2471))) (syntax-dispatch tmp2471
(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))) ()))))) y2470))
tmp2468) (syntax-error tmp2467))) (syntax-dispatch tmp2467 (quote (any any)))))
(list x2465 y2466)))) (quasivector2447 (lambda (x2474) ((lambda (tmp2475)
((lambda (x2476) ((lambda (tmp2477) ((lambda (tmp2478) (if tmp2478 (apply
(lambda (x2479) (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 x2479))) tmp2478) ((lambda (tmp2481) (if tmp2481 (apply
(lambda (x2482) (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))) x2482)) tmp2481) ((lambda (_2484) (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))) x2476)) tmp2477))) (syntax-dispatch
tmp2477 (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)))))) (syntax-dispatch
tmp2477 (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))))) x2476)) tmp2475)) x2474)))
(quasi2448 (lambda (p2485 lev2486) ((lambda (tmp2487) ((lambda (tmp2488) (if
tmp2488 (apply (lambda (p2489) (if (= lev2486 0) p2489 (quasicons2445 (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)))) (quasi2448 (list p2489) (- lev2486 1)))))
tmp2488) ((lambda (tmp2490) (if tmp2490 (apply (lambda (p2491 q2492) (if (=
lev2486 0) (quasiappend2446 p2491 (quasi2448 q2492 lev2486)) (quasicons2445
(quasicons2445 (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)))) (quasi2448 (list p2491) (- lev2486 1))) (quasi2448 q2492 lev2486))))
tmp2490) ((lambda (tmp2493) (if tmp2493 (apply (lambda (p2494) (quasicons2445
(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)))) (quasi2448 (list p2494) (+ lev2486
1)))) tmp2493) ((lambda (tmp2495) (if tmp2495 (apply (lambda (p2496 q2497)
(quasicons2445 (quasi2448 p2496 lev2486) (quasi2448 q2497 lev2486))) tmp2495)
((lambda (tmp2498) (if tmp2498 (apply (lambda (x2499) (quasivector2447
(quasi2448 x2499 lev2486))) tmp2498) ((lambda (p2501) (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))) p2501)) tmp2487))) (syntax-dispatch tmp2487 (quote #(vector
each-any)))))) (syntax-dispatch tmp2487 (quote (any . any))))))
(syntax-dispatch tmp2487 (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)))))) (syntax-dispatch tmp2487 (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)))))) (syntax-dispatch tmp2487 (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))))) p2485))))
(lambda (x2502) ((lambda (tmp2503) ((lambda (tmp2504) (if tmp2504 (apply
(lambda (_2505 e2506) (quasi2448 e2506 0)) tmp2504) (syntax-error tmp2503)))
(syntax-dispatch tmp2503 (quote (any any))))) x2502))))
-(install-global-transformer (quote include) (lambda (x2507) (letrec
((read-file2508 (lambda (fn2509 k2510) (let ((p2511 (open-input-file fn2509)))
(let f2512 ((x2513 (read p2511))) (if (eof-object? x2513) (begin
(close-input-port p2511) (quote ())) (cons (datum->syntax-object k2510 x2513)
(f2512 (read p2511))))))))) ((lambda (tmp2514) ((lambda (tmp2515) (if tmp2515
(apply (lambda (k2516 filename2517) (let ((fn2518 (syntax-object->datum
filename2517))) ((lambda (tmp2519) ((lambda (tmp2520) (if tmp2520 (apply
(lambda (exp2521) (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)))
exp2521)) tmp2520) (syntax-error tmp2519))) (syntax-dispatch tmp2519 (quote
each-any)))) (read-file2508 fn2518 k2516)))) tmp2515) (syntax-error tmp2514)))
(syntax-dispatch tmp2514 (quote (any any))))) x2507))))
-(install-global-transformer (quote unquote) (lambda (x2523) ((lambda (tmp2524)
((lambda (tmp2525) (if tmp2525 (apply (lambda (_2526 e2527) (error (quote
unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum
e2527))) tmp2525) (syntax-error tmp2524))) (syntax-dispatch tmp2524 (quote (any
any))))) x2523)))
-(install-global-transformer (quote unquote-splicing) (lambda (x2528) ((lambda
(tmp2529) ((lambda (tmp2530) (if tmp2530 (apply (lambda (_2531 e2532) (error
(quote unquote-splicing) "expression ,@~s not valid outside of quasiquote"
(syntax-object->datum e2532))) tmp2530) (syntax-error tmp2529)))
(syntax-dispatch tmp2529 (quote (any any))))) x2528)))
-(install-global-transformer (quote case) (lambda (x2533) ((lambda (tmp2534)
((lambda (tmp2535) (if tmp2535 (apply (lambda (_2536 e2537 m12538 m22539)
((lambda (tmp2540) ((lambda (body2541) (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))) e2537)) body2541)) tmp2540)) (let f2542 ((clause2543 m12538)
(clauses2544 m22539)) (if (null? clauses2544) ((lambda (tmp2546) ((lambda
(tmp2547) (if tmp2547 (apply (lambda (e12548 e22549) (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
e12548 e22549))) tmp2547) ((lambda (tmp2551) (if tmp2551 (apply (lambda (k2552
e12553 e22554) (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))) k2552)) (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 e12553 e22554)))) tmp2551) ((lambda
(_2557) (syntax-error x2533)) tmp2546))) (syntax-dispatch tmp2546 (quote
(each-any any . each-any)))))) (syntax-dispatch tmp2546 (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))))) clause2543) ((lambda (tmp2558) ((lambda
(rest2559) ((lambda (tmp2560) ((lambda (tmp2561) (if tmp2561 (apply (lambda
(k2562 e12563 e22564) (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))) k2562))
(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 e12563 e22564))
rest2559)) tmp2561) ((lambda (_2567) (syntax-error x2533)) tmp2560)))
(syntax-dispatch tmp2560 (quote (each-any any . each-any))))) clause2543))
tmp2558)) (f2542 (car clauses2544) (cdr clauses2544))))))) tmp2535)
(syntax-error tmp2534))) (syntax-dispatch tmp2534 (quote (any any any .
each-any))))) x2533)))
-(install-global-transformer (quote identifier-syntax) (lambda (x2568) ((lambda
(tmp2569) ((lambda (tmp2570) (if tmp2570 (apply (lambda (_2571 e2572) (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)))
e2572)) (list (cons _2571 (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 e2572 (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)))))))))) tmp2570) (syntax-error tmp2569))) (syntax-dispatch tmp2569
(quote (any any))))) x2568)))
+(letrec ((lambda-var-list1132 (lambda (vars1337) (let lvl1338 ((vars1339
vars1337) (ls1340 (quote ())) (w1341 (quote (())))) (cond ((pair? vars1339)
(lvl1338 (cdr vars1339) (cons (wrap1111 (car vars1339) w1341 #f) ls1340)
w1341)) ((id?1083 vars1339) (cons (wrap1111 vars1339 w1341 #f) ls1340)) ((null?
vars1339) ls1340) ((syntax-object?1067 vars1339) (lvl1338
(syntax-object-expression1068 vars1339) ls1340 (join-wraps1102 w1341
(syntax-object-wrap1069 vars1339)))) ((annotation? vars1339) (lvl1338
(annotation-expression vars1339) ls1340 w1341)) (else (cons vars1339
ls1340)))))) (gen-var1131 (lambda (id1342) (let ((id1343 (if
(syntax-object?1067 id1342) (syntax-object-expression1068 id1342) id1342))) (if
(annotation? id1343) (build-annotated1060 (annotation-source id1343) (gensym
(symbol->string (annotation-expression id1343)))) (build-annotated1060 #f
(gensym (symbol->string id1343))))))) (strip1130 (lambda (x1344 w1345) (if
(memq (quote top) (wrap-marks1086 w1345)) (if (or (annotation? x1344) (and
(pair? x1344) (annotation? (car x1344)))) (strip-annotation1129 x1344 #f)
x1344) (let f1346 ((x1347 x1344)) (cond ((syntax-object?1067 x1347) (strip1130
(syntax-object-expression1068 x1347) (syntax-object-wrap1069 x1347))) ((pair?
x1347) (let ((a1348 (f1346 (car x1347))) (d1349 (f1346 (cdr x1347)))) (if (and
(eq? a1348 (car x1347)) (eq? d1349 (cdr x1347))) x1347 (cons a1348 d1349))))
((vector? x1347) (let ((old1350 (vector->list x1347))) (let ((new1351 (map
f1346 old1350))) (if (andmap eq? old1350 new1351) x1347 (list->vector
new1351))))) (else x1347)))))) (strip-annotation1129 (lambda (x1352 parent1353)
(cond ((pair? x1352) (let ((new1354 (cons #f #f))) (begin (if parent1353
(set-annotation-stripped! parent1353 new1354)) (set-car! new1354
(strip-annotation1129 (car x1352) #f)) (set-cdr! new1354 (strip-annotation1129
(cdr x1352) #f)) new1354))) ((annotation? x1352) (or (annotation-stripped
x1352) (strip-annotation1129 (annotation-expression x1352) x1352))) ((vector?
x1352) (let ((new1355 (make-vector (vector-length x1352)))) (begin (if
parent1353 (set-annotation-stripped! parent1353 new1355)) (let loop1356 ((i1357
(- (vector-length x1352) 1))) (unless (fx<1053 i1357 0) (vector-set! new1355
i1357 (strip-annotation1129 (vector-ref x1352 i1357) #f)) (loop1356 (fx-1051
i1357 1)))) new1355))) (else x1352)))) (ellipsis?1128 (lambda (x1358) (and
(nonsymbol-id?1082 x1358) (free-id=?1106 x1358 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))))))) (chi-void1127 (lambda
() (build-annotated1060 #f (list (build-annotated1060 #f (quote void))))))
(eval-local-transformer1126 (lambda (expanded1359 mod1360) (let ((p1361
(local-eval-hook1055 expanded1359 mod1360))) (if (procedure? p1361) p1361
(syntax-violation #f "nonprocedure transformer" p1361)))))
(chi-local-syntax1125 (lambda (rec?1362 e1363 r1364 w1365 s1366 mod1367 k1368)
((lambda (tmp1369) ((lambda (tmp1370) (if tmp1370 (apply (lambda (_1371 id1372
val1373 e11374 e21375) (let ((ids1376 id1372)) (if (not (valid-bound-ids?1108
ids1376)) (syntax-violation #f "duplicate bound keyword" e1363) (let
((labels1378 (gen-labels1089 ids1376))) (let ((new-w1379 (make-binding-wrap1100
ids1376 labels1378 w1365))) (k1368 (cons e11374 e21375) (extend-env1077
labels1378 (let ((w1381 (if rec?1362 new-w1379 w1365)) (trans-r1382
(macros-only-env1079 r1364))) (map (lambda (x1383) (cons (quote macro)
(eval-local-transformer1126 (chi1119 x1383 trans-r1382 w1381 mod1367)
mod1367))) val1373)) r1364) new-w1379 s1366 mod1367)))))) tmp1370) ((lambda
(_1385) (syntax-violation #f "bad local syntax definition" (source-wrap1112
e1363 w1365 s1366 mod1367))) tmp1369))) (syntax-dispatch tmp1369 (quote (any
#(each (any any)) any . each-any))))) e1363))) (chi-lambda-clause1124 (lambda
(e1386 docstring1387 c1388 r1389 w1390 mod1391 k1392) ((lambda (tmp1393)
((lambda (tmp1394) (if (if tmp1394 (apply (lambda (args1395 doc1396 e11397
e21398) (and (string? (syntax->datum doc1396)) (not docstring1387))) tmp1394)
#f) (apply (lambda (args1399 doc1400 e11401 e21402) (chi-lambda-clause1124
e1386 doc1400 (cons args1399 (cons e11401 e21402)) r1389 w1390 mod1391 k1392))
tmp1394) ((lambda (tmp1404) (if tmp1404 (apply (lambda (id1405 e11406 e21407)
(let ((ids1408 id1405)) (if (not (valid-bound-ids?1108 ids1408))
(syntax-violation (quote lambda) "invalid parameter list" e1386) (let
((labels1410 (gen-labels1089 ids1408)) (new-vars1411 (map gen-var1131
ids1408))) (k1392 new-vars1411 docstring1387 (chi-body1123 (cons e11406 e21407)
e1386 (extend-var-env1078 labels1410 new-vars1411 r1389) (make-binding-wrap1100
ids1408 labels1410 w1390) mod1391)))))) tmp1404) ((lambda (tmp1413) (if tmp1413
(apply (lambda (ids1414 e11415 e21416) (let ((old-ids1417 (lambda-var-list1132
ids1414))) (if (not (valid-bound-ids?1108 old-ids1417)) (syntax-violation
(quote lambda) "invalid parameter list" e1386) (let ((labels1418
(gen-labels1089 old-ids1417)) (new-vars1419 (map gen-var1131 old-ids1417)))
(k1392 (let f1420 ((ls11421 (cdr new-vars1419)) (ls21422 (car new-vars1419)))
(if (null? ls11421) ls21422 (f1420 (cdr ls11421) (cons (car ls11421)
ls21422)))) docstring1387 (chi-body1123 (cons e11415 e21416) e1386
(extend-var-env1078 labels1418 new-vars1419 r1389) (make-binding-wrap1100
old-ids1417 labels1418 w1390) mod1391)))))) tmp1413) ((lambda (_1424)
(syntax-violation (quote lambda) "bad lambda" e1386)) tmp1393)))
(syntax-dispatch tmp1393 (quote (any any . each-any)))))) (syntax-dispatch
tmp1393 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1393 (quote
(any any any . each-any))))) c1388))) (chi-body1123 (lambda (body1425
outer-form1426 r1427 w1428 mod1429) (let ((r1430 (cons (quote ("placeholder"
placeholder)) r1427))) (let ((ribcage1431 (make-ribcage1090 (quote ()) (quote
()) (quote ())))) (let ((w1432 (make-wrap1085 (wrap-marks1086 w1428) (cons
ribcage1431 (wrap-subst1087 w1428))))) (let parse1433 ((body1434 (map (lambda
(x1440) (cons r1430 (wrap1111 x1440 w1432 mod1429))) body1425)) (ids1435 (quote
())) (labels1436 (quote ())) (vars1437 (quote ())) (vals1438 (quote ()))
(bindings1439 (quote ()))) (if (null? body1434) (syntax-violation #f "no
expressions in body" outer-form1426) (let ((e1441 (cdar body1434)) (er1442
(caar body1434))) (call-with-values (lambda () (syntax-type1117 e1441 er1442
(quote (())) #f ribcage1431 mod1429)) (lambda (type1443 value1444 e1445 w1446
s1447 mod1448) (let ((t1449 type1443)) (if (memv t1449 (quote (define-form)))
(let ((id1450 (wrap1111 value1444 w1446 mod1448)) (label1451 (gen-label1088)))
(let ((var1452 (gen-var1131 id1450))) (begin (extend-ribcage!1099 ribcage1431
id1450 label1451) (parse1433 (cdr body1434) (cons id1450 ids1435) (cons
label1451 labels1436) (cons var1452 vars1437) (cons (cons er1442 (wrap1111
e1445 w1446 mod1448)) vals1438) (cons (cons (quote lexical) var1452)
bindings1439))))) (if (memv t1449 (quote (define-syntax-form))) (let ((id1453
(wrap1111 value1444 w1446 mod1448)) (label1454 (gen-label1088))) (begin
(extend-ribcage!1099 ribcage1431 id1453 label1454) (parse1433 (cdr body1434)
(cons id1453 ids1435) (cons label1454 labels1436) vars1437 vals1438 (cons (cons
(quote macro) (cons er1442 (wrap1111 e1445 w1446 mod1448))) bindings1439))))
(if (memv t1449 (quote (begin-form))) ((lambda (tmp1455) ((lambda (tmp1456) (if
tmp1456 (apply (lambda (_1457 e11458) (parse1433 (let f1459 ((forms1460
e11458)) (if (null? forms1460) (cdr body1434) (cons (cons er1442 (wrap1111 (car
forms1460) w1446 mod1448)) (f1459 (cdr forms1460))))) ids1435 labels1436
vars1437 vals1438 bindings1439)) tmp1456) (syntax-violation #f "source
expression failed to match any pattern" tmp1455))) (syntax-dispatch tmp1455
(quote (any . each-any))))) e1445) (if (memv t1449 (quote (local-syntax-form)))
(chi-local-syntax1125 value1444 e1445 er1442 w1446 s1447 mod1448 (lambda
(forms1462 er1463 w1464 s1465 mod1466) (parse1433 (let f1467 ((forms1468
forms1462)) (if (null? forms1468) (cdr body1434) (cons (cons er1463 (wrap1111
(car forms1468) w1464 mod1466)) (f1467 (cdr forms1468))))) ids1435 labels1436
vars1437 vals1438 bindings1439))) (if (null? ids1435) (build-sequence1062 #f
(map (lambda (x1469) (chi1119 (cdr x1469) (car x1469) (quote (())) mod1448))
(cons (cons er1442 (source-wrap1112 e1445 w1446 s1447 mod1448)) (cdr
body1434)))) (begin (if (not (valid-bound-ids?1108 ids1435)) (syntax-violation
#f "invalid or duplicate identifier in definition" outer-form1426)) (let
loop1470 ((bs1471 bindings1439) (er-cache1472 #f) (r-cache1473 #f)) (if (not
(null? bs1471)) (let ((b1474 (car bs1471))) (if (eq? (car b1474) (quote macro))
(let ((er1475 (cadr b1474))) (let ((r-cache1476 (if (eq? er1475 er-cache1472)
r-cache1473 (macros-only-env1079 er1475)))) (begin (set-cdr! b1474
(eval-local-transformer1126 (chi1119 (cddr b1474) r-cache1476 (quote (()))
mod1448) mod1448)) (loop1470 (cdr bs1471) er1475 r-cache1476)))) (loop1470 (cdr
bs1471) er-cache1472 r-cache1473))))) (set-cdr! r1430 (extend-env1077
labels1436 bindings1439 (cdr r1430))) (build-letrec1065 #f vars1437 (map
(lambda (x1477) (chi1119 (cdr x1477) (car x1477) (quote (())) mod1448))
vals1438) (build-sequence1062 #f (map (lambda (x1478) (chi1119 (cdr x1478) (car
x1478) (quote (())) mod1448)) (cons (cons er1442 (source-wrap1112 e1445 w1446
s1447 mod1448)) (cdr body1434)))))))))))))))))))))) (chi-macro1122 (lambda
(p1479 e1480 r1481 w1482 rib1483 mod1484) (letrec ((rebuild-macro-output1485
(lambda (x1486 m1487) (cond ((pair? x1486) (cons (rebuild-macro-output1485 (car
x1486) m1487) (rebuild-macro-output1485 (cdr x1486) m1487)))
((syntax-object?1067 x1486) (let ((w1488 (syntax-object-wrap1069 x1486))) (let
((ms1489 (wrap-marks1086 w1488)) (s1490 (wrap-subst1087 w1488))) (if (and
(pair? ms1489) (eq? (car ms1489) #f)) (make-syntax-object1066
(syntax-object-expression1068 x1486) (make-wrap1085 (cdr ms1489) (if rib1483
(cons rib1483 (cdr s1490)) (cdr s1490))) (syntax-object-module1070 x1486))
(make-syntax-object1066 (syntax-object-expression1068 x1486) (make-wrap1085
(cons m1487 ms1489) (if rib1483 (cons rib1483 (cons (quote shift) s1490)) (cons
(quote shift) s1490))) (let ((pmod1491 (procedure-module p1479))) (if pmod1491
(cons (quote hygiene) (module-name pmod1491)) (quote (hygiene guile)))))))))
((vector? x1486) (let ((n1492 (vector-length x1486))) (let ((v1493 (make-vector
n1492))) (let doloop1494 ((i1495 0)) (if (fx=1052 i1495 n1492) v1493 (begin
(vector-set! v1493 i1495 (rebuild-macro-output1485 (vector-ref x1486 i1495)
m1487)) (doloop1494 (fx+1050 i1495 1)))))))) ((symbol? x1486) (syntax-violation
#f "encountered raw symbol in macro output" (source-wrap1112 e1480 w1482 s
mod1484) x1486)) (else x1486))))) (rebuild-macro-output1485 (p1479 (wrap1111
e1480 (anti-mark1098 w1482) mod1484)) (string #\m))))) (chi-application1121
(lambda (x1496 e1497 r1498 w1499 s1500 mod1501) ((lambda (tmp1502) ((lambda
(tmp1503) (if tmp1503 (apply (lambda (e01504 e11505) (build-annotated1060 s1500
(cons x1496 (map (lambda (e1506) (chi1119 e1506 r1498 w1499 mod1501))
e11505)))) tmp1503) (syntax-violation #f "source expression failed to match any
pattern" tmp1502))) (syntax-dispatch tmp1502 (quote (any . each-any)))))
e1497))) (chi-expr1120 (lambda (type1508 value1509 e1510 r1511 w1512 s1513
mod1514) (let ((t1515 type1508)) (if (memv t1515 (quote (lexical)))
(build-annotated1060 s1513 value1509) (if (memv t1515 (quote (core
external-macro))) (value1509 e1510 r1511 w1512 s1513 mod1514) (if (memv t1515
(quote (module-ref))) (call-with-values (lambda () (value1509 e1510)) (lambda
(id1516 mod1517) (build-annotated1060 s1513 (if mod1517 (make-module-ref (cdr
mod1517) id1516 (car mod1517)) (make-module-ref mod1517 id1516 (quote
bare)))))) (if (memv t1515 (quote (lexical-call))) (chi-application1121
(build-annotated1060 (source-annotation1074 (car e1510)) value1509) e1510 r1511
w1512 s1513 mod1514) (if (memv t1515 (quote (global-call)))
(chi-application1121 (build-annotated1060 (source-annotation1074 (car e1510))
(if (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510))
mod1514) (make-module-ref (cdr (if (syntax-object?1067 (car e1510))
(syntax-object-module1070 (car e1510)) mod1514)) value1509 (car (if
(syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510))
mod1514))) (make-module-ref (if (syntax-object?1067 (car e1510))
(syntax-object-module1070 (car e1510)) mod1514) value1509 (quote bare)))) e1510
r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (constant))) (build-data1061
s1513 (strip1130 (source-wrap1112 e1510 w1512 s1513 mod1514) (quote (())))) (if
(memv t1515 (quote (global))) (build-annotated1060 s1513 (if mod1514
(make-module-ref (cdr mod1514) value1509 (car mod1514)) (make-module-ref
mod1514 value1509 (quote bare)))) (if (memv t1515 (quote (call)))
(chi-application1121 (chi1119 (car e1510) r1511 w1512 mod1514) e1510 r1511
w1512 s1513 mod1514) (if (memv t1515 (quote (begin-form))) ((lambda (tmp1518)
((lambda (tmp1519) (if tmp1519 (apply (lambda (_1520 e11521 e21522)
(chi-sequence1113 (cons e11521 e21522) r1511 w1512 s1513 mod1514)) tmp1519)
(syntax-violation #f "source expression failed to match any pattern" tmp1518)))
(syntax-dispatch tmp1518 (quote (any any . each-any))))) e1510) (if (memv t1515
(quote (local-syntax-form))) (chi-local-syntax1125 value1509 e1510 r1511 w1512
s1513 mod1514 chi-sequence1113) (if (memv t1515 (quote (eval-when-form)))
((lambda (tmp1524) ((lambda (tmp1525) (if tmp1525 (apply (lambda (_1526 x1527
e11528 e21529) (let ((when-list1530 (chi-when-list1116 e1510 x1527 w1512))) (if
(memq (quote eval) when-list1530) (chi-sequence1113 (cons e11528 e21529) r1511
w1512 s1513 mod1514) (chi-void1127)))) tmp1525) (syntax-violation #f "source
expression failed to match any pattern" tmp1524))) (syntax-dispatch tmp1524
(quote (any each-any any . each-any))))) e1510) (if (memv t1515 (quote
(define-form define-syntax-form))) (syntax-violation #f "definition in
expression context" e1510 (wrap1111 value1509 w1512 mod1514)) (if (memv t1515
(quote (syntax))) (syntax-violation #f "reference to pattern variable outside
syntax form" (source-wrap1112 e1510 w1512 s1513 mod1514)) (if (memv t1515
(quote (displaced-lexical))) (syntax-violation #f (source-wrap1112 e1510 w1512
s1513 mod1514) "reference to identifier outside its scope") (syntax-violation
#f "unexpected syntax" (source-wrap1112 e1510 w1512 s1513
mod1514))))))))))))))))))) (chi1119 (lambda (e1533 r1534 w1535 mod1536)
(call-with-values (lambda () (syntax-type1117 e1533 r1534 w1535 #f #f mod1536))
(lambda (type1537 value1538 e1539 w1540 s1541 mod1542) (chi-expr1120 type1537
value1538 e1539 r1534 w1540 s1541 mod1542))))) (chi-top1118 (lambda (e1543
r1544 w1545 m1546 esew1547 mod1548) (call-with-values (lambda ()
(syntax-type1117 e1543 r1544 w1545 #f #f mod1548)) (lambda (type1556 value1557
e1558 w1559 s1560 mod1561) (let ((t1562 type1556)) (if (memv t1562 (quote
(begin-form))) ((lambda (tmp1563) ((lambda (tmp1564) (if tmp1564 (apply (lambda
(_1565) (chi-void1127)) tmp1564) ((lambda (tmp1566) (if tmp1566 (apply (lambda
(_1567 e11568 e21569) (chi-top-sequence1114 (cons e11568 e21569) r1544 w1559
s1560 m1546 esew1547 mod1561)) tmp1566) (syntax-violation #f "source expression
failed to match any pattern" tmp1563))) (syntax-dispatch tmp1563 (quote (any
any . each-any)))))) (syntax-dispatch tmp1563 (quote (any))))) e1558) (if (memv
t1562 (quote (local-syntax-form))) (chi-local-syntax1125 value1557 e1558 r1544
w1559 s1560 mod1561 (lambda (body1571 r1572 w1573 s1574 mod1575)
(chi-top-sequence1114 body1571 r1572 w1573 s1574 m1546 esew1547 mod1575))) (if
(memv t1562 (quote (eval-when-form))) ((lambda (tmp1576) ((lambda (tmp1577) (if
tmp1577 (apply (lambda (_1578 x1579 e11580 e21581) (let ((when-list1582
(chi-when-list1116 e1558 x1579 w1559)) (body1583 (cons e11580 e21581))) (cond
((eq? m1546 (quote e)) (if (memq (quote eval) when-list1582)
(chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote e) (quote (eval))
mod1561) (chi-void1127))) ((memq (quote load) when-list1582) (if (or (memq
(quote compile) when-list1582) (and (eq? m1546 (quote c&e)) (memq (quote eval)
when-list1582))) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote c&e)
(quote (compile load)) mod1561) (if (memq m1546 (quote (c c&e)))
(chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote c) (quote (load))
mod1561) (chi-void1127)))) ((or (memq (quote compile) when-list1582) (and (eq?
m1546 (quote c&e)) (memq (quote eval) when-list1582))) (top-level-eval-hook1054
(chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote e) (quote (eval))
mod1561) mod1561) (chi-void1127)) (else (chi-void1127))))) tmp1577)
(syntax-violation #f "source expression failed to match any pattern" tmp1576)))
(syntax-dispatch tmp1576 (quote (any each-any any . each-any))))) e1558) (if
(memv t1562 (quote (define-syntax-form))) (let ((n1586 (id-var-name1105
value1557 w1559)) (r1587 (macros-only-env1079 r1544))) (let ((t1588 m1546)) (if
(memv t1588 (quote (c))) (if (memq (quote compile) esew1547) (let ((e1589
(chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)))) (begin
(top-level-eval-hook1054 e1589 mod1561) (if (memq (quote load) esew1547) e1589
(chi-void1127)))) (if (memq (quote load) esew1547) (chi-install-global1115
n1586 (chi1119 e1558 r1587 w1559 mod1561)) (chi-void1127))) (if (memv t1588
(quote (c&e))) (let ((e1590 (chi-install-global1115 n1586 (chi1119 e1558 r1587
w1559 mod1561)))) (begin (top-level-eval-hook1054 e1590 mod1561) e1590)) (begin
(if (memq (quote eval) esew1547) (top-level-eval-hook1054
(chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)) mod1561))
(chi-void1127)))))) (if (memv t1562 (quote (define-form))) (let ((n1591
(id-var-name1105 value1557 w1559))) (let ((type1592 (binding-type1075
(lookup1080 n1591 r1544 mod1561)))) (let ((t1593 type1592)) (if (memv t1593
(quote (global))) (let ((x1594 (build-annotated1060 s1560 (list (quote define)
n1591 (chi1119 e1558 r1544 w1559 mod1561))))) (begin (if (eq? m1546 (quote
c&e)) (top-level-eval-hook1054 x1594 mod1561)) x1594)) (if (memv t1593 (quote
(displaced-lexical))) (syntax-violation #f "identifier out of context" e1558
(wrap1111 value1557 w1559 mod1561)) (if (memv t1593 (quote (core macro
module-ref))) (begin (remove-global-definition-hook1058 n1591) (let ((x1595
(build-annotated1060 s1560 (list (quote define) n1591 (chi1119 e1558 r1544
w1559 mod1561))))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054
x1595 mod1561)) x1595))) (syntax-violation #f "cannot define keyword at top
level" e1558 (wrap1111 value1557 w1559 mod1561)))))))) (let ((x1596
(chi-expr1120 type1556 value1557 e1558 r1544 w1559 s1560 mod1561))) (begin (if
(eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1596 mod1561))
x1596)))))))))))) (syntax-type1117 (lambda (e1597 r1598 w1599 s1600 rib1601
mod1602) (cond ((symbol? e1597) (let ((n1603 (id-var-name1105 e1597 w1599)))
(let ((b1604 (lookup1080 n1603 r1598 mod1602))) (let ((type1605
(binding-type1075 b1604))) (let ((t1606 type1605)) (if (memv t1606 (quote
(lexical))) (values type1605 (binding-value1076 b1604) e1597 w1599 s1600
mod1602) (if (memv t1606 (quote (global))) (values type1605 n1603 e1597 w1599
s1600 mod1602) (if (memv t1606 (quote (macro))) (syntax-type1117 (chi-macro1122
(binding-value1076 b1604) e1597 r1598 w1599 rib1601 mod1602) r1598 (quote (()))
s1600 rib1601 mod1602) (values type1605 (binding-value1076 b1604) e1597 w1599
s1600 mod1602))))))))) ((pair? e1597) (let ((first1607 (car e1597))) (if
(id?1083 first1607) (let ((n1608 (id-var-name1105 first1607 w1599))) (let
((b1609 (lookup1080 n1608 r1598 (or (and (syntax-object?1067 first1607)
(syntax-object-module1070 first1607)) mod1602)))) (let ((type1610
(binding-type1075 b1609))) (let ((t1611 type1610)) (if (memv t1611 (quote
(lexical))) (values (quote lexical-call) (binding-value1076 b1609) e1597 w1599
s1600 mod1602) (if (memv t1611 (quote (global))) (values (quote global-call)
n1608 e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (macro)))
(syntax-type1117 (chi-macro1122 (binding-value1076 b1609) e1597 r1598 w1599
rib1601 mod1602) r1598 (quote (())) s1600 rib1601 mod1602) (if (memv t1611
(quote (core external-macro module-ref))) (values type1610 (binding-value1076
b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (local-syntax)))
(values (quote local-syntax-form) (binding-value1076 b1609) e1597 w1599 s1600
mod1602) (if (memv t1611 (quote (begin))) (values (quote begin-form) #f e1597
w1599 s1600 mod1602) (if (memv t1611 (quote (eval-when))) (values (quote
eval-when-form) #f e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (define)))
((lambda (tmp1612) ((lambda (tmp1613) (if (if tmp1613 (apply (lambda (_1614
name1615 val1616) (id?1083 name1615)) tmp1613) #f) (apply (lambda (_1617
name1618 val1619) (values (quote define-form) name1618 val1619 w1599 s1600
mod1602)) tmp1613) ((lambda (tmp1620) (if (if tmp1620 (apply (lambda (_1621
name1622 args1623 e11624 e21625) (and (id?1083 name1622) (valid-bound-ids?1108
(lambda-var-list1132 args1623)))) tmp1620) #f) (apply (lambda (_1626 name1627
args1628 e11629 e21630) (values (quote define-form) (wrap1111 name1627 w1599
mod1602) (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) (wrap1111 (cons args1628
(cons e11629 e21630)) w1599 mod1602)) (quote (())) s1600 mod1602)) tmp1620)
((lambda (tmp1632) (if (if tmp1632 (apply (lambda (_1633 name1634) (id?1083
name1634)) tmp1632) #f) (apply (lambda (_1635 name1636) (values (quote
define-form) (wrap1111 name1636 w1599 mod1602) (quote (#(syntax-object void
((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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1600
mod1602)) tmp1632) (syntax-violation #f "source expression failed to match any
pattern" tmp1612))) (syntax-dispatch tmp1612 (quote (any any))))))
(syntax-dispatch tmp1612 (quote (any (any . any) any . each-any))))))
(syntax-dispatch tmp1612 (quote (any any any))))) e1597) (if (memv t1611 (quote
(define-syntax))) ((lambda (tmp1637) ((lambda (tmp1638) (if (if tmp1638 (apply
(lambda (_1639 name1640 val1641) (id?1083 name1640)) tmp1638) #f) (apply
(lambda (_1642 name1643 val1644) (values (quote define-syntax-form) name1643
val1644 w1599 s1600 mod1602)) tmp1638) (syntax-violation #f "source expression
failed to match any pattern" tmp1637))) (syntax-dispatch tmp1637 (quote (any
any any))))) e1597) (values (quote call) #f e1597 w1599 s1600
mod1602)))))))))))))) (values (quote call) #f e1597 w1599 s1600 mod1602))))
((syntax-object?1067 e1597) (syntax-type1117 (syntax-object-expression1068
e1597) r1598 (join-wraps1102 w1599 (syntax-object-wrap1069 e1597)) #f rib1601
(or (syntax-object-module1070 e1597) mod1602))) ((annotation? e1597)
(syntax-type1117 (annotation-expression e1597) r1598 w1599 (annotation-source
e1597) rib1601 mod1602)) ((self-evaluating? e1597) (values (quote constant) #f
e1597 w1599 s1600 mod1602)) (else (values (quote other) #f e1597 w1599 s1600
mod1602))))) (chi-when-list1116 (lambda (e1645 when-list1646 w1647) (let f1648
((when-list1649 when-list1646) (situations1650 (quote ()))) (if (null?
when-list1649) situations1650 (f1648 (cdr when-list1649) (cons (let ((x1651
(car when-list1649))) (cond ((free-id=?1106 x1651 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile)))) (quote compile))
((free-id=?1106 x1651 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile)))) (quote load))
((free-id=?1106 x1651 (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else
(syntax-violation (quote eval-when) "invalid situation" e1645 (wrap1111 x1651
w1647 #f))))) situations1650)))))) (chi-install-global1115 (lambda (name1652
e1653) (build-annotated1060 #f (list (build-annotated1060 #f (quote
install-global-transformer)) (build-data1061 #f name1652) e1653))))
(chi-top-sequence1114 (lambda (body1654 r1655 w1656 s1657 m1658 esew1659
mod1660) (build-sequence1062 s1657 (let dobody1661 ((body1662 body1654) (r1663
r1655) (w1664 w1656) (m1665 m1658) (esew1666 esew1659) (mod1667 mod1660)) (if
(null? body1662) (quote ()) (let ((first1668 (chi-top1118 (car body1662) r1663
w1664 m1665 esew1666 mod1667))) (cons first1668 (dobody1661 (cdr body1662)
r1663 w1664 m1665 esew1666 mod1667)))))))) (chi-sequence1113 (lambda (body1669
r1670 w1671 s1672 mod1673) (build-sequence1062 s1672 (let dobody1674 ((body1675
body1669) (r1676 r1670) (w1677 w1671) (mod1678 mod1673)) (if (null? body1675)
(quote ()) (let ((first1679 (chi1119 (car body1675) r1676 w1677 mod1678)))
(cons first1679 (dobody1674 (cdr body1675) r1676 w1677 mod1678))))))))
(source-wrap1112 (lambda (x1680 w1681 s1682 defmod1683) (wrap1111 (if s1682
(make-annotation x1680 s1682 #f) x1680) w1681 defmod1683))) (wrap1111 (lambda
(x1684 w1685 defmod1686) (cond ((and (null? (wrap-marks1086 w1685)) (null?
(wrap-subst1087 w1685))) x1684) ((syntax-object?1067 x1684)
(make-syntax-object1066 (syntax-object-expression1068 x1684) (join-wraps1102
w1685 (syntax-object-wrap1069 x1684)) (syntax-object-module1070 x1684)))
((null? x1684) x1684) (else (make-syntax-object1066 x1684 w1685 defmod1686)))))
(bound-id-member?1110 (lambda (x1687 list1688) (and (not (null? list1688)) (or
(bound-id=?1107 x1687 (car list1688)) (bound-id-member?1110 x1687 (cdr
list1688)))))) (distinct-bound-ids?1109 (lambda (ids1689) (let distinct?1690
((ids1691 ids1689)) (or (null? ids1691) (and (not (bound-id-member?1110 (car
ids1691) (cdr ids1691))) (distinct?1690 (cdr ids1691)))))))
(valid-bound-ids?1108 (lambda (ids1692) (and (let all-ids?1693 ((ids1694
ids1692)) (or (null? ids1694) (and (id?1083 (car ids1694)) (all-ids?1693 (cdr
ids1694))))) (distinct-bound-ids?1109 ids1692)))) (bound-id=?1107 (lambda
(i1695 j1696) (if (and (syntax-object?1067 i1695) (syntax-object?1067 j1696))
(and (eq? (let ((e1697 (syntax-object-expression1068 i1695))) (if (annotation?
e1697) (annotation-expression e1697) e1697)) (let ((e1698
(syntax-object-expression1068 j1696))) (if (annotation? e1698)
(annotation-expression e1698) e1698))) (same-marks?1104 (wrap-marks1086
(syntax-object-wrap1069 i1695)) (wrap-marks1086 (syntax-object-wrap1069
j1696)))) (eq? (let ((e1699 i1695)) (if (annotation? e1699)
(annotation-expression e1699) e1699)) (let ((e1700 j1696)) (if (annotation?
e1700) (annotation-expression e1700) e1700)))))) (free-id=?1106 (lambda (i1701
j1702) (and (eq? (let ((x1703 i1701)) (let ((e1704 (if (syntax-object?1067
x1703) (syntax-object-expression1068 x1703) x1703))) (if (annotation? e1704)
(annotation-expression e1704) e1704))) (let ((x1705 j1702)) (let ((e1706 (if
(syntax-object?1067 x1705) (syntax-object-expression1068 x1705) x1705))) (if
(annotation? e1706) (annotation-expression e1706) e1706)))) (eq?
(id-var-name1105 i1701 (quote (()))) (id-var-name1105 j1702 (quote (())))))))
(id-var-name1105 (lambda (id1707 w1708) (letrec ((search-vector-rib1711 (lambda
(sym1717 subst1718 marks1719 symnames1720 ribcage1721) (let ((n1722
(vector-length symnames1720))) (let f1723 ((i1724 0)) (cond ((fx=1052 i1724
n1722) (search1709 sym1717 (cdr subst1718) marks1719)) ((and (eq? (vector-ref
symnames1720 i1724) sym1717) (same-marks?1104 marks1719 (vector-ref
(ribcage-marks1093 ribcage1721) i1724))) (values (vector-ref
(ribcage-labels1094 ribcage1721) i1724) marks1719)) (else (f1723 (fx+1050 i1724
1)))))))) (search-list-rib1710 (lambda (sym1725 subst1726 marks1727
symnames1728 ribcage1729) (let f1730 ((symnames1731 symnames1728) (i1732 0))
(cond ((null? symnames1731) (search1709 sym1725 (cdr subst1726) marks1727))
((and (eq? (car symnames1731) sym1725) (same-marks?1104 marks1727 (list-ref
(ribcage-marks1093 ribcage1729) i1732))) (values (list-ref (ribcage-labels1094
ribcage1729) i1732) marks1727)) (else (f1730 (cdr symnames1731) (fx+1050 i1732
1))))))) (search1709 (lambda (sym1733 subst1734 marks1735) (if (null?
subst1734) (values #f marks1735) (let ((fst1736 (car subst1734))) (if (eq?
fst1736 (quote shift)) (search1709 sym1733 (cdr subst1734) (cdr marks1735))
(let ((symnames1737 (ribcage-symnames1092 fst1736))) (if (vector? symnames1737)
(search-vector-rib1711 sym1733 subst1734 marks1735 symnames1737 fst1736)
(search-list-rib1710 sym1733 subst1734 marks1735 symnames1737 fst1736)))))))))
(cond ((symbol? id1707) (or (call-with-values (lambda () (search1709 id1707
(wrap-subst1087 w1708) (wrap-marks1086 w1708))) (lambda (x1739 . ignore1738)
x1739)) id1707)) ((syntax-object?1067 id1707) (let ((id1740 (let ((e1742
(syntax-object-expression1068 id1707))) (if (annotation? e1742)
(annotation-expression e1742) e1742))) (w11741 (syntax-object-wrap1069
id1707))) (let ((marks1743 (join-marks1103 (wrap-marks1086 w1708)
(wrap-marks1086 w11741)))) (call-with-values (lambda () (search1709 id1740
(wrap-subst1087 w1708) marks1743)) (lambda (new-id1744 marks1745) (or
new-id1744 (call-with-values (lambda () (search1709 id1740 (wrap-subst1087
w11741) marks1745)) (lambda (x1747 . ignore1746) x1747)) id1740))))))
((annotation? id1707) (let ((id1748 (let ((e1749 id1707)) (if (annotation?
e1749) (annotation-expression e1749) e1749)))) (or (call-with-values (lambda ()
(search1709 id1748 (wrap-subst1087 w1708) (wrap-marks1086 w1708))) (lambda
(x1751 . ignore1750) x1751)) id1748))) (else (error-hook1056 (quote
id-var-name) "invalid id" id1707)))))) (same-marks?1104 (lambda (x1752 y1753)
(or (eq? x1752 y1753) (and (not (null? x1752)) (not (null? y1753)) (eq? (car
x1752) (car y1753)) (same-marks?1104 (cdr x1752) (cdr y1753))))))
(join-marks1103 (lambda (m11754 m21755) (smart-append1101 m11754 m21755)))
(join-wraps1102 (lambda (w11756 w21757) (let ((m11758 (wrap-marks1086 w11756))
(s11759 (wrap-subst1087 w11756))) (if (null? m11758) (if (null? s11759) w21757
(make-wrap1085 (wrap-marks1086 w21757) (smart-append1101 s11759 (wrap-subst1087
w21757)))) (make-wrap1085 (smart-append1101 m11758 (wrap-marks1086 w21757))
(smart-append1101 s11759 (wrap-subst1087 w21757))))))) (smart-append1101
(lambda (m11760 m21761) (if (null? m21761) m11760 (append m11760 m21761))))
(make-binding-wrap1100 (lambda (ids1762 labels1763 w1764) (if (null? ids1762)
w1764 (make-wrap1085 (wrap-marks1086 w1764) (cons (let ((labelvec1765
(list->vector labels1763))) (let ((n1766 (vector-length labelvec1765))) (let
((symnamevec1767 (make-vector n1766)) (marksvec1768 (make-vector n1766)))
(begin (let f1769 ((ids1770 ids1762) (i1771 0)) (if (not (null? ids1770))
(call-with-values (lambda () (id-sym-name&marks1084 (car ids1770) w1764))
(lambda (symname1772 marks1773) (begin (vector-set! symnamevec1767 i1771
symname1772) (vector-set! marksvec1768 i1771 marks1773) (f1769 (cdr ids1770)
(fx+1050 i1771 1))))))) (make-ribcage1090 symnamevec1767 marksvec1768
labelvec1765))))) (wrap-subst1087 w1764)))))) (extend-ribcage!1099 (lambda
(ribcage1774 id1775 label1776) (begin (set-ribcage-symnames!1095 ribcage1774
(cons (let ((e1777 (syntax-object-expression1068 id1775))) (if (annotation?
e1777) (annotation-expression e1777) e1777)) (ribcage-symnames1092
ribcage1774))) (set-ribcage-marks!1096 ribcage1774 (cons (wrap-marks1086
(syntax-object-wrap1069 id1775)) (ribcage-marks1093 ribcage1774)))
(set-ribcage-labels!1097 ribcage1774 (cons label1776 (ribcage-labels1094
ribcage1774)))))) (anti-mark1098 (lambda (w1778) (make-wrap1085 (cons #f
(wrap-marks1086 w1778)) (cons (quote shift) (wrap-subst1087 w1778)))))
(set-ribcage-labels!1097 (lambda (x1779 update1780) (vector-set! x1779 3
update1780))) (set-ribcage-marks!1096 (lambda (x1781 update1782) (vector-set!
x1781 2 update1782))) (set-ribcage-symnames!1095 (lambda (x1783 update1784)
(vector-set! x1783 1 update1784))) (ribcage-labels1094 (lambda (x1785)
(vector-ref x1785 3))) (ribcage-marks1093 (lambda (x1786) (vector-ref x1786
2))) (ribcage-symnames1092 (lambda (x1787) (vector-ref x1787 1))) (ribcage?1091
(lambda (x1788) (and (vector? x1788) (= (vector-length x1788) 4) (eq?
(vector-ref x1788 0) (quote ribcage))))) (make-ribcage1090 (lambda
(symnames1789 marks1790 labels1791) (vector (quote ribcage) symnames1789
marks1790 labels1791))) (gen-labels1089 (lambda (ls1792) (if (null? ls1792)
(quote ()) (cons (gen-label1088) (gen-labels1089 (cdr ls1792))))))
(gen-label1088 (lambda () (string #\i))) (wrap-subst1087 cdr) (wrap-marks1086
car) (make-wrap1085 cons) (id-sym-name&marks1084 (lambda (x1793 w1794) (if
(syntax-object?1067 x1793) (values (let ((e1795 (syntax-object-expression1068
x1793))) (if (annotation? e1795) (annotation-expression e1795) e1795))
(join-marks1103 (wrap-marks1086 w1794) (wrap-marks1086 (syntax-object-wrap1069
x1793)))) (values (let ((e1796 x1793)) (if (annotation? e1796)
(annotation-expression e1796) e1796)) (wrap-marks1086 w1794))))) (id?1083
(lambda (x1797) (cond ((symbol? x1797) #t) ((syntax-object?1067 x1797) (symbol?
(let ((e1798 (syntax-object-expression1068 x1797))) (if (annotation? e1798)
(annotation-expression e1798) e1798)))) ((annotation? x1797) (symbol?
(annotation-expression x1797))) (else #f)))) (nonsymbol-id?1082 (lambda (x1799)
(and (syntax-object?1067 x1799) (symbol? (let ((e1800
(syntax-object-expression1068 x1799))) (if (annotation? e1800)
(annotation-expression e1800) e1800)))))) (global-extend1081 (lambda (type1801
sym1802 val1803) (put-global-definition-hook1057 sym1802 type1801 val1803)))
(lookup1080 (lambda (x1804 r1805 mod1806) (cond ((assq x1804 r1805) => cdr)
((symbol? x1804) (or (get-global-definition-hook1059 x1804 mod1806) (quote
(global)))) (else (quote (displaced-lexical)))))) (macros-only-env1079 (lambda
(r1807) (if (null? r1807) (quote ()) (let ((a1808 (car r1807))) (if (eq? (cadr
a1808) (quote macro)) (cons a1808 (macros-only-env1079 (cdr r1807)))
(macros-only-env1079 (cdr r1807))))))) (extend-var-env1078 (lambda (labels1809
vars1810 r1811) (if (null? labels1809) r1811 (extend-var-env1078 (cdr
labels1809) (cdr vars1810) (cons (cons (car labels1809) (cons (quote lexical)
(car vars1810))) r1811))))) (extend-env1077 (lambda (labels1812 bindings1813
r1814) (if (null? labels1812) r1814 (extend-env1077 (cdr labels1812) (cdr
bindings1813) (cons (cons (car labels1812) (car bindings1813)) r1814)))))
(binding-value1076 cdr) (binding-type1075 car) (source-annotation1074 (lambda
(x1815) (cond ((annotation? x1815) (annotation-source x1815))
((syntax-object?1067 x1815) (source-annotation1074
(syntax-object-expression1068 x1815))) (else #f))))
(set-syntax-object-module!1073 (lambda (x1816 update1817) (vector-set! x1816 3
update1817))) (set-syntax-object-wrap!1072 (lambda (x1818 update1819)
(vector-set! x1818 2 update1819))) (set-syntax-object-expression!1071 (lambda
(x1820 update1821) (vector-set! x1820 1 update1821))) (syntax-object-module1070
(lambda (x1822) (vector-ref x1822 3))) (syntax-object-wrap1069 (lambda (x1823)
(vector-ref x1823 2))) (syntax-object-expression1068 (lambda (x1824)
(vector-ref x1824 1))) (syntax-object?1067 (lambda (x1825) (and (vector? x1825)
(= (vector-length x1825) 4) (eq? (vector-ref x1825 0) (quote syntax-object)))))
(make-syntax-object1066 (lambda (expression1826 wrap1827 module1828) (vector
(quote syntax-object) expression1826 wrap1827 module1828))) (build-letrec1065
(lambda (src1829 vars1830 val-exps1831 body-exp1832) (if (null? vars1830)
(build-annotated1060 src1829 body-exp1832) (build-annotated1060 src1829 (list
(quote letrec) (map list vars1830 val-exps1831) body-exp1832)))))
(build-named-let1064 (lambda (src1833 vars1834 val-exps1835 body-exp1836) (if
(null? vars1834) (build-annotated1060 src1833 body-exp1836)
(build-annotated1060 src1833 (list (quote let) (car vars1834) (map list (cdr
vars1834) val-exps1835) body-exp1836))))) (build-let1063 (lambda (src1837
vars1838 val-exps1839 body-exp1840) (if (null? vars1838) (build-annotated1060
src1837 body-exp1840) (build-annotated1060 src1837 (list (quote let) (map list
vars1838 val-exps1839) body-exp1840))))) (build-sequence1062 (lambda (src1841
exps1842) (if (null? (cdr exps1842)) (build-annotated1060 src1841 (car
exps1842)) (build-annotated1060 src1841 (cons (quote begin) exps1842)))))
(build-data1061 (lambda (src1843 exp1844) (if (and (self-evaluating? exp1844)
(not (vector? exp1844))) (build-annotated1060 src1843 exp1844)
(build-annotated1060 src1843 (list (quote quote) exp1844)))))
(build-annotated1060 (lambda (src1845 exp1846) (if (and src1845 (not
(annotation? exp1846))) (make-annotation exp1846 src1845 #t) exp1846)))
(get-global-definition-hook1059 (lambda (symbol1847 module1848) (begin (if (and
(not module1848) (current-module)) (warn "module system is booted, we should
have a module" symbol1847)) (module-lookup-keyword (if module1848
(resolve-module (cdr module1848)) (current-module)) symbol1847))))
(remove-global-definition-hook1058 (lambda (symbol1849)
(module-undefine-keyword! (current-module) symbol1849)))
(put-global-definition-hook1057 (lambda (symbol1850 type1851 val1852)
(module-define-keyword! (current-module) symbol1850 type1851 val1852)))
(error-hook1056 (lambda (who1853 why1854 what1855) (error who1853 "~a ~s"
why1854 what1855))) (local-eval-hook1055 (lambda (x1856 mod1857)
(primitive-eval (list noexpand1049 x1856)))) (top-level-eval-hook1054 (lambda
(x1858 mod1859) (primitive-eval (list noexpand1049 x1858)))) (fx<1053 <)
(fx=1052 =) (fx-1051 -) (fx+1050 +) (noexpand1049 "noexpand")) (begin
(global-extend1081 (quote local-syntax) (quote letrec-syntax) #t)
(global-extend1081 (quote local-syntax) (quote let-syntax) #f)
(global-extend1081 (quote core) (quote fluid-let-syntax) (lambda (e1860 r1861
w1862 s1863 mod1864) ((lambda (tmp1865) ((lambda (tmp1866) (if (if tmp1866
(apply (lambda (_1867 var1868 val1869 e11870 e21871) (valid-bound-ids?1108
var1868)) tmp1866) #f) (apply (lambda (_1873 var1874 val1875 e11876 e21877)
(let ((names1878 (map (lambda (x1879) (id-var-name1105 x1879 w1862)) var1874)))
(begin (for-each (lambda (id1881 n1882) (let ((t1883 (binding-type1075
(lookup1080 n1882 r1861 mod1864)))) (if (memv t1883 (quote
(displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier
out of context" e1860 (source-wrap1112 id1881 w1862 s1863 mod1864))))) var1874
names1878) (chi-body1123 (cons e11876 e21877) (source-wrap1112 e1860 w1862
s1863 mod1864) (extend-env1077 names1878 (let ((trans-r1886
(macros-only-env1079 r1861))) (map (lambda (x1887) (cons (quote macro)
(eval-local-transformer1126 (chi1119 x1887 trans-r1886 w1862 mod1864)
mod1864))) val1875)) r1861) w1862 mod1864)))) tmp1866) ((lambda (_1889)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1112 e1860
w1862 s1863 mod1864))) tmp1865))) (syntax-dispatch tmp1865 (quote (any #(each
(any any)) any . each-any))))) e1860))) (global-extend1081 (quote core) (quote
quote) (lambda (e1890 r1891 w1892 s1893 mod1894) ((lambda (tmp1895) ((lambda
(tmp1896) (if tmp1896 (apply (lambda (_1897 e1898) (build-data1061 s1893
(strip1130 e1898 w1892))) tmp1896) ((lambda (_1899) (syntax-violation (quote
quote) "bad syntax" (source-wrap1112 e1890 w1892 s1893 mod1894))) tmp1895)))
(syntax-dispatch tmp1895 (quote (any any))))) e1890))) (global-extend1081
(quote core) (quote syntax) (letrec ((regen1907 (lambda (x1908) (let ((t1909
(car x1908))) (if (memv t1909 (quote (ref))) (build-annotated1060 #f (cadr
x1908)) (if (memv t1909 (quote (primitive))) (build-annotated1060 #f (cadr
x1908)) (if (memv t1909 (quote (quote))) (build-data1061 #f (cadr x1908)) (if
(memv t1909 (quote (lambda))) (build-annotated1060 #f (list (quote lambda)
(cadr x1908) (regen1907 (caddr x1908)))) (if (memv t1909 (quote (map))) (let
((ls1910 (map regen1907 (cdr x1908)))) (build-annotated1060 #f (cons (if
(fx=1052 (length ls1910) 2) (build-annotated1060 #f (quote map))
(build-annotated1060 #f (quote map))) ls1910))) (build-annotated1060 #f (cons
(build-annotated1060 #f (car x1908)) (map regen1907 (cdr x1908))))))))))))
(gen-vector1906 (lambda (x1911) (cond ((eq? (car x1911) (quote list)) (cons
(quote vector) (cdr x1911))) ((eq? (car x1911) (quote quote)) (list (quote
quote) (list->vector (cadr x1911)))) (else (list (quote list->vector)
x1911))))) (gen-append1905 (lambda (x1912 y1913) (if (equal? y1913 (quote
(quote ()))) x1912 (list (quote append) x1912 y1913)))) (gen-cons1904 (lambda
(x1914 y1915) (let ((t1916 (car y1915))) (if (memv t1916 (quote (quote))) (if
(eq? (car x1914) (quote quote)) (list (quote quote) (cons (cadr x1914) (cadr
y1915))) (if (eq? (cadr y1915) (quote ())) (list (quote list) x1914) (list
(quote cons) x1914 y1915))) (if (memv t1916 (quote (list))) (cons (quote list)
(cons x1914 (cdr y1915))) (list (quote cons) x1914 y1915)))))) (gen-map1903
(lambda (e1917 map-env1918) (let ((formals1919 (map cdr map-env1918))
(actuals1920 (map (lambda (x1921) (list (quote ref) (car x1921)))
map-env1918))) (cond ((eq? (car e1917) (quote ref)) (car actuals1920)) ((andmap
(lambda (x1922) (and (eq? (car x1922) (quote ref)) (memq (cadr x1922)
formals1919))) (cdr e1917)) (cons (quote map) (cons (list (quote primitive)
(car e1917)) (map (let ((r1923 (map cons formals1919 actuals1920))) (lambda
(x1924) (cdr (assq (cadr x1924) r1923)))) (cdr e1917))))) (else (cons (quote
map) (cons (list (quote lambda) formals1919 e1917) actuals1920)))))))
(gen-mappend1902 (lambda (e1925 map-env1926) (list (quote apply) (quote
(primitive append)) (gen-map1903 e1925 map-env1926)))) (gen-ref1901 (lambda
(src1927 var1928 level1929 maps1930) (if (fx=1052 level1929 0) (values var1928
maps1930) (if (null? maps1930) (syntax-violation (quote syntax) "missing
ellipsis" src1927) (call-with-values (lambda () (gen-ref1901 src1927 var1928
(fx-1051 level1929 1) (cdr maps1930))) (lambda (outer-var1931 outer-maps1932)
(let ((b1933 (assq outer-var1931 (car maps1930)))) (if b1933 (values (cdr
b1933) maps1930) (let ((inner-var1934 (gen-var1131 (quote tmp)))) (values
inner-var1934 (cons (cons (cons outer-var1931 inner-var1934) (car maps1930))
outer-maps1932))))))))))) (gen-syntax1900 (lambda (src1935 e1936 r1937 maps1938
ellipsis?1939 mod1940) (if (id?1083 e1936) (let ((label1941 (id-var-name1105
e1936 (quote (()))))) (let ((b1942 (lookup1080 label1941 r1937 mod1940))) (if
(eq? (binding-type1075 b1942) (quote syntax)) (call-with-values (lambda () (let
((var.lev1943 (binding-value1076 b1942))) (gen-ref1901 src1935 (car
var.lev1943) (cdr var.lev1943) maps1938))) (lambda (var1944 maps1945) (values
(list (quote ref) var1944) maps1945))) (if (ellipsis?1939 e1936)
(syntax-violation (quote syntax) "misplaced ellipsis" src1935) (values (list
(quote quote) e1936) maps1938))))) ((lambda (tmp1946) ((lambda (tmp1947) (if
(if tmp1947 (apply (lambda (dots1948 e1949) (ellipsis?1939 dots1948)) tmp1947)
#f) (apply (lambda (dots1950 e1951) (gen-syntax1900 src1935 e1951 r1937
maps1938 (lambda (x1952) #f) mod1940)) tmp1947) ((lambda (tmp1953) (if (if
tmp1953 (apply (lambda (x1954 dots1955 y1956) (ellipsis?1939 dots1955))
tmp1953) #f) (apply (lambda (x1957 dots1958 y1959) (let f1960 ((y1961 y1959)
(k1962 (lambda (maps1963) (call-with-values (lambda () (gen-syntax1900 src1935
x1957 r1937 (cons (quote ()) maps1963) ellipsis?1939 mod1940)) (lambda (x1964
maps1965) (if (null? (car maps1965)) (syntax-violation (quote syntax) "extra
ellipsis" src1935) (values (gen-map1903 x1964 (car maps1965)) (cdr
maps1965)))))))) ((lambda (tmp1966) ((lambda (tmp1967) (if (if tmp1967 (apply
(lambda (dots1968 y1969) (ellipsis?1939 dots1968)) tmp1967) #f) (apply (lambda
(dots1970 y1971) (f1960 y1971 (lambda (maps1972) (call-with-values (lambda ()
(k1962 (cons (quote ()) maps1972))) (lambda (x1973 maps1974) (if (null? (car
maps1974)) (syntax-violation (quote syntax) "extra ellipsis" src1935) (values
(gen-mappend1902 x1973 (car maps1974)) (cdr maps1974)))))))) tmp1967) ((lambda
(_1975) (call-with-values (lambda () (gen-syntax1900 src1935 y1961 r1937
maps1938 ellipsis?1939 mod1940)) (lambda (y1976 maps1977) (call-with-values
(lambda () (k1962 maps1977)) (lambda (x1978 maps1979) (values (gen-append1905
x1978 y1976) maps1979)))))) tmp1966))) (syntax-dispatch tmp1966 (quote (any .
any))))) y1961))) tmp1953) ((lambda (tmp1980) (if tmp1980 (apply (lambda (x1981
y1982) (call-with-values (lambda () (gen-syntax1900 src1935 x1981 r1937
maps1938 ellipsis?1939 mod1940)) (lambda (x1983 maps1984) (call-with-values
(lambda () (gen-syntax1900 src1935 y1982 r1937 maps1984 ellipsis?1939 mod1940))
(lambda (y1985 maps1986) (values (gen-cons1904 x1983 y1985) maps1986))))))
tmp1980) ((lambda (tmp1987) (if tmp1987 (apply (lambda (e11988 e21989)
(call-with-values (lambda () (gen-syntax1900 src1935 (cons e11988 e21989) r1937
maps1938 ellipsis?1939 mod1940)) (lambda (e1991 maps1992) (values
(gen-vector1906 e1991) maps1992)))) tmp1987) ((lambda (_1993) (values (list
(quote quote) e1936) maps1938)) tmp1946))) (syntax-dispatch tmp1946 (quote
#(vector (any . each-any))))))) (syntax-dispatch tmp1946 (quote (any .
any)))))) (syntax-dispatch tmp1946 (quote (any any . any)))))) (syntax-dispatch
tmp1946 (quote (any any))))) e1936))))) (lambda (e1994 r1995 w1996 s1997
mod1998) (let ((e1999 (source-wrap1112 e1994 w1996 s1997 mod1998))) ((lambda
(tmp2000) ((lambda (tmp2001) (if tmp2001 (apply (lambda (_2002 x2003)
(call-with-values (lambda () (gen-syntax1900 e1999 x2003 r1995 (quote ())
ellipsis?1128 mod1998)) (lambda (e2004 maps2005) (regen1907 e2004)))) tmp2001)
((lambda (_2006) (syntax-violation (quote syntax) "bad `syntax' form" e1999))
tmp2000))) (syntax-dispatch tmp2000 (quote (any any))))) e1999)))))
(global-extend1081 (quote core) (quote lambda) (lambda (e2007 r2008 w2009 s2010
mod2011) ((lambda (tmp2012) ((lambda (tmp2013) (if tmp2013 (apply (lambda
(_2014 c2015) (chi-lambda-clause1124 (source-wrap1112 e2007 w2009 s2010
mod2011) #f c2015 r2008 w2009 mod2011 (lambda (vars2016 docstring2017 body2018)
(build-annotated1060 s2010 (cons (quote lambda) (cons vars2016 (append (if
docstring2017 (list docstring2017) (quote ())) (list body2018)))))))) tmp2013)
(syntax-violation #f "source expression failed to match any pattern" tmp2012)))
(syntax-dispatch tmp2012 (quote (any . any))))) e2007))) (global-extend1081
(quote core) (quote let) (letrec ((chi-let2019 (lambda (e2020 r2021 w2022 s2023
mod2024 constructor2025 ids2026 vals2027 exps2028) (if (not
(valid-bound-ids?1108 ids2026)) (syntax-violation (quote let) "duplicate bound
variable" e2020) (let ((labels2029 (gen-labels1089 ids2026)) (new-vars2030 (map
gen-var1131 ids2026))) (let ((nw2031 (make-binding-wrap1100 ids2026 labels2029
w2022)) (nr2032 (extend-var-env1078 labels2029 new-vars2030 r2021)))
(constructor2025 s2023 new-vars2030 (map (lambda (x2033) (chi1119 x2033 r2021
w2022 mod2024)) vals2027) (chi-body1123 exps2028 (source-wrap1112 e2020 nw2031
s2023 mod2024) nr2032 nw2031 mod2024)))))))) (lambda (e2034 r2035 w2036 s2037
mod2038) ((lambda (tmp2039) ((lambda (tmp2040) (if tmp2040 (apply (lambda
(_2041 id2042 val2043 e12044 e22045) (chi-let2019 e2034 r2035 w2036 s2037
mod2038 build-let1063 id2042 val2043 (cons e12044 e22045))) tmp2040) ((lambda
(tmp2049) (if (if tmp2049 (apply (lambda (_2050 f2051 id2052 val2053 e12054
e22055) (id?1083 f2051)) tmp2049) #f) (apply (lambda (_2056 f2057 id2058
val2059 e12060 e22061) (chi-let2019 e2034 r2035 w2036 s2037 mod2038
build-named-let1064 (cons f2057 id2058) val2059 (cons e12060 e22061))) tmp2049)
((lambda (_2065) (syntax-violation (quote let) "bad let" (source-wrap1112 e2034
w2036 s2037 mod2038))) tmp2039))) (syntax-dispatch tmp2039 (quote (any any
#(each (any any)) any . each-any)))))) (syntax-dispatch tmp2039 (quote (any
#(each (any any)) any . each-any))))) e2034)))) (global-extend1081 (quote core)
(quote letrec) (lambda (e2066 r2067 w2068 s2069 mod2070) ((lambda (tmp2071)
((lambda (tmp2072) (if tmp2072 (apply (lambda (_2073 id2074 val2075 e12076
e22077) (let ((ids2078 id2074)) (if (not (valid-bound-ids?1108 ids2078))
(syntax-violation (quote letrec) "duplicate bound variable" e2066) (let
((labels2080 (gen-labels1089 ids2078)) (new-vars2081 (map gen-var1131
ids2078))) (let ((w2082 (make-binding-wrap1100 ids2078 labels2080 w2068))
(r2083 (extend-var-env1078 labels2080 new-vars2081 r2067))) (build-letrec1065
s2069 new-vars2081 (map (lambda (x2084) (chi1119 x2084 r2083 w2082 mod2070))
val2075) (chi-body1123 (cons e12076 e22077) (source-wrap1112 e2066 w2082 s2069
mod2070) r2083 w2082 mod2070))))))) tmp2072) ((lambda (_2087) (syntax-violation
(quote letrec) "bad letrec" (source-wrap1112 e2066 w2068 s2069 mod2070)))
tmp2071))) (syntax-dispatch tmp2071 (quote (any #(each (any any)) any .
each-any))))) e2066))) (global-extend1081 (quote core) (quote set!) (lambda
(e2088 r2089 w2090 s2091 mod2092) ((lambda (tmp2093) ((lambda (tmp2094) (if (if
tmp2094 (apply (lambda (_2095 id2096 val2097) (id?1083 id2096)) tmp2094) #f)
(apply (lambda (_2098 id2099 val2100) (let ((val2101 (chi1119 val2100 r2089
w2090 mod2092)) (n2102 (id-var-name1105 id2099 w2090))) (let ((b2103
(lookup1080 n2102 r2089 mod2092))) (let ((t2104 (binding-type1075 b2103))) (if
(memv t2104 (quote (lexical))) (build-annotated1060 s2091 (list (quote set!)
(binding-value1076 b2103) val2101)) (if (memv t2104 (quote (global)))
(build-annotated1060 s2091 (list (quote set!) (if mod2092 (make-module-ref (cdr
mod2092) n2102 (car mod2092)) (make-module-ref mod2092 n2102 (quote bare)))
val2101)) (if (memv t2104 (quote (displaced-lexical))) (syntax-violation (quote
set!) "identifier out of context" (wrap1111 id2099 w2090 mod2092))
(syntax-violation (quote set!) "bad set!" (source-wrap1112 e2088 w2090 s2091
mod2092))))))))) tmp2094) ((lambda (tmp2105) (if tmp2105 (apply (lambda (_2106
head2107 tail2108 val2109) (call-with-values (lambda () (syntax-type1117
head2107 r2089 (quote (())) #f #f mod2092)) (lambda (type2110 value2111 ee2112
ww2113 ss2114 modmod2115) (let ((t2116 type2110)) (if (memv t2116 (quote
(module-ref))) (let ((val2117 (chi1119 val2109 r2089 w2090 mod2092)))
(call-with-values (lambda () (value2111 (cons head2107 tail2108))) (lambda
(id2119 mod2120) (build-annotated1060 s2091 (list (quote set!) (if mod2120
(make-module-ref (cdr mod2120) id2119 (car mod2120)) (make-module-ref mod2120
id2119 (quote bare))) val2117))))) (build-annotated1060 s2091 (cons (chi1119
(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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) head2107) r2089 w2090
mod2092) (map (lambda (e2121) (chi1119 e2121 r2089 w2090 mod2092)) (append
tail2108 (list val2109)))))))))) tmp2105) ((lambda (_2123) (syntax-violation
(quote set!) "bad set!" (source-wrap1112 e2088 w2090 s2091 mod2092)))
tmp2093))) (syntax-dispatch tmp2093 (quote (any (any . each-any) any))))))
(syntax-dispatch tmp2093 (quote (any any any))))) e2088))) (global-extend1081
(quote module-ref) (quote @) (lambda (e2124) ((lambda (tmp2125) ((lambda
(tmp2126) (if (if tmp2126 (apply (lambda (_2127 mod2128 id2129) (and (andmap
id?1083 mod2128) (id?1083 id2129))) tmp2126) #f) (apply (lambda (_2131 mod2132
id2133) (values (syntax->datum id2133) (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) mod2132)))) tmp2126)
(syntax-violation #f "source expression failed to match any pattern" tmp2125)))
(syntax-dispatch tmp2125 (quote (any each-any any))))) e2124)))
(global-extend1081 (quote module-ref) (quote @@) (lambda (e2135) ((lambda
(tmp2136) ((lambda (tmp2137) (if (if tmp2137 (apply (lambda (_2138 mod2139
id2140) (and (andmap id?1083 mod2139) (id?1083 id2140))) tmp2137) #f) (apply
(lambda (_2142 mod2143 id2144) (values (syntax->datum id2144) (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) mod2143)))) tmp2137)
(syntax-violation #f "source expression failed to match any pattern" tmp2136)))
(syntax-dispatch tmp2136 (quote (any each-any any))))) e2135)))
(global-extend1081 (quote begin) (quote begin) (quote ())) (global-extend1081
(quote define) (quote define) (quote ())) (global-extend1081 (quote
define-syntax) (quote define-syntax) (quote ())) (global-extend1081 (quote
eval-when) (quote eval-when) (quote ())) (global-extend1081 (quote core) (quote
syntax-case) (letrec ((gen-syntax-case2149 (lambda (x2150 keys2151 clauses2152
r2153 mod2154) (if (null? clauses2152) (build-annotated1060 #f (list
(build-annotated1060 #f (quote syntax-violation)) #f "source expression failed
to match any pattern" x2150)) ((lambda (tmp2155) ((lambda (tmp2156) (if tmp2156
(apply (lambda (pat2157 exp2158) (if (and (id?1083 pat2157) (andmap (lambda
(x2159) (not (free-id=?1106 pat2157 x2159))) (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 build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook remove-global-definition-hook
put-global-definition-hook gensym-hook error-hook local-eval-hook
top-level-eval-hook fx< fx= fx- fx+ 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) ((top)) ("i"))) (hygiene guile))) keys2151))) (let
((labels2160 (list (gen-label1088))) (var2161 (gen-var1131 pat2157)))
(build-annotated1060 #f (list (build-annotated1060 #f (list (quote lambda)
(list var2161) (chi1119 exp2158 (extend-env1077 labels2160 (list (cons (quote
syntax) (cons var2161 0))) r2153) (make-binding-wrap1100 (list pat2157)
labels2160 (quote (()))) mod2154))) x2150))) (gen-clause2148 x2150 keys2151
(cdr clauses2152) r2153 pat2157 #t exp2158 mod2154))) tmp2156) ((lambda
(tmp2162) (if tmp2162 (apply (lambda (pat2163 fender2164 exp2165)
(gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2163 fender2164
exp2165 mod2154)) tmp2162) ((lambda (_2166) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses2152))) tmp2155))) (syntax-dispatch
tmp2155 (quote (any any any)))))) (syntax-dispatch tmp2155 (quote (any any)))))
(car clauses2152))))) (gen-clause2148 (lambda (x2167 keys2168 clauses2169 r2170
pat2171 fender2172 exp2173 mod2174) (call-with-values (lambda ()
(convert-pattern2146 pat2171 keys2168)) (lambda (p2175 pvars2176) (cond ((not
(distinct-bound-ids?1109 (map car pvars2176))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat2171)) ((not (andmap (lambda
(x2177) (not (ellipsis?1128 (car x2177)))) pvars2176)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat2171)) (else (let ((y2178 (gen-var1131
(quote tmp)))) (build-annotated1060 #f (list (build-annotated1060 #f (list
(quote lambda) (list y2178) (let ((y2179 (build-annotated1060 #f y2178)))
(build-annotated1060 #f (list (quote if) ((lambda (tmp2180) ((lambda (tmp2181)
(if tmp2181 (apply (lambda () y2179) tmp2181) ((lambda (_2182)
(build-annotated1060 #f (list (quote if) y2179 (build-dispatch-call2147
pvars2176 fender2172 y2179 r2170 mod2174) (build-data1061 #f #f)))) tmp2180)))
(syntax-dispatch tmp2180 (quote #(atom #t))))) fender2172)
(build-dispatch-call2147 pvars2176 exp2173 y2179 r2170 mod2174)
(gen-syntax-case2149 x2167 keys2168 clauses2169 r2170 mod2174)))))) (if (eq?
p2175 (quote any)) (build-annotated1060 #f (list (build-annotated1060 #f (quote
list)) x2167)) (build-annotated1060 #f (list (build-annotated1060 #f (quote
syntax-dispatch)) x2167 (build-data1061 #f p2175)))))))))))))
(build-dispatch-call2147 (lambda (pvars2183 exp2184 y2185 r2186 mod2187) (let
((ids2188 (map car pvars2183)) (levels2189 (map cdr pvars2183))) (let
((labels2190 (gen-labels1089 ids2188)) (new-vars2191 (map gen-var1131
ids2188))) (build-annotated1060 #f (list (build-annotated1060 #f (quote apply))
(build-annotated1060 #f (list (quote lambda) new-vars2191 (chi1119 exp2184
(extend-env1077 labels2190 (map (lambda (var2192 level2193) (cons (quote
syntax) (cons var2192 level2193))) new-vars2191 (map cdr pvars2183)) r2186)
(make-binding-wrap1100 ids2188 labels2190 (quote (()))) mod2187))) y2185))))))
(convert-pattern2146 (lambda (pattern2194 keys2195) (let cvt2196 ((p2197
pattern2194) (n2198 0) (ids2199 (quote ()))) (if (id?1083 p2197) (if
(bound-id-member?1110 p2197 keys2195) (values (vector (quote free-id) p2197)
ids2199) (values (quote any) (cons (cons p2197 n2198) ids2199))) ((lambda
(tmp2200) ((lambda (tmp2201) (if (if tmp2201 (apply (lambda (x2202 dots2203)
(ellipsis?1128 dots2203)) tmp2201) #f) (apply (lambda (x2204 dots2205)
(call-with-values (lambda () (cvt2196 x2204 (fx+1050 n2198 1) ids2199)) (lambda
(p2206 ids2207) (values (if (eq? p2206 (quote any)) (quote each-any) (vector
(quote each) p2206)) ids2207)))) tmp2201) ((lambda (tmp2208) (if tmp2208 (apply
(lambda (x2209 y2210) (call-with-values (lambda () (cvt2196 y2210 n2198
ids2199)) (lambda (y2211 ids2212) (call-with-values (lambda () (cvt2196 x2209
n2198 ids2212)) (lambda (x2213 ids2214) (values (cons x2213 y2211)
ids2214)))))) tmp2208) ((lambda (tmp2215) (if tmp2215 (apply (lambda () (values
(quote ()) ids2199)) tmp2215) ((lambda (tmp2216) (if tmp2216 (apply (lambda
(x2217) (call-with-values (lambda () (cvt2196 x2217 n2198 ids2199)) (lambda
(p2219 ids2220) (values (vector (quote vector) p2219) ids2220)))) tmp2216)
((lambda (x2221) (values (vector (quote atom) (strip1130 p2197 (quote (()))))
ids2199)) tmp2200))) (syntax-dispatch tmp2200 (quote #(vector each-any))))))
(syntax-dispatch tmp2200 (quote ()))))) (syntax-dispatch tmp2200 (quote (any .
any)))))) (syntax-dispatch tmp2200 (quote (any any))))) p2197)))))) (lambda
(e2222 r2223 w2224 s2225 mod2226) (let ((e2227 (source-wrap1112 e2222 w2224
s2225 mod2226))) ((lambda (tmp2228) ((lambda (tmp2229) (if tmp2229 (apply
(lambda (_2230 val2231 key2232 m2233) (if (andmap (lambda (x2234) (and (id?1083
x2234) (not (ellipsis?1128 x2234)))) key2232) (let ((x2236 (gen-var1131 (quote
tmp)))) (build-annotated1060 s2225 (list (build-annotated1060 #f (list (quote
lambda) (list x2236) (gen-syntax-case2149 (build-annotated1060 #f x2236)
key2232 m2233 r2223 mod2226))) (chi1119 val2231 r2223 (quote (())) mod2226))))
(syntax-violation (quote syntax-case) "invalid literals list" e2227))) tmp2229)
(syntax-violation #f "source expression failed to match any pattern" tmp2228)))
(syntax-dispatch tmp2228 (quote (any any each-any . each-any))))) e2227)))))
(set! sc-expand (let ((m2239 (quote e)) (esew2240 (quote (eval)))) (lambda
(x2241) (if (and (pair? x2241) (equal? (car x2241) noexpand1049)) (cadr x2241)
(chi-top1118 x2241 (quote ()) (quote ((top))) m2239 esew2240 (cons (quote
hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2242
(quote e)) (esew2243 (quote (eval)))) (lambda (x2245 . rest2244) (if (and
(pair? x2245) (equal? (car x2245) noexpand1049)) (cadr x2245) (chi-top1118
x2245 (quote ()) (quote ((top))) (if (null? rest2244) m2242 (car rest2244)) (if
(or (null? rest2244) (null? (cdr rest2244))) esew2243 (cadr rest2244)) (cons
(quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda
(x2246) (nonsymbol-id?1082 x2246))) (set! datum->syntax (lambda (id2247
datum2248) (make-syntax-object1066 datum2248 (syntax-object-wrap1069 id2247)
#f))) (set! syntax->datum (lambda (x2249) (strip1130 x2249 (quote (())))))
(set! generate-temporaries (lambda (ls2250) (begin (let ((x2251 ls2250)) (if
(not (list? x2251)) (error-hook1056 (quote generate-temporaries) "invalid
argument" x2251))) (map (lambda (x2252) (wrap1111 (gensym) (quote ((top))) #f))
ls2250)))) (set! free-identifier=? (lambda (x2253 y2254) (begin (let ((x2255
x2253)) (if (not (nonsymbol-id?1082 x2255)) (error-hook1056 (quote
free-identifier=?) "invalid argument" x2255))) (let ((x2256 y2254)) (if (not
(nonsymbol-id?1082 x2256)) (error-hook1056 (quote free-identifier=?) "invalid
argument" x2256))) (free-id=?1106 x2253 y2254)))) (set! bound-identifier=?
(lambda (x2257 y2258) (begin (let ((x2259 x2257)) (if (not (nonsymbol-id?1082
x2259)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2259)))
(let ((x2260 y2258)) (if (not (nonsymbol-id?1082 x2260)) (error-hook1056 (quote
bound-identifier=?) "invalid argument" x2260))) (bound-id=?1107 x2257 y2258))))
(set! syntax-violation (lambda (who2264 message2263 form2262 . subform2261)
(begin (let ((x2265 who2264)) (if (not ((lambda (x2266) (or (not x2266)
(string? x2266) (symbol? x2266))) x2265)) (error-hook1056 (quote
syntax-violation) "invalid argument" x2265))) (let ((x2267 message2263)) (if
(not (string? x2267)) (error-hook1056 (quote syntax-violation) "invalid
argument" x2267))) (scm-error (quote syntax-error) (quote sc-expand)
(string-append (if who2264 "~a: " "") "~a " (if (null? subform2261) "in ~a" "in
subform `~s' of `~s'")) (let ((tail2268 (cons message2263 (map (lambda (x2269)
(strip1130 x2269 (quote (())))) (append subform2261 (list form2262)))))) (if
who2264 (cons who2264 tail2268) tail2268)) #f)))) (set!
install-global-transformer (lambda (sym2270 v2271) (begin (let ((x2272
sym2270)) (if (not (symbol? x2272)) (error-hook1056 (quote define-syntax)
"invalid argument" x2272))) (let ((x2273 v2271)) (if (not (procedure? x2273))
(error-hook1056 (quote define-syntax) "invalid argument" x2273)))
(global-extend1081 (quote macro) sym2270 v2271)))) (letrec ((match2278 (lambda
(e2279 p2280 w2281 r2282 mod2283) (cond ((not r2282) #f) ((eq? p2280 (quote
any)) (cons (wrap1111 e2279 w2281 mod2283) r2282)) ((syntax-object?1067 e2279)
(match*2277 (let ((e2284 (syntax-object-expression1068 e2279))) (if
(annotation? e2284) (annotation-expression e2284) e2284)) p2280 (join-wraps1102
w2281 (syntax-object-wrap1069 e2279)) r2282 (syntax-object-module1070 e2279)))
(else (match*2277 (let ((e2285 e2279)) (if (annotation? e2285)
(annotation-expression e2285) e2285)) p2280 w2281 r2282 mod2283)))))
(match*2277 (lambda (e2286 p2287 w2288 r2289 mod2290) (cond ((null? p2287) (and
(null? e2286) r2289)) ((pair? p2287) (and (pair? e2286) (match2278 (car e2286)
(car p2287) w2288 (match2278 (cdr e2286) (cdr p2287) w2288 r2289 mod2290)
mod2290))) ((eq? p2287 (quote each-any)) (let ((l2291 (match-each-any2275 e2286
w2288 mod2290))) (and l2291 (cons l2291 r2289)))) (else (let ((t2292
(vector-ref p2287 0))) (if (memv t2292 (quote (each))) (if (null? e2286)
(match-empty2276 (vector-ref p2287 1) r2289) (let ((l2293 (match-each2274 e2286
(vector-ref p2287 1) w2288 mod2290))) (and l2293 (let collect2294 ((l2295
l2293)) (if (null? (car l2295)) r2289 (cons (map car l2295) (collect2294 (map
cdr l2295)))))))) (if (memv t2292 (quote (free-id))) (and (id?1083 e2286)
(free-id=?1106 (wrap1111 e2286 w2288 mod2290) (vector-ref p2287 1)) r2289) (if
(memv t2292 (quote (atom))) (and (equal? (vector-ref p2287 1) (strip1130 e2286
w2288)) r2289) (if (memv t2292 (quote (vector))) (and (vector? e2286)
(match2278 (vector->list e2286) (vector-ref p2287 1) w2288 r2289
mod2290))))))))))) (match-empty2276 (lambda (p2296 r2297) (cond ((null? p2296)
r2297) ((eq? p2296 (quote any)) (cons (quote ()) r2297)) ((pair? p2296)
(match-empty2276 (car p2296) (match-empty2276 (cdr p2296) r2297))) ((eq? p2296
(quote each-any)) (cons (quote ()) r2297)) (else (let ((t2298 (vector-ref p2296
0))) (if (memv t2298 (quote (each))) (match-empty2276 (vector-ref p2296 1)
r2297) (if (memv t2298 (quote (free-id atom))) r2297 (if (memv t2298 (quote
(vector))) (match-empty2276 (vector-ref p2296 1) r2297)))))))))
(match-each-any2275 (lambda (e2299 w2300 mod2301) (cond ((annotation? e2299)
(match-each-any2275 (annotation-expression e2299) w2300 mod2301)) ((pair?
e2299) (let ((l2302 (match-each-any2275 (cdr e2299) w2300 mod2301))) (and l2302
(cons (wrap1111 (car e2299) w2300 mod2301) l2302)))) ((null? e2299) (quote ()))
((syntax-object?1067 e2299) (match-each-any2275 (syntax-object-expression1068
e2299) (join-wraps1102 w2300 (syntax-object-wrap1069 e2299)) mod2301)) (else
#f)))) (match-each2274 (lambda (e2303 p2304 w2305 mod2306) (cond ((annotation?
e2303) (match-each2274 (annotation-expression e2303) p2304 w2305 mod2306))
((pair? e2303) (let ((first2307 (match2278 (car e2303) p2304 w2305 (quote ())
mod2306))) (and first2307 (let ((rest2308 (match-each2274 (cdr e2303) p2304
w2305 mod2306))) (and rest2308 (cons first2307 rest2308)))))) ((null? e2303)
(quote ())) ((syntax-object?1067 e2303) (match-each2274
(syntax-object-expression1068 e2303) p2304 (join-wraps1102 w2305
(syntax-object-wrap1069 e2303)) (syntax-object-module1070 e2303))) (else
#f))))) (set! syntax-dispatch (lambda (e2309 p2310) (cond ((eq? p2310 (quote
any)) (list e2309)) ((syntax-object?1067 e2309) (match*2277 (let ((e2311
(syntax-object-expression1068 e2309))) (if (annotation? e2311)
(annotation-expression e2311) e2311)) p2310 (syntax-object-wrap1069 e2309)
(quote ()) (syntax-object-module1070 e2309))) (else (match*2277 (let ((e2312
e2309)) (if (annotation? e2312) (annotation-expression e2312) e2312)) p2310
(quote (())) (quote ()) #f))))))))
+(install-global-transformer (quote with-syntax) (lambda (x2313) ((lambda
(tmp2314) ((lambda (tmp2315) (if tmp2315 (apply (lambda (_2316 e12317 e22318)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e12317 e22318))) tmp2315) ((lambda (tmp2320) (if
tmp2320 (apply (lambda (_2321 out2322 in2323 e12324 e22325) (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))) in2323 (quote ()) (list out2322 (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 e12324 e22325))))) tmp2320) ((lambda
(tmp2327) (if tmp2327 (apply (lambda (_2328 out2329 in2330 e12331 e22332) (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))) in2330) (quote ()) (list out2329 (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 e12331 e22332))))) tmp2327) (syntax-violation #f "source
expression failed to match any pattern" tmp2314))) (syntax-dispatch tmp2314
(quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2314
(quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2314 (quote
(any () any . each-any))))) x2313)))
+(install-global-transformer (quote syntax-rules) (lambda (x2336) ((lambda
(tmp2337) ((lambda (tmp2338) (if tmp2338 (apply (lambda (_2339 k2340
keyword2341 pattern2342 template2343) (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 k2340 (map (lambda (tmp2346
tmp2345) (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)))
tmp2345) (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)))
tmp2346))) template2343 pattern2342)))))) tmp2338) (syntax-violation #f "source
expression failed to match any pattern" tmp2337))) (syntax-dispatch tmp2337
(quote (any each-any . #(each ((any . any) any))))))) x2336)))
+(install-global-transformer (quote let*) (lambda (x2347) ((lambda (tmp2348)
((lambda (tmp2349) (if (if tmp2349 (apply (lambda (let*2350 x2351 v2352 e12353
e22354) (andmap identifier? x2351)) tmp2349) #f) (apply (lambda (let*2356 x2357
v2358 e12359 e22360) (let f2361 ((bindings2362 (map list x2357 v2358))) (if
(null? bindings2362) (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
e12359 e22360))) ((lambda (tmp2366) ((lambda (tmp2367) (if tmp2367 (apply
(lambda (body2368 binding2369) (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 binding2369)
body2368)) tmp2367) (syntax-violation #f "source expression failed to match any
pattern" tmp2366))) (syntax-dispatch tmp2366 (quote (any any))))) (list (f2361
(cdr bindings2362)) (car bindings2362)))))) tmp2349) (syntax-violation #f
"source expression failed to match any pattern" tmp2348))) (syntax-dispatch
tmp2348 (quote (any #(each (any any)) any . each-any))))) x2347)))
+(install-global-transformer (quote do) (lambda (orig-x2370) ((lambda (tmp2371)
((lambda (tmp2372) (if tmp2372 (apply (lambda (_2373 var2374 init2375 step2376
e02377 e12378 c2379) ((lambda (tmp2380) ((lambda (tmp2381) (if tmp2381 (apply
(lambda (step2382) ((lambda (tmp2383) ((lambda (tmp2384) (if tmp2384 (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 var2374 init2375) (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))) e02377) (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 c2379 (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))) step2382))))))) tmp2384) ((lambda (tmp2389)
(if tmp2389 (apply (lambda (e12390 e22391) (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 var2374 init2375) (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))) e02377 (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 e12390 e22391)) (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 c2379 (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))) step2382))))))) tmp2389)
(syntax-violation #f "source expression failed to match any pattern" tmp2383)))
(syntax-dispatch tmp2383 (quote (any . each-any)))))) (syntax-dispatch tmp2383
(quote ())))) e12378)) tmp2381) (syntax-violation #f "source expression failed
to match any pattern" tmp2380))) (syntax-dispatch tmp2380 (quote each-any))))
(map (lambda (v2398 s2399) ((lambda (tmp2400) ((lambda (tmp2401) (if tmp2401
(apply (lambda () v2398) tmp2401) ((lambda (tmp2402) (if tmp2402 (apply (lambda
(e2403) e2403) tmp2402) ((lambda (_2404) (syntax-violation (quote do) "bad step
expression" orig-x2370 s2399)) tmp2400))) (syntax-dispatch tmp2400 (quote
(any)))))) (syntax-dispatch tmp2400 (quote ())))) s2399)) var2374 step2376)))
tmp2372) (syntax-violation #f "source expression failed to match any pattern"
tmp2371))) (syntax-dispatch tmp2371 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x2370)))
+(install-global-transformer (quote quasiquote) (letrec ((quasicons2407 (lambda
(x2411 y2412) ((lambda (tmp2413) ((lambda (tmp2414) (if tmp2414 (apply (lambda
(x2415 y2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda
(dy2419) ((lambda (tmp2420) ((lambda (tmp2421) (if tmp2421 (apply (lambda
(dx2422) (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 dx2422 dy2419)))
tmp2421) ((lambda (_2423) (if (null? dy2419) (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))) x2415) (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))) x2415
y2416))) tmp2420))) (syntax-dispatch tmp2420 (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))))) x2415))
tmp2418) ((lambda (tmp2424) (if tmp2424 (apply (lambda (stuff2425) (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
x2415 stuff2425))) tmp2424) ((lambda (else2426) (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))) x2415 y2416))
tmp2417))) (syntax-dispatch tmp2417 (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)))))) (syntax-dispatch tmp2417 (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))))) y2416)) tmp2414)
(syntax-violation #f "source expression failed to match any pattern" tmp2413)))
(syntax-dispatch tmp2413 (quote (any any))))) (list x2411 y2412))))
(quasiappend2408 (lambda (x2427 y2428) ((lambda (tmp2429) ((lambda (tmp2430)
(if tmp2430 (apply (lambda (x2431 y2432) ((lambda (tmp2433) ((lambda (tmp2434)
(if tmp2434 (apply (lambda () x2431) tmp2434) ((lambda (_2435) (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))) x2431
y2432)) tmp2433))) (syntax-dispatch tmp2433 (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))) ()))))) y2432)) tmp2430) (syntax-violation #f
"source expression failed to match any pattern" tmp2429))) (syntax-dispatch
tmp2429 (quote (any any))))) (list x2427 y2428)))) (quasivector2409 (lambda
(x2436) ((lambda (tmp2437) ((lambda (x2438) ((lambda (tmp2439) ((lambda
(tmp2440) (if tmp2440 (apply (lambda (x2441) (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 x2441))) tmp2440) ((lambda
(tmp2443) (if tmp2443 (apply (lambda (x2444) (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))) x2444)) tmp2443) ((lambda (_2446) (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)))
x2438)) tmp2439))) (syntax-dispatch tmp2439 (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)))))) (syntax-dispatch tmp2439 (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))))) x2438)) tmp2437)) x2436))) (quasi2410 (lambda
(p2447 lev2448) ((lambda (tmp2449) ((lambda (tmp2450) (if tmp2450 (apply
(lambda (p2451) (if (= lev2448 0) p2451 (quasicons2407 (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)))) (quasi2410 (list p2451) (- lev2448 1))))) tmp2450) ((lambda
(tmp2452) (if tmp2452 (apply (lambda (p2453 q2454) (if (= lev2448 0)
(quasiappend2408 p2453 (quasi2410 q2454 lev2448)) (quasicons2407 (quasicons2407
(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))))
(quasi2410 (list p2453) (- lev2448 1))) (quasi2410 q2454 lev2448)))) tmp2452)
((lambda (tmp2455) (if tmp2455 (apply (lambda (p2456) (quasicons2407 (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)))) (quasi2410 (list p2456) (+ lev2448
1)))) tmp2455) ((lambda (tmp2457) (if tmp2457 (apply (lambda (p2458 q2459)
(quasicons2407 (quasi2410 p2458 lev2448) (quasi2410 q2459 lev2448))) tmp2457)
((lambda (tmp2460) (if tmp2460 (apply (lambda (x2461) (quasivector2409
(quasi2410 x2461 lev2448))) tmp2460) ((lambda (p2463) (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))) p2463)) tmp2449))) (syntax-dispatch tmp2449 (quote #(vector
each-any)))))) (syntax-dispatch tmp2449 (quote (any . any))))))
(syntax-dispatch tmp2449 (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)))))) (syntax-dispatch tmp2449 (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)))))) (syntax-dispatch tmp2449 (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))))) p2447))))
(lambda (x2464) ((lambda (tmp2465) ((lambda (tmp2466) (if tmp2466 (apply
(lambda (_2467 e2468) (quasi2410 e2468 0)) tmp2466) (syntax-violation #f
"source expression failed to match any pattern" tmp2465))) (syntax-dispatch
tmp2465 (quote (any any))))) x2464))))
+(install-global-transformer (quote include) (lambda (x2469) (letrec
((read-file2470 (lambda (fn2471 k2472) (let ((p2473 (open-input-file fn2471)))
(let f2474 ((x2475 (read p2473))) (if (eof-object? x2475) (begin
(close-input-port p2473) (quote ())) (cons (datum->syntax k2472 x2475) (f2474
(read p2473))))))))) ((lambda (tmp2476) ((lambda (tmp2477) (if tmp2477 (apply
(lambda (k2478 filename2479) (let ((fn2480 (syntax->datum filename2479)))
((lambda (tmp2481) ((lambda (tmp2482) (if tmp2482 (apply (lambda (exp2483)
(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))) exp2483))
tmp2482) (syntax-violation #f "source expression failed to match any pattern"
tmp2481))) (syntax-dispatch tmp2481 (quote each-any)))) (read-file2470 fn2480
k2478)))) tmp2477) (syntax-violation #f "source expression failed to match any
pattern" tmp2476))) (syntax-dispatch tmp2476 (quote (any any))))) x2469))))
+(install-global-transformer (quote unquote) (lambda (x2485) ((lambda (tmp2486)
((lambda (tmp2487) (if tmp2487 (apply (lambda (_2488 e2489) (error (quote
unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum
e2489))) tmp2487) (syntax-violation #f "source expression failed to match any
pattern" tmp2486))) (syntax-dispatch tmp2486 (quote (any any))))) x2485)))
+(install-global-transformer (quote unquote-splicing) (lambda (x2490) ((lambda
(tmp2491) ((lambda (tmp2492) (if tmp2492 (apply (lambda (_2493 e2494) (error
(quote unquote-splicing) "expression ,@~s not valid outside of quasiquote"
(syntax->datum e2494))) tmp2492) (syntax-violation #f "source expression failed
to match any pattern" tmp2491))) (syntax-dispatch tmp2491 (quote (any any)))))
x2490)))
+(install-global-transformer (quote case) (lambda (x2495) ((lambda (tmp2496)
((lambda (tmp2497) (if tmp2497 (apply (lambda (_2498 e2499 m12500 m22501)
((lambda (tmp2502) ((lambda (body2503) (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))) e2499)) body2503)) tmp2502)) (let f2504 ((clause2505 m12500)
(clauses2506 m22501)) (if (null? clauses2506) ((lambda (tmp2508) ((lambda
(tmp2509) (if tmp2509 (apply (lambda (e12510 e22511) (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
e12510 e22511))) tmp2509) ((lambda (tmp2513) (if tmp2513 (apply (lambda (k2514
e12515 e22516) (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))) k2514)) (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 e12515 e22516)))) tmp2513) ((lambda
(_2519) (syntax-violation (quote case) "bad clause" x2495 clause2505))
tmp2508))) (syntax-dispatch tmp2508 (quote (each-any any . each-any))))))
(syntax-dispatch tmp2508 (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))))) clause2505) ((lambda (tmp2520) ((lambda (rest2521) ((lambda
(tmp2522) ((lambda (tmp2523) (if tmp2523 (apply (lambda (k2524 e12525 e22526)
(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))) k2524)) (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 e12525 e22526)) rest2521)) tmp2523)
((lambda (_2529) (syntax-violation (quote case) "bad clause" x2495 clause2505))
tmp2522))) (syntax-dispatch tmp2522 (quote (each-any any . each-any)))))
clause2505)) tmp2520)) (f2504 (car clauses2506) (cdr clauses2506)))))))
tmp2497) (syntax-violation #f "source expression failed to match any pattern"
tmp2496))) (syntax-dispatch tmp2496 (quote (any any any . each-any))))) x2495)))
+(install-global-transformer (quote identifier-syntax) (lambda (x2530) ((lambda
(tmp2531) ((lambda (tmp2532) (if tmp2532 (apply (lambda (_2533 e2534) (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)))
e2534)) (list (cons _2533 (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 e2534 (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)))))))))) tmp2532) (syntax-violation #f "source expression failed to
match any pattern" tmp2531))) (syntax-dispatch tmp2531 (quote (any any)))))
x2530)))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 8dfab12..347a776 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -49,7 +49,7 @@
;;; also documented in the R4RS and draft R5RS.
;;;
;;; bound-identifier=?
-;;; datum->syntax-object
+;;; datum->syntax
;;; define-syntax
;;; fluid-let-syntax
;;; free-identifier=?
@@ -60,7 +60,7 @@
;;; letrec-syntax
;;; syntax
;;; syntax-case
-;;; syntax-object->datum
+;;; syntax->datum
;;; syntax-rules
;;; with-syntax
;;;
@@ -79,7 +79,7 @@
;;; conditionally evaluates expr ... at compile-time or run-time
;;; depending upon situations (see the Chez Scheme System Manual,
;;; Revision 3, for a complete description)
-;;; (syntax-error object message)
+;;; (syntax-violation who message form [subform])
;;; used to report errors found during expansion
;;; (install-global-transformer symbol value)
;;; used by expanded code to install top-level syntactic abstractions
@@ -209,7 +209,7 @@
;;; Objects with no standard print syntax, including objects containing
;;; cycles and syntax object, are allowed in quoted data as long as they
-;;; are contained within a syntax form or produced by datum->syntax-object.
+;;; are contained within a syntax form or produced by datum->syntax.
;;; Such objects are never copied.
;;; All identifiers that don't have macro definitions and are not bound
@@ -264,14 +264,14 @@
(lambda (x)
(define construct-name
(lambda (template-identifier . args)
- (datum->syntax-object
+ (datum->syntax
template-identifier
(string->symbol
(apply string-append
(map (lambda (x)
(if (string? x)
x
- (symbol->string (syntax-object->datum x))))
+ (symbol->string (syntax->datum x))))
args))))))
(syntax-case x ()
((_ (name id1 ...))
@@ -339,34 +339,19 @@
(define put-global-definition-hook
(lambda (symbol type val)
- (let* ((module (current-module))
- (v (or (module-variable module symbol)
- (let ((v (make-variable val)))
- (module-add! module symbol v)
- v))))
- (if (not (variable-bound? v))
- (variable-set! v val))
- ;; Properties are tied to variable objects
- (set-object-property! v '*sc-expander*
- (make-binding type val)))))
+ (module-define-keyword! (current-module) symbol type val)))
(define remove-global-definition-hook
(lambda (symbol)
- (let* ((module (current-module))
- (v (module-local-variable module symbol)))
- (if v
- (let ((p (assq '*sc-expander* (object-properties v))))
- (set-object-properties! v (delq p (object-properties v))))))))
+ (module-undefine-keyword! (current-module) symbol)))
(define get-global-definition-hook
(lambda (symbol module)
- (let* ((module (if module
- (resolve-module (cdr module))
- (let ((mod (current-module)))
- (if mod (warn "wha" symbol))
- mod)))
- (v (module-variable module symbol)))
- (and v (object-property v '*sc-expander*)))))
+ (if (and (not module) (current-module))
+ (warn "module system is booted, we should have a module" symbol))
+ (module-lookup-keyword (if module (resolve-module (cdr module))
+ (current-module))
+ symbol)))
)
@@ -927,8 +912,9 @@
((free-id=? x (syntax compile)) 'compile)
((free-id=? x (syntax load)) 'load)
((free-id=? x (syntax eval)) 'eval)
- (else (syntax-error (wrap x w #f)
- "invalid eval-when situation"))))
+ (else (syntax-violation 'eval-when
+ "invalid situation"
+ e (wrap x w #f)))))
situations))))))
;;; syntax-type returns six values: type, value, e, w, s, and mod. The
@@ -1117,15 +1103,16 @@
(build-global-definition s n (chi e r w mod) mod)
mod))
((displaced-lexical)
- (syntax-error (wrap value w mod) "identifier out of context"))
+ (syntax-violation #f "identifier out of context"
+ e (wrap value w mod)))
((core macro module-ref)
(remove-global-definition-hook n)
(eval-if-c&e m
(build-global-definition s n (chi e r w mod) mod)
mod))
(else
- (syntax-error (wrap value w mod)
- "cannot define keyword at top level")))))
+ (syntax-violation #f "cannot define keyword at top level"
+ e (wrap value w mod))))))
(else (eval-if-c&e m (chi-expr type value e r w s mod) mod)))))))
(define chi
@@ -1174,14 +1161,16 @@
(chi-sequence (syntax (e1 e2 ...)) r w s mod)
(chi-void))))))
((define-form define-syntax-form)
- (syntax-error (wrap value w mod) "invalid context for definition of"))
+ (syntax-violation #f "definition in expression context"
+ e (wrap value w mod)))
((syntax)
- (syntax-error (source-wrap e w s mod)
- "reference to pattern variable outside syntax form"))
+ (syntax-violation #f "reference to pattern variable outside syntax form"
+ (source-wrap e w s mod)))
((displaced-lexical)
- (syntax-error (source-wrap e w s mod)
+ (syntax-violation #f (source-wrap e w s mod)
"reference to identifier outside its scope"))
- (else (syntax-error (source-wrap e w s mod))))))
+ (else (syntax-violation #f "unexpected syntax"
+ (source-wrap e w s mod))))))
(define chi-application
(lambda (x e r w s mod)
@@ -1228,7 +1217,8 @@
(vector-set! v i
(rebuild-macro-output (vector-ref x i) m)))))
((symbol? x)
- (syntax-error x "encountered raw symbol in macro output"))
+ (syntax-violation #f "encountered raw symbol in macro output"
+ (source-wrap e w s mod) x))
(else x))))
(rebuild-macro-output (p (wrap e (anti-mark w) mod)) (new-mark))))
@@ -1278,7 +1268,7 @@
(let parse ((body (map (lambda (x) (cons r (wrap x w mod))) body))
(ids '()) (labels '()) (vars '()) (vals '()) (bindings '()))
(if (null? body)
- (syntax-error outer-form "no expressions in body")
+ (syntax-violation #f "no expressions in body" outer-form)
(let ((e (cdar body)) (er (caar body)))
(call-with-values
(lambda () (syntax-type e er empty-wrap no-source ribcage mod))
@@ -1327,8 +1317,9 @@
(cdr body))))
(begin
(if (not (valid-bound-ids? ids))
- (syntax-error outer-form
- "invalid or duplicate identifier in
definition"))
+ (syntax-violation
+ #f "invalid or duplicate identifier in
definition"
+ outer-form))
(let loop ((bs bindings) (er-cache #f) (r-cache #f))
(if (not (null? bs))
(let* ((b (car bs)))
@@ -1360,12 +1351,12 @@
(lambda (e docstring c r w mod k)
(syntax-case c ()
((args doc e1 e2 ...)
- (and (string? (syntax-object->datum (syntax doc))) (not docstring))
+ (and (string? (syntax->datum (syntax doc))) (not docstring))
(chi-lambda-clause e (syntax doc) (syntax (args e1 e2 ...)) r w mod k))
(((id ...) e1 e2 ...)
(let ((ids (syntax (id ...))))
(if (not (valid-bound-ids? ids))
- (syntax-error e "invalid parameter list in")
+ (syntax-violation 'lambda "invalid parameter list" e)
(let ((labels (gen-labels ids))
(new-vars (map gen-var ids)))
(k new-vars
@@ -1378,7 +1369,7 @@
((ids e1 e2 ...)
(let ((old-ids (lambda-var-list (syntax ids))))
(if (not (valid-bound-ids? old-ids))
- (syntax-error e "invalid parameter list in")
+ (syntax-violation 'lambda "invalid parameter list" e)
(let ((labels (gen-labels old-ids))
(new-vars (map gen-var old-ids)))
(k (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
@@ -1391,7 +1382,7 @@
(extend-var-env labels new-vars r)
(make-binding-wrap old-ids labels w)
mod))))))
- (_ (syntax-error e)))))
+ (_ (syntax-violation 'lambda "bad lambda" e)))))
(define chi-local-syntax
(lambda (rec? e r w s mod k)
@@ -1399,7 +1390,7 @@
((_ ((id val) ...) e1 e2 ...)
(let ((ids (syntax (id ...))))
(if (not (valid-bound-ids? ids))
- (syntax-error e "duplicate bound keyword in")
+ (syntax-violation #f "duplicate bound keyword" e)
(let ((labels (gen-labels ids)))
(let ((new-w (make-binding-wrap ids labels w)))
(k (syntax (e1 e2 ...))
@@ -1417,14 +1408,15 @@
new-w
s
mod))))))
- (_ (syntax-error (source-wrap e w s mod))))))
+ (_ (syntax-violation #f "bad local syntax definition"
+ (source-wrap e w s mod))))))
(define eval-local-transformer
(lambda (expanded mod)
(let ((p (local-eval-hook expanded mod)))
(if (procedure? p)
p
- (syntax-error p "nonprocedure transformer")))))
+ (syntax-violation #f "nonprocedure transformer" p)))))
(define chi-void
(lambda ()
@@ -1529,8 +1521,10 @@
(lambda (id n)
(case (binding-type (lookup n r mod))
((displaced-lexical)
- (syntax-error (source-wrap id w s mod)
- "identifier out of context"))))
+ (syntax-violation 'fluid-let-syntax
+ "identifier out of context"
+ e
+ (source-wrap id w s mod)))))
(syntax (var ...))
names)
(chi-body
@@ -1547,13 +1541,15 @@
r)
w
mod)))
- (_ (syntax-error (source-wrap e w s mod))))))
+ (_ (syntax-violation 'fluid-let-syntax "bad syntax"
+ (source-wrap e w s mod))))))
(global-extend 'core 'quote
(lambda (e r w s mod)
(syntax-case e ()
((_ e) (build-data s (strip (syntax e) w)))
- (_ (syntax-error (source-wrap e w s mod))))))
+ (_ (syntax-violation 'quote "bad syntax"
+ (source-wrap e w s mod))))))
(global-extend 'core 'syntax
(let ()
@@ -1569,7 +1565,7 @@
(gen-ref src (car var.lev) (cdr var.lev) maps)))
(lambda (var maps) (values `(ref ,var) maps)))
(if (ellipsis? e)
- (syntax-error src "misplaced ellipsis in syntax form")
+ (syntax-violation 'syntax "misplaced ellipsis" src)
(values `(quote ,e) maps)))))
(syntax-case e ()
((dots e)
@@ -1587,8 +1583,8 @@
(cons '() maps) ellipsis? mod))
(lambda (x maps)
(if (null? (car maps))
- (syntax-error src
- "extra ellipsis in syntax form")
+ (syntax-violation 'syntax "extra ellipsis"
+ src)
(values (gen-map x (car maps))
(cdr maps))))))))
(syntax-case y ()
@@ -1600,8 +1596,7 @@
(lambda () (k (cons '() maps)))
(lambda (x maps)
(if (null? (car maps))
- (syntax-error src
- "extra ellipsis in syntax form")
+ (syntax-violation 'syntax "extra ellipsis"
src)
(values (gen-mappend x (car maps))
(cdr maps))))))))
(_ (call-with-values
@@ -1630,7 +1625,7 @@
(if (fx= level 0)
(values var maps)
(if (null? maps)
- (syntax-error src "missing ellipsis in syntax form")
+ (syntax-violation 'syntax "missing ellipsis" src)
(call-with-values
(lambda () (gen-ref src var (fx- level 1) (cdr maps)))
(lambda (outer-var outer-maps)
@@ -1718,7 +1713,7 @@
(call-with-values
(lambda () (gen-syntax e (syntax x) r '() ellipsis? mod))
(lambda (e maps) (regen e))))
- (_ (syntax-error e)))))))
+ (_ (syntax-violation 'syntax "bad `syntax' form" e)))))))
(global-extend 'core 'lambda
@@ -1733,7 +1728,7 @@
(let ()
(define (chi-let e r w s mod constructor ids vals exps)
(if (not (valid-bound-ids? ids))
- (syntax-error e "duplicate bound variable in")
+ (syntax-violation 'let "duplicate bound variable" e)
(let ((labels (gen-labels ids))
(new-vars (map gen-var ids)))
(let ((nw (make-binding-wrap ids labels w))
@@ -1758,7 +1753,7 @@
(syntax (f id ...))
(syntax (val ...))
(syntax (e1 e2 ...))))
- (_ (syntax-error (source-wrap e w s mod)))))))
+ (_ (syntax-violation 'let "bad let" (source-wrap e w s mod)))))))
(global-extend 'core 'letrec
@@ -1767,7 +1762,7 @@
((_ ((id val) ...) e1 e2 ...)
(let ((ids (syntax (id ...))))
(if (not (valid-bound-ids? ids))
- (syntax-error e "duplicate bound variable in")
+ (syntax-violation 'letrec "duplicate bound variable" e)
(let ((labels (gen-labels ids))
(new-vars (map gen-var ids)))
(let ((w (make-binding-wrap ids labels w))
@@ -1777,7 +1772,7 @@
(map (lambda (x) (chi x r w mod)) (syntax (val ...)))
(chi-body (syntax (e1 e2 ...))
(source-wrap e w s mod) r w mod)))))))
- (_ (syntax-error (source-wrap e w s mod))))))
+ (_ (syntax-violation 'letrec "bad letrec" (source-wrap e w s mod))))))
(global-extend 'core 'set!
@@ -1793,9 +1788,10 @@
(build-lexical-assignment s (binding-value b) val))
((global) (build-global-assignment s n val mod))
((displaced-lexical)
- (syntax-error (wrap (syntax id) w mod)
- "identifier out of context"))
- (else (syntax-error (source-wrap e w s mod)))))))
+ (syntax-violation 'set! "identifier out of context"
+ (wrap (syntax id) w mod)))
+ (else (syntax-violation 'set! "bad set!"
+ (source-wrap e w s mod)))))))
((_ (head tail ...) val)
(call-with-values
(lambda () (syntax-type (syntax head) r empty-wrap no-source #f
mod))
@@ -1811,15 +1807,15 @@
(chi (syntax (setter head)) r w mod)
(map (lambda (e) (chi e r w mod))
(syntax (tail ... val)))))))))
- (_ (syntax-error (source-wrap e w s mod))))))
+ (_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))
(global-extend 'module-ref '@
(lambda (e)
(syntax-case e ()
((_ (mod ...) id)
(and (andmap id? (syntax (mod ...))) (id? (syntax id)))
- (values (syntax-object->datum (syntax id))
- (syntax-object->datum
+ (values (syntax->datum (syntax id))
+ (syntax->datum
(syntax (public mod ...))))))))
(global-extend 'module-ref '@@
@@ -1827,8 +1823,8 @@
(syntax-case e ()
((_ (mod ...) id)
(and (andmap id? (syntax (mod ...))) (id? (syntax id)))
- (values (syntax-object->datum (syntax id))
- (syntax-object->datum
+ (values (syntax->datum (syntax id))
+ (syntax->datum
(syntax (private mod ...))))))))
(global-extend 'begin 'begin '())
@@ -1899,11 +1895,9 @@
(lambda (p pvars)
(cond
((not (distinct-bound-ids? (map car pvars)))
- (syntax-error pat
- "duplicate pattern variable in syntax-case pattern"))
+ (syntax-violation 'syntax-case "duplicate pattern variable"
pat))
((not (andmap (lambda (x) (not (ellipsis? (car x)))) pvars))
- (syntax-error pat
- "misplaced ellipsis in syntax-case pattern"))
+ (syntax-violation 'syntax-case "misplaced ellipsis" pat))
(else
(let ((y (gen-var 'tmp)))
; fat finger binding and references to temp variable y
@@ -1931,8 +1925,8 @@
(lambda (x keys clauses r mod)
(if (null? clauses)
(build-application no-source
- (build-primref no-source 'syntax-error)
- (list x))
+ (build-primref no-source 'syntax-violation)
+ (list #f "source expression failed to match any pattern" x))
(syntax-case (car clauses) ()
((pat exp)
(if (and (id? (syntax pat))
@@ -1955,7 +1949,8 @@
((pat fender exp)
(gen-clause x keys (cdr clauses) r
(syntax pat) (syntax fender) (syntax exp) mod))
- (_ (syntax-error (car clauses) "invalid syntax-case clause"))))))
+ (_ (syntax-violation 'syntax-case "invalid clause"
+ (car clauses)))))))
(lambda (e r w s mod)
(let ((e (source-wrap e w s mod)))
@@ -1972,7 +1967,7 @@
r
mod))
(list (chi (syntax val) r empty-wrap mod))))
- (syntax-error e "invalid literals list in"))))))))
+ (syntax-violation 'syntax-case "invalid literals list" e))))))))
;;; The portable sc-expand seeds chi-top's mode m with 'e (for
;;; evaluating) and esew (which stands for "eval syntax expanders
@@ -2009,11 +2004,11 @@
(lambda (x)
(nonsymbol-id? x)))
-(set! datum->syntax-object
+(set! datum->syntax
(lambda (id datum)
(make-syntax-object datum (syntax-object-wrap id) #f)))
-(set! syntax-object->datum
+(set! syntax->datum
; accepts any object, since syntax objects may consist partially
; or entirely of unwrapped, nonsymbolic data
(lambda (x)
@@ -2036,13 +2031,21 @@
(arg-check nonsymbol-id? y 'bound-identifier=?)
(bound-id=? x y)))
-(set! syntax-error
- (lambda (object . messages)
- (for-each (lambda (x) (arg-check string? x 'syntax-error)) messages)
- (let ((message (if (null? messages)
- "invalid syntax"
- (apply string-append messages))))
- (error-hook #f message (strip object empty-wrap)))))
+(set! syntax-violation
+ (lambda (who message form . subform)
+ (arg-check (lambda (x) (or (not x) (string? x) (symbol? x)))
+ who 'syntax-violation)
+ (arg-check string? message 'syntax-violation)
+ (scm-error 'syntax-error 'sc-expand
+ (string-append
+ (if who "~a: " "")
+ "~a "
+ (if (null? subform) "in ~a" "in subform `~s' of `~s'"))
+ (let ((tail (cons message
+ (map (lambda (x) (strip x empty-wrap))
+ (append subform (list form))))))
+ (if who (cons who tail) tail))
+ #f)))
(set! install-global-transformer
(lambda (sym v)
@@ -2170,7 +2173,6 @@
p (syntax-object-wrap e) '() (syntax-object-module e)))
(else (match* (unannotate e) p empty-wrap '() #f)))))
-(set! sc-chi chi)
))
)
@@ -2215,7 +2217,9 @@
(syntax-case s ()
(() v)
((e) (syntax e))
- (_ (syntax-error orig-x))))
+ (_ (syntax-violation
+ 'do "bad step expression"
+ orig-x s))))
(syntax (var ...))
(syntax (step ...)))))
(syntax-case (syntax (e1 ...)) ()
@@ -2288,11 +2292,11 @@
(let f ((x (read p)))
(if (eof-object? x)
(begin (close-input-port p) '())
- (cons (datum->syntax-object k x)
+ (cons (datum->syntax k x)
(f (read p))))))))
(syntax-case x ()
((k filename)
- (let ((fn (syntax-object->datum (syntax filename))))
+ (let ((fn (syntax->datum (syntax filename))))
(with-syntax (((exp ...) (read-file fn (syntax k))))
(syntax (begin exp ...))))))))
@@ -2302,7 +2306,7 @@
((_ e)
(error 'unquote
"expression ,~s not valid outside of quasiquote"
- (syntax-object->datum (syntax e)))))))
+ (syntax->datum (syntax e)))))))
(define-syntax unquote-splicing
(lambda (x)
@@ -2310,7 +2314,7 @@
((_ e)
(error 'unquote-splicing
"expression ,@~s not valid outside of quasiquote"
- (syntax-object->datum (syntax e)))))))
+ (syntax->datum (syntax e)))))))
(define-syntax case
(lambda (x)
@@ -2323,14 +2327,15 @@
((else e1 e2 ...) (syntax (begin e1 e2 ...)))
(((k ...) e1 e2 ...)
(syntax (if (memv t '(k ...)) (begin e1 e2 ...))))
- (_ (syntax-error x)))
+ (_ (syntax-violation 'case "bad clause" x clause)))
(with-syntax ((rest (f (car clauses) (cdr clauses))))
(syntax-case clause (else)
(((k ...) e1 e2 ...)
(syntax (if (memv t '(k ...))
(begin e1 e2 ...)
rest)))
- (_ (syntax-error x))))))))
+ (_ (syntax-violation 'case "bad clause" x
+ clause))))))))
(syntax (let ((t e)) body)))))))
(define-syntax identifier-syntax
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 873e4b8..f84af33 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -241,8 +241,8 @@
(lambda (x)
(syntax-case x ()
((_ (k arg rest ...) out ...)
- (keyword? (syntax-object->datum (syntax k)))
- (case (syntax-object->datum (syntax k))
+ (keyword? (syntax->datum (syntax k)))
+ (case (syntax->datum (syntax k))
((#:getter #:setter)
(syntax
(define-class-pre-definition (rest ...)
@@ -277,7 +277,7 @@
((_ () out ...)
(syntax (begin out ...)))
((_ (slot rest ...) out ...)
- (keyword? (syntax-object->datum (syntax slot)))
+ (keyword? (syntax->datum (syntax slot)))
(syntax (begin out ...)))
((_ (slot rest ...) out ...)
(identifier? (syntax slot))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. bac0272216e89fa93bc935952befe0e7973625f7,
Andy Wingo <=