[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. 3d5f3091e1
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 3d5f3091e100550052abc698e980b3e86cc01b65 |
|
Date: |
Wed, 29 Apr 2009 19:24:07 +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=3d5f3091e100550052abc698e980b3e86cc01b65
The branch, syncase-in-boot-9 has been updated
via 3d5f3091e100550052abc698e980b3e86cc01b65 (commit)
via 5a0132b3375b35c69c6afb735acbaa8619237fb5 (commit)
from 5f1a2fb10f5eb97e302c50f5b62d6df28f73d97a (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 3d5f3091e100550052abc698e980b3e86cc01b65
Author: Andy Wingo <address@hidden>
Date: Wed Apr 29 21:19:23 2009 +0200
first-class macro representation (no bits on variables)
* libguile/macros.c (scm_macro_p): Update docs.
* module/ice-9/boot-9.scm (module-define!, module-ref): Define pre-boot
forms of these functions as well. I suspect module-add! can go soon.
(module-lookup-keyword, module-define-keyword!)
(module-undefine-keyword!) Remove these.
* module/ice-9/psyntax-pp.scm: Regenerate. Notice the difference?
* module/ice-9/psyntax.scm (put-global-definition-hook)
(get-global-definition-hook): Rework to expect first-class macros. Heh
heh.
(remove-global-definition-hook): Pleasantly, this hook can go away.
(chi-install-global): Terrorism to generate the right kind of output --
will clean up.
(chi-top): Unify definition handling for all kinds of values.
commit 5a0132b3375b35c69c6afb735acbaa8619237fb5
Author: Andy Wingo <address@hidden>
Date: Wed Apr 29 00:38:12 2009 +0200
a different tack for syncase macro representation
* libguile/macros.c (macro_print): Show syntax-case bindings, if present.
(macro_mark): Mark the extra two words if they're there.
(scm_make_syncase_macro, scm_make_extended_syncase_macro): OK! A new
take at the "how do we represent syncase macros in Guile" problem.
Whereas we need a disjoint type, but would like it to be compatible
with old predicates (e.g. `macro?'), and need to be able to extend
existing syntax definitions (e.g. `cond'), let's add a bit to macros to
indicate whether they have syncase macro bindings or not, and a fourth
macro type for native syncase macros.
(scm_macro_type): Return 'syntax-case for native syntax-case macros.
Note that other macro types may have syntax-case bindings.
(scm_macro_name): Return #f if the transformer is not a procedure.
(scm_syncase_macro_type, scm_syncase_macro_binding): New accessors for
the syncase macro bindings.
* libguile/macros.h: Add API for syncase macros.
* module/ice-9/boot-9.scm (module-define-keyword!): Adapt to use syncase
macros, though they are not yet used. Reorder other syncase API.
* module/ice-9/psyntax.scm (chi-expr): Fix syntax-violation invocation.
-----------------------------------------------------------------------
Summary of changes:
libguile/macros.c | 113 ++++++++++++++++++++++++++++++++++++++-----
libguile/macros.h | 13 +++++-
module/ice-9/boot-9.scm | 60 +++++++++--------------
module/ice-9/psyntax-pp.scm | 22 ++++----
module/ice-9/psyntax.scm | 60 ++++++++++++++++-------
5 files changed, 189 insertions(+), 79 deletions(-)
diff --git a/libguile/macros.c b/libguile/macros.c
index d132c01..ca3e83e 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -48,10 +48,13 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
|| scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE,
macro, port, pstate)))
{
+ scm_puts ("#<", port);
+
+ if (SCM_MACRO_TYPE (macro) < 4 && SCM_MACRO_IS_EXTENDED (macro))
+ scm_puts ("extended-", port);
+
if (!SCM_CLOSUREP (code) && !SCM_PROGRAM_P (code))
- scm_puts ("#<primitive-", port);
- else
- scm_puts ("#<", port);
+ scm_puts ("primitive-", port);
if (SCM_MACRO_TYPE (macro) == 0)
scm_puts ("syntax", port);
@@ -63,6 +66,8 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
scm_puts ("macro!", port);
if (SCM_MACRO_TYPE (macro) == 3)
scm_puts ("builtin-macro!", port);
+ if (SCM_MACRO_TYPE (macro) == 4)
+ scm_puts ("syncase-macro", port);
scm_putc (' ', port);
scm_iprin1 (scm_macro_name (macro), port, pstate);
@@ -77,6 +82,14 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
scm_iprin1 (src, port, pstate);
}
+ if (SCM_MACRO_IS_EXTENDED (macro))
+ {
+ scm_putc (' ', port);
+ scm_write (SCM_SMOB_OBJECT_2 (macro), port);
+ scm_putc (' ', port);
+ scm_write (SCM_SMOB_OBJECT_3 (macro), port);
+ }
+
scm_putc ('>', port);
}
@@ -84,6 +97,16 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
}
static SCM
+macro_mark (SCM macro)
+{
+ if (SCM_MACRO_IS_EXTENDED (macro))
+ { scm_gc_mark (SCM_SMOB_OBJECT_2 (macro));
+ scm_gc_mark (SCM_SMOB_OBJECT_3 (macro));
+ }
+ return SCM_SMOB_OBJECT (macro);
+}
+
+static SCM
makmac (SCM code, scm_t_bits flags)
{
SCM z;
@@ -164,11 +187,45 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0,
#endif
+SCM_DEFINE (scm_make_syncase_macro, "make-syncase-macro", 2, 0, 0,
+ (SCM type, SCM binding),
+ "Return a @dfn{macro} that requires expansion by syntax-case.\n"
+ "While users should not call this function, it is useful to know\n"
+ "that syntax-case macros are represented as Guile primitive
macros.")
+#define FUNC_NAME s_scm_make_syncase_macro
+{
+ SCM z;
+ SCM_VALIDATE_SYMBOL (1, type);
+
+ SCM_NEWSMOB3 (z, scm_tc16_macro, SCM_UNPACK (binding), SCM_UNPACK (type),
+ SCM_UNPACK (binding));
+ SCM_SET_SMOB_FLAGS (z, 4 | SCM_F_MACRO_EXTENDED);
+ return z;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_extended_syncase_macro, "make-extended-syncase-macro", 3,
0, 0,
+ (SCM m, SCM type, SCM binding),
+ "Extend a core macro @var{m} with a syntax-case binding.")
+#define FUNC_NAME s_scm_make_extended_syncase_macro
+{
+ SCM z;
+ SCM_VALIDATE_SMOB (1, m, macro);
+ SCM_VALIDATE_SYMBOL (2, type);
+
+ SCM_NEWSMOB3 (z, scm_tc16_macro, SCM_SMOB_DATA (m), SCM_UNPACK (type),
+ SCM_UNPACK (binding));
+ SCM_SET_SMOB_FLAGS (z, SCM_SMOB_FLAGS (m) | SCM_F_MACRO_EXTENDED);
+ return z;
+}
+#undef FUNC_NAME
+
+
SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0,
(SCM obj),
- "Return @code{#t} if @var{obj} is a regular macro, a memoizing
macro or a\n"
- "syntax transformer.")
+ "Return @code{#t} if @var{obj} is a regular macro, a memoizing
macro, a\n"
+ "syntax transformer, or a syntax-case macro.")
#define FUNC_NAME s_scm_macro_p
{
return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_macro, obj));
@@ -182,14 +239,15 @@ SCM_SYMBOL (scm_sym_macro, "macro");
#endif
SCM_SYMBOL (scm_sym_mmacro, "macro!");
SCM_SYMBOL (scm_sym_bimacro, "builtin-macro!");
+SCM_SYMBOL (scm_sym_syncase_macro, "syncase-macro");
SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0,
(SCM m),
- "Return one of the symbols @code{syntax}, @code{macro} or\n"
- "@code{macro!}, depending on whether @var{m} is a syntax\n"
- "transformer, a regular macro, or a memoizing macro,\n"
- "respectively. If @var{m} is not a macro, @code{#f} is\n"
- "returned.")
+ "Return one of the symbols @code{syntax}, @code{macro},\n"
+ "@code{macro!}, or @code{syntax-case}, depending on whether\n"
+ "@var{m} is a syntax transformer, a regular macro, a memoizing\n"
+ "macro, or a syntax-case macro, respectively. If @var{m} is\n"
+ "not a macro, @code{#f} is returned.")
#define FUNC_NAME s_scm_macro_type
{
if (!SCM_SMOB_PREDICATE (scm_tc16_macro, m))
@@ -202,6 +260,7 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0,
#endif
case 2: return scm_sym_mmacro;
case 3: return scm_sym_bimacro;
+ case 4: return scm_sym_syncase_macro;
default: scm_wrong_type_arg (FUNC_NAME, 1, m);
}
}
@@ -214,7 +273,9 @@ SCM_DEFINE (scm_macro_name, "macro-name", 1, 0, 0,
#define FUNC_NAME s_scm_macro_name
{
SCM_VALIDATE_SMOB (1, m, macro);
- return scm_procedure_name (SCM_PACK (SCM_SMOB_DATA (m)));
+ if (scm_is_true (scm_procedure_p (SCM_SMOB_OBJECT (m))))
+ return scm_procedure_name (SCM_SMOB_OBJECT (m));
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
@@ -236,6 +297,34 @@ SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1,
0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_syncase_macro_type, "syncase-macro-type", 1, 0, 0,
+ (SCM m),
+ "Return the type of the macro @var{m}.")
+#define FUNC_NAME s_scm_syncase_macro_type
+{
+ SCM_VALIDATE_SMOB (1, m, macro);
+
+ if (SCM_MACRO_IS_EXTENDED (m))
+ return SCM_SMOB_OBJECT_2 (m);
+ else
+ return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_syncase_macro_binding, "syncase-macro-binding", 1, 0, 0,
+ (SCM m),
+ "Return the binding of the macro @var{m}.")
+#define FUNC_NAME s_scm_syncase_macro_binding
+{
+ SCM_VALIDATE_SMOB (1, m, macro);
+
+ if (SCM_MACRO_IS_EXTENDED (m))
+ return SCM_SMOB_OBJECT_3 (m);
+ else
+ return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
SCM
scm_make_synt (const char *name, SCM (*macroizer) (), SCM (*fcn)() )
{
@@ -249,7 +338,7 @@ void
scm_init_macros ()
{
scm_tc16_macro = scm_make_smob_type ("macro", 0);
- scm_set_smob_mark (scm_tc16_macro, scm_markcdr);
+ scm_set_smob_mark (scm_tc16_macro, macro_mark);
scm_set_smob_print (scm_tc16_macro, macro_print);
#include "libguile/macros.x"
}
diff --git a/libguile/macros.h b/libguile/macros.h
index e1de77f..5e3d64a 100644
--- a/libguile/macros.h
+++ b/libguile/macros.h
@@ -29,9 +29,15 @@
#define SCM_ASSYNT(_cond, _msg, _subr) \
if (!(_cond)) scm_misc_error (_subr, _msg, SCM_EOL);
+#define SCM_MACRO_TYPE_BITS (3)
+#define SCM_MACRO_TYPE_MASK ((1<<SCM_MACRO_TYPE_BITS)-1)
+#define SCM_F_MACRO_EXTENDED (1<<SCM_MACRO_TYPE_BITS)
+
#define SCM_MACROP(x) SCM_SMOB_PREDICATE (scm_tc16_macro, (x))
-#define SCM_MACRO_TYPE(m) SCM_SMOB_FLAGS (m)
+#define SCM_MACRO_TYPE(m) (SCM_SMOB_FLAGS (m) & SCM_MACRO_TYPE_MASK)
+#define SCM_MACRO_IS_EXTENDED(m) (SCM_SMOB_FLAGS (m) & SCM_F_MACRO_EXTENDED)
#define SCM_BUILTIN_MACRO_P(x) (SCM_MACROP (x) && SCM_MACRO_TYPE (x) == 3)
+#define SCM_SYNCASE_MACRO_P(x) (SCM_MACROP (x) && SCM_MACRO_TYPE (x) == 4)
#define SCM_MACRO_CODE(m) SCM_SMOB_OBJECT (m)
SCM_API scm_t_bits scm_tc16_macro;
@@ -39,10 +45,15 @@ SCM_API scm_t_bits scm_tc16_macro;
SCM_INTERNAL SCM scm_i_makbimacro (SCM code);
SCM_API SCM scm_makmmacro (SCM code);
SCM_API SCM scm_makacro (SCM code);
+SCM_API SCM scm_make_syncase_macro (SCM type, SCM binding);
+SCM_API SCM scm_make_extended_syncase_macro (SCM builtin, SCM type,
+ SCM binding);
SCM_API SCM scm_macro_p (SCM obj);
SCM_API SCM scm_macro_type (SCM m);
SCM_API SCM scm_macro_name (SCM m);
SCM_API SCM scm_macro_transformer (SCM m);
+SCM_API SCM scm_syncase_macro_type (SCM m);
+SCM_API SCM scm_syncase_macro_binding (SCM m);
SCM_API SCM scm_make_synt (const char *name,
SCM (*macroizer) (SCM),
SCM (*fcn) ());
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 44f5f02..c12dc96 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -140,6 +140,16 @@
'(guile))
(define (module-add! module sym var)
(hashq-set! (%get-pre-modules-obarray) sym var))
+(define (module-define! module sym val)
+ (let ((v (hashq-ref (%get-pre-modules-obarray) sym)))
+ (if v
+ (variable-set! v val)
+ (hashq-set! (%get-pre-modules-obarray) sym
+ (make-variable val)))))
+(define (module-ref module sym)
+ (let ((v (module-variable module sym)))
+ (if v (variable-ref v) (error "badness!" (pk module) (pk sym)))))
+
(define (make-module-ref mod var kind)
(case kind
((public) (if mod `(@ ,mod ,var) var))
@@ -156,44 +166,25 @@
(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 install-global-transformer #f)
-(define $sc-dispatch #f)
+;;; API provided by psyntax
(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 free-identifier=? #f)
+(define sc-expand #f)
+(define sc-expand3 #f)
+
+;;; Implementation detail of psyntax -- the thing that does expand-time
+;;; dispatch for syntax-case macros
+(define $sc-dispatch #f)
+
+;;; Useless crap I'd like to get rid of
+(define install-global-transformer #f)
+(define (annotation? x) #f)
+
(define andmap
(lambda (f first . rest)
@@ -213,14 +204,9 @@
(apply f (cons x xr))
(and (apply f (cons x xr)) (andmap first rest)))))))))
-(define (syncase-error who format-string why what)
- (%start-stack 'syncase-stack
- (lambda ()
- (scm-error 'misc-error who "~A ~S" (list why what) '()))))
-
-;; Until the module system is booted, this will be the current expander.
(primitive-load-path "ice-9/psyntax-pp")
+;; Until the module system is booted, this will be the current expander.
(define %pre-modules-transformer sc-expand)
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 31066c3..5cb5213 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-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))) ($sc-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))) ($sc-dispatch
tmp1393 (quote (any any . each-any)))))) ($sc-dispatch tmp1393 (quote (each-any
any . each-any)))))) ($sc-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)))
($sc-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))) ($sc-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)))
($sc-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))) ($sc-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))) ($sc-dispatch tmp1563 (quote (any any .
each-any)))))) ($sc-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)))
($sc-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))) ($sc-dispatch tmp1612 (quote (any any)))))) ($sc-dispatch
tmp1612 (quote (any (any . any) any . each-any)))))) ($sc-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))) ($sc-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))) ($sc-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)))
($sc-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))) ($sc-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))) ($sc-dispatch tmp1946 (quote
#(vector (any . each-any))))))) ($sc-dispatch tmp1946 (quote (any . any))))))
($sc-dispatch tmp1946 (quote (any any . any)))))) ($sc-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)))
($sc-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)))
($sc-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))) ($sc-dispatch tmp2039 (quote (any any #(each
(any any)) any . each-any)))))) ($sc-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)))
($sc-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))) ($sc-dispatch tmp2093 (quote (any (any . each-any) any))))))
($sc-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)))
($sc-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)))
($sc-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))) ($sc-dispatch
tmp2155 (quote (any any any)))))) ($sc-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)))
($sc-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
$sc-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))) ($sc-dispatch tmp2200 (quote #(vector each-any))))))
($sc-dispatch tmp2200 (quote ()))))) ($sc-dispatch tmp2200 (quote (any .
any)))))) ($sc-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)))
($sc-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! $sc-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))) ($sc-dispatch tmp2314 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2314 (quote (any
((any any)) any . each-any)))))) ($sc-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))) ($sc-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))) ($sc-dispatch tmp2366 (quote (any any))))) (list (f2361
(cdr bindings2362)) (car bindings2362)))))) tmp2349) (syntax-violation #f
"source expression failed to match any pattern" tmp2348))) ($sc-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)))
($sc-dispatch tmp2383 (quote (any . each-any)))))) ($sc-dispatch tmp2383 (quote
())))) e12378)) tmp2381) (syntax-violation #f "source expression failed to
match any pattern" tmp2380))) ($sc-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))) ($sc-dispatch tmp2400 (quote
(any)))))) ($sc-dispatch tmp2400 (quote ())))) s2399)) var2374 step2376)))
tmp2372) (syntax-violation #f "source expression failed to match any pattern"
tmp2371))) ($sc-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))) ($sc-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))) ($sc-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)))))) ($sc-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)))
($sc-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))) ($sc-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))) ($sc-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))) ($sc-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)))))) ($sc-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))) ($sc-dispatch tmp2449 (quote #(vector
each-any)))))) ($sc-dispatch tmp2449 (quote (any . any)))))) ($sc-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)))))) ($sc-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))))))
($sc-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))) ($sc-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))) ($sc-dispatch tmp2481 (quote each-any)))) (read-file2470 fn2480
k2478)))) tmp2477) (syntax-violation #f "source expression failed to match any
pattern" tmp2476))) ($sc-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))) ($sc-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))) ($sc-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))) ($sc-dispatch tmp2508 (quote (each-any any . each-any))))))
($sc-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))) ($sc-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))) ($sc-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))) ($sc-dispatch tmp2531 (quote (any any)))))
x2530)))
+(letrec ((lambda-var-list1131 (lambda (vars1336) (let lvl1337 ((vars1338
vars1336) (ls1339 (quote ())) (w1340 (quote (())))) (cond ((pair? vars1338)
(lvl1337 (cdr vars1338) (cons (wrap1110 (car vars1338) w1340 #f) ls1339)
w1340)) ((id?1082 vars1338) (cons (wrap1110 vars1338 w1340 #f) ls1339)) ((null?
vars1338) ls1339) ((syntax-object?1066 vars1338) (lvl1337
(syntax-object-expression1067 vars1338) ls1339 (join-wraps1101 w1340
(syntax-object-wrap1068 vars1338)))) ((annotation? vars1338) (lvl1337
(annotation-expression vars1338) ls1339 w1340)) (else (cons vars1338
ls1339)))))) (gen-var1130 (lambda (id1341) (let ((id1342 (if
(syntax-object?1066 id1341) (syntax-object-expression1067 id1341) id1341))) (if
(annotation? id1342) (build-annotated1059 (annotation-source id1342) (gensym
(symbol->string (annotation-expression id1342)))) (build-annotated1059 #f
(gensym (symbol->string id1342))))))) (strip1129 (lambda (x1343 w1344) (if
(memq (quote top) (wrap-marks1085 w1344)) (if (or (annotation? x1343) (and
(pair? x1343) (annotation? (car x1343)))) (strip-annotation1128 x1343 #f)
x1343) (let f1345 ((x1346 x1343)) (cond ((syntax-object?1066 x1346) (strip1129
(syntax-object-expression1067 x1346) (syntax-object-wrap1068 x1346))) ((pair?
x1346) (let ((a1347 (f1345 (car x1346))) (d1348 (f1345 (cdr x1346)))) (if (and
(eq? a1347 (car x1346)) (eq? d1348 (cdr x1346))) x1346 (cons a1347 d1348))))
((vector? x1346) (let ((old1349 (vector->list x1346))) (let ((new1350 (map
f1345 old1349))) (if (andmap eq? old1349 new1350) x1346 (list->vector
new1350))))) (else x1346)))))) (strip-annotation1128 (lambda (x1351 parent1352)
(cond ((pair? x1351) (let ((new1353 (cons #f #f))) (begin (if parent1352
(set-annotation-stripped! parent1352 new1353)) (set-car! new1353
(strip-annotation1128 (car x1351) #f)) (set-cdr! new1353 (strip-annotation1128
(cdr x1351) #f)) new1353))) ((annotation? x1351) (or (annotation-stripped
x1351) (strip-annotation1128 (annotation-expression x1351) x1351))) ((vector?
x1351) (let ((new1354 (make-vector (vector-length x1351)))) (begin (if
parent1352 (set-annotation-stripped! parent1352 new1354)) (let loop1355 ((i1356
(- (vector-length x1351) 1))) (unless (fx<1053 i1356 0) (vector-set! new1354
i1356 (strip-annotation1128 (vector-ref x1351 i1356) #f)) (loop1355 (fx-1051
i1356 1)))) new1354))) (else x1351)))) (ellipsis?1127 (lambda (x1357) (and
(nonsymbol-id?1081 x1357) (free-id=?1105 x1357 (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-void1126 (lambda () (build-annotated1059 #f (list (build-annotated1059 #f
(quote void)))))) (eval-local-transformer1125 (lambda (expanded1358 mod1359)
(let ((p1360 (local-eval-hook1055 expanded1358 mod1359))) (if (procedure?
p1360) p1360 (syntax-violation #f "nonprocedure transformer" p1360)))))
(chi-local-syntax1124 (lambda (rec?1361 e1362 r1363 w1364 s1365 mod1366 k1367)
((lambda (tmp1368) ((lambda (tmp1369) (if tmp1369 (apply (lambda (_1370 id1371
val1372 e11373 e21374) (let ((ids1375 id1371)) (if (not (valid-bound-ids?1107
ids1375)) (syntax-violation #f "duplicate bound keyword" e1362) (let
((labels1377 (gen-labels1088 ids1375))) (let ((new-w1378 (make-binding-wrap1099
ids1375 labels1377 w1364))) (k1367 (cons e11373 e21374) (extend-env1076
labels1377 (let ((w1380 (if rec?1361 new-w1378 w1364)) (trans-r1381
(macros-only-env1078 r1363))) (map (lambda (x1382) (cons (quote macro)
(eval-local-transformer1125 (chi1118 x1382 trans-r1381 w1380 mod1366)
mod1366))) val1372)) r1363) new-w1378 s1365 mod1366)))))) tmp1369) ((lambda
(_1384) (syntax-violation #f "bad local syntax definition" (source-wrap1111
e1362 w1364 s1365 mod1366))) tmp1368))) ($sc-dispatch tmp1368 (quote (any
#(each (any any)) any . each-any))))) e1362))) (chi-lambda-clause1123 (lambda
(e1385 docstring1386 c1387 r1388 w1389 mod1390 k1391) ((lambda (tmp1392)
((lambda (tmp1393) (if (if tmp1393 (apply (lambda (args1394 doc1395 e11396
e21397) (and (string? (syntax->datum doc1395)) (not docstring1386))) tmp1393)
#f) (apply (lambda (args1398 doc1399 e11400 e21401) (chi-lambda-clause1123
e1385 doc1399 (cons args1398 (cons e11400 e21401)) r1388 w1389 mod1390 k1391))
tmp1393) ((lambda (tmp1403) (if tmp1403 (apply (lambda (id1404 e11405 e21406)
(let ((ids1407 id1404)) (if (not (valid-bound-ids?1107 ids1407))
(syntax-violation (quote lambda) "invalid parameter list" e1385) (let
((labels1409 (gen-labels1088 ids1407)) (new-vars1410 (map gen-var1130
ids1407))) (k1391 new-vars1410 docstring1386 (chi-body1122 (cons e11405 e21406)
e1385 (extend-var-env1077 labels1409 new-vars1410 r1388) (make-binding-wrap1099
ids1407 labels1409 w1389) mod1390)))))) tmp1403) ((lambda (tmp1412) (if tmp1412
(apply (lambda (ids1413 e11414 e21415) (let ((old-ids1416 (lambda-var-list1131
ids1413))) (if (not (valid-bound-ids?1107 old-ids1416)) (syntax-violation
(quote lambda) "invalid parameter list" e1385) (let ((labels1417
(gen-labels1088 old-ids1416)) (new-vars1418 (map gen-var1130 old-ids1416)))
(k1391 (let f1419 ((ls11420 (cdr new-vars1418)) (ls21421 (car new-vars1418)))
(if (null? ls11420) ls21421 (f1419 (cdr ls11420) (cons (car ls11420)
ls21421)))) docstring1386 (chi-body1122 (cons e11414 e21415) e1385
(extend-var-env1077 labels1417 new-vars1418 r1388) (make-binding-wrap1099
old-ids1416 labels1417 w1389) mod1390)))))) tmp1412) ((lambda (_1423)
(syntax-violation (quote lambda) "bad lambda" e1385)) tmp1392))) ($sc-dispatch
tmp1392 (quote (any any . each-any)))))) ($sc-dispatch tmp1392 (quote (each-any
any . each-any)))))) ($sc-dispatch tmp1392 (quote (any any any . each-any)))))
c1387))) (chi-body1122 (lambda (body1424 outer-form1425 r1426 w1427 mod1428)
(let ((r1429 (cons (quote ("placeholder" placeholder)) r1426))) (let
((ribcage1430 (make-ribcage1089 (quote ()) (quote ()) (quote ())))) (let
((w1431 (make-wrap1084 (wrap-marks1085 w1427) (cons ribcage1430 (wrap-subst1086
w1427))))) (let parse1432 ((body1433 (map (lambda (x1439) (cons r1429 (wrap1110
x1439 w1431 mod1428))) body1424)) (ids1434 (quote ())) (labels1435 (quote ()))
(vars1436 (quote ())) (vals1437 (quote ())) (bindings1438 (quote ()))) (if
(null? body1433) (syntax-violation #f "no expressions in body" outer-form1425)
(let ((e1440 (cdar body1433)) (er1441 (caar body1433))) (call-with-values
(lambda () (syntax-type1116 e1440 er1441 (quote (())) #f ribcage1430 mod1428))
(lambda (type1442 value1443 e1444 w1445 s1446 mod1447) (let ((t1448 type1442))
(if (memv t1448 (quote (define-form))) (let ((id1449 (wrap1110 value1443 w1445
mod1447)) (label1450 (gen-label1087))) (let ((var1451 (gen-var1130 id1449)))
(begin (extend-ribcage!1098 ribcage1430 id1449 label1450) (parse1432 (cdr
body1433) (cons id1449 ids1434) (cons label1450 labels1435) (cons var1451
vars1436) (cons (cons er1441 (wrap1110 e1444 w1445 mod1447)) vals1437) (cons
(cons (quote lexical) var1451) bindings1438))))) (if (memv t1448 (quote
(define-syntax-form))) (let ((id1452 (wrap1110 value1443 w1445 mod1447))
(label1453 (gen-label1087))) (begin (extend-ribcage!1098 ribcage1430 id1452
label1453) (parse1432 (cdr body1433) (cons id1452 ids1434) (cons label1453
labels1435) vars1436 vals1437 (cons (cons (quote macro) (cons er1441 (wrap1110
e1444 w1445 mod1447))) bindings1438)))) (if (memv t1448 (quote (begin-form)))
((lambda (tmp1454) ((lambda (tmp1455) (if tmp1455 (apply (lambda (_1456 e11457)
(parse1432 (let f1458 ((forms1459 e11457)) (if (null? forms1459) (cdr body1433)
(cons (cons er1441 (wrap1110 (car forms1459) w1445 mod1447)) (f1458 (cdr
forms1459))))) ids1434 labels1435 vars1436 vals1437 bindings1438)) tmp1455)
(syntax-violation #f "source expression failed to match any pattern" tmp1454)))
($sc-dispatch tmp1454 (quote (any . each-any))))) e1444) (if (memv t1448 (quote
(local-syntax-form))) (chi-local-syntax1124 value1443 e1444 er1441 w1445 s1446
mod1447 (lambda (forms1461 er1462 w1463 s1464 mod1465) (parse1432 (let f1466
((forms1467 forms1461)) (if (null? forms1467) (cdr body1433) (cons (cons er1462
(wrap1110 (car forms1467) w1463 mod1465)) (f1466 (cdr forms1467))))) ids1434
labels1435 vars1436 vals1437 bindings1438))) (if (null? ids1434)
(build-sequence1061 #f (map (lambda (x1468) (chi1118 (cdr x1468) (car x1468)
(quote (())) mod1447)) (cons (cons er1441 (source-wrap1111 e1444 w1445 s1446
mod1447)) (cdr body1433)))) (begin (if (not (valid-bound-ids?1107 ids1434))
(syntax-violation #f "invalid or duplicate identifier in definition"
outer-form1425)) (let loop1469 ((bs1470 bindings1438) (er-cache1471 #f)
(r-cache1472 #f)) (if (not (null? bs1470)) (let ((b1473 (car bs1470))) (if (eq?
(car b1473) (quote macro)) (let ((er1474 (cadr b1473))) (let ((r-cache1475 (if
(eq? er1474 er-cache1471) r-cache1472 (macros-only-env1078 er1474)))) (begin
(set-cdr! b1473 (eval-local-transformer1125 (chi1118 (cddr b1473) r-cache1475
(quote (())) mod1447) mod1447)) (loop1469 (cdr bs1470) er1474 r-cache1475))))
(loop1469 (cdr bs1470) er-cache1471 r-cache1472))))) (set-cdr! r1429
(extend-env1076 labels1435 bindings1438 (cdr r1429))) (build-letrec1064 #f
vars1436 (map (lambda (x1476) (chi1118 (cdr x1476) (car x1476) (quote (()))
mod1447)) vals1437) (build-sequence1061 #f (map (lambda (x1477) (chi1118 (cdr
x1477) (car x1477) (quote (())) mod1447)) (cons (cons er1441 (source-wrap1111
e1444 w1445 s1446 mod1447)) (cdr body1433)))))))))))))))))))))) (chi-macro1121
(lambda (p1478 e1479 r1480 w1481 rib1482 mod1483) (letrec
((rebuild-macro-output1484 (lambda (x1485 m1486) (cond ((pair? x1485) (cons
(rebuild-macro-output1484 (car x1485) m1486) (rebuild-macro-output1484 (cdr
x1485) m1486))) ((syntax-object?1066 x1485) (let ((w1487
(syntax-object-wrap1068 x1485))) (let ((ms1488 (wrap-marks1085 w1487)) (s1489
(wrap-subst1086 w1487))) (if (and (pair? ms1488) (eq? (car ms1488) #f))
(make-syntax-object1065 (syntax-object-expression1067 x1485) (make-wrap1084
(cdr ms1488) (if rib1482 (cons rib1482 (cdr s1489)) (cdr s1489)))
(syntax-object-module1069 x1485)) (make-syntax-object1065
(syntax-object-expression1067 x1485) (make-wrap1084 (cons m1486 ms1488) (if
rib1482 (cons rib1482 (cons (quote shift) s1489)) (cons (quote shift) s1489)))
(let ((pmod1490 (procedure-module p1478))) (if pmod1490 (cons (quote hygiene)
(module-name pmod1490)) (quote (hygiene guile))))))))) ((vector? x1485) (let
((n1491 (vector-length x1485))) (let ((v1492 (make-vector n1491))) (let
doloop1493 ((i1494 0)) (if (fx=1052 i1494 n1491) v1492 (begin (vector-set!
v1492 i1494 (rebuild-macro-output1484 (vector-ref x1485 i1494) m1486))
(doloop1493 (fx+1050 i1494 1)))))))) ((symbol? x1485) (syntax-violation #f
"encountered raw symbol in macro output" (source-wrap1111 e1479 w1481 s
mod1483) x1485)) (else x1485))))) (rebuild-macro-output1484 (p1478 (wrap1110
e1479 (anti-mark1097 w1481) mod1483)) (string #\m))))) (chi-application1120
(lambda (x1495 e1496 r1497 w1498 s1499 mod1500) ((lambda (tmp1501) ((lambda
(tmp1502) (if tmp1502 (apply (lambda (e01503 e11504) (build-annotated1059 s1499
(cons x1495 (map (lambda (e1505) (chi1118 e1505 r1497 w1498 mod1500))
e11504)))) tmp1502) (syntax-violation #f "source expression failed to match any
pattern" tmp1501))) ($sc-dispatch tmp1501 (quote (any . each-any))))) e1496)))
(chi-expr1119 (lambda (type1507 value1508 e1509 r1510 w1511 s1512 mod1513) (let
((t1514 type1507)) (if (memv t1514 (quote (lexical))) (build-annotated1059
s1512 value1508) (if (memv t1514 (quote (core external-macro))) (value1508
e1509 r1510 w1511 s1512 mod1513) (if (memv t1514 (quote (module-ref)))
(call-with-values (lambda () (value1508 e1509)) (lambda (id1515 mod1516)
(build-annotated1059 s1512 (if mod1516 (make-module-ref (cdr mod1516) id1515
(car mod1516)) (make-module-ref mod1516 id1515 (quote bare)))))) (if (memv
t1514 (quote (lexical-call))) (chi-application1120 (build-annotated1059
(source-annotation1073 (car e1509)) value1508) e1509 r1510 w1511 s1512 mod1513)
(if (memv t1514 (quote (global-call))) (chi-application1120
(build-annotated1059 (source-annotation1073 (car e1509)) (if (if
(syntax-object?1066 (car e1509)) (syntax-object-module1069 (car e1509))
mod1513) (make-module-ref (cdr (if (syntax-object?1066 (car e1509))
(syntax-object-module1069 (car e1509)) mod1513)) value1508 (car (if
(syntax-object?1066 (car e1509)) (syntax-object-module1069 (car e1509))
mod1513))) (make-module-ref (if (syntax-object?1066 (car e1509))
(syntax-object-module1069 (car e1509)) mod1513) value1508 (quote bare)))) e1509
r1510 w1511 s1512 mod1513) (if (memv t1514 (quote (constant))) (build-data1060
s1512 (strip1129 (source-wrap1111 e1509 w1511 s1512 mod1513) (quote (())))) (if
(memv t1514 (quote (global))) (build-annotated1059 s1512 (if mod1513
(make-module-ref (cdr mod1513) value1508 (car mod1513)) (make-module-ref
mod1513 value1508 (quote bare)))) (if (memv t1514 (quote (call)))
(chi-application1120 (chi1118 (car e1509) r1510 w1511 mod1513) e1509 r1510
w1511 s1512 mod1513) (if (memv t1514 (quote (begin-form))) ((lambda (tmp1517)
((lambda (tmp1518) (if tmp1518 (apply (lambda (_1519 e11520 e21521)
(chi-sequence1112 (cons e11520 e21521) r1510 w1511 s1512 mod1513)) tmp1518)
(syntax-violation #f "source expression failed to match any pattern" tmp1517)))
($sc-dispatch tmp1517 (quote (any any . each-any))))) e1509) (if (memv t1514
(quote (local-syntax-form))) (chi-local-syntax1124 value1508 e1509 r1510 w1511
s1512 mod1513 chi-sequence1112) (if (memv t1514 (quote (eval-when-form)))
((lambda (tmp1523) ((lambda (tmp1524) (if tmp1524 (apply (lambda (_1525 x1526
e11527 e21528) (let ((when-list1529 (chi-when-list1115 e1509 x1526 w1511))) (if
(memq (quote eval) when-list1529) (chi-sequence1112 (cons e11527 e21528) r1510
w1511 s1512 mod1513) (chi-void1126)))) tmp1524) (syntax-violation #f "source
expression failed to match any pattern" tmp1523))) ($sc-dispatch tmp1523 (quote
(any each-any any . each-any))))) e1509) (if (memv t1514 (quote (define-form
define-syntax-form))) (syntax-violation #f "definition in expression context"
e1509 (wrap1110 value1508 w1511 mod1513)) (if (memv t1514 (quote (syntax)))
(syntax-violation #f "reference to pattern variable outside syntax form"
(source-wrap1111 e1509 w1511 s1512 mod1513)) (if (memv t1514 (quote
(displaced-lexical))) (syntax-violation #f "reference to identifier outside its
scope" (source-wrap1111 e1509 w1511 s1512 mod1513)) (syntax-violation #f
"unexpected syntax" (source-wrap1111 e1509 w1511 s1512
mod1513))))))))))))))))))) (chi1118 (lambda (e1532 r1533 w1534 mod1535)
(call-with-values (lambda () (syntax-type1116 e1532 r1533 w1534 #f #f mod1535))
(lambda (type1536 value1537 e1538 w1539 s1540 mod1541) (chi-expr1119 type1536
value1537 e1538 r1533 w1539 s1540 mod1541))))) (chi-top1117 (lambda (e1542
r1543 w1544 m1545 esew1546 mod1547) (call-with-values (lambda ()
(syntax-type1116 e1542 r1543 w1544 #f #f mod1547)) (lambda (type1555 value1556
e1557 w1558 s1559 mod1560) (let ((t1561 type1555)) (if (memv t1561 (quote
(begin-form))) ((lambda (tmp1562) ((lambda (tmp1563) (if tmp1563 (apply (lambda
(_1564) (chi-void1126)) tmp1563) ((lambda (tmp1565) (if tmp1565 (apply (lambda
(_1566 e11567 e21568) (chi-top-sequence1113 (cons e11567 e21568) r1543 w1558
s1559 m1545 esew1546 mod1560)) tmp1565) (syntax-violation #f "source expression
failed to match any pattern" tmp1562))) ($sc-dispatch tmp1562 (quote (any any .
each-any)))))) ($sc-dispatch tmp1562 (quote (any))))) e1557) (if (memv t1561
(quote (local-syntax-form))) (chi-local-syntax1124 value1556 e1557 r1543 w1558
s1559 mod1560 (lambda (body1570 r1571 w1572 s1573 mod1574)
(chi-top-sequence1113 body1570 r1571 w1572 s1573 m1545 esew1546 mod1574))) (if
(memv t1561 (quote (eval-when-form))) ((lambda (tmp1575) ((lambda (tmp1576) (if
tmp1576 (apply (lambda (_1577 x1578 e11579 e21580) (let ((when-list1581
(chi-when-list1115 e1557 x1578 w1558)) (body1582 (cons e11579 e21580))) (cond
((eq? m1545 (quote e)) (if (memq (quote eval) when-list1581)
(chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote e) (quote (eval))
mod1560) (chi-void1126))) ((memq (quote load) when-list1581) (if (or (memq
(quote compile) when-list1581) (and (eq? m1545 (quote c&e)) (memq (quote eval)
when-list1581))) (chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote c&e)
(quote (compile load)) mod1560) (if (memq m1545 (quote (c c&e)))
(chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote c) (quote (load))
mod1560) (chi-void1126)))) ((or (memq (quote compile) when-list1581) (and (eq?
m1545 (quote c&e)) (memq (quote eval) when-list1581))) (top-level-eval-hook1054
(chi-top-sequence1113 body1582 r1543 w1558 s1559 (quote e) (quote (eval))
mod1560) mod1560) (chi-void1126)) (else (chi-void1126))))) tmp1576)
(syntax-violation #f "source expression failed to match any pattern" tmp1575)))
($sc-dispatch tmp1575 (quote (any each-any any . each-any))))) e1557) (if (memv
t1561 (quote (define-syntax-form))) (let ((n1585 (id-var-name1104 value1556
w1558)) (r1586 (macros-only-env1078 r1543))) (let ((t1587 m1545)) (if (memv
t1587 (quote (c))) (if (memq (quote compile) esew1546) (let ((e1588
(chi-install-global1114 n1585 (chi1118 e1557 r1586 w1558 mod1560)))) (begin
(top-level-eval-hook1054 e1588 mod1560) (if (memq (quote load) esew1546) e1588
(chi-void1126)))) (if (memq (quote load) esew1546) (chi-install-global1114
n1585 (chi1118 e1557 r1586 w1558 mod1560)) (chi-void1126))) (if (memv t1587
(quote (c&e))) (let ((e1589 (chi-install-global1114 n1585 (chi1118 e1557 r1586
w1558 mod1560)))) (begin (top-level-eval-hook1054 e1589 mod1560) e1589)) (begin
(if (memq (quote eval) esew1546) (top-level-eval-hook1054
(chi-install-global1114 n1585 (chi1118 e1557 r1586 w1558 mod1560)) mod1560))
(chi-void1126)))))) (if (memv t1561 (quote (define-form))) (let ((n1590
(id-var-name1104 value1556 w1558))) (let ((type1591 (binding-type1074
(lookup1079 n1590 r1543 mod1560)))) (let ((t1592 type1591)) (if (memv t1592
(quote (global core macro module-ref))) (let ((x1593 (build-annotated1059 s1559
(list (quote define) n1590 (chi1118 e1557 r1543 w1558 mod1560))))) (begin (if
(eq? m1545 (quote c&e)) (top-level-eval-hook1054 x1593 mod1560)) x1593)) (if
(memv t1592 (quote (displaced-lexical))) (syntax-violation #f "identifier out
of context" e1557 (wrap1110 value1556 w1558 mod1560)) (syntax-violation #f
"cannot define keyword at top level" e1557 (wrap1110 value1556 w1558
mod1560))))))) (let ((x1594 (chi-expr1119 type1555 value1556 e1557 r1543 w1558
s1559 mod1560))) (begin (if (eq? m1545 (quote c&e)) (top-level-eval-hook1054
x1594 mod1560)) x1594)))))))))))) (syntax-type1116 (lambda (e1595 r1596 w1597
s1598 rib1599 mod1600) (cond ((symbol? e1595) (let ((n1601 (id-var-name1104
e1595 w1597))) (let ((b1602 (lookup1079 n1601 r1596 mod1600))) (let ((type1603
(binding-type1074 b1602))) (let ((t1604 type1603)) (if (memv t1604 (quote
(lexical))) (values type1603 (binding-value1075 b1602) e1595 w1597 s1598
mod1600) (if (memv t1604 (quote (global))) (values type1603 n1601 e1595 w1597
s1598 mod1600) (if (memv t1604 (quote (macro))) (syntax-type1116 (chi-macro1121
(binding-value1075 b1602) e1595 r1596 w1597 rib1599 mod1600) r1596 (quote (()))
s1598 rib1599 mod1600) (values type1603 (binding-value1075 b1602) e1595 w1597
s1598 mod1600))))))))) ((pair? e1595) (let ((first1605 (car e1595))) (if
(id?1082 first1605) (let ((n1606 (id-var-name1104 first1605 w1597))) (let
((b1607 (lookup1079 n1606 r1596 (or (and (syntax-object?1066 first1605)
(syntax-object-module1069 first1605)) mod1600)))) (let ((type1608
(binding-type1074 b1607))) (let ((t1609 type1608)) (if (memv t1609 (quote
(lexical))) (values (quote lexical-call) (binding-value1075 b1607) e1595 w1597
s1598 mod1600) (if (memv t1609 (quote (global))) (values (quote global-call)
n1606 e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (macro)))
(syntax-type1116 (chi-macro1121 (binding-value1075 b1607) e1595 r1596 w1597
rib1599 mod1600) r1596 (quote (())) s1598 rib1599 mod1600) (if (memv t1609
(quote (core external-macro module-ref))) (values type1608 (binding-value1075
b1607) e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (local-syntax)))
(values (quote local-syntax-form) (binding-value1075 b1607) e1595 w1597 s1598
mod1600) (if (memv t1609 (quote (begin))) (values (quote begin-form) #f e1595
w1597 s1598 mod1600) (if (memv t1609 (quote (eval-when))) (values (quote
eval-when-form) #f e1595 w1597 s1598 mod1600) (if (memv t1609 (quote (define)))
((lambda (tmp1610) ((lambda (tmp1611) (if (if tmp1611 (apply (lambda (_1612
name1613 val1614) (id?1082 name1613)) tmp1611) #f) (apply (lambda (_1615
name1616 val1617) (values (quote define-form) name1616 val1617 w1597 s1598
mod1600)) tmp1611) ((lambda (tmp1618) (if (if tmp1618 (apply (lambda (_1619
name1620 args1621 e11622 e21623) (and (id?1082 name1620) (valid-bound-ids?1107
(lambda-var-list1131 args1621)))) tmp1618) #f) (apply (lambda (_1624 name1625
args1626 e11627 e21628) (values (quote define-form) (wrap1110 name1625 w1597
mod1600) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) (wrap1110 (cons
args1626 (cons e11627 e21628)) w1597 mod1600)) (quote (())) s1598 mod1600))
tmp1618) ((lambda (tmp1630) (if (if tmp1630 (apply (lambda (_1631 name1632)
(id?1082 name1632)) tmp1630) #f) (apply (lambda (_1633 name1634) (values (quote
define-form) (wrap1110 name1634 w1597 mod1600) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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 (()))
s1598 mod1600)) tmp1630) (syntax-violation #f "source expression failed to
match any pattern" tmp1610))) ($sc-dispatch tmp1610 (quote (any any))))))
($sc-dispatch tmp1610 (quote (any (any . any) any . each-any))))))
($sc-dispatch tmp1610 (quote (any any any))))) e1595) (if (memv t1609 (quote
(define-syntax))) ((lambda (tmp1635) ((lambda (tmp1636) (if (if tmp1636 (apply
(lambda (_1637 name1638 val1639) (id?1082 name1638)) tmp1636) #f) (apply
(lambda (_1640 name1641 val1642) (values (quote define-syntax-form) name1641
val1642 w1597 s1598 mod1600)) tmp1636) (syntax-violation #f "source expression
failed to match any pattern" tmp1635))) ($sc-dispatch tmp1635 (quote (any any
any))))) e1595) (values (quote call) #f e1595 w1597 s1598 mod1600))))))))))))))
(values (quote call) #f e1595 w1597 s1598 mod1600)))) ((syntax-object?1066
e1595) (syntax-type1116 (syntax-object-expression1067 e1595) r1596
(join-wraps1101 w1597 (syntax-object-wrap1068 e1595)) #f rib1599 (or
(syntax-object-module1069 e1595) mod1600))) ((annotation? e1595)
(syntax-type1116 (annotation-expression e1595) r1596 w1597 (annotation-source
e1595) rib1599 mod1600)) ((self-evaluating? e1595) (values (quote constant) #f
e1595 w1597 s1598 mod1600)) (else (values (quote other) #f e1595 w1597 s1598
mod1600))))) (chi-when-list1115 (lambda (e1643 when-list1644 w1645) (let f1646
((when-list1647 when-list1644) (situations1648 (quote ()))) (if (null?
when-list1647) situations1648 (f1646 (cdr when-list1647) (cons (let ((x1649
(car when-list1647))) (cond ((free-id=?1105 x1649 (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?1105 x1649 (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?1105 x1649 (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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" e1643 (wrap1110
x1649 w1645 #f))))) situations1648)))))) (chi-install-global1114 (lambda
(name1650 e1651) (build-annotated1059 #f (list (build-annotated1059 #f (quote
define)) name1650 (if (let ((v1652 (module-variable (current-module)
name1650))) (and v1652 (variable-bound? v1652) (macro? (variable-ref v1652))
(not (eq? (macro-type (variable-ref v1652)) (quote syncase-macro)))))
(build-annotated1059 #f (list (build-annotated1059 #f (quote
make-extended-syncase-macro)) (build-annotated1059 #f (list
(build-annotated1059 #f (quote module-ref)) (build-annotated1059 #f (quote
(current-module))) (build-data1060 #f name1650))) (build-data1060 #f (quote
macro)) e1651)) (build-annotated1059 #f (list (build-annotated1059 #f (quote
make-syncase-macro)) (build-data1060 #f (quote macro)) e1651)))))))
(chi-top-sequence1113 (lambda (body1653 r1654 w1655 s1656 m1657 esew1658
mod1659) (build-sequence1061 s1656 (let dobody1660 ((body1661 body1653) (r1662
r1654) (w1663 w1655) (m1664 m1657) (esew1665 esew1658) (mod1666 mod1659)) (if
(null? body1661) (quote ()) (let ((first1667 (chi-top1117 (car body1661) r1662
w1663 m1664 esew1665 mod1666))) (cons first1667 (dobody1660 (cdr body1661)
r1662 w1663 m1664 esew1665 mod1666)))))))) (chi-sequence1112 (lambda (body1668
r1669 w1670 s1671 mod1672) (build-sequence1061 s1671 (let dobody1673 ((body1674
body1668) (r1675 r1669) (w1676 w1670) (mod1677 mod1672)) (if (null? body1674)
(quote ()) (let ((first1678 (chi1118 (car body1674) r1675 w1676 mod1677)))
(cons first1678 (dobody1673 (cdr body1674) r1675 w1676 mod1677))))))))
(source-wrap1111 (lambda (x1679 w1680 s1681 defmod1682) (wrap1110 (if s1681
(make-annotation x1679 s1681 #f) x1679) w1680 defmod1682))) (wrap1110 (lambda
(x1683 w1684 defmod1685) (cond ((and (null? (wrap-marks1085 w1684)) (null?
(wrap-subst1086 w1684))) x1683) ((syntax-object?1066 x1683)
(make-syntax-object1065 (syntax-object-expression1067 x1683) (join-wraps1101
w1684 (syntax-object-wrap1068 x1683)) (syntax-object-module1069 x1683)))
((null? x1683) x1683) (else (make-syntax-object1065 x1683 w1684 defmod1685)))))
(bound-id-member?1109 (lambda (x1686 list1687) (and (not (null? list1687)) (or
(bound-id=?1106 x1686 (car list1687)) (bound-id-member?1109 x1686 (cdr
list1687)))))) (distinct-bound-ids?1108 (lambda (ids1688) (let distinct?1689
((ids1690 ids1688)) (or (null? ids1690) (and (not (bound-id-member?1109 (car
ids1690) (cdr ids1690))) (distinct?1689 (cdr ids1690)))))))
(valid-bound-ids?1107 (lambda (ids1691) (and (let all-ids?1692 ((ids1693
ids1691)) (or (null? ids1693) (and (id?1082 (car ids1693)) (all-ids?1692 (cdr
ids1693))))) (distinct-bound-ids?1108 ids1691)))) (bound-id=?1106 (lambda
(i1694 j1695) (if (and (syntax-object?1066 i1694) (syntax-object?1066 j1695))
(and (eq? (let ((e1696 (syntax-object-expression1067 i1694))) (if (annotation?
e1696) (annotation-expression e1696) e1696)) (let ((e1697
(syntax-object-expression1067 j1695))) (if (annotation? e1697)
(annotation-expression e1697) e1697))) (same-marks?1103 (wrap-marks1085
(syntax-object-wrap1068 i1694)) (wrap-marks1085 (syntax-object-wrap1068
j1695)))) (eq? (let ((e1698 i1694)) (if (annotation? e1698)
(annotation-expression e1698) e1698)) (let ((e1699 j1695)) (if (annotation?
e1699) (annotation-expression e1699) e1699)))))) (free-id=?1105 (lambda (i1700
j1701) (and (eq? (let ((x1702 i1700)) (let ((e1703 (if (syntax-object?1066
x1702) (syntax-object-expression1067 x1702) x1702))) (if (annotation? e1703)
(annotation-expression e1703) e1703))) (let ((x1704 j1701)) (let ((e1705 (if
(syntax-object?1066 x1704) (syntax-object-expression1067 x1704) x1704))) (if
(annotation? e1705) (annotation-expression e1705) e1705)))) (eq?
(id-var-name1104 i1700 (quote (()))) (id-var-name1104 j1701 (quote (())))))))
(id-var-name1104 (lambda (id1706 w1707) (letrec ((search-vector-rib1710 (lambda
(sym1716 subst1717 marks1718 symnames1719 ribcage1720) (let ((n1721
(vector-length symnames1719))) (let f1722 ((i1723 0)) (cond ((fx=1052 i1723
n1721) (search1708 sym1716 (cdr subst1717) marks1718)) ((and (eq? (vector-ref
symnames1719 i1723) sym1716) (same-marks?1103 marks1718 (vector-ref
(ribcage-marks1092 ribcage1720) i1723))) (values (vector-ref
(ribcage-labels1093 ribcage1720) i1723) marks1718)) (else (f1722 (fx+1050 i1723
1)))))))) (search-list-rib1709 (lambda (sym1724 subst1725 marks1726
symnames1727 ribcage1728) (let f1729 ((symnames1730 symnames1727) (i1731 0))
(cond ((null? symnames1730) (search1708 sym1724 (cdr subst1725) marks1726))
((and (eq? (car symnames1730) sym1724) (same-marks?1103 marks1726 (list-ref
(ribcage-marks1092 ribcage1728) i1731))) (values (list-ref (ribcage-labels1093
ribcage1728) i1731) marks1726)) (else (f1729 (cdr symnames1730) (fx+1050 i1731
1))))))) (search1708 (lambda (sym1732 subst1733 marks1734) (if (null?
subst1733) (values #f marks1734) (let ((fst1735 (car subst1733))) (if (eq?
fst1735 (quote shift)) (search1708 sym1732 (cdr subst1733) (cdr marks1734))
(let ((symnames1736 (ribcage-symnames1091 fst1735))) (if (vector? symnames1736)
(search-vector-rib1710 sym1732 subst1733 marks1734 symnames1736 fst1735)
(search-list-rib1709 sym1732 subst1733 marks1734 symnames1736 fst1735)))))))))
(cond ((symbol? id1706) (or (call-with-values (lambda () (search1708 id1706
(wrap-subst1086 w1707) (wrap-marks1085 w1707))) (lambda (x1738 . ignore1737)
x1738)) id1706)) ((syntax-object?1066 id1706) (let ((id1739 (let ((e1741
(syntax-object-expression1067 id1706))) (if (annotation? e1741)
(annotation-expression e1741) e1741))) (w11740 (syntax-object-wrap1068
id1706))) (let ((marks1742 (join-marks1102 (wrap-marks1085 w1707)
(wrap-marks1085 w11740)))) (call-with-values (lambda () (search1708 id1739
(wrap-subst1086 w1707) marks1742)) (lambda (new-id1743 marks1744) (or
new-id1743 (call-with-values (lambda () (search1708 id1739 (wrap-subst1086
w11740) marks1744)) (lambda (x1746 . ignore1745) x1746)) id1739))))))
((annotation? id1706) (let ((id1747 (let ((e1748 id1706)) (if (annotation?
e1748) (annotation-expression e1748) e1748)))) (or (call-with-values (lambda ()
(search1708 id1747 (wrap-subst1086 w1707) (wrap-marks1085 w1707))) (lambda
(x1750 . ignore1749) x1750)) id1747))) (else (error-hook1056 (quote
id-var-name) "invalid id" id1706)))))) (same-marks?1103 (lambda (x1751 y1752)
(or (eq? x1751 y1752) (and (not (null? x1751)) (not (null? y1752)) (eq? (car
x1751) (car y1752)) (same-marks?1103 (cdr x1751) (cdr y1752))))))
(join-marks1102 (lambda (m11753 m21754) (smart-append1100 m11753 m21754)))
(join-wraps1101 (lambda (w11755 w21756) (let ((m11757 (wrap-marks1085 w11755))
(s11758 (wrap-subst1086 w11755))) (if (null? m11757) (if (null? s11758) w21756
(make-wrap1084 (wrap-marks1085 w21756) (smart-append1100 s11758 (wrap-subst1086
w21756)))) (make-wrap1084 (smart-append1100 m11757 (wrap-marks1085 w21756))
(smart-append1100 s11758 (wrap-subst1086 w21756))))))) (smart-append1100
(lambda (m11759 m21760) (if (null? m21760) m11759 (append m11759 m21760))))
(make-binding-wrap1099 (lambda (ids1761 labels1762 w1763) (if (null? ids1761)
w1763 (make-wrap1084 (wrap-marks1085 w1763) (cons (let ((labelvec1764
(list->vector labels1762))) (let ((n1765 (vector-length labelvec1764))) (let
((symnamevec1766 (make-vector n1765)) (marksvec1767 (make-vector n1765)))
(begin (let f1768 ((ids1769 ids1761) (i1770 0)) (if (not (null? ids1769))
(call-with-values (lambda () (id-sym-name&marks1083 (car ids1769) w1763))
(lambda (symname1771 marks1772) (begin (vector-set! symnamevec1766 i1770
symname1771) (vector-set! marksvec1767 i1770 marks1772) (f1768 (cdr ids1769)
(fx+1050 i1770 1))))))) (make-ribcage1089 symnamevec1766 marksvec1767
labelvec1764))))) (wrap-subst1086 w1763)))))) (extend-ribcage!1098 (lambda
(ribcage1773 id1774 label1775) (begin (set-ribcage-symnames!1094 ribcage1773
(cons (let ((e1776 (syntax-object-expression1067 id1774))) (if (annotation?
e1776) (annotation-expression e1776) e1776)) (ribcage-symnames1091
ribcage1773))) (set-ribcage-marks!1095 ribcage1773 (cons (wrap-marks1085
(syntax-object-wrap1068 id1774)) (ribcage-marks1092 ribcage1773)))
(set-ribcage-labels!1096 ribcage1773 (cons label1775 (ribcage-labels1093
ribcage1773)))))) (anti-mark1097 (lambda (w1777) (make-wrap1084 (cons #f
(wrap-marks1085 w1777)) (cons (quote shift) (wrap-subst1086 w1777)))))
(set-ribcage-labels!1096 (lambda (x1778 update1779) (vector-set! x1778 3
update1779))) (set-ribcage-marks!1095 (lambda (x1780 update1781) (vector-set!
x1780 2 update1781))) (set-ribcage-symnames!1094 (lambda (x1782 update1783)
(vector-set! x1782 1 update1783))) (ribcage-labels1093 (lambda (x1784)
(vector-ref x1784 3))) (ribcage-marks1092 (lambda (x1785) (vector-ref x1785
2))) (ribcage-symnames1091 (lambda (x1786) (vector-ref x1786 1))) (ribcage?1090
(lambda (x1787) (and (vector? x1787) (= (vector-length x1787) 4) (eq?
(vector-ref x1787 0) (quote ribcage))))) (make-ribcage1089 (lambda
(symnames1788 marks1789 labels1790) (vector (quote ribcage) symnames1788
marks1789 labels1790))) (gen-labels1088 (lambda (ls1791) (if (null? ls1791)
(quote ()) (cons (gen-label1087) (gen-labels1088 (cdr ls1791))))))
(gen-label1087 (lambda () (string #\i))) (wrap-subst1086 cdr) (wrap-marks1085
car) (make-wrap1084 cons) (id-sym-name&marks1083 (lambda (x1792 w1793) (if
(syntax-object?1066 x1792) (values (let ((e1794 (syntax-object-expression1067
x1792))) (if (annotation? e1794) (annotation-expression e1794) e1794))
(join-marks1102 (wrap-marks1085 w1793) (wrap-marks1085 (syntax-object-wrap1068
x1792)))) (values (let ((e1795 x1792)) (if (annotation? e1795)
(annotation-expression e1795) e1795)) (wrap-marks1085 w1793))))) (id?1082
(lambda (x1796) (cond ((symbol? x1796) #t) ((syntax-object?1066 x1796) (symbol?
(let ((e1797 (syntax-object-expression1067 x1796))) (if (annotation? e1797)
(annotation-expression e1797) e1797)))) ((annotation? x1796) (symbol?
(annotation-expression x1796))) (else #f)))) (nonsymbol-id?1081 (lambda (x1798)
(and (syntax-object?1066 x1798) (symbol? (let ((e1799
(syntax-object-expression1067 x1798))) (if (annotation? e1799)
(annotation-expression e1799) e1799)))))) (global-extend1080 (lambda (type1800
sym1801 val1802) (put-global-definition-hook1057 sym1801 type1800 val1802)))
(lookup1079 (lambda (x1803 r1804 mod1805) (cond ((assq x1803 r1804) => cdr)
((symbol? x1803) (or (get-global-definition-hook1058 x1803 mod1805) (quote
(global)))) (else (quote (displaced-lexical)))))) (macros-only-env1078 (lambda
(r1806) (if (null? r1806) (quote ()) (let ((a1807 (car r1806))) (if (eq? (cadr
a1807) (quote macro)) (cons a1807 (macros-only-env1078 (cdr r1806)))
(macros-only-env1078 (cdr r1806))))))) (extend-var-env1077 (lambda (labels1808
vars1809 r1810) (if (null? labels1808) r1810 (extend-var-env1077 (cdr
labels1808) (cdr vars1809) (cons (cons (car labels1808) (cons (quote lexical)
(car vars1809))) r1810))))) (extend-env1076 (lambda (labels1811 bindings1812
r1813) (if (null? labels1811) r1813 (extend-env1076 (cdr labels1811) (cdr
bindings1812) (cons (cons (car labels1811) (car bindings1812)) r1813)))))
(binding-value1075 cdr) (binding-type1074 car) (source-annotation1073 (lambda
(x1814) (cond ((annotation? x1814) (annotation-source x1814))
((syntax-object?1066 x1814) (source-annotation1073
(syntax-object-expression1067 x1814))) (else #f))))
(set-syntax-object-module!1072 (lambda (x1815 update1816) (vector-set! x1815 3
update1816))) (set-syntax-object-wrap!1071 (lambda (x1817 update1818)
(vector-set! x1817 2 update1818))) (set-syntax-object-expression!1070 (lambda
(x1819 update1820) (vector-set! x1819 1 update1820))) (syntax-object-module1069
(lambda (x1821) (vector-ref x1821 3))) (syntax-object-wrap1068 (lambda (x1822)
(vector-ref x1822 2))) (syntax-object-expression1067 (lambda (x1823)
(vector-ref x1823 1))) (syntax-object?1066 (lambda (x1824) (and (vector? x1824)
(= (vector-length x1824) 4) (eq? (vector-ref x1824 0) (quote syntax-object)))))
(make-syntax-object1065 (lambda (expression1825 wrap1826 module1827) (vector
(quote syntax-object) expression1825 wrap1826 module1827))) (build-letrec1064
(lambda (src1828 vars1829 val-exps1830 body-exp1831) (if (null? vars1829)
(build-annotated1059 src1828 body-exp1831) (build-annotated1059 src1828 (list
(quote letrec) (map list vars1829 val-exps1830) body-exp1831)))))
(build-named-let1063 (lambda (src1832 vars1833 val-exps1834 body-exp1835) (if
(null? vars1833) (build-annotated1059 src1832 body-exp1835)
(build-annotated1059 src1832 (list (quote let) (car vars1833) (map list (cdr
vars1833) val-exps1834) body-exp1835))))) (build-let1062 (lambda (src1836
vars1837 val-exps1838 body-exp1839) (if (null? vars1837) (build-annotated1059
src1836 body-exp1839) (build-annotated1059 src1836 (list (quote let) (map list
vars1837 val-exps1838) body-exp1839))))) (build-sequence1061 (lambda (src1840
exps1841) (if (null? (cdr exps1841)) (build-annotated1059 src1840 (car
exps1841)) (build-annotated1059 src1840 (cons (quote begin) exps1841)))))
(build-data1060 (lambda (src1842 exp1843) (if (and (self-evaluating? exp1843)
(not (vector? exp1843))) (build-annotated1059 src1842 exp1843)
(build-annotated1059 src1842 (list (quote quote) exp1843)))))
(build-annotated1059 (lambda (src1844 exp1845) (if (and src1844 (not
(annotation? exp1845))) (make-annotation exp1845 src1844 #t) exp1845)))
(get-global-definition-hook1058 (lambda (symbol1846 module1847) (begin (if (and
(not module1847) (current-module)) (warn "module system is booted, we should
have a module" symbol1846)) (let ((v1848 (module-variable (if module1847
(resolve-module (cdr module1847)) (current-module)) symbol1846))) (and v1848
(variable-bound? v1848) (let ((val1849 (variable-ref v1848))) (and (macro?
val1849) (syncase-macro-type val1849) (cons (syncase-macro-type val1849)
(syncase-macro-binding val1849))))))))) (put-global-definition-hook1057 (lambda
(symbol1850 type1851 val1852) (let ((existing1853 (let ((v1854 (module-variable
(current-module) symbol1850))) (and v1854 (variable-bound? v1854) (let
((val1855 (variable-ref v1854))) (and (macro? val1855) (not (syncase-macro-type
val1855)) val1855)))))) (module-define! (current-module) symbol1850 (if
existing1853 (make-extended-syncase-macro existing1853 type1851 val1852)
(make-syncase-macro type1851 val1852)))))) (error-hook1056 (lambda (who1856
why1857 what1858) (error who1856 "~a ~s" why1857 what1858)))
(local-eval-hook1055 (lambda (x1859 mod1860) (primitive-eval (list noexpand1049
x1859)))) (top-level-eval-hook1054 (lambda (x1861 mod1862) (primitive-eval
(list noexpand1049 x1861)))) (fx<1053 <) (fx=1052 =) (fx-1051 -) (fx+1050 +)
(noexpand1049 "noexpand")) (begin (global-extend1080 (quote local-syntax)
(quote letrec-syntax) #t) (global-extend1080 (quote local-syntax) (quote
let-syntax) #f) (global-extend1080 (quote core) (quote fluid-let-syntax)
(lambda (e1863 r1864 w1865 s1866 mod1867) ((lambda (tmp1868) ((lambda (tmp1869)
(if (if tmp1869 (apply (lambda (_1870 var1871 val1872 e11873 e21874)
(valid-bound-ids?1107 var1871)) tmp1869) #f) (apply (lambda (_1876 var1877
val1878 e11879 e21880) (let ((names1881 (map (lambda (x1882) (id-var-name1104
x1882 w1865)) var1877))) (begin (for-each (lambda (id1884 n1885) (let ((t1886
(binding-type1074 (lookup1079 n1885 r1864 mod1867)))) (if (memv t1886 (quote
(displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier
out of context" e1863 (source-wrap1111 id1884 w1865 s1866 mod1867))))) var1877
names1881) (chi-body1122 (cons e11879 e21880) (source-wrap1111 e1863 w1865
s1866 mod1867) (extend-env1076 names1881 (let ((trans-r1889
(macros-only-env1078 r1864))) (map (lambda (x1890) (cons (quote macro)
(eval-local-transformer1125 (chi1118 x1890 trans-r1889 w1865 mod1867)
mod1867))) val1878)) r1864) w1865 mod1867)))) tmp1869) ((lambda (_1892)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1111 e1863
w1865 s1866 mod1867))) tmp1868))) ($sc-dispatch tmp1868 (quote (any #(each (any
any)) any . each-any))))) e1863))) (global-extend1080 (quote core) (quote
quote) (lambda (e1893 r1894 w1895 s1896 mod1897) ((lambda (tmp1898) ((lambda
(tmp1899) (if tmp1899 (apply (lambda (_1900 e1901) (build-data1060 s1896
(strip1129 e1901 w1895))) tmp1899) ((lambda (_1902) (syntax-violation (quote
quote) "bad syntax" (source-wrap1111 e1893 w1895 s1896 mod1897))) tmp1898)))
($sc-dispatch tmp1898 (quote (any any))))) e1893))) (global-extend1080 (quote
core) (quote syntax) (letrec ((regen1910 (lambda (x1911) (let ((t1912 (car
x1911))) (if (memv t1912 (quote (ref))) (build-annotated1059 #f (cadr x1911))
(if (memv t1912 (quote (primitive))) (build-annotated1059 #f (cadr x1911)) (if
(memv t1912 (quote (quote))) (build-data1060 #f (cadr x1911)) (if (memv t1912
(quote (lambda))) (build-annotated1059 #f (list (quote lambda) (cadr x1911)
(regen1910 (caddr x1911)))) (if (memv t1912 (quote (map))) (let ((ls1913 (map
regen1910 (cdr x1911)))) (build-annotated1059 #f (cons (if (fx=1052 (length
ls1913) 2) (build-annotated1059 #f (quote map)) (build-annotated1059 #f (quote
map))) ls1913))) (build-annotated1059 #f (cons (build-annotated1059 #f (car
x1911)) (map regen1910 (cdr x1911)))))))))))) (gen-vector1909 (lambda (x1914)
(cond ((eq? (car x1914) (quote list)) (cons (quote vector) (cdr x1914))) ((eq?
(car x1914) (quote quote)) (list (quote quote) (list->vector (cadr x1914))))
(else (list (quote list->vector) x1914))))) (gen-append1908 (lambda (x1915
y1916) (if (equal? y1916 (quote (quote ()))) x1915 (list (quote append) x1915
y1916)))) (gen-cons1907 (lambda (x1917 y1918) (let ((t1919 (car y1918))) (if
(memv t1919 (quote (quote))) (if (eq? (car x1917) (quote quote)) (list (quote
quote) (cons (cadr x1917) (cadr y1918))) (if (eq? (cadr y1918) (quote ()))
(list (quote list) x1917) (list (quote cons) x1917 y1918))) (if (memv t1919
(quote (list))) (cons (quote list) (cons x1917 (cdr y1918))) (list (quote cons)
x1917 y1918)))))) (gen-map1906 (lambda (e1920 map-env1921) (let ((formals1922
(map cdr map-env1921)) (actuals1923 (map (lambda (x1924) (list (quote ref) (car
x1924))) map-env1921))) (cond ((eq? (car e1920) (quote ref)) (car actuals1923))
((andmap (lambda (x1925) (and (eq? (car x1925) (quote ref)) (memq (cadr x1925)
formals1922))) (cdr e1920)) (cons (quote map) (cons (list (quote primitive)
(car e1920)) (map (let ((r1926 (map cons formals1922 actuals1923))) (lambda
(x1927) (cdr (assq (cadr x1927) r1926)))) (cdr e1920))))) (else (cons (quote
map) (cons (list (quote lambda) formals1922 e1920) actuals1923)))))))
(gen-mappend1905 (lambda (e1928 map-env1929) (list (quote apply) (quote
(primitive append)) (gen-map1906 e1928 map-env1929)))) (gen-ref1904 (lambda
(src1930 var1931 level1932 maps1933) (if (fx=1052 level1932 0) (values var1931
maps1933) (if (null? maps1933) (syntax-violation (quote syntax) "missing
ellipsis" src1930) (call-with-values (lambda () (gen-ref1904 src1930 var1931
(fx-1051 level1932 1) (cdr maps1933))) (lambda (outer-var1934 outer-maps1935)
(let ((b1936 (assq outer-var1934 (car maps1933)))) (if b1936 (values (cdr
b1936) maps1933) (let ((inner-var1937 (gen-var1130 (quote tmp)))) (values
inner-var1937 (cons (cons (cons outer-var1934 inner-var1937) (car maps1933))
outer-maps1935))))))))))) (gen-syntax1903 (lambda (src1938 e1939 r1940 maps1941
ellipsis?1942 mod1943) (if (id?1082 e1939) (let ((label1944 (id-var-name1104
e1939 (quote (()))))) (let ((b1945 (lookup1079 label1944 r1940 mod1943))) (if
(eq? (binding-type1074 b1945) (quote syntax)) (call-with-values (lambda () (let
((var.lev1946 (binding-value1075 b1945))) (gen-ref1904 src1938 (car
var.lev1946) (cdr var.lev1946) maps1941))) (lambda (var1947 maps1948) (values
(list (quote ref) var1947) maps1948))) (if (ellipsis?1942 e1939)
(syntax-violation (quote syntax) "misplaced ellipsis" src1938) (values (list
(quote quote) e1939) maps1941))))) ((lambda (tmp1949) ((lambda (tmp1950) (if
(if tmp1950 (apply (lambda (dots1951 e1952) (ellipsis?1942 dots1951)) tmp1950)
#f) (apply (lambda (dots1953 e1954) (gen-syntax1903 src1938 e1954 r1940
maps1941 (lambda (x1955) #f) mod1943)) tmp1950) ((lambda (tmp1956) (if (if
tmp1956 (apply (lambda (x1957 dots1958 y1959) (ellipsis?1942 dots1958))
tmp1956) #f) (apply (lambda (x1960 dots1961 y1962) (let f1963 ((y1964 y1962)
(k1965 (lambda (maps1966) (call-with-values (lambda () (gen-syntax1903 src1938
x1960 r1940 (cons (quote ()) maps1966) ellipsis?1942 mod1943)) (lambda (x1967
maps1968) (if (null? (car maps1968)) (syntax-violation (quote syntax) "extra
ellipsis" src1938) (values (gen-map1906 x1967 (car maps1968)) (cdr
maps1968)))))))) ((lambda (tmp1969) ((lambda (tmp1970) (if (if tmp1970 (apply
(lambda (dots1971 y1972) (ellipsis?1942 dots1971)) tmp1970) #f) (apply (lambda
(dots1973 y1974) (f1963 y1974 (lambda (maps1975) (call-with-values (lambda ()
(k1965 (cons (quote ()) maps1975))) (lambda (x1976 maps1977) (if (null? (car
maps1977)) (syntax-violation (quote syntax) "extra ellipsis" src1938) (values
(gen-mappend1905 x1976 (car maps1977)) (cdr maps1977)))))))) tmp1970) ((lambda
(_1978) (call-with-values (lambda () (gen-syntax1903 src1938 y1964 r1940
maps1941 ellipsis?1942 mod1943)) (lambda (y1979 maps1980) (call-with-values
(lambda () (k1965 maps1980)) (lambda (x1981 maps1982) (values (gen-append1908
x1981 y1979) maps1982)))))) tmp1969))) ($sc-dispatch tmp1969 (quote (any .
any))))) y1964))) tmp1956) ((lambda (tmp1983) (if tmp1983 (apply (lambda (x1984
y1985) (call-with-values (lambda () (gen-syntax1903 src1938 x1984 r1940
maps1941 ellipsis?1942 mod1943)) (lambda (x1986 maps1987) (call-with-values
(lambda () (gen-syntax1903 src1938 y1985 r1940 maps1987 ellipsis?1942 mod1943))
(lambda (y1988 maps1989) (values (gen-cons1907 x1986 y1988) maps1989))))))
tmp1983) ((lambda (tmp1990) (if tmp1990 (apply (lambda (e11991 e21992)
(call-with-values (lambda () (gen-syntax1903 src1938 (cons e11991 e21992) r1940
maps1941 ellipsis?1942 mod1943)) (lambda (e1994 maps1995) (values
(gen-vector1909 e1994) maps1995)))) tmp1990) ((lambda (_1996) (values (list
(quote quote) e1939) maps1941)) tmp1949))) ($sc-dispatch tmp1949 (quote
#(vector (any . each-any))))))) ($sc-dispatch tmp1949 (quote (any . any))))))
($sc-dispatch tmp1949 (quote (any any . any)))))) ($sc-dispatch tmp1949 (quote
(any any))))) e1939))))) (lambda (e1997 r1998 w1999 s2000 mod2001) (let ((e2002
(source-wrap1111 e1997 w1999 s2000 mod2001))) ((lambda (tmp2003) ((lambda
(tmp2004) (if tmp2004 (apply (lambda (_2005 x2006) (call-with-values (lambda ()
(gen-syntax1903 e2002 x2006 r1998 (quote ()) ellipsis?1127 mod2001)) (lambda
(e2007 maps2008) (regen1910 e2007)))) tmp2004) ((lambda (_2009)
(syntax-violation (quote syntax) "bad `syntax' form" e2002)) tmp2003)))
($sc-dispatch tmp2003 (quote (any any))))) e2002))))) (global-extend1080 (quote
core) (quote lambda) (lambda (e2010 r2011 w2012 s2013 mod2014) ((lambda
(tmp2015) ((lambda (tmp2016) (if tmp2016 (apply (lambda (_2017 c2018)
(chi-lambda-clause1123 (source-wrap1111 e2010 w2012 s2013 mod2014) #f c2018
r2011 w2012 mod2014 (lambda (vars2019 docstring2020 body2021)
(build-annotated1059 s2013 (cons (quote lambda) (cons vars2019 (append (if
docstring2020 (list docstring2020) (quote ())) (list body2021)))))))) tmp2016)
(syntax-violation #f "source expression failed to match any pattern" tmp2015)))
($sc-dispatch tmp2015 (quote (any . any))))) e2010))) (global-extend1080 (quote
core) (quote let) (letrec ((chi-let2022 (lambda (e2023 r2024 w2025 s2026
mod2027 constructor2028 ids2029 vals2030 exps2031) (if (not
(valid-bound-ids?1107 ids2029)) (syntax-violation (quote let) "duplicate bound
variable" e2023) (let ((labels2032 (gen-labels1088 ids2029)) (new-vars2033 (map
gen-var1130 ids2029))) (let ((nw2034 (make-binding-wrap1099 ids2029 labels2032
w2025)) (nr2035 (extend-var-env1077 labels2032 new-vars2033 r2024)))
(constructor2028 s2026 new-vars2033 (map (lambda (x2036) (chi1118 x2036 r2024
w2025 mod2027)) vals2030) (chi-body1122 exps2031 (source-wrap1111 e2023 nw2034
s2026 mod2027) nr2035 nw2034 mod2027)))))))) (lambda (e2037 r2038 w2039 s2040
mod2041) ((lambda (tmp2042) ((lambda (tmp2043) (if tmp2043 (apply (lambda
(_2044 id2045 val2046 e12047 e22048) (chi-let2022 e2037 r2038 w2039 s2040
mod2041 build-let1062 id2045 val2046 (cons e12047 e22048))) tmp2043) ((lambda
(tmp2052) (if (if tmp2052 (apply (lambda (_2053 f2054 id2055 val2056 e12057
e22058) (id?1082 f2054)) tmp2052) #f) (apply (lambda (_2059 f2060 id2061
val2062 e12063 e22064) (chi-let2022 e2037 r2038 w2039 s2040 mod2041
build-named-let1063 (cons f2060 id2061) val2062 (cons e12063 e22064))) tmp2052)
((lambda (_2068) (syntax-violation (quote let) "bad let" (source-wrap1111 e2037
w2039 s2040 mod2041))) tmp2042))) ($sc-dispatch tmp2042 (quote (any any #(each
(any any)) any . each-any)))))) ($sc-dispatch tmp2042 (quote (any #(each (any
any)) any . each-any))))) e2037)))) (global-extend1080 (quote core) (quote
letrec) (lambda (e2069 r2070 w2071 s2072 mod2073) ((lambda (tmp2074) ((lambda
(tmp2075) (if tmp2075 (apply (lambda (_2076 id2077 val2078 e12079 e22080) (let
((ids2081 id2077)) (if (not (valid-bound-ids?1107 ids2081)) (syntax-violation
(quote letrec) "duplicate bound variable" e2069) (let ((labels2083
(gen-labels1088 ids2081)) (new-vars2084 (map gen-var1130 ids2081))) (let
((w2085 (make-binding-wrap1099 ids2081 labels2083 w2071)) (r2086
(extend-var-env1077 labels2083 new-vars2084 r2070))) (build-letrec1064 s2072
new-vars2084 (map (lambda (x2087) (chi1118 x2087 r2086 w2085 mod2073)) val2078)
(chi-body1122 (cons e12079 e22080) (source-wrap1111 e2069 w2085 s2072 mod2073)
r2086 w2085 mod2073))))))) tmp2075) ((lambda (_2090) (syntax-violation (quote
letrec) "bad letrec" (source-wrap1111 e2069 w2071 s2072 mod2073))) tmp2074)))
($sc-dispatch tmp2074 (quote (any #(each (any any)) any . each-any)))))
e2069))) (global-extend1080 (quote core) (quote set!) (lambda (e2091 r2092
w2093 s2094 mod2095) ((lambda (tmp2096) ((lambda (tmp2097) (if (if tmp2097
(apply (lambda (_2098 id2099 val2100) (id?1082 id2099)) tmp2097) #f) (apply
(lambda (_2101 id2102 val2103) (let ((val2104 (chi1118 val2103 r2092 w2093
mod2095)) (n2105 (id-var-name1104 id2102 w2093))) (let ((b2106 (lookup1079
n2105 r2092 mod2095))) (let ((t2107 (binding-type1074 b2106))) (if (memv t2107
(quote (lexical))) (build-annotated1059 s2094 (list (quote set!)
(binding-value1075 b2106) val2104)) (if (memv t2107 (quote (global)))
(build-annotated1059 s2094 (list (quote set!) (if mod2095 (make-module-ref (cdr
mod2095) n2105 (car mod2095)) (make-module-ref mod2095 n2105 (quote bare)))
val2104)) (if (memv t2107 (quote (displaced-lexical))) (syntax-violation (quote
set!) "identifier out of context" (wrap1110 id2102 w2093 mod2095))
(syntax-violation (quote set!) "bad set!" (source-wrap1111 e2091 w2093 s2094
mod2095))))))))) tmp2097) ((lambda (tmp2108) (if tmp2108 (apply (lambda (_2109
head2110 tail2111 val2112) (call-with-values (lambda () (syntax-type1116
head2110 r2092 (quote (())) #f #f mod2095)) (lambda (type2113 value2114 ee2115
ww2116 ss2117 modmod2118) (let ((t2119 type2113)) (if (memv t2119 (quote
(module-ref))) (let ((val2120 (chi1118 val2112 r2092 w2093 mod2095)))
(call-with-values (lambda () (value2114 (cons head2110 tail2111))) (lambda
(id2122 mod2123) (build-annotated1059 s2094 (list (quote set!) (if mod2123
(make-module-ref (cdr mod2123) id2122 (car mod2123)) (make-module-ref mod2123
id2122 (quote bare))) val2120))))) (build-annotated1059 s2094 (cons (chi1118
(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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) head2110) r2092
w2093 mod2095) (map (lambda (e2124) (chi1118 e2124 r2092 w2093 mod2095))
(append tail2111 (list val2112)))))))))) tmp2108) ((lambda (_2126)
(syntax-violation (quote set!) "bad set!" (source-wrap1111 e2091 w2093 s2094
mod2095))) tmp2096))) ($sc-dispatch tmp2096 (quote (any (any . each-any)
any)))))) ($sc-dispatch tmp2096 (quote (any any any))))) e2091)))
(global-extend1080 (quote module-ref) (quote @) (lambda (e2127) ((lambda
(tmp2128) ((lambda (tmp2129) (if (if tmp2129 (apply (lambda (_2130 mod2131
id2132) (and (andmap id?1082 mod2131) (id?1082 id2132))) tmp2129) #f) (apply
(lambda (_2134 mod2135 id2136) (values (syntax->datum id2136) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) mod2135))))
tmp2129) (syntax-violation #f "source expression failed to match any pattern"
tmp2128))) ($sc-dispatch tmp2128 (quote (any each-any any))))) e2127)))
(global-extend1080 (quote module-ref) (quote @@) (lambda (e2138) ((lambda
(tmp2139) ((lambda (tmp2140) (if (if tmp2140 (apply (lambda (_2141 mod2142
id2143) (and (andmap id?1082 mod2142) (id?1082 id2143))) tmp2140) #f) (apply
(lambda (_2145 mod2146 id2147) (values (syntax->datum id2147) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) mod2146))))
tmp2140) (syntax-violation #f "source expression failed to match any pattern"
tmp2139))) ($sc-dispatch tmp2139 (quote (any each-any any))))) e2138)))
(global-extend1080 (quote begin) (quote begin) (quote ())) (global-extend1080
(quote define) (quote define) (quote ())) (global-extend1080 (quote
define-syntax) (quote define-syntax) (quote ())) (global-extend1080 (quote
eval-when) (quote eval-when) (quote ())) (global-extend1080 (quote core) (quote
syntax-case) (letrec ((gen-syntax-case2152 (lambda (x2153 keys2154 clauses2155
r2156 mod2157) (if (null? clauses2155) (build-annotated1059 #f (list
(build-annotated1059 #f (quote syntax-violation)) #f "source expression failed
to match any pattern" x2153)) ((lambda (tmp2158) ((lambda (tmp2159) (if tmp2159
(apply (lambda (pat2160 exp2161) (if (and (id?1082 pat2160) (andmap (lambda
(x2162) (not (free-id=?1105 pat2160 x2162))) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) keys2154))) (let
((labels2163 (list (gen-label1087))) (var2164 (gen-var1130 pat2160)))
(build-annotated1059 #f (list (build-annotated1059 #f (list (quote lambda)
(list var2164) (chi1118 exp2161 (extend-env1076 labels2163 (list (cons (quote
syntax) (cons var2164 0))) r2156) (make-binding-wrap1099 (list pat2160)
labels2163 (quote (()))) mod2157))) x2153))) (gen-clause2151 x2153 keys2154
(cdr clauses2155) r2156 pat2160 #t exp2161 mod2157))) tmp2159) ((lambda
(tmp2165) (if tmp2165 (apply (lambda (pat2166 fender2167 exp2168)
(gen-clause2151 x2153 keys2154 (cdr clauses2155) r2156 pat2166 fender2167
exp2168 mod2157)) tmp2165) ((lambda (_2169) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses2155))) tmp2158))) ($sc-dispatch
tmp2158 (quote (any any any)))))) ($sc-dispatch tmp2158 (quote (any any)))))
(car clauses2155))))) (gen-clause2151 (lambda (x2170 keys2171 clauses2172 r2173
pat2174 fender2175 exp2176 mod2177) (call-with-values (lambda ()
(convert-pattern2149 pat2174 keys2171)) (lambda (p2178 pvars2179) (cond ((not
(distinct-bound-ids?1108 (map car pvars2179))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat2174)) ((not (andmap (lambda
(x2180) (not (ellipsis?1127 (car x2180)))) pvars2179)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat2174)) (else (let ((y2181 (gen-var1130
(quote tmp)))) (build-annotated1059 #f (list (build-annotated1059 #f (list
(quote lambda) (list y2181) (let ((y2182 (build-annotated1059 #f y2181)))
(build-annotated1059 #f (list (quote if) ((lambda (tmp2183) ((lambda (tmp2184)
(if tmp2184 (apply (lambda () y2182) tmp2184) ((lambda (_2185)
(build-annotated1059 #f (list (quote if) y2182 (build-dispatch-call2150
pvars2179 fender2175 y2182 r2173 mod2177) (build-data1060 #f #f)))) tmp2183)))
($sc-dispatch tmp2183 (quote #(atom #t))))) fender2175)
(build-dispatch-call2150 pvars2179 exp2176 y2182 r2173 mod2177)
(gen-syntax-case2152 x2170 keys2171 clauses2172 r2173 mod2177)))))) (if (eq?
p2178 (quote any)) (build-annotated1059 #f (list (build-annotated1059 #f (quote
list)) x2170)) (build-annotated1059 #f (list (build-annotated1059 #f (quote
$sc-dispatch)) x2170 (build-data1060 #f p2178)))))))))))))
(build-dispatch-call2150 (lambda (pvars2186 exp2187 y2188 r2189 mod2190) (let
((ids2191 (map car pvars2186)) (levels2192 (map cdr pvars2186))) (let
((labels2193 (gen-labels1088 ids2191)) (new-vars2194 (map gen-var1130
ids2191))) (build-annotated1059 #f (list (build-annotated1059 #f (quote apply))
(build-annotated1059 #f (list (quote lambda) new-vars2194 (chi1118 exp2187
(extend-env1076 labels2193 (map (lambda (var2195 level2196) (cons (quote
syntax) (cons var2195 level2196))) new-vars2194 (map cdr pvars2186)) r2189)
(make-binding-wrap1099 ids2191 labels2193 (quote (()))) mod2190))) y2188))))))
(convert-pattern2149 (lambda (pattern2197 keys2198) (let cvt2199 ((p2200
pattern2197) (n2201 0) (ids2202 (quote ()))) (if (id?1082 p2200) (if
(bound-id-member?1109 p2200 keys2198) (values (vector (quote free-id) p2200)
ids2202) (values (quote any) (cons (cons p2200 n2201) ids2202))) ((lambda
(tmp2203) ((lambda (tmp2204) (if (if tmp2204 (apply (lambda (x2205 dots2206)
(ellipsis?1127 dots2206)) tmp2204) #f) (apply (lambda (x2207 dots2208)
(call-with-values (lambda () (cvt2199 x2207 (fx+1050 n2201 1) ids2202)) (lambda
(p2209 ids2210) (values (if (eq? p2209 (quote any)) (quote each-any) (vector
(quote each) p2209)) ids2210)))) tmp2204) ((lambda (tmp2211) (if tmp2211 (apply
(lambda (x2212 y2213) (call-with-values (lambda () (cvt2199 y2213 n2201
ids2202)) (lambda (y2214 ids2215) (call-with-values (lambda () (cvt2199 x2212
n2201 ids2215)) (lambda (x2216 ids2217) (values (cons x2216 y2214)
ids2217)))))) tmp2211) ((lambda (tmp2218) (if tmp2218 (apply (lambda () (values
(quote ()) ids2202)) tmp2218) ((lambda (tmp2219) (if tmp2219 (apply (lambda
(x2220) (call-with-values (lambda () (cvt2199 x2220 n2201 ids2202)) (lambda
(p2222 ids2223) (values (vector (quote vector) p2222) ids2223)))) tmp2219)
((lambda (x2224) (values (vector (quote atom) (strip1129 p2200 (quote (()))))
ids2202)) tmp2203))) ($sc-dispatch tmp2203 (quote #(vector each-any))))))
($sc-dispatch tmp2203 (quote ()))))) ($sc-dispatch tmp2203 (quote (any .
any)))))) ($sc-dispatch tmp2203 (quote (any any))))) p2200)))))) (lambda (e2225
r2226 w2227 s2228 mod2229) (let ((e2230 (source-wrap1111 e2225 w2227 s2228
mod2229))) ((lambda (tmp2231) ((lambda (tmp2232) (if tmp2232 (apply (lambda
(_2233 val2234 key2235 m2236) (if (andmap (lambda (x2237) (and (id?1082 x2237)
(not (ellipsis?1127 x2237)))) key2235) (let ((x2239 (gen-var1130 (quote tmp))))
(build-annotated1059 s2228 (list (build-annotated1059 #f (list (quote lambda)
(list x2239) (gen-syntax-case2152 (build-annotated1059 #f x2239) key2235 m2236
r2226 mod2229))) (chi1118 val2234 r2226 (quote (())) mod2229))))
(syntax-violation (quote syntax-case) "invalid literals list" e2230))) tmp2232)
(syntax-violation #f "source expression failed to match any pattern" tmp2231)))
($sc-dispatch tmp2231 (quote (any any each-any . each-any))))) e2230))))) (set!
sc-expand (let ((m2242 (quote e)) (esew2243 (quote (eval)))) (lambda (x2244)
(if (and (pair? x2244) (equal? (car x2244) noexpand1049)) (cadr x2244)
(chi-top1117 x2244 (quote ()) (quote ((top))) m2242 esew2243 (cons (quote
hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2245
(quote e)) (esew2246 (quote (eval)))) (lambda (x2248 . rest2247) (if (and
(pair? x2248) (equal? (car x2248) noexpand1049)) (cadr x2248) (chi-top1117
x2248 (quote ()) (quote ((top))) (if (null? rest2247) m2245 (car rest2247)) (if
(or (null? rest2247) (null? (cdr rest2247))) esew2246 (cadr rest2247)) (cons
(quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda
(x2249) (nonsymbol-id?1081 x2249))) (set! datum->syntax (lambda (id2250
datum2251) (make-syntax-object1065 datum2251 (syntax-object-wrap1068 id2250)
#f))) (set! syntax->datum (lambda (x2252) (strip1129 x2252 (quote (())))))
(set! generate-temporaries (lambda (ls2253) (begin (let ((x2254 ls2253)) (if
(not (list? x2254)) (error-hook1056 (quote generate-temporaries) "invalid
argument" x2254))) (map (lambda (x2255) (wrap1110 (gensym) (quote ((top))) #f))
ls2253)))) (set! free-identifier=? (lambda (x2256 y2257) (begin (let ((x2258
x2256)) (if (not (nonsymbol-id?1081 x2258)) (error-hook1056 (quote
free-identifier=?) "invalid argument" x2258))) (let ((x2259 y2257)) (if (not
(nonsymbol-id?1081 x2259)) (error-hook1056 (quote free-identifier=?) "invalid
argument" x2259))) (free-id=?1105 x2256 y2257)))) (set! bound-identifier=?
(lambda (x2260 y2261) (begin (let ((x2262 x2260)) (if (not (nonsymbol-id?1081
x2262)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2262)))
(let ((x2263 y2261)) (if (not (nonsymbol-id?1081 x2263)) (error-hook1056 (quote
bound-identifier=?) "invalid argument" x2263))) (bound-id=?1106 x2260 y2261))))
(set! syntax-violation (lambda (who2267 message2266 form2265 . subform2264)
(begin (let ((x2268 who2267)) (if (not ((lambda (x2269) (or (not x2269)
(string? x2269) (symbol? x2269))) x2268)) (error-hook1056 (quote
syntax-violation) "invalid argument" x2268))) (let ((x2270 message2266)) (if
(not (string? x2270)) (error-hook1056 (quote syntax-violation) "invalid
argument" x2270))) (scm-error (quote syntax-error) (quote sc-expand)
(string-append (if who2267 "~a: " "") "~a " (if (null? subform2264) "in ~a" "in
subform `~s' of `~s'")) (let ((tail2271 (cons message2266 (map (lambda (x2272)
(strip1129 x2272 (quote (())))) (append subform2264 (list form2265)))))) (if
who2267 (cons who2267 tail2271) tail2271)) #f)))) (set!
install-global-transformer (lambda (sym2273 v2274) (begin (let ((x2275
sym2273)) (if (not (symbol? x2275)) (error-hook1056 (quote define-syntax)
"invalid argument" x2275))) (let ((x2276 v2274)) (if (not (procedure? x2276))
(error-hook1056 (quote define-syntax) "invalid argument" x2276)))
(global-extend1080 (quote macro) sym2273 v2274)))) (letrec ((match2281 (lambda
(e2282 p2283 w2284 r2285 mod2286) (cond ((not r2285) #f) ((eq? p2283 (quote
any)) (cons (wrap1110 e2282 w2284 mod2286) r2285)) ((syntax-object?1066 e2282)
(match*2280 (let ((e2287 (syntax-object-expression1067 e2282))) (if
(annotation? e2287) (annotation-expression e2287) e2287)) p2283 (join-wraps1101
w2284 (syntax-object-wrap1068 e2282)) r2285 (syntax-object-module1069 e2282)))
(else (match*2280 (let ((e2288 e2282)) (if (annotation? e2288)
(annotation-expression e2288) e2288)) p2283 w2284 r2285 mod2286)))))
(match*2280 (lambda (e2289 p2290 w2291 r2292 mod2293) (cond ((null? p2290) (and
(null? e2289) r2292)) ((pair? p2290) (and (pair? e2289) (match2281 (car e2289)
(car p2290) w2291 (match2281 (cdr e2289) (cdr p2290) w2291 r2292 mod2293)
mod2293))) ((eq? p2290 (quote each-any)) (let ((l2294 (match-each-any2278 e2289
w2291 mod2293))) (and l2294 (cons l2294 r2292)))) (else (let ((t2295
(vector-ref p2290 0))) (if (memv t2295 (quote (each))) (if (null? e2289)
(match-empty2279 (vector-ref p2290 1) r2292) (let ((l2296 (match-each2277 e2289
(vector-ref p2290 1) w2291 mod2293))) (and l2296 (let collect2297 ((l2298
l2296)) (if (null? (car l2298)) r2292 (cons (map car l2298) (collect2297 (map
cdr l2298)))))))) (if (memv t2295 (quote (free-id))) (and (id?1082 e2289)
(free-id=?1105 (wrap1110 e2289 w2291 mod2293) (vector-ref p2290 1)) r2292) (if
(memv t2295 (quote (atom))) (and (equal? (vector-ref p2290 1) (strip1129 e2289
w2291)) r2292) (if (memv t2295 (quote (vector))) (and (vector? e2289)
(match2281 (vector->list e2289) (vector-ref p2290 1) w2291 r2292
mod2293))))))))))) (match-empty2279 (lambda (p2299 r2300) (cond ((null? p2299)
r2300) ((eq? p2299 (quote any)) (cons (quote ()) r2300)) ((pair? p2299)
(match-empty2279 (car p2299) (match-empty2279 (cdr p2299) r2300))) ((eq? p2299
(quote each-any)) (cons (quote ()) r2300)) (else (let ((t2301 (vector-ref p2299
0))) (if (memv t2301 (quote (each))) (match-empty2279 (vector-ref p2299 1)
r2300) (if (memv t2301 (quote (free-id atom))) r2300 (if (memv t2301 (quote
(vector))) (match-empty2279 (vector-ref p2299 1) r2300)))))))))
(match-each-any2278 (lambda (e2302 w2303 mod2304) (cond ((annotation? e2302)
(match-each-any2278 (annotation-expression e2302) w2303 mod2304)) ((pair?
e2302) (let ((l2305 (match-each-any2278 (cdr e2302) w2303 mod2304))) (and l2305
(cons (wrap1110 (car e2302) w2303 mod2304) l2305)))) ((null? e2302) (quote ()))
((syntax-object?1066 e2302) (match-each-any2278 (syntax-object-expression1067
e2302) (join-wraps1101 w2303 (syntax-object-wrap1068 e2302)) mod2304)) (else
#f)))) (match-each2277 (lambda (e2306 p2307 w2308 mod2309) (cond ((annotation?
e2306) (match-each2277 (annotation-expression e2306) p2307 w2308 mod2309))
((pair? e2306) (let ((first2310 (match2281 (car e2306) p2307 w2308 (quote ())
mod2309))) (and first2310 (let ((rest2311 (match-each2277 (cdr e2306) p2307
w2308 mod2309))) (and rest2311 (cons first2310 rest2311)))))) ((null? e2306)
(quote ())) ((syntax-object?1066 e2306) (match-each2277
(syntax-object-expression1067 e2306) p2307 (join-wraps1101 w2308
(syntax-object-wrap1068 e2306)) (syntax-object-module1069 e2306))) (else
#f))))) (set! $sc-dispatch (lambda (e2312 p2313) (cond ((eq? p2313 (quote any))
(list e2312)) ((syntax-object?1066 e2312) (match*2280 (let ((e2314
(syntax-object-expression1067 e2312))) (if (annotation? e2314)
(annotation-expression e2314) e2314)) p2313 (syntax-object-wrap1068 e2312)
(quote ()) (syntax-object-module1069 e2312))) (else (match*2280 (let ((e2315
e2312)) (if (annotation? e2315) (annotation-expression e2315) e2315)) p2313
(quote (())) (quote ()) #f))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x2316) ((lambda
(tmp2317) ((lambda (tmp2318) (if tmp2318 (apply (lambda (_2319 e12320 e22321)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e12320 e22321))) tmp2318) ((lambda (tmp2323) (if
tmp2323 (apply (lambda (_2324 out2325 in2326 e12327 e22328) (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))) in2326 (quote ()) (list out2325 (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 e12327 e22328))))) tmp2323) ((lambda
(tmp2330) (if tmp2330 (apply (lambda (_2331 out2332 in2333 e12334 e22335) (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))) in2333) (quote ()) (list out2332 (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 e12334 e22335))))) tmp2330) (syntax-violation #f "source
expression failed to match any pattern" tmp2317))) ($sc-dispatch tmp2317 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2317 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp2317 (quote (any () any .
each-any))))) x2316))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2339)
((lambda (tmp2340) ((lambda (tmp2341) (if tmp2341 (apply (lambda (_2342 k2343
keyword2344 pattern2345 template2346) (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 k2343 (map (lambda (tmp2349
tmp2348) (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)))
tmp2348) (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)))
tmp2349))) template2346 pattern2345)))))) tmp2341) (syntax-violation #f "source
expression failed to match any pattern" tmp2340))) ($sc-dispatch tmp2340 (quote
(any each-any . #(each ((any . any) any))))))) x2339))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x2350) ((lambda (tmp2351) ((lambda (tmp2352) (if
(if tmp2352 (apply (lambda (let*2353 x2354 v2355 e12356 e22357) (andmap
identifier? x2354)) tmp2352) #f) (apply (lambda (let*2359 x2360 v2361 e12362
e22363) (let f2364 ((bindings2365 (map list x2360 v2361))) (if (null?
bindings2365) (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
e12362 e22363))) ((lambda (tmp2369) ((lambda (tmp2370) (if tmp2370 (apply
(lambda (body2371 binding2372) (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 binding2372)
body2371)) tmp2370) (syntax-violation #f "source expression failed to match any
pattern" tmp2369))) ($sc-dispatch tmp2369 (quote (any any))))) (list (f2364
(cdr bindings2365)) (car bindings2365)))))) tmp2352) (syntax-violation #f
"source expression failed to match any pattern" tmp2351))) ($sc-dispatch
tmp2351 (quote (any #(each (any any)) any . each-any))))) x2350))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x2373) ((lambda (tmp2374) ((lambda (tmp2375)
(if tmp2375 (apply (lambda (_2376 var2377 init2378 step2379 e02380 e12381
c2382) ((lambda (tmp2383) ((lambda (tmp2384) (if tmp2384 (apply (lambda
(step2385) ((lambda (tmp2386) ((lambda (tmp2387) (if tmp2387 (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
var2377 init2378) (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))) e02380) (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 c2382 (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))) step2385))))))) tmp2387) ((lambda (tmp2392)
(if tmp2392 (apply (lambda (e12393 e22394) (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 var2377 init2378) (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))) e02380 (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 e12393 e22394)) (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 c2382 (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))) step2385))))))) tmp2392)
(syntax-violation #f "source expression failed to match any pattern" tmp2386)))
($sc-dispatch tmp2386 (quote (any . each-any)))))) ($sc-dispatch tmp2386 (quote
())))) e12381)) tmp2384) (syntax-violation #f "source expression failed to
match any pattern" tmp2383))) ($sc-dispatch tmp2383 (quote each-any)))) (map
(lambda (v2401 s2402) ((lambda (tmp2403) ((lambda (tmp2404) (if tmp2404 (apply
(lambda () v2401) tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda
(e2406) e2406) tmp2405) ((lambda (_2407) (syntax-violation (quote do) "bad step
expression" orig-x2373 s2402)) tmp2403))) ($sc-dispatch tmp2403 (quote
(any)))))) ($sc-dispatch tmp2403 (quote ())))) s2402)) var2377 step2379)))
tmp2375) (syntax-violation #f "source expression failed to match any pattern"
tmp2374))) ($sc-dispatch tmp2374 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x2373))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons2410 (lambda (x2414 y2415)
((lambda (tmp2416) ((lambda (tmp2417) (if tmp2417 (apply (lambda (x2418 y2419)
((lambda (tmp2420) ((lambda (tmp2421) (if tmp2421 (apply (lambda (dy2422)
((lambda (tmp2423) ((lambda (tmp2424) (if tmp2424 (apply (lambda (dx2425) (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 dx2425 dy2422))) tmp2424) ((lambda
(_2426) (if (null? dy2422) (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))) x2418) (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))) x2418 y2419))) tmp2423))) ($sc-dispatch
tmp2423 (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))))) x2418)) tmp2421) ((lambda (tmp2427) (if
tmp2427 (apply (lambda (stuff2428) (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 x2418 stuff2428))) tmp2427)
((lambda (else2429) (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))) x2418 y2419)) tmp2420))) ($sc-dispatch tmp2420
(quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any))))))
($sc-dispatch tmp2420 (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))))) y2419)) tmp2417) (syntax-violation #f "source expression
failed to match any pattern" tmp2416))) ($sc-dispatch tmp2416 (quote (any
any))))) (list x2414 y2415)))) (quasiappend2411 (lambda (x2430 y2431) ((lambda
(tmp2432) ((lambda (tmp2433) (if tmp2433 (apply (lambda (x2434 y2435) ((lambda
(tmp2436) ((lambda (tmp2437) (if tmp2437 (apply (lambda () x2434) tmp2437)
((lambda (_2438) (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))) x2434 y2435)) tmp2436))) ($sc-dispatch tmp2436
(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))) ()))))) y2435))
tmp2433) (syntax-violation #f "source expression failed to match any pattern"
tmp2432))) ($sc-dispatch tmp2432 (quote (any any))))) (list x2430 y2431))))
(quasivector2412 (lambda (x2439) ((lambda (tmp2440) ((lambda (x2441) ((lambda
(tmp2442) ((lambda (tmp2443) (if tmp2443 (apply (lambda (x2444) (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
x2444))) tmp2443) ((lambda (tmp2446) (if tmp2446 (apply (lambda (x2447) (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))) x2447)) tmp2446)
((lambda (_2449) (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))) x2441)) tmp2442))) ($sc-dispatch tmp2442 (quote (#(free-id
#(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) . each-any)))))) ($sc-dispatch tmp2442 (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))))) x2441)) tmp2440)) x2439))) (quasi2413 (lambda
(p2450 lev2451) ((lambda (tmp2452) ((lambda (tmp2453) (if tmp2453 (apply
(lambda (p2454) (if (= lev2451 0) p2454 (quasicons2410 (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)))) (quasi2413 (list p2454) (- lev2451 1))))) tmp2453) ((lambda
(tmp2455) (if tmp2455 (apply (lambda (p2456 q2457) (if (= lev2451 0)
(quasiappend2411 p2456 (quasi2413 q2457 lev2451)) (quasicons2410 (quasicons2410
(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))))
(quasi2413 (list p2456) (- lev2451 1))) (quasi2413 q2457 lev2451)))) tmp2455)
((lambda (tmp2458) (if tmp2458 (apply (lambda (p2459) (quasicons2410 (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)))) (quasi2413 (list p2459) (+ lev2451
1)))) tmp2458) ((lambda (tmp2460) (if tmp2460 (apply (lambda (p2461 q2462)
(quasicons2410 (quasi2413 p2461 lev2451) (quasi2413 q2462 lev2451))) tmp2460)
((lambda (tmp2463) (if tmp2463 (apply (lambda (x2464) (quasivector2412
(quasi2413 x2464 lev2451))) tmp2463) ((lambda (p2466) (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))) p2466)) tmp2452))) ($sc-dispatch tmp2452 (quote #(vector
each-any)))))) ($sc-dispatch tmp2452 (quote (any . any)))))) ($sc-dispatch
tmp2452 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ())
#(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any)))))) ($sc-dispatch tmp2452 (quote ((#(free-id #(syntax-object
unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top))
#("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top)
(top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any))))))
($sc-dispatch tmp2452 (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))))) p2450)))) (lambda (x2467) ((lambda
(tmp2468) ((lambda (tmp2469) (if tmp2469 (apply (lambda (_2470 e2471)
(quasi2413 e2471 0)) tmp2469) (syntax-violation #f "source expression failed to
match any pattern" tmp2468))) ($sc-dispatch tmp2468 (quote (any any)))))
x2467)))))
+(define include (make-syncase-macro (quote macro) (lambda (x2472) (letrec
((read-file2473 (lambda (fn2474 k2475) (let ((p2476 (open-input-file fn2474)))
(let f2477 ((x2478 (read p2476))) (if (eof-object? x2478) (begin
(close-input-port p2476) (quote ())) (cons (datum->syntax k2475 x2478) (f2477
(read p2476))))))))) ((lambda (tmp2479) ((lambda (tmp2480) (if tmp2480 (apply
(lambda (k2481 filename2482) (let ((fn2483 (syntax->datum filename2482)))
((lambda (tmp2484) ((lambda (tmp2485) (if tmp2485 (apply (lambda (exp2486)
(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))) exp2486))
tmp2485) (syntax-violation #f "source expression failed to match any pattern"
tmp2484))) ($sc-dispatch tmp2484 (quote each-any)))) (read-file2473 fn2483
k2481)))) tmp2480) (syntax-violation #f "source expression failed to match any
pattern" tmp2479))) ($sc-dispatch tmp2479 (quote (any any))))) x2472)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x2488) ((lambda
(tmp2489) ((lambda (tmp2490) (if tmp2490 (apply (lambda (_2491 e2492) (error
(quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum
e2492))) tmp2490) (syntax-violation #f "source expression failed to match any
pattern" tmp2489))) ($sc-dispatch tmp2489 (quote (any any))))) x2488))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2493)
((lambda (tmp2494) ((lambda (tmp2495) (if tmp2495 (apply (lambda (_2496 e2497)
(error (quote unquote-splicing) "expression ,@~s not valid outside of
quasiquote" (syntax->datum e2497))) tmp2495) (syntax-violation #f "source
expression failed to match any pattern" tmp2494))) ($sc-dispatch tmp2494 (quote
(any any))))) x2493))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x2498) ((lambda (tmp2499) ((lambda (tmp2500) (if
tmp2500 (apply (lambda (_2501 e2502 m12503 m22504) ((lambda (tmp2505) ((lambda
(body2506) (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))) e2502)) body2506))
tmp2505)) (let f2507 ((clause2508 m12503) (clauses2509 m22504)) (if (null?
clauses2509) ((lambda (tmp2511) ((lambda (tmp2512) (if tmp2512 (apply (lambda
(e12513 e22514) (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 e12513 e22514))) tmp2512) ((lambda (tmp2516) (if
tmp2516 (apply (lambda (k2517 e12518 e22519) (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))) k2517)) (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 e12518 e22519)))) tmp2516)
((lambda (_2522) (syntax-violation (quote case) "bad clause" x2498 clause2508))
tmp2511))) ($sc-dispatch tmp2511 (quote (each-any any . each-any))))))
($sc-dispatch tmp2511 (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))))) clause2508) ((lambda (tmp2523) ((lambda (rest2524) ((lambda
(tmp2525) ((lambda (tmp2526) (if tmp2526 (apply (lambda (k2527 e12528 e22529)
(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))) k2527)) (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 e12528 e22529)) rest2524)) tmp2526)
((lambda (_2532) (syntax-violation (quote case) "bad clause" x2498 clause2508))
tmp2525))) ($sc-dispatch tmp2525 (quote (each-any any . each-any)))))
clause2508)) tmp2523)) (f2507 (car clauses2509) (cdr clauses2509)))))))
tmp2500) (syntax-violation #f "source expression failed to match any pattern"
tmp2499))) ($sc-dispatch tmp2499 (quote (any any any . each-any))))) x2498))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2533)
((lambda (tmp2534) ((lambda (tmp2535) (if tmp2535 (apply (lambda (_2536 e2537)
(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)))
e2537)) (list (cons _2536 (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 e2537 (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)))))))))) tmp2535) (syntax-violation #f "source expression failed to
match any pattern" tmp2534))) ($sc-dispatch tmp2534 (quote (any any)))))
x2533))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 00ce0b9..2cf83f7 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -339,19 +339,31 @@
(define put-global-definition-hook
(lambda (symbol type val)
- (module-define-keyword! (current-module) symbol type val)))
-
-(define remove-global-definition-hook
- (lambda (symbol)
- (module-undefine-keyword! (current-module) symbol)))
+ (let ((existing (let ((v (module-variable (current-module) symbol)))
+ (and v (variable-bound? v)
+ (let ((val (variable-ref v)))
+ (and (macro? val)
+ (not (syncase-macro-type val))
+ val))))))
+ (module-define! (current-module)
+ symbol
+ (if existing
+ (make-extended-syncase-macro existing type val)
+ (make-syncase-macro type val))))))
(define get-global-definition-hook
(lambda (symbol module)
(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)))
+ (let ((v (module-variable (if module
+ (resolve-module (cdr module))
+ (current-module))
+ symbol)))
+ (and v (variable-bound? v)
+ (let ((val (variable-ref v)))
+ (and (macro? val) (syncase-macro-type val)
+ (cons (syncase-macro-type val)
+ (syncase-macro-binding val))))))))
)
@@ -897,8 +909,25 @@
(define chi-install-global
(lambda (name e)
(build-application no-source
- (build-primref no-source 'install-global-transformer)
- (list (build-data no-source name) e))))
+ (build-primref no-source 'define)
+ (list
+ name
+ ;; FIXME: seems nasty to call current-module here
+ (if (let ((v (module-variable (current-module) name)))
+ ;; FIXME use primitive-macro?
+ (and v (variable-bound? v) (macro? (variable-ref v))
+ (not (eq? (macro-type (variable-ref v)) 'syncase-macro))))
+ (build-application no-source
+ (build-primref no-source
'make-extended-syncase-macro)
+ (list (build-application no-source
+ (build-primref
no-source 'module-ref)
+ (list
(build-application no-source 'current-module '())
+ (build-data
no-source name)))
+ (build-data no-source 'macro)
+ e))
+ (build-application no-source
+ (build-primref no-source 'make-syncase-macro)
+ (list (build-data no-source 'macro) e)))))))
(define chi-when-list
(lambda (e when-list w)
@@ -1098,18 +1127,13 @@
(let* ((n (id-var-name value w))
(type (binding-type (lookup n r mod))))
(case type
- ((global)
+ ((global core macro module-ref)
(eval-if-c&e m
(build-global-definition s n (chi e r w mod) mod)
mod))
((displaced-lexical)
(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-violation #f "cannot define keyword at top level"
e (wrap value w mod))))))
@@ -1167,8 +1191,8 @@
(syntax-violation #f "reference to pattern variable outside syntax form"
(source-wrap e w s mod)))
((displaced-lexical)
- (syntax-violation #f (source-wrap e w s mod)
- "reference to identifier outside its scope"))
+ (syntax-violation #f "reference to identifier outside its scope"
+ (source-wrap e w s mod)))
(else (syntax-violation #f "unexpected syntax"
(source-wrap e w s mod))))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 3d5f3091e100550052abc698e980b3e86cc01b65,
Andy Wingo <=