|
| From: | Andy Wingo |
| Subject: | [Guile-commits] GNU Guile branch, master, updated. v2.1.0-41-g8dfb7bb |
| Date: | Fri, 17 Feb 2012 15:58:45 +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=8dfb7bbfd908ca883d0fdd0d868e13e6b20803ae
The branch, master has been updated
via 8dfb7bbfd908ca883d0fdd0d868e13e6b20803ae (commit)
via 6a97b1f93aace5c7c976aef51d36b3ae9cfd5630 (commit)
via 2f745b64a1eb06e9e175a1b497d5270bebff9097 (commit)
via f609480611cfd1585409fd6b1b90beb730b026cf (commit)
via 58565208bdfe7544f7e4da8762e4c331171f9876 (commit)
via cac24946da089e1e1fddf9c9dc7ae7dae9e29014 (commit)
via 38f190749da57150b5329676b6fd70ff73d66e02 (commit)
via 32fbc38fbb3c7544a45f7be3cf0a981a31681cbb (commit)
via 76b9bac565182dd7d0ffe416c3382ac7d59d93ab (commit)
via fb3a112122b6406e88adbff2299aacc5230cc8ec (commit)
from 2c84211e6317dacddfbda979ea67683e1d8fbdb4 (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 8dfb7bbfd908ca883d0fdd0d868e13e6b20803ae
Author: Andy Wingo <address@hidden>
Date: Tue Feb 14 14:30:48 2012 +0100
wrap iconv_open / iconv_close with a lock to help in thread/fork issues
* libguile/bytevectors.c (STRING_TO_UTF, scm_string_to_utf8)
(UTF_TO_STRING):
* libguile/ports.c (open_iconv_descriptors, close_iconv_descriptors):
* libguile/strings.c (scm_from_stringn, scm_to_stringn): Wrap operations
that acquire and destroy iconv contexts with a mutex. While iconv is
threadsafe, internally it uses a lock, and we need to make sure when
we fork() that no one has that lock -- so we surround it with another
one. Gross.
commit 6a97b1f93aace5c7c976aef51d36b3ae9cfd5630
Author: Andy Wingo <address@hidden>
Date: Wed Feb 8 19:57:41 2012 +0100
install pthread_atfork handlers for guile's static mutexen
* libguile/async.c:
* libguile/deprecation.c:
* libguile/fluids.c:
* libguile/gc.c:
* libguile/instructions.c:
* libguile/ports.c:
* libguile/posix.c:
* libguile/strings.c:
* libguile/threads.c: Use the SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX
mechanism to lock a number of static mutexen.
commit 2f745b64a1eb06e9e175a1b497d5270bebff9097
Author: Andy Wingo <address@hidden>
Date: Fri Feb 17 11:35:02 2012 +0100
add pthread_atfork helpers to our threading shims
* libguile/null-threads.h:
* libguile/pthread-threads.h (SCM_DEFINE_ATFORK_HANDLERS_FOR_MUTEX)
(scm_i_pthread_atfork): Define a pthread_atfork shim, and a helper to
declare procedures to lock and unlock a mutex.
* libguile/threads.h (SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX): New macro,
causes the snarfer to emit a pthread_atfork call to lock a mutex, if
threads are enabled.
commit f609480611cfd1585409fd6b1b90beb730b026cf
Author: Andy Wingo <address@hidden>
Date: Fri Feb 17 11:47:52 2012 +0100
with a threaded guile, lock weak sets and tables during a fork
* libguile/weak-set.c (make_weak_set):
* libguile/weak-table.c (make_weak_table): If we have a threaded Guile,
* keep a weak set (table) of weak sets (tables). Use this and the
pthread_atfork mechanism to lock and unlock weak sets and weak tables
during a fork().
* libguile/weak-set.h (scm_weak_set_prehistory): New internal API.
* libguile/init.c: Add call to scm_weak_set_prehistory().
commit 58565208bdfe7544f7e4da8762e4c331171f9876
Merge: 2c84211 cac2494
Author: Andy Wingo <address@hidden>
Date: Fri Feb 17 10:21:50 2012 +0100
Merge remote-tracking branch 'local-2.0/stable-2.0'
Conflicts:
libguile/read.c
libguile/srcprop.c
module/ice-9/psyntax-pp.scm
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-debug.texi | 10 +-
libguile/async.c | 3 +-
libguile/bytevectors.c | 6 +
libguile/deprecation.c | 3 +-
libguile/fluids.c | 1 +
libguile/gc.c | 3 +-
libguile/init.c | 1 +
libguile/instructions.c | 3 +-
libguile/null-threads.h | 5 +-
libguile/ports.c | 11 +
libguile/posix.c | 3 +-
libguile/pthread-threads.h | 10 +-
libguile/read.c | 8 +-
libguile/srcprop.c | 63 +-
libguile/srcprop.h | 4 +-
libguile/strings.c | 26 +
libguile/strings.h | 5 +-
libguile/threads.c | 3 +
libguile/threads.h | 6 +-
libguile/weak-set.c | 108 +-
libguile/weak-set.h | 5 +-
libguile/weak-table.c | 108 +-
module/ice-9/psyntax-pp.scm |19905 ++++++++++++++++++++++-------------------
module/ice-9/psyntax.scm | 15 +-
test-suite/tests/srcprop.test | 48 +-
25 files changed, 11190 insertions(+), 9173 deletions(-)
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index c5fbe56..dd2a3d1 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -239,8 +239,8 @@ Guile's debugger can point back to the file and location
where the
expression originated.
The way that source properties are stored means that Guile cannot
-associate source properties with individual numbers, symbols,
-characters, booleans, or keywords. This can be seen by typing
+associate source properties with individual symbols, keywords,
+characters, booleans, or small integers. This can be seen by typing
@code{(xxx)} and @code{xxx} at the Guile prompt (where the variable
@code{xxx} has not been defined):
@@ -258,6 +258,12 @@ ERROR: Unbound variable: xxx
In the latter case, no source properties were stored, so the error
doesn't have any source information.
address@hidden {Scheme Procedure} supports-source-properties? obj
address@hidden {C Function} scm_supports_source_properties_p (obj)
+Return #t if source properties can be associated with @var{obj},
+otherwise return #f.
address@hidden deffn
+
The recording of source properties is controlled by the read option
named ``positions'' (@pxref{Scheme Read}). This option is switched
@emph{on} by default.
diff --git a/libguile/async.c b/libguile/async.c
index 80f561d..e873997 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008, 2009,
2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008, 2009,
2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -133,6 +133,7 @@ SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0,
static scm_i_pthread_mutex_t async_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (async_mutex);
/* System asyncs. */
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 668c46d..6ea60f8 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -1934,10 +1934,12 @@ utf_encoding_name (char *name, size_t utf_width, SCM
endianness)
c_strlen = scm_i_string_length (str); \
if (scm_i_is_narrow_string (str)) \
{ \
+ scm_i_lock_iconv (); \
err = mem_iconveh (scm_i_string_chars (str), c_strlen, \
"ISO-8859-1", c_utf_name, \
iconveh_question_mark, NULL, \
&c_utf, &c_utf_len); \
+ scm_i_unlock_iconv (); \
if (SCM_UNLIKELY (err)) \
scm_syserror_msg (FUNC_NAME, "failed to convert string: ~A", \
scm_list_1 (str), err); \
@@ -1945,10 +1947,12 @@ utf_encoding_name (char *name, size_t utf_width, SCM
endianness)
else \
{ \
const scm_t_wchar *wbuf = scm_i_string_wide_chars (str); \
+ scm_i_lock_iconv (); \
c_utf = u32_conv_to_encoding (c_utf_name, \
iconveh_question_mark, \
(scm_t_uint32 *) wbuf, \
c_strlen, NULL, NULL, &c_utf_len); \
+ scm_i_unlock_iconv (); \
if (SCM_UNLIKELY (c_utf == NULL)) \
scm_syserror_msg (FUNC_NAME, "failed to convert string: ~A", \
scm_list_1 (str), errno); \
@@ -2050,10 +2054,12 @@ SCM_DEFINE (scm_string_to_utf32, "string->utf32",
c_utf = (char *) SCM_BYTEVECTOR_CONTENTS (utf); \
utf_encoding_name (c_utf_name, (_utf_width), endianness); \
\
+ scm_i_lock_iconv (); \
err = mem_iconveh (c_utf, c_utf_len, \
c_utf_name, "UTF-8", \
iconveh_question_mark, NULL, \
&c_str, &c_strlen); \
+ scm_i_unlock_iconv (); \
if (SCM_UNLIKELY (err)) \
scm_syserror_msg (FUNC_NAME, "failed to convert to string: ~A", \
scm_list_1 (utf), err); \
diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index 5c1a246..cb5377a 100644
--- a/libguile/deprecation.c
+++ b/libguile/deprecation.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2006, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2006, 2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -48,6 +48,7 @@ struct issued_warning {
};
static scm_i_pthread_mutex_t warn_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (warn_lock);
static struct issued_warning *issued_warnings;
static int print_summary = 0;
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 282718e..e4906a4 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -44,6 +44,7 @@ static void **allocated_fluids = NULL;
static size_t allocated_fluids_len = 0;
static scm_i_pthread_mutex_t fluid_admin_mutex =
SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (fluid_admin_mutex);
#define IS_FLUID(x) SCM_FLUID_P (x)
#define FLUID_NUM(x) SCM_I_FLUID_NUM (x)
diff --git a/libguile/gc.c b/libguile/gc.c
index 6d44f5e..2c026b7 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008,
2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008,
2009, 2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -647,6 +647,7 @@ scm_storage_prehistory ()
}
scm_i_pthread_mutex_t scm_i_gc_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (scm_i_gc_admin_mutex);
void
scm_init_gc_protect_object ()
diff --git a/libguile/init.c b/libguile/init.c
index 3509ba3..35fbedb 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -383,6 +383,7 @@ scm_i_init_guile (void *base)
scm_storage_prehistory ();
scm_threads_prehistory (base); /* requires storage_prehistory */
+ scm_weak_set_prehistory (); /* requires storage_prehistory */
scm_weak_table_prehistory (); /* requires storage_prehistory */
#ifdef GUILE_DEBUG_MALLOC
scm_debug_malloc_prehistory ();
diff --git a/libguile/instructions.c b/libguile/instructions.c
index f3b8963..2646f90 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -48,6 +48,7 @@ struct scm_instruction {
static scm_i_pthread_mutex_t itable_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (itable_lock);
static struct scm_instruction*
diff --git a/libguile/null-threads.h b/libguile/null-threads.h
index 116b845..4779ee0 100644
--- a/libguile/null-threads.h
+++ b/libguile/null-threads.h
@@ -3,7 +3,7 @@
#ifndef SCM_NULL_THREADS_H
#define SCM_NULL_THREADS_H
-/* Copyright (C) 2005, 2006, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2005, 2006, 2010, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -102,6 +102,9 @@ SCM_API int scm_i_pthread_key_create (scm_i_pthread_key_t
*key,
#define scm_i_scm_pthread_cond_wait scm_i_pthread_cond_wait
#define scm_i_scm_pthread_cond_timedwait scm_i_pthread_cond_timedwait
+#define SCM_DEFINE_ATFORK_HANDLERS_FOR_MUTEX(m,lock,unlock) /* noop */
+#define scm_i_pthread_atfork(pre,parent,child) do {} while (0)
+
#endif /* SCM_NULL_THREADS_H */
diff --git a/libguile/ports.c b/libguile/ports.c
index d3fc453..414ea94 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -103,6 +103,7 @@ static long scm_numptob = 0; /* Number of port types. */
static long scm_ptobs_size = 0; /* Number of slots in the port type
table. */
static scm_i_pthread_mutex_t scm_ptobs_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (scm_ptobs_lock);
long
scm_c_num_port_types (void)
@@ -881,7 +882,9 @@ open_iconv_descriptors (const char *encoding, int reading,
int writing)
allocation. */
scm_gc_register_allocation (16 * 1024);
+ scm_i_lock_iconv ();
input_cd = iconv_open ("UTF-8", encoding);
+ scm_i_unlock_iconv ();
if (input_cd == (iconv_t) -1)
goto invalid_encoding;
}
@@ -892,11 +895,15 @@ open_iconv_descriptors (const char *encoding, int
reading, int writing)
allocation. */
scm_gc_register_allocation (16 * 1024);
+ scm_i_lock_iconv ();
output_cd = iconv_open (encoding, "UTF-8");
+ scm_i_unlock_iconv ();
if (output_cd == (iconv_t) -1)
{
+ scm_i_lock_iconv ();
if (input_cd != (iconv_t) -1)
iconv_close (input_cd);
+ scm_i_unlock_iconv ();
goto invalid_encoding;
}
}
@@ -929,10 +936,12 @@ open_iconv_descriptors (const char *encoding, int
reading, int writing)
static void
close_iconv_descriptors (scm_t_iconv_descriptors *id)
{
+ scm_i_lock_iconv ();
if (id->input_cd != (iconv_t) -1)
iconv_close (id->input_cd);
if (id->output_cd != (iconv_t) -1)
iconv_close (id->output_cd);
+ scm_i_unlock_iconv ();
id->input_cd = (void *) -1;
id->output_cd = (void *) -1;
}
@@ -1936,10 +1945,12 @@ scm_ungetc_unlocked (scm_t_wchar c, SCM port)
encoding = "ISO-8859-1";
len = sizeof (result_buf);
+ scm_i_lock_iconv ();
result = u32_conv_to_encoding (encoding,
(enum iconv_ilseq_handler) pt->ilseq_handler,
(uint32_t *) &c, 1, NULL,
result_buf, &len);
+ scm_i_unlock_iconv ();
if (SCM_UNLIKELY (result == NULL || len == 0))
scm_encoding_error (FUNC_NAME, errno,
diff --git a/libguile/posix.c b/libguile/posix.c
index 154d26a..f4d93f0 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005,
2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005,
2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -1493,6 +1493,7 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
is also acquired before calls to `nl_langinfo ()'. See `i18n.c' for
details. */
scm_i_pthread_mutex_t scm_i_locale_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (scm_i_locale_mutex);
#ifdef HAVE_SETLOCALE
diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h
index b5fae4e..63b47b2 100644
--- a/libguile/pthread-threads.h
+++ b/libguile/pthread-threads.h
@@ -3,7 +3,7 @@
#ifndef SCM_PTHREADS_THREADS_H
#define SCM_PTHREADS_THREADS_H
-/* Copyright (C) 2002, 2005, 2006, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2005, 2006, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -97,6 +97,14 @@ extern pthread_mutexattr_t
scm_i_pthread_mutexattr_recursive[1];
#define scm_i_scm_pthread_cond_wait scm_pthread_cond_wait
#define scm_i_scm_pthread_cond_timedwait scm_pthread_cond_timedwait
+#define SCM_DEFINE_ATFORK_HANDLERS_FOR_MUTEX(m,lock,unlock) \
+ static void lock (void) { pthread_mutex_lock (m); } \
+ static void unlock (void) { pthread_mutex_unlock (m); }
+
+/* noop */
+#define scm_i_pthread_atfork(pre,parent,child) \
+ pthread_atfork (pre, parent, child)
+
#endif /* SCM_PTHREADS_THREADS_H */
/*
diff --git a/libguile/read.c b/libguile/read.c
index 7b53bc7..dff9d85 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -600,6 +600,10 @@ scm_read_number (scm_t_wchar chr, SCM port)
int overflow;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ /* Need to capture line and column numbers here. */
+ long line = SCM_LINUM (port);
+ int column = SCM_COL (port) - 1;
+
scm_ungetc_unlocked (chr, port);
overflow = read_complete_token (port, buffer, sizeof (buffer),
&overflow_buffer, &bytes_read);
@@ -611,13 +615,15 @@ scm_read_number (scm_t_wchar chr, SCM port)
pt->ilseq_handler);
result = scm_string_to_number (str, SCM_UNDEFINED);
- if (!scm_is_true (result))
+ if (scm_is_false (result))
{
/* Return a symbol instead of a number */
if (SCM_CASE_INSENSITIVE_P)
str = scm_string_downcase_x (str);
result = scm_string_to_symbol (str);
}
+ else if (SCM_NIMP (result))
+ result = maybe_annotate_source (result, port, line, column);
if (overflow)
free (overflow_buffer);
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index f63f1bc..cc71fd1 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002, 2006, 2008, 2009,
2010, 2011 Free Software Foundation
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2006,
+ * 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -91,6 +92,14 @@ static SCM scm_srcprops_to_alist (SCM obj);
scm_t_bits scm_tc16_srcprops;
+
+static int
+supports_source_props (SCM obj)
+{
+ return SCM_NIMP (obj) && !scm_is_symbol (obj) && !scm_is_keyword (obj);
+}
+
+
static int
srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
{
@@ -157,21 +166,33 @@ scm_srcprops_to_alist (SCM obj)
return alist;
}
+SCM_DEFINE (scm_supports_source_properties_p, "supports-source-properties?",
1, 0, 0,
+ (SCM obj),
+ "Return #t if @var{obj} supports adding source properties,\n"
+ "otherwise return #f.")
+#define FUNC_NAME s_scm_supports_source_properties_p
+{
+ return scm_from_bool (supports_source_props (obj));
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
(SCM obj),
"Return the source property association list of @var{obj}.")
#define FUNC_NAME s_scm_source_properties
{
- SCM p;
- SCM_VALIDATE_NIM (1, obj);
-
- p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
-
- if (SRCPROPSP (p))
- return scm_srcprops_to_alist (p);
+ if (SCM_IMP (obj))
+ return SCM_EOL;
else
- /* list from set-source-properties!, or SCM_EOL for not found */
- return p;
+ {
+ SCM p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
+
+ if (SRCPROPSP (p))
+ return scm_srcprops_to_alist (p);
+ else
+ /* list from set-source-properties!, or SCM_EOL for not found */
+ return p;
+ }
}
#undef FUNC_NAME
@@ -195,13 +216,10 @@ int
scm_i_has_source_properties (SCM obj)
#define FUNC_NAME "%set-source-properties"
{
- int ret;
-
- SCM_VALIDATE_NIM (1, obj);
-
- ret = scm_is_true (scm_weak_table_refq (scm_source_whash, obj, SCM_BOOL_F));
-
- return ret;
+ if (SCM_IMP (obj))
+ return 0;
+ else
+ return scm_is_true (scm_weak_table_refq (scm_source_whash, obj,
SCM_BOOL_F));
}
#undef FUNC_NAME
@@ -228,18 +246,20 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0,
0,
#define FUNC_NAME s_scm_source_property
{
SCM p;
- SCM_VALIDATE_NIM (1, obj);
+
+ if (SCM_IMP (obj))
+ return SCM_BOOL_F;
p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
if (!SRCPROPSP (p))
goto alist;
if (scm_is_eq (scm_sym_line, key))
- p = scm_from_int (SRCPROPLINE (p));
+ return scm_from_int (SRCPROPLINE (p));
else if (scm_is_eq (scm_sym_column, key))
- p = scm_from_int (SRCPROPCOL (p));
+ return scm_from_int (SRCPROPCOL (p));
else if (scm_is_eq (scm_sym_copy, key))
- p = SRCPROPCOPY (p);
+ return SRCPROPCOPY (p);
else
{
p = SRCPROPALIST (p);
@@ -247,7 +267,6 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
p = scm_assoc (key, p);
return (scm_is_pair (p) ? SCM_CDR (p) : SCM_BOOL_F);
}
- return SCM_UNBNDP (p) ? SCM_BOOL_F : p;
}
#undef FUNC_NAME
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index 250756d..0252e54 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -3,7 +3,8 @@
#ifndef SCM_SRCPROP_H
#define SCM_SRCPROP_H
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009, 2010, 2011 Free
Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008, 2009, 2010,
+ * 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -41,6 +42,7 @@ SCM_API SCM scm_sym_column;
+SCM_API SCM scm_supports_source_properties_p (SCM obj);
SCM_API SCM scm_make_srcprops (long line, int col, SCM fname, SCM copy, SCM
plist);
SCM_API SCM scm_source_property (SCM obj, SCM key);
SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
diff --git a/libguile/strings.c b/libguile/strings.c
index 9617057..977548b 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -225,7 +225,24 @@ narrow_stringbuf (SCM buf)
return new_buf;
}
+
+
scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (stringbuf_write_mutex);
+
+static scm_i_pthread_mutex_t iconv_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
+void
+scm_i_lock_iconv (void)
+{
+ scm_i_pthread_mutex_lock (&iconv_mutex);
+}
+
+void
+scm_i_unlock_iconv (void)
+{
+ scm_i_pthread_mutex_unlock (&iconv_mutex);
+}
/* Copy-on-write strings.
@@ -1530,12 +1547,14 @@ scm_from_stringn (const char *str, size_t len, const
char *encoding,
return scm_from_utf8_stringn (str, len);
u32len = 0;
+ scm_i_lock_iconv ();
u32 = (scm_t_wchar *) u32_conv_from_encoding (encoding,
(enum iconv_ilseq_handler)
handler,
str, len,
NULL,
NULL, &u32len);
+ scm_i_unlock_iconv ();
if (SCM_UNLIKELY (u32 == NULL))
decoding_error (__func__, errno, str, len);
@@ -2070,10 +2089,12 @@ scm_to_stringn (SCM str, size_t *lenp, const char
*encoding,
enc = "ISO-8859-1";
if (scm_i_is_narrow_string (str))
{
+ scm_i_lock_iconv ();
ret = mem_iconveh (scm_i_string_chars (str), ilen,
"ISO-8859-1", enc,
(enum iconv_ilseq_handler) handler, NULL,
&buf, &len);
+ scm_i_unlock_iconv ();
if (ret != 0)
scm_encoding_error (__func__, errno,
@@ -2084,12 +2105,14 @@ scm_to_stringn (SCM str, size_t *lenp, const char
*encoding,
}
else
{
+ scm_i_lock_iconv ();
buf = u32_conv_to_encoding (enc,
(enum iconv_ilseq_handler) handler,
(scm_t_uint32 *) scm_i_string_wide_chars
(str),
ilen,
NULL,
NULL, &len);
+ scm_i_unlock_iconv ();
if (buf == NULL)
scm_encoding_error (__func__, errno,
"cannot convert wide string to output locale",
@@ -2333,6 +2356,9 @@ scm_init_strings ()
{
scm_nullstr = scm_i_make_string (0, NULL, 0);
+ scm_i_pthread_atfork (scm_i_lock_iconv, scm_i_unlock_iconv,
+ scm_i_unlock_iconv);
+
#include "libguile/strings.x"
}
diff --git a/libguile/strings.h b/libguile/strings.h
index 04a9762..b88e97c 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -3,7 +3,7 @@
#ifndef SCM_STRINGS_H
#define SCM_STRINGS_H
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006, 2008, 2009,
2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006, 2008, 2009,
2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -220,6 +220,9 @@ SCM_INTERNAL void scm_decoding_error (const char *subr, int
err,
/* internal utility functions. */
+SCM_INTERNAL void scm_i_lock_iconv (void);
+SCM_INTERNAL void scm_i_unlock_iconv (void);
+
SCM_INTERNAL char **scm_i_allocate_string_pointers (SCM list);
SCM_INTERNAL void scm_i_get_substring_spec (size_t len,
SCM start, size_t *cstart,
diff --git a/libguile/threads.c b/libguile/threads.c
index d5c51ea..f78889b 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -500,6 +500,7 @@ SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread = NULL;
static scm_i_pthread_mutex_t thread_admin_mutex =
SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (thread_admin_mutex);
static scm_i_thread *all_threads = NULL;
static int thread_count;
@@ -2134,6 +2135,7 @@ static int threads_initialized_p = 0;
/* This mutex is used by SCM_CRITICAL_SECTION_START/END.
*/
scm_i_pthread_mutex_t scm_i_critical_section_mutex;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (scm_i_critical_section_mutex);
static SCM dynwind_critical_section_mutex;
@@ -2149,6 +2151,7 @@ scm_dynwind_critical_section (SCM mutex)
/*** Initialization */
scm_i_pthread_mutex_t scm_i_misc_mutex;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (scm_i_misc_mutex);
#if SCM_USE_PTHREAD_THREADS
pthread_mutexattr_t scm_i_pthread_mutexattr_recursive[1];
diff --git a/libguile/threads.h b/libguile/threads.h
index 54d6414..f8404cf 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -3,7 +3,7 @@
#ifndef SCM_THREADS_H
#define SCM_THREADS_H
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008,
2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008,
2009, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -130,6 +130,10 @@ typedef struct scm_i_thread {
#define SCM_VALIDATE_CONDVAR(pos, a) \
scm_assert_smob_type (scm_tc16_condvar, (a))
+#define SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX(m) \
+ SCM_SNARF_HERE(SCM_DEFINE_ATFORK_HANDLERS_FOR_MUTEX(&m,lock_##m,unlock_##m))\
+ SCM_SNARF_INIT(scm_i_pthread_atfork (lock_##m, unlock_##m, unlock_##m);)
+
SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data,
scm_t_catch_handler handler, void *handler_data);
diff --git a/libguile/weak-set.c b/libguile/weak-set.c
index 004fedb..a1ae4ea 100644
--- a/libguile/weak-set.c
+++ b/libguile/weak-set.c
@@ -614,6 +614,74 @@ weak_set_remove_x (scm_t_weak_set *set, unsigned long hash,
+
+static void
+lock_weak_set (scm_t_weak_set *set)
+{
+ scm_i_pthread_mutex_lock (&set->lock);
+}
+
+static void
+unlock_weak_set (scm_t_weak_set *set)
+{
+ scm_i_pthread_mutex_unlock (&set->lock);
+}
+
+/* A weak set of weak sets, for use in the pthread_atfork handler. */
+static SCM all_weak_sets = SCM_BOOL_F;
+
+#if SCM_USE_PTHREAD_THREADS
+
+static void
+lock_all_weak_sets (void)
+{
+ scm_t_weak_set *s;
+ scm_t_weak_entry *entries;
+ unsigned long k, size;
+ scm_t_weak_entry copy;
+
+ s = SCM_WEAK_SET (all_weak_sets);
+ lock_weak_set (s);
+ size = s->size;
+ entries = s->entries;
+
+ for (k = 0; k < size; k++)
+ if (entries[k].hash)
+ {
+ copy_weak_entry (&entries[k], ©);
+ if (copy.key)
+ lock_weak_set (SCM_WEAK_SET (SCM_PACK (copy.key)));
+ }
+}
+
+static void
+unlock_all_weak_sets (void)
+{
+ scm_t_weak_set *s;
+ scm_t_weak_entry *entries;
+ unsigned long k, size;
+ scm_t_weak_entry copy;
+
+ s = SCM_WEAK_SET (all_weak_sets);
+ size = s->size;
+ entries = s->entries;
+
+ for (k = 0; k < size; k++)
+ if (entries[k].hash)
+ {
+ copy_weak_entry (&entries[k], ©);
+ if (copy.key)
+ unlock_weak_set (SCM_WEAK_SET (SCM_PACK (copy.key)));
+ }
+
+ unlock_weak_set (s);
+}
+
+#endif /* SCM_USE_PTHREAD_THREADS */
+
+
+
+
static SCM
make_weak_set (unsigned long k)
{
@@ -660,7 +728,7 @@ do_vacuum_weak_set (SCM set)
if (scm_i_pthread_mutex_trylock (&s->lock) == 0)
{
vacuum_weak_set (s);
- scm_i_pthread_mutex_unlock (&s->lock);
+ unlock_weak_set (s);
}
return;
@@ -725,6 +793,9 @@ scm_c_make_weak_set (unsigned long k)
scm_c_register_weak_gc_callback (ret, do_vacuum_weak_set);
+ if (scm_is_true (all_weak_sets))
+ scm_weak_set_add_x (all_weak_sets, ret);
+
return ret;
}
@@ -739,12 +810,12 @@ scm_weak_set_clear_x (SCM set)
{
scm_t_weak_set *s = SCM_WEAK_SET (set);
- scm_i_pthread_mutex_lock (&s->lock);
+ lock_weak_set (s);
memset (s->entries, 0, sizeof (scm_t_weak_entry) * s->size);
s->n_items = 0;
- scm_i_pthread_mutex_unlock (&s->lock);
+ unlock_weak_set (s);
return SCM_UNSPECIFIED;
}
@@ -757,11 +828,11 @@ scm_c_weak_set_lookup (SCM set, unsigned long raw_hash,
SCM ret;
scm_t_weak_set *s = SCM_WEAK_SET (set);
- scm_i_pthread_mutex_lock (&s->lock);
+ lock_weak_set (s);
ret = weak_set_lookup (s, raw_hash, pred, closure, dflt);
- scm_i_pthread_mutex_unlock (&s->lock);
+ unlock_weak_set (s);
return ret;
}
@@ -774,11 +845,11 @@ scm_c_weak_set_add_x (SCM set, unsigned long raw_hash,
SCM ret;
scm_t_weak_set *s = SCM_WEAK_SET (set);
- scm_i_pthread_mutex_lock (&s->lock);
+ lock_weak_set (s);
ret = weak_set_add_x (s, raw_hash, pred, closure, obj);
- scm_i_pthread_mutex_unlock (&s->lock);
+ unlock_weak_set (s);
return ret;
}
@@ -790,11 +861,11 @@ scm_c_weak_set_remove_x (SCM set, unsigned long raw_hash,
{
scm_t_weak_set *s = SCM_WEAK_SET (set);
- scm_i_pthread_mutex_lock (&s->lock);
+ lock_weak_set (s);
weak_set_remove_x (s, raw_hash, pred, closure);
- scm_i_pthread_mutex_unlock (&s->lock);
+ unlock_weak_set (s);
}
static int
@@ -829,7 +900,7 @@ scm_c_weak_set_fold (scm_t_set_fold_fn proc, void *closure,
s = SCM_WEAK_SET (set);
- scm_i_pthread_mutex_lock (&s->lock);
+ lock_weak_set (s);
size = s->size;
entries = s->entries;
@@ -845,14 +916,14 @@ scm_c_weak_set_fold (scm_t_set_fold_fn proc, void
*closure,
if (copy.key)
{
/* Release set lock while we call the function. */
- scm_i_pthread_mutex_unlock (&s->lock);
+ unlock_weak_set (s);
init = proc (closure, SCM_PACK (copy.key), init);
- scm_i_pthread_mutex_lock (&s->lock);
+ lock_weak_set (s);
}
}
}
- scm_i_pthread_mutex_unlock (&s->lock);
+ unlock_weak_set (s);
return init;
}
@@ -897,6 +968,17 @@ scm_weak_set_map_to_list (SCM proc, SCM set)
}
+
+
+void
+scm_weak_set_prehistory (void)
+{
+#if SCM_USE_PTHREAD_THREADS
+ all_weak_sets = scm_c_make_weak_set (0);
+ pthread_atfork (lock_all_weak_sets, unlock_all_weak_sets,
unlock_all_weak_sets);
+#endif
+}
+
void
scm_init_weak_set ()
{
diff --git a/libguile/weak-set.h b/libguile/weak-set.h
index 86781c7..6a1c00d 100644
--- a/libguile/weak-set.h
+++ b/libguile/weak-set.h
@@ -3,7 +3,7 @@
#ifndef SCM_WEAK_SET_H
#define SCM_WEAK_SET_H
-/* Copyright (C) 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -57,7 +57,10 @@ SCM_INTERNAL SCM scm_weak_set_fold (SCM proc, SCM init, SCM
set);
SCM_INTERNAL SCM scm_weak_set_for_each (SCM proc, SCM set);
SCM_INTERNAL SCM scm_weak_set_map_to_list (SCM proc, SCM set);
+SCM_INTERNAL void scm_i_weak_set_lock (SCM set);
+SCM_INTERNAL void scm_i_weak_set_unlock (SCM set);
SCM_INTERNAL void scm_i_weak_set_print (SCM exp, SCM port, scm_print_state
*pstate);
+SCM_INTERNAL void scm_weak_set_prehistory (void);
SCM_INTERNAL void scm_init_weak_set (void);
#endif /* SCM_WEAK_SET_H */
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index 38fd23d..3d453ba 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -736,10 +736,79 @@ weak_table_remove_x (scm_t_weak_table *table, unsigned
long hash,
+
+static void
+lock_weak_table (scm_t_weak_table *table)
+{
+ scm_i_pthread_mutex_lock (&table->lock);
+}
+
+static void
+unlock_weak_table (scm_t_weak_table *table)
+{
+ scm_i_pthread_mutex_unlock (&table->lock);
+}
+
+/* A weak table of weak tables, for use in the pthread_atfork handler. */
+static SCM all_weak_tables = SCM_BOOL_F;
+
+#if SCM_USE_PTHREAD_THREADS
+
+static void
+lock_all_weak_tables (void)
+{
+ scm_t_weak_table *s;
+ scm_t_weak_entry *entries;
+ unsigned long k, size;
+ scm_t_weak_entry copy;
+
+ s = SCM_WEAK_TABLE (all_weak_tables);
+ lock_weak_table (s);
+ size = s->size;
+ entries = s->entries;
+
+ for (k = 0; k < size; k++)
+ if (entries[k].hash)
+ {
+ copy_weak_entry (&entries[k], ©);
+ if (copy.key)
+ lock_weak_table (SCM_WEAK_TABLE (SCM_PACK (copy.key)));
+ }
+}
+
+static void
+unlock_all_weak_tables (void)
+{
+ scm_t_weak_table *s;
+ scm_t_weak_entry *entries;
+ unsigned long k, size;
+ scm_t_weak_entry copy;
+
+ s = SCM_WEAK_TABLE (all_weak_tables);
+ size = s->size;
+ entries = s->entries;
+
+ for (k = 0; k < size; k++)
+ if (entries[k].hash)
+ {
+ copy_weak_entry (&entries[k], ©);
+ if (copy.key)
+ unlock_weak_table (SCM_WEAK_TABLE (SCM_PACK (copy.key)));
+ }
+
+ unlock_weak_table (s);
+}
+
+#endif /* SCM_USE_PTHREAD_THREADS */
+
+
+
+
static SCM
make_weak_table (unsigned long k, scm_t_weak_table_kind kind)
{
scm_t_weak_table *table;
+ SCM ret;
int i = 0, n = k ? k : 31;
while (i + 1 < HASHTABLE_SIZE_N && n > hashtable_size[i])
@@ -757,7 +826,12 @@ make_weak_table (unsigned long k, scm_t_weak_table_kind
kind)
table->min_size_index = i;
scm_i_pthread_mutex_init (&table->lock, NULL);
- return scm_cell (scm_tc7_weak_table, (scm_t_bits)table);
+ ret = scm_cell (scm_tc7_weak_table, (scm_t_bits)table);
+
+ if (scm_is_true (all_weak_tables))
+ scm_weak_table_putq_x (all_weak_tables, ret, SCM_BOOL_T);
+
+ return ret;
}
void
@@ -781,7 +855,7 @@ do_vacuum_weak_table (SCM table)
if (scm_i_pthread_mutex_trylock (&t->lock) == 0)
{
vacuum_weak_table (t);
- scm_i_pthread_mutex_unlock (&t->lock);
+ unlock_weak_table (t);
}
return;
@@ -868,11 +942,11 @@ scm_c_weak_table_ref (SCM table, unsigned long raw_hash,
t = SCM_WEAK_TABLE (table);
- scm_i_pthread_mutex_lock (&t->lock);
+ lock_weak_table (t);
ret = weak_table_ref (t, raw_hash, pred, closure, dflt);
- scm_i_pthread_mutex_unlock (&t->lock);
+ unlock_weak_table (t);
return ret;
}
@@ -890,11 +964,11 @@ scm_c_weak_table_put_x (SCM table, unsigned long raw_hash,
t = SCM_WEAK_TABLE (table);
- scm_i_pthread_mutex_lock (&t->lock);
+ lock_weak_table (t);
weak_table_put_x (t, raw_hash, pred, closure, key, value);
- scm_i_pthread_mutex_unlock (&t->lock);
+ unlock_weak_table (t);
}
#undef FUNC_NAME
@@ -910,11 +984,11 @@ scm_c_weak_table_remove_x (SCM table, unsigned long
raw_hash,
t = SCM_WEAK_TABLE (table);
- scm_i_pthread_mutex_lock (&t->lock);
+ lock_weak_table (t);
weak_table_remove_x (t, raw_hash, pred, closure);
- scm_i_pthread_mutex_unlock (&t->lock);
+ unlock_weak_table (t);
}
#undef FUNC_NAME
@@ -962,12 +1036,12 @@ scm_weak_table_clear_x (SCM table)
t = SCM_WEAK_TABLE (table);
- scm_i_pthread_mutex_lock (&t->lock);
+ lock_weak_table (t);
memset (t->entries, 0, sizeof (scm_t_weak_entry) * t->size);
t->n_items = 0;
- scm_i_pthread_mutex_unlock (&t->lock);
+ unlock_weak_table (t);
return SCM_UNSPECIFIED;
}
@@ -983,7 +1057,7 @@ scm_c_weak_table_fold (scm_t_table_fold_fn proc, void
*closure,
t = SCM_WEAK_TABLE (table);
- scm_i_pthread_mutex_lock (&t->lock);
+ lock_weak_table (t);
size = t->size;
entries = t->entries;
@@ -999,16 +1073,16 @@ scm_c_weak_table_fold (scm_t_table_fold_fn proc, void
*closure,
if (copy.key && copy.value)
{
/* Release table lock while we call the function. */
- scm_i_pthread_mutex_unlock (&t->lock);
+ unlock_weak_table (t);
init = proc (closure,
SCM_PACK (copy.key), SCM_PACK (copy.value),
init);
- scm_i_pthread_mutex_lock (&t->lock);
+ lock_weak_table (t);
}
}
}
- scm_i_pthread_mutex_unlock (&t->lock);
+ unlock_weak_table (t);
return init;
}
@@ -1163,6 +1237,12 @@ scm_weak_table_prehistory (void)
GC_new_kind (GC_new_free_list (),
GC_MAKE_PROC (GC_new_proc (mark_weak_value_table), 0),
0, 0);
+
+#if SCM_USE_PTHREAD_THREADS
+ all_weak_tables = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
+ pthread_atfork (lock_all_weak_tables, unlock_all_weak_tables,
+ unlock_all_weak_tables);
+#endif
}
void
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 0e353d8..9e3c91e 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,2176 +1,2405 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
-(let ((session-id-4307 (if #f #f))
- (transformer-environment-4368 (if #f #f)))
+(let ((session-id-4308 (if #f #f))
+ (transformer-environment-4369 (if #f #f)))
(letrec*
- ((top-level-eval-hook-4305
- (lambda (x-36477 mod-36478)
- (primitive-eval x-36477)))
- (maybe-name-value!-4311
- (lambda (name-19172 val-19173)
- (if (if (struct? val-19173)
- (eq? (struct-vtable val-19173)
+ ((top-level-eval-hook-4306
+ (lambda (x-34042 mod-34043)
+ (primitive-eval x-34042)))
+ (maybe-name-value!-4312
+ (lambda (name-17933 val-17934)
+ (if (if (struct? val-17934)
+ (eq? (struct-vtable val-17934)
(vector-ref %expanded-vtables 14))
#f)
- (let ((meta-19180 (struct-ref val-19173 1)))
- (if (not (assq 'name meta-19180))
- (let ((v-19185
- (cons (cons 'name name-19172) meta-19180)))
- (struct-set! val-19173 1 v-19185)))))))
- (build-call-4313
- (lambda (source-18917 fun-exp-18918 arg-exps-18919)
+ (let ((meta-17941 (struct-ref val-17934 1)))
+ (if (not (assq 'name meta-17941))
+ (let ((v-17946
+ (cons (cons 'name name-17933) meta-17941)))
+ (struct-set! val-17934 1 v-17946)))))))
+ (build-call-4314
+ (lambda (source-17748 fun-exp-17749 arg-exps-17750)
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
- source-18917
- fun-exp-18918
- arg-exps-18919)))
- (build-conditional-4314
- (lambda (source-18925
- test-exp-18926
- then-exp-18927
- else-exp-18928)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 10)
- source-18925
- test-exp-18926
- then-exp-18927
- else-exp-18928)))
- (build-dynlet-4315
- (lambda (source-18935 fluids-18936 vals-18937 body-18938)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 18)
- source-18935
- fluids-18936
- vals-18937
- body-18938)))
- (build-lexical-reference-4316
- (lambda (type-36479 source-36480 name-36481 var-36482)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- source-36480
- name-36481
- var-36482)))
- (build-lexical-assignment-4317
- (lambda (source-18945 name-18946 var-18947 exp-18948)
- (begin
- (if (if (struct? exp-18948)
- (eq? (struct-vtable exp-18948)
- (vector-ref %expanded-vtables 14))
- #f)
- (let ((meta-18964 (struct-ref exp-18948 1)))
- (if (not (assq 'name meta-18964))
- (let ((v-18971
- (cons (cons 'name name-18946) meta-18964)))
- (struct-set! exp-18948 1 v-18971)))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 4)
- source-18945
- name-18946
- var-18947
- exp-18948))))
- (analyze-variable-4318
- (lambda (mod-36488
- var-36489
- modref-cont-36490
- bare-cont-36491)
- (if (not mod-36488)
- (bare-cont-36491 var-36489)
- (let ((kind-36492 (car mod-36488))
- (mod-36493 (cdr mod-36488)))
- (if (eqv? kind-36492 'public)
- (modref-cont-36490 mod-36493 var-36489 #t)
- (if (eqv? kind-36492 'private)
- (if (not (equal? mod-36493 (module-name (current-module))))
- (modref-cont-36490 mod-36493 var-36489 #f)
- (bare-cont-36491 var-36489))
- (if (eqv? kind-36492 'bare)
- (bare-cont-36491 var-36489)
- (if (eqv? kind-36492 'hygiene)
+ source-17748
+ fun-exp-17749
+ arg-exps-17750)))
+ (analyze-variable-4319
+ (lambda (mod-17756
+ var-17757
+ modref-cont-17758
+ bare-cont-17759)
+ (if (not mod-17756)
+ (bare-cont-17759 var-17757)
+ (let ((kind-17760 (car mod-17756))
+ (mod-17761 (cdr mod-17756)))
+ (if (eqv? kind-17760 'public)
+ (modref-cont-17758 mod-17761 var-17757 #t)
+ (if (eqv? kind-17760 'private)
+ (if (not (equal? mod-17761 (module-name (current-module))))
+ (modref-cont-17758 mod-17761 var-17757 #f)
+ (bare-cont-17759 var-17757))
+ (if (eqv? kind-17760 'bare)
+ (bare-cont-17759 var-17757)
+ (if (eqv? kind-17760 'hygiene)
(if (if (not (equal?
- mod-36493
+ mod-17761
(module-name (current-module))))
(module-variable
- (resolve-module mod-36493)
- var-36489)
+ (resolve-module mod-17761)
+ var-17757)
#f)
- (modref-cont-36490 mod-36493 var-36489 #f)
- (bare-cont-36491 var-36489))
+ (modref-cont-17758 mod-17761 var-17757 #f)
+ (bare-cont-17759 var-17757))
(syntax-violation
#f
"bad module kind"
- var-36489
- mod-36493)))))))))
- (build-global-reference-4319
- (lambda (source-36520 var-36521 mod-36522)
- (analyze-variable-4318
- mod-36522
- var-36521
- (lambda (mod-36525 var-36526 public?-36527)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- source-36520
- mod-36525
- var-36526
- public?-36527))
- (lambda (var-36534)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- source-36520
- var-36534)))))
- (build-global-assignment-4320
- (lambda (source-18980 var-18981 exp-18982 mod-18983)
- (begin
- (if (if (struct? exp-18982)
- (eq? (struct-vtable exp-18982)
- (vector-ref %expanded-vtables 14))
- #f)
- (let ((meta-18999 (struct-ref exp-18982 1)))
- (if (not (assq 'name meta-18999))
- (let ((v-19006
- (cons (cons 'name var-18981) meta-18999)))
- (struct-set! exp-18982 1 v-19006)))))
- (analyze-variable-4318
- mod-18983
- var-18981
- (lambda (mod-19011 var-19012 public?-19013)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 6)
- source-18980
- mod-19011
- var-19012
- public?-19013
- exp-18982))
- (lambda (var-19021)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 8)
- source-18980
- var-19021
- exp-18982))))))
- (build-global-definition-4321
- (lambda (source-36539 var-36540 exp-36541)
- (begin
- (if (if (struct? exp-36541)
- (eq? (struct-vtable exp-36541)
- (vector-ref %expanded-vtables 14))
- #f)
- (let ((meta-36557 (struct-ref exp-36541 1)))
- (if (not (assq 'name meta-36557))
- (let ((v-36564
- (cons (cons 'name var-36540) meta-36557)))
- (struct-set! exp-36541 1 v-36564)))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 9)
- source-36539
- var-36540
- exp-36541))))
- (build-simple-lambda-4322
- (lambda (src-19027
- req-19028
- rest-19029
- vars-19030
- meta-19031
- exp-19032)
- (let ((body-19038
+ var-17757
+ mod-17761)))))))))
+ (build-simple-lambda-4323
+ (lambda (src-17788
+ req-17789
+ rest-17790
+ vars-17791
+ meta-17792
+ exp-17793)
+ (let ((body-17799
(make-struct/no-tail
(vector-ref %expanded-vtables 15)
- src-19027
- req-19028
+ src-17788
+ req-17789
#f
- rest-19029
+ rest-17790
#f
'()
- vars-19030
- exp-19032
+ vars-17791
+ exp-17793
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
- src-19027
- meta-19031
- body-19038))))
- (build-primcall-4325
- (lambda (src-19050 name-19051 args-19052)
+ src-17788
+ meta-17792
+ body-17799))))
+ (build-primcall-4326
+ (lambda (src-17811 name-17812 args-17813)
(make-struct/no-tail
(vector-ref %expanded-vtables 12)
- src-19050
- name-19051
- args-19052)))
- (build-sequence-4328
- (lambda (src-36572 exps-36573)
- (if (null? (cdr exps-36573))
- (car exps-36573)
- (let ((head-36577 (car exps-36573))
- (tail-36578
- (build-sequence-4328 #f (cdr exps-36573))))
+ src-17811
+ name-17812
+ args-17813)))
+ (build-sequence-4329
+ (lambda (src-34044 exps-34045)
+ (if (null? (cdr exps-34045))
+ (car exps-34045)
+ (let ((head-34049 (car exps-34045))
+ (tail-34050
+ (build-sequence-4329 #f (cdr exps-34045))))
(make-struct/no-tail
(vector-ref %expanded-vtables 13)
- src-36572
- head-36577
- tail-36578)))))
- (build-named-let-4330
- (lambda (src-19058
- ids-19059
- vars-19060
- val-exps-19061
- body-exp-19062)
- (let ((f-19063 (car vars-19060))
- (f-name-19064 (car ids-19059))
- (vars-19065 (cdr vars-19060))
- (ids-19066 (cdr ids-19059)))
- (let ((proc-19067
- (let ((body-19087
+ src-34044
+ head-34049
+ tail-34050)))))
+ (build-named-let-4331
+ (lambda (src-17819
+ ids-17820
+ vars-17821
+ val-exps-17822
+ body-exp-17823)
+ (let ((f-17824 (car vars-17821))
+ (f-name-17825 (car ids-17820))
+ (vars-17826 (cdr vars-17821))
+ (ids-17827 (cdr ids-17820)))
+ (let ((proc-17828
+ (let ((body-17848
(make-struct/no-tail
(vector-ref %expanded-vtables 15)
- src-19058
- ids-19066
+ src-17819
+ ids-17827
#f
#f
#f
'()
- vars-19065
- body-exp-19062
+ vars-17826
+ body-exp-17823
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
- src-19058
+ src-17819
'()
- body-19087))))
+ body-17848))))
(begin
- (if (if (struct? proc-19067)
- (eq? (struct-vtable proc-19067)
+ (if (if (struct? proc-17828)
+ (eq? (struct-vtable proc-17828)
(vector-ref %expanded-vtables 14))
#f)
- (let ((meta-19111 (struct-ref proc-19067 1)))
- (if (not (assq 'name meta-19111))
- (let ((v-19118
- (cons (cons 'name f-name-19064) meta-19111)))
- (struct-set! proc-19067 1 v-19118)))))
+ (let ((meta-17872 (struct-ref proc-17828 1)))
+ (if (not (assq 'name meta-17872))
+ (let ((v-17879
+ (cons (cons 'name f-name-17825) meta-17872)))
+ (struct-set! proc-17828 1 v-17879)))))
(for-each
- maybe-name-value!-4311
- ids-19066
- val-exps-19061)
- (let ((names-19142 (list f-name-19064))
- (gensyms-19143 (list f-19063))
- (vals-19144 (list proc-19067))
- (body-19145
- (let ((fun-exp-19149
+ maybe-name-value!-4312
+ ids-17827
+ val-exps-17822)
+ (let ((names-17903 (list f-name-17825))
+ (gensyms-17904 (list f-17824))
+ (vals-17905 (list proc-17828))
+ (body-17906
+ (let ((fun-exp-17910
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
- src-19058
- f-name-19064
- f-19063)))
+ src-17819
+ f-name-17825
+ f-17824)))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
- src-19058
- fun-exp-19149
- val-exps-19061))))
+ src-17819
+ fun-exp-17910
+ val-exps-17822))))
(make-struct/no-tail
(vector-ref %expanded-vtables 17)
- src-19058
+ src-17819
#f
- names-19142
- gensyms-19143
- vals-19144
- body-19145)))))))
- (build-letrec-4331
- (lambda (src-19165
- in-order?-19166
- ids-19167
- vars-19168
- val-exps-19169
- body-exp-19170)
- (if (null? vars-19168)
- body-exp-19170
+ names-17903
+ gensyms-17904
+ vals-17905
+ body-17906)))))))
+ (build-letrec-4332
+ (lambda (src-17926
+ in-order?-17927
+ ids-17928
+ vars-17929
+ val-exps-17930
+ body-exp-17931)
+ (if (null? vars-17929)
+ body-exp-17931
(begin
(for-each
- maybe-name-value!-4311
- ids-19167
- val-exps-19169)
+ maybe-name-value!-4312
+ ids-17928
+ val-exps-17930)
(make-struct/no-tail
(vector-ref %expanded-vtables 17)
- src-19165
- in-order?-19166
- ids-19167
- vars-19168
- val-exps-19169
- body-exp-19170)))))
- (source-annotation-4340
- (lambda (x-19196)
- (if (if (vector? x-19196)
- (if (= (vector-length x-19196) 4)
- (eq? (vector-ref x-19196 0) 'syntax-object)
- #f)
- #f)
- (source-annotation-4340 (vector-ref x-19196 1))
- (if (pair? x-19196)
- (let ((props-19211 (source-properties x-19196)))
- (if (pair? props-19211) props-19211 #f))
- #f))))
- (extend-env-4341
- (lambda (labels-19213 bindings-19214 r-19215)
- (if (null? labels-19213)
- r-19215
- (extend-env-4341
- (cdr labels-19213)
- (cdr bindings-19214)
- (cons (cons (car labels-19213) (car bindings-19214))
- r-19215)))))
- (extend-var-env-4342
- (lambda (labels-19216 vars-19217 r-19218)
- (if (null? labels-19216)
- r-19218
- (extend-var-env-4342
- (cdr labels-19216)
- (cdr vars-19217)
- (cons (cons (car labels-19216)
- (cons 'lexical (car vars-19217)))
- r-19218)))))
- (macros-only-env-4343
- (lambda (r-19219)
- (if (null? r-19219)
+ src-17926
+ in-order?-17927
+ ids-17928
+ vars-17929
+ val-exps-17930
+ body-exp-17931)))))
+ (make-syntax-object-4333
+ (lambda (expression-17957 wrap-17958 module-17959)
+ (vector
+ 'syntax-object
+ expression-17957
+ wrap-17958
+ module-17959)))
+ (extend-env-4342
+ (lambda (labels-17961 bindings-17962 r-17963)
+ (if (null? labels-17961)
+ r-17963
+ (extend-env-4342
+ (cdr labels-17961)
+ (cdr bindings-17962)
+ (cons (cons (car labels-17961) (car bindings-17962))
+ r-17963)))))
+ (extend-var-env-4343
+ (lambda (labels-17964 vars-17965 r-17966)
+ (if (null? labels-17964)
+ r-17966
+ (extend-var-env-4343
+ (cdr labels-17964)
+ (cdr vars-17965)
+ (cons (cons (car labels-17964)
+ (cons 'lexical (car vars-17965)))
+ r-17966)))))
+ (macros-only-env-4344
+ (lambda (r-17967)
+ (if (null? r-17967)
'()
- (let ((a-19220 (car r-19219)))
- (if (let ((t-19223 (car (cdr a-19220))))
- (if (eq? t-19223 'macro)
+ (let ((a-17968 (car r-17967)))
+ (if (let ((t-17971 (car (cdr a-17968))))
+ (if (eq? t-17971 'macro)
#t
- (eq? t-19223 'syntax-parameter)))
- (cons a-19220
- (macros-only-env-4343 (cdr r-19219)))
- (macros-only-env-4343 (cdr r-19219)))))))
- (global-extend-4344
- (lambda (type-19225 sym-19226 val-19227)
+ (eq? t-17971 'syntax-parameter)))
+ (cons a-17968
+ (macros-only-env-4344 (cdr r-17967)))
+ (macros-only-env-4344 (cdr r-17967)))))))
+ (global-extend-4345
+ (lambda (type-17973 sym-17974 val-17975)
(module-define!
(current-module)
- sym-19226
+ sym-17974
(make-syntax-transformer
- sym-19226
- type-19225
- val-19227))))
- (id?-4346
- (lambda (x-11718)
- (if (symbol? x-11718)
+ sym-17974
+ type-17973
+ val-17975))))
+ (id?-4347
+ (lambda (x-11477)
+ (if (symbol? x-11477)
#t
- (if (if (vector? x-11718)
- (if (= (vector-length x-11718) 4)
- (eq? (vector-ref x-11718 0) 'syntax-object)
+ (if (if (vector? x-11477)
+ (if (= (vector-length x-11477) 4)
+ (eq? (vector-ref x-11477 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-11718 1))
+ (symbol? (vector-ref x-11477 1))
#f))))
- (gen-labels-4349
- (lambda (ls-19237)
- (if (null? ls-19237)
+ (gen-labels-4350
+ (lambda (ls-17985)
+ (if (null? ls-17985)
'()
(cons (string-append
"l-"
- (session-id-4307)
+ (session-id-4308)
(symbol->string (gensym "-")))
- (gen-labels-4349 (cdr ls-19237))))))
- (make-binding-wrap-4360
- (lambda (ids-19241 labels-19242 w-19243)
- (if (null? ids-19241)
- w-19243
- (cons (car w-19243)
- (cons (let ((labelvec-19244 (list->vector labels-19242)))
- (let ((n-19245 (vector-length labelvec-19244)))
- (let ((symnamevec-19246 (make-vector n-19245))
- (marksvec-19247 (make-vector n-19245)))
+ (gen-labels-4350 (cdr ls-17985))))))
+ (make-binding-wrap-4361
+ (lambda (ids-17989 labels-17990 w-17991)
+ (if (null? ids-17989)
+ w-17991
+ (cons (car w-17991)
+ (cons (let ((labelvec-17992 (list->vector labels-17990)))
+ (let ((n-17993 (vector-length labelvec-17992)))
+ (let ((symnamevec-17994 (make-vector n-17993))
+ (marksvec-17995 (make-vector n-17993)))
(begin
(letrec*
- ((f-19248
- (lambda (ids-19445 i-19446)
- (if (not (null? ids-19445))
+ ((f-17996
+ (lambda (ids-18193 i-18194)
+ (if (not (null? ids-18193))
(call-with-values
(lambda ()
- (let ((x-19449 (car ids-19445)))
- (if (if (vector? x-19449)
+ (let ((x-18197 (car ids-18193)))
+ (if (if (vector? x-18197)
(if (= (vector-length
- x-19449)
+ x-18197)
4)
(eq? (vector-ref
- x-19449
+ x-18197
0)
'syntax-object)
#f)
#f)
(values
- (vector-ref x-19449 1)
- (let ((m1-19465
- (car w-19243))
- (m2-19466
+ (vector-ref x-18197 1)
+ (let ((m1-18213
+ (car w-17991))
+ (m2-18214
(car (vector-ref
- x-19449
+ x-18197
2))))
- (if (null? m2-19466)
- m1-19465
+ (if (null? m2-18214)
+ m1-18213
(append
- m1-19465
- m2-19466))))
+ m1-18213
+ m2-18214))))
(values
- x-19449
- (car w-19243)))))
- (lambda (symname-19486 marks-19487)
+ x-18197
+ (car w-17991)))))
+ (lambda (symname-18234 marks-18235)
(begin
(vector-set!
- symnamevec-19246
- i-19446
- symname-19486)
+ symnamevec-17994
+ i-18194
+ symname-18234)
(vector-set!
- marksvec-19247
- i-19446
- marks-19487)
- (f-19248
- (cdr ids-19445)
- (#{1+}# i-19446)))))))))
- (f-19248 ids-19241 0))
+ marksvec-17995
+ i-18194
+ marks-18235)
+ (f-17996
+ (cdr ids-18193)
+ (#{1+}# i-18194)))))))))
+ (f-17996 ids-17989 0))
(vector
'ribcage
- symnamevec-19246
- marksvec-19247
- labelvec-19244)))))
- (cdr w-19243))))))
- (same-marks?-4364
- (lambda (x-36579 y-36580)
- (if (eq? x-36579 y-36580)
- (eq? x-36579 y-36580)
- (if (not (null? x-36579))
- (if (not (null? y-36580))
- (if (eq? (car x-36579) (car y-36580))
- (same-marks?-4364 (cdr x-36579) (cdr y-36580))
+ symnamevec-17994
+ marksvec-17995
+ labelvec-17992)))))
+ (cdr w-17991))))))
+ (same-marks?-4365
+ (lambda (x-34051 y-34052)
+ (if (eq? x-34051 y-34052)
+ (eq? x-34051 y-34052)
+ (if (not (null? x-34051))
+ (if (not (null? y-34052))
+ (if (eq? (car x-34051) (car y-34052))
+ (same-marks?-4365 (cdr x-34051) (cdr y-34052))
#f)
#f)
#f))))
- (id-var-name-4365
- (lambda (id-36588 w-36589 mod-36590)
+ (id-var-name-4366
+ (lambda (id-34060 w-34061 mod-34062)
(letrec*
- ((search-36591
- (lambda (sym-36657 subst-36658 marks-36659 mod-36660)
- (if (null? subst-36658)
- (values #f marks-36659)
- (let ((fst-36661 (car subst-36658)))
- (if (eq? fst-36661 'shift)
- (search-36591
- sym-36657
- (cdr subst-36658)
- (cdr marks-36659)
- mod-36660)
- (let ((symnames-36663 (vector-ref fst-36661 1)))
- (if (vector? symnames-36663)
- (search-vector-rib-36593
- sym-36657
- subst-36658
- marks-36659
- symnames-36663
- fst-36661
- mod-36660)
- (search-list-rib-36592
- sym-36657
- subst-36658
- marks-36659
- symnames-36663
- fst-36661
- mod-36660))))))))
- (search-list-rib-36592
- (lambda (sym-36838
- subst-36839
- marks-36840
- symnames-36841
- ribcage-36842
- mod-36843)
+ ((search-34063
+ (lambda (sym-34129 subst-34130 marks-34131 mod-34132)
+ (if (null? subst-34130)
+ (values #f marks-34131)
+ (let ((fst-34133 (car subst-34130)))
+ (if (eq? fst-34133 'shift)
+ (search-34063
+ sym-34129
+ (cdr subst-34130)
+ (cdr marks-34131)
+ mod-34132)
+ (let ((symnames-34135 (vector-ref fst-34133 1)))
+ (if (vector? symnames-34135)
+ (search-vector-rib-34065
+ sym-34129
+ subst-34130
+ marks-34131
+ symnames-34135
+ fst-34133
+ mod-34132)
+ (search-list-rib-34064
+ sym-34129
+ subst-34130
+ marks-34131
+ symnames-34135
+ fst-34133
+ mod-34132))))))))
+ (search-list-rib-34064
+ (lambda (sym-34310
+ subst-34311
+ marks-34312
+ symnames-34313
+ ribcage-34314
+ mod-34315)
(letrec*
- ((f-36844
- (lambda (symnames-36847 i-36848)
- (if (null? symnames-36847)
- (search-36591
- sym-36838
- (cdr subst-36839)
- marks-36840
- mod-36843)
- (if (if (eq? (car symnames-36847) sym-36838)
- (same-marks?-4364
- marks-36840
+ ((f-34316
+ (lambda (symnames-34319 i-34320)
+ (if (null? symnames-34319)
+ (search-34063
+ sym-34310
+ (cdr subst-34311)
+ marks-34312
+ mod-34315)
+ (if (if (eq? (car symnames-34319) sym-34310)
+ (same-marks?-4365
+ marks-34312
(list-ref
- (vector-ref ribcage-36842 2)
- i-36848))
+ (vector-ref ribcage-34314 2)
+ i-34320))
#f)
- (let ((n-36994
+ (let ((n-34466
(list-ref
- (vector-ref ribcage-36842 3)
- i-36848)))
- (if (pair? n-36994)
- (if (equal? mod-36843 (car n-36994))
- (values (cdr n-36994) marks-36840)
- (f-36844
- (cdr symnames-36847)
- (#{1+}# i-36848)))
- (values n-36994 marks-36840)))
- (f-36844 (cdr symnames-36847) (#{1+}# i-36848)))))))
- (f-36844 symnames-36841 0))))
- (search-vector-rib-36593
- (lambda (sym-36999
- subst-37000
- marks-37001
- symnames-37002
- ribcage-37003
- mod-37004)
- (let ((n-37005 (vector-length symnames-37002)))
+ (vector-ref ribcage-34314 3)
+ i-34320)))
+ (if (pair? n-34466)
+ (if (equal? mod-34315 (car n-34466))
+ (values (cdr n-34466) marks-34312)
+ (f-34316
+ (cdr symnames-34319)
+ (#{1+}# i-34320)))
+ (values n-34466 marks-34312)))
+ (f-34316 (cdr symnames-34319) (#{1+}# i-34320)))))))
+ (f-34316 symnames-34313 0))))
+ (search-vector-rib-34065
+ (lambda (sym-34471
+ subst-34472
+ marks-34473
+ symnames-34474
+ ribcage-34475
+ mod-34476)
+ (let ((n-34477 (vector-length symnames-34474)))
(letrec*
- ((f-37006
- (lambda (i-37009)
- (if (= i-37009 n-37005)
- (search-36591
- sym-36999
- (cdr subst-37000)
- marks-37001
- mod-37004)
- (if (if (eq? (vector-ref symnames-37002 i-37009)
- sym-36999)
- (same-marks?-4364
- marks-37001
+ ((f-34478
+ (lambda (i-34481)
+ (if (= i-34481 n-34477)
+ (search-34063
+ sym-34471
+ (cdr subst-34472)
+ marks-34473
+ mod-34476)
+ (if (if (eq? (vector-ref symnames-34474 i-34481)
+ sym-34471)
+ (same-marks?-4365
+ marks-34473
(vector-ref
- (vector-ref ribcage-37003 2)
- i-37009))
+ (vector-ref ribcage-34475 2)
+ i-34481))
#f)
- (let ((n-37156
+ (let ((n-34628
(vector-ref
- (vector-ref ribcage-37003 3)
- i-37009)))
- (if (pair? n-37156)
- (if (equal? mod-37004 (car n-37156))
- (values (cdr n-37156) marks-37001)
- (f-37006 (#{1+}# i-37009)))
- (values n-37156 marks-37001)))
- (f-37006 (#{1+}# i-37009)))))))
- (f-37006 0))))))
- (if (symbol? id-36588)
- (let ((t-36594
- (search-36591
- id-36588
- (cdr w-36589)
- (car w-36589)
- mod-36590)))
- (if t-36594 t-36594 id-36588))
- (if (if (vector? id-36588)
- (if (= (vector-length id-36588) 4)
- (eq? (vector-ref id-36588 0) 'syntax-object)
+ (vector-ref ribcage-34475 3)
+ i-34481)))
+ (if (pair? n-34628)
+ (if (equal? mod-34476 (car n-34628))
+ (values (cdr n-34628) marks-34473)
+ (f-34478 (#{1+}# i-34481)))
+ (values n-34628 marks-34473)))
+ (f-34478 (#{1+}# i-34481)))))))
+ (f-34478 0))))))
+ (if (symbol? id-34060)
+ (let ((t-34066
+ (search-34063
+ id-34060
+ (cdr w-34061)
+ (car w-34061)
+ mod-34062)))
+ (if t-34066 t-34066 id-34060))
+ (if (if (vector? id-34060)
+ (if (= (vector-length id-34060) 4)
+ (eq? (vector-ref id-34060 0) 'syntax-object)
#f)
#f)
- (let ((id-36609 (vector-ref id-36588 1))
- (w1-36610 (vector-ref id-36588 2))
- (mod-36611 (vector-ref id-36588 3)))
- (let ((marks-36612
- (let ((m1-36622 (car w-36589))
- (m2-36623 (car w1-36610)))
- (if (null? m2-36623)
- m1-36622
- (append m1-36622 m2-36623)))))
+ (let ((id-34081 (vector-ref id-34060 1))
+ (w1-34082 (vector-ref id-34060 2))
+ (mod-34083 (vector-ref id-34060 3)))
+ (let ((marks-34084
+ (let ((m1-34094 (car w-34061))
+ (m2-34095 (car w1-34082)))
+ (if (null? m2-34095)
+ m1-34094
+ (append m1-34094 m2-34095)))))
(call-with-values
(lambda ()
- (search-36591
- id-36609
- (cdr w-36589)
- marks-36612
- mod-36611))
- (lambda (new-id-36643 marks-36644)
- (if new-id-36643
- new-id-36643
- (let ((t-36652
- (search-36591
- id-36609
- (cdr w1-36610)
- marks-36644
- mod-36611)))
- (if t-36652 t-36652 id-36609)))))))
+ (search-34063
+ id-34081
+ (cdr w-34061)
+ marks-34084
+ mod-34083))
+ (lambda (new-id-34115 marks-34116)
+ (if new-id-34115
+ new-id-34115
+ (let ((t-34124
+ (search-34063
+ id-34081
+ (cdr w1-34082)
+ marks-34116
+ mod-34083)))
+ (if t-34124 t-34124 id-34081)))))))
(syntax-violation
'id-var-name
"invalid id"
- id-36588))))))
- (locally-bound-identifiers-4366
- (lambda (w-19494 mod-19495)
+ id-34060))))))
+ (locally-bound-identifiers-4367
+ (lambda (w-18242 mod-18243)
(letrec*
- ((scan-19496
- (lambda (subst-19501 results-19502)
- (if (null? subst-19501)
- results-19502
- (let ((fst-19503 (car subst-19501)))
- (if (eq? fst-19503 'shift)
- (scan-19496 (cdr subst-19501) results-19502)
- (let ((symnames-19505 (vector-ref fst-19503 1))
- (marks-19506 (vector-ref fst-19503 2)))
- (if (vector? symnames-19505)
- (scan-vector-rib-19498
- subst-19501
- symnames-19505
- marks-19506
- results-19502)
- (scan-list-rib-19497
- subst-19501
- symnames-19505
- marks-19506
- results-19502))))))))
- (scan-list-rib-19497
- (lambda (subst-19623
- symnames-19624
- marks-19625
- results-19626)
+ ((scan-18244
+ (lambda (subst-18249 results-18250)
+ (if (null? subst-18249)
+ results-18250
+ (let ((fst-18251 (car subst-18249)))
+ (if (eq? fst-18251 'shift)
+ (scan-18244 (cdr subst-18249) results-18250)
+ (let ((symnames-18253 (vector-ref fst-18251 1))
+ (marks-18254 (vector-ref fst-18251 2)))
+ (if (vector? symnames-18253)
+ (scan-vector-rib-18246
+ subst-18249
+ symnames-18253
+ marks-18254
+ results-18250)
+ (scan-list-rib-18245
+ subst-18249
+ symnames-18253
+ marks-18254
+ results-18250))))))))
+ (scan-list-rib-18245
+ (lambda (subst-18371
+ symnames-18372
+ marks-18373
+ results-18374)
(letrec*
- ((f-19627
- (lambda (symnames-19812 marks-19813 results-19814)
- (if (null? symnames-19812)
- (scan-19496 (cdr subst-19623) results-19814)
- (f-19627
- (cdr symnames-19812)
- (cdr marks-19813)
- (cons (let ((x-19820 (car symnames-19812))
- (w-19821
- (let ((w-19825
- (cons (car marks-19813)
- subst-19623)))
- (cons (cons #f (car w-19825))
+ ((f-18375
+ (lambda (symnames-18560 marks-18561 results-18562)
+ (if (null? symnames-18560)
+ (scan-18244 (cdr subst-18371) results-18562)
+ (f-18375
+ (cdr symnames-18560)
+ (cdr marks-18561)
+ (cons (let ((x-18568 (car symnames-18560))
+ (w-18569
+ (let ((w-18573
+ (cons (car marks-18561)
+ subst-18371)))
+ (cons (cons #f (car w-18573))
(cons 'shift
- (cdr w-19825))))))
- (if (if (null? (car w-19821))
- (null? (cdr w-19821))
+ (cdr w-18573))))))
+ (if (if (null? (car w-18569))
+ (null? (cdr w-18569))
#f)
- x-19820
- (if (if (vector? x-19820)
- (if (= (vector-length x-19820) 4)
- (eq? (vector-ref x-19820 0)
+ x-18568
+ (if (if (vector? x-18568)
+ (if (= (vector-length x-18568) 4)
+ (eq? (vector-ref x-18568 0)
'syntax-object)
#f)
#f)
- (let ((expression-19837
- (vector-ref x-19820 1))
- (wrap-19838
- (let ((w2-19846
- (vector-ref x-19820 2)))
- (let ((m1-19847 (car w-19821))
- (s1-19848
- (cdr w-19821)))
- (if (null? m1-19847)
- (if (null? s1-19848)
- w2-19846
- (cons (car w2-19846)
- (let ((m2-19859
- (cdr
w2-19846)))
- (if (null?
m2-19859)
- s1-19848
+ (let ((expression-18585
+ (vector-ref x-18568 1))
+ (wrap-18586
+ (let ((w2-18594
+ (vector-ref x-18568 2)))
+ (let ((m1-18595 (car w-18569))
+ (s1-18596
+ (cdr w-18569)))
+ (if (null? m1-18595)
+ (if (null? s1-18596)
+ w2-18594
+ (cons (car w2-18594)
+ (let ((m2-18607
+ (cdr
w2-18594)))
+ (if (null?
m2-18607)
+ s1-18596
(append
- s1-19848
-
m2-19859)))))
- (cons (let ((m2-19867
- (car
w2-19846)))
- (if (null?
m2-19867)
- m1-19847
+ s1-18596
+
m2-18607)))))
+ (cons (let ((m2-18615
+ (car
w2-18594)))
+ (if (null?
m2-18615)
+ m1-18595
(append
- m1-19847
- m2-19867)))
- (let ((m2-19875
- (cdr
w2-19846)))
- (if (null?
m2-19875)
- s1-19848
+ m1-18595
+ m2-18615)))
+ (let ((m2-18623
+ (cdr
w2-18594)))
+ (if (null?
m2-18623)
+ s1-18596
(append
- s1-19848
-
m2-19875))))))))
- (module-19839
- (vector-ref x-19820 3)))
+ s1-18596
+
m2-18623))))))))
+ (module-18587
+ (vector-ref x-18568 3)))
(vector
'syntax-object
- expression-19837
- wrap-19838
- module-19839))
- (if (null? x-19820)
- x-19820
+ expression-18585
+ wrap-18586
+ module-18587))
+ (if (null? x-18568)
+ x-18568
(vector
'syntax-object
- x-19820
- w-19821
- mod-19495)))))
- results-19814))))))
- (f-19627
- symnames-19624
- marks-19625
- results-19626))))
- (scan-vector-rib-19498
- (lambda (subst-19888
- symnames-19889
- marks-19890
- results-19891)
- (let ((n-19892 (vector-length symnames-19889)))
+ x-18568
+ w-18569
+ mod-18243)))))
+ results-18562))))))
+ (f-18375
+ symnames-18372
+ marks-18373
+ results-18374))))
+ (scan-vector-rib-18246
+ (lambda (subst-18636
+ symnames-18637
+ marks-18638
+ results-18639)
+ (let ((n-18640 (vector-length symnames-18637)))
(letrec*
- ((f-19893
- (lambda (i-20064 results-20065)
- (if (= i-20064 n-19892)
- (scan-19496 (cdr subst-19888) results-20065)
- (f-19893
- (#{1+}# i-20064)
- (cons (let ((x-20071
- (vector-ref symnames-19889 i-20064))
- (w-20072
- (let ((w-20076
+ ((f-18641
+ (lambda (i-18812 results-18813)
+ (if (= i-18812 n-18640)
+ (scan-18244 (cdr subst-18636) results-18813)
+ (f-18641
+ (#{1+}# i-18812)
+ (cons (let ((x-18819
+ (vector-ref symnames-18637 i-18812))
+ (w-18820
+ (let ((w-18824
(cons (vector-ref
- marks-19890
- i-20064)
- subst-19888)))
- (cons (cons #f (car w-20076))
+ marks-18638
+ i-18812)
+ subst-18636)))
+ (cons (cons #f (car w-18824))
(cons 'shift
- (cdr w-20076))))))
- (if (if (null? (car w-20072))
- (null? (cdr w-20072))
+ (cdr w-18824))))))
+ (if (if (null? (car w-18820))
+ (null? (cdr w-18820))
#f)
- x-20071
- (if (if (vector? x-20071)
- (if (= (vector-length x-20071) 4)
- (eq? (vector-ref x-20071 0)
+ x-18819
+ (if (if (vector? x-18819)
+ (if (= (vector-length x-18819) 4)
+ (eq? (vector-ref x-18819 0)
'syntax-object)
#f)
#f)
- (let ((expression-20088
- (vector-ref x-20071 1))
- (wrap-20089
- (let ((w2-20097
+ (let ((expression-18836
+ (vector-ref x-18819 1))
+ (wrap-18837
+ (let ((w2-18845
(vector-ref
- x-20071
+ x-18819
2)))
- (let ((m1-20098
- (car w-20072))
- (s1-20099
- (cdr w-20072)))
- (if (null? m1-20098)
- (if (null? s1-20099)
- w2-20097
- (cons (car w2-20097)
- (let ((m2-20110
- (cdr
w2-20097)))
- (if (null?
m2-20110)
- s1-20099
+ (let ((m1-18846
+ (car w-18820))
+ (s1-18847
+ (cdr w-18820)))
+ (if (null? m1-18846)
+ (if (null? s1-18847)
+ w2-18845
+ (cons (car w2-18845)
+ (let ((m2-18858
+ (cdr
w2-18845)))
+ (if (null?
m2-18858)
+ s1-18847
(append
- s1-20099
-
m2-20110)))))
- (cons (let ((m2-20118
- (car
w2-20097)))
- (if (null?
m2-20118)
- m1-20098
+ s1-18847
+
m2-18858)))))
+ (cons (let ((m2-18866
+ (car
w2-18845)))
+ (if (null?
m2-18866)
+ m1-18846
(append
- m1-20098
- m2-20118)))
- (let ((m2-20126
- (cdr
w2-20097)))
- (if (null?
m2-20126)
- s1-20099
+ m1-18846
+ m2-18866)))
+ (let ((m2-18874
+ (cdr
w2-18845)))
+ (if (null?
m2-18874)
+ s1-18847
(append
- s1-20099
-
m2-20126))))))))
- (module-20090
- (vector-ref x-20071 3)))
+ s1-18847
+
m2-18874))))))))
+ (module-18838
+ (vector-ref x-18819 3)))
(vector
'syntax-object
- expression-20088
- wrap-20089
- module-20090))
- (if (null? x-20071)
- x-20071
+ expression-18836
+ wrap-18837
+ module-18838))
+ (if (null? x-18819)
+ x-18819
(vector
'syntax-object
- x-20071
- w-20072
- mod-19495)))))
- results-20065))))))
- (f-19893 0 results-19891))))))
- (scan-19496 (cdr w-19494) '()))))
- (resolve-identifier-4367
- (lambda (id-20139
- w-20140
- r-20141
- mod-20142
- resolve-syntax-parameters?-20143)
- (let ((n-20147
- (id-var-name-4365 id-20139 w-20140 mod-20142)))
- (if (if (vector? n-20147)
- (if (= (vector-length n-20147) 4)
- (eq? (vector-ref n-20147 0) 'syntax-object)
+ x-18819
+ w-18820
+ mod-18243)))))
+ results-18813))))))
+ (f-18641 0 results-18639))))))
+ (scan-18244 (cdr w-18242) '()))))
+ (resolve-identifier-4368
+ (lambda (id-18887
+ w-18888
+ r-18889
+ mod-18890
+ resolve-syntax-parameters?-18891)
+ (let ((n-18895
+ (id-var-name-4366 id-18887 w-18888 mod-18890)))
+ (if (if (vector? n-18895)
+ (if (= (vector-length n-18895) 4)
+ (eq? (vector-ref n-18895 0) 'syntax-object)
#f)
#f)
- (resolve-identifier-4367
- n-20147
- w-20140
- r-20141
- mod-20142
- resolve-syntax-parameters?-20143)
- (if (symbol? n-20147)
- (let ((mod-20162
- (if (if (vector? id-20139)
- (if (= (vector-length id-20139) 4)
- (eq? (vector-ref id-20139 0) 'syntax-object)
+ (resolve-identifier-4368
+ n-18895
+ w-18888
+ r-18889
+ mod-18890
+ resolve-syntax-parameters?-18891)
+ (if (symbol? n-18895)
+ (let ((mod-18910
+ (if (if (vector? id-18887)
+ (if (= (vector-length id-18887) 4)
+ (eq? (vector-ref id-18887 0) 'syntax-object)
#f)
#f)
- (vector-ref id-20139 3)
- mod-20142)))
- (let ((b-20163
- (let ((b-20166
- (let ((t-20167
+ (vector-ref id-18887 3)
+ mod-18890)))
+ (let ((b-18911
+ (let ((b-18914
+ (let ((t-18915
(begin
- (if (if (not mod-20162)
+ (if (if (not mod-18910)
(current-module)
#f)
(warn "module system is booted,
we should have a module"
- n-20147))
- (let ((v-20216
+ n-18895))
+ (let ((v-18964
(module-variable
- (if mod-20162
+ (if mod-18910
(resolve-module
- (cdr mod-20162))
+ (cdr mod-18910))
(current-module))
- n-20147)))
- (if v-20216
- (if (variable-bound? v-20216)
- (let ((val-20225
+ n-18895)))
+ (if v-18964
+ (if (variable-bound? v-18964)
+ (let ((val-18973
(variable-ref
- v-20216)))
- (if (macro? val-20225)
- (if (macro-type val-20225)
+ v-18964)))
+ (if (macro? val-18973)
+ (if (macro-type val-18973)
(cons (macro-type
- val-20225)
+ val-18973)
(macro-binding
- val-20225))
+ val-18973))
#f)
#f))
#f)
#f)))))
- (if t-20167 t-20167 '(global)))))
- (if (if resolve-syntax-parameters?-20143
- (eq? (car b-20166) 'syntax-parameter)
+ (if t-18915 t-18915 '(global)))))
+ (if (if resolve-syntax-parameters?-18891
+ (eq? (car b-18914) 'syntax-parameter)
#f)
- (let ((t-20234 (assq-ref r-20141 (cdr b-20166))))
- (if t-20234
- t-20234
- (cons 'macro (car (cdr b-20166)))))
- b-20166))))
- (if (eq? (car b-20163) 'global)
- (values 'global n-20147 mod-20162)
- (values (car b-20163) (cdr b-20163) mod-20162))))
- (if (string? n-20147)
- (let ((mod-20240
- (if (if (vector? id-20139)
- (if (= (vector-length id-20139) 4)
- (eq? (vector-ref id-20139 0) 'syntax-object)
+ (let ((t-18982 (assq-ref r-18889 (cdr b-18914))))
+ (if t-18982
+ t-18982
+ (cons 'macro (car (cdr b-18914)))))
+ b-18914))))
+ (if (eq? (car b-18911) 'global)
+ (values 'global n-18895 mod-18910)
+ (values (car b-18911) (cdr b-18911) mod-18910))))
+ (if (string? n-18895)
+ (let ((mod-18988
+ (if (if (vector? id-18887)
+ (if (= (vector-length id-18887) 4)
+ (eq? (vector-ref id-18887 0) 'syntax-object)
#f)
#f)
- (vector-ref id-20139 3)
- mod-20142)))
- (let ((b-20241
- (let ((b-20244
- (let ((t-20245 (assq-ref r-20141 n-20147)))
- (if t-20245
- t-20245
+ (vector-ref id-18887 3)
+ mod-18890)))
+ (let ((b-18989
+ (let ((b-18992
+ (let ((t-18993 (assq-ref r-18889 n-18895)))
+ (if t-18993
+ t-18993
'(displaced-lexical)))))
- (if (if resolve-syntax-parameters?-20143
- (eq? (car b-20244) 'syntax-parameter)
+ (if (if resolve-syntax-parameters?-18891
+ (eq? (car b-18992) 'syntax-parameter)
#f)
- (let ((t-20246
- (assq-ref r-20141 (cdr b-20244))))
- (if t-20246
- t-20246
- (cons 'macro (car (cdr b-20244)))))
- b-20244))))
- (values (car b-20241) (cdr b-20241) mod-20240)))
+ (let ((t-18994
+ (assq-ref r-18889 (cdr b-18992))))
+ (if t-18994
+ t-18994
+ (cons 'macro (car (cdr b-18992)))))
+ b-18992))))
+ (values (car b-18989) (cdr b-18989) mod-18988)))
(error "unexpected id-var-name"
- id-20139
- w-20140
- n-20147)))))))
- (free-id=?-4370
- (lambda (i-20259 j-20260)
- (let ((mi-20261
- (if (if (vector? i-20259)
- (if (= (vector-length i-20259) 4)
- (eq? (vector-ref i-20259 0) 'syntax-object)
+ id-18887
+ w-18888
+ n-18895)))))))
+ (free-id=?-4371
+ (lambda (i-19007 j-19008)
+ (let ((mi-19009
+ (if (if (vector? i-19007)
+ (if (= (vector-length i-19007) 4)
+ (eq? (vector-ref i-19007 0) 'syntax-object)
#f)
#f)
- (vector-ref i-20259 3)
+ (vector-ref i-19007 3)
#f)))
- (let ((mj-20262
- (if (if (vector? j-20260)
- (if (= (vector-length j-20260) 4)
- (eq? (vector-ref j-20260 0) 'syntax-object)
+ (let ((mj-19010
+ (if (if (vector? j-19008)
+ (if (= (vector-length j-19008) 4)
+ (eq? (vector-ref j-19008 0) 'syntax-object)
#f)
#f)
- (vector-ref j-20260 3)
+ (vector-ref j-19008 3)
#f)))
- (let ((ni-20263
- (id-var-name-4365 i-20259 '(()) mi-20261)))
- (let ((nj-20264
- (id-var-name-4365 j-20260 '(()) mj-20262)))
- (if (if (vector? ni-20263)
- (if (= (vector-length ni-20263) 4)
- (eq? (vector-ref ni-20263 0) 'syntax-object)
+ (let ((ni-19011
+ (id-var-name-4366 i-19007 '(()) mi-19009)))
+ (let ((nj-19012
+ (id-var-name-4366 j-19008 '(()) mj-19010)))
+ (if (if (vector? ni-19011)
+ (if (= (vector-length ni-19011) 4)
+ (eq? (vector-ref ni-19011 0) 'syntax-object)
#f)
#f)
- (free-id=?-4370 ni-20263 j-20260)
- (if (if (vector? nj-20264)
- (if (= (vector-length nj-20264) 4)
- (eq? (vector-ref nj-20264 0) 'syntax-object)
+ (free-id=?-4371 ni-19011 j-19008)
+ (if (if (vector? nj-19012)
+ (if (= (vector-length nj-19012) 4)
+ (eq? (vector-ref nj-19012 0) 'syntax-object)
#f)
#f)
- (free-id=?-4370 i-20259 nj-20264)
- (if (symbol? ni-20263)
- (if (eq? nj-20264
- (if (if (vector? j-20260)
- (if (= (vector-length j-20260) 4)
- (eq? (vector-ref j-20260 0)
+ (free-id=?-4371 i-19007 nj-19012)
+ (if (symbol? ni-19011)
+ (if (eq? nj-19012
+ (if (if (vector? j-19008)
+ (if (= (vector-length j-19008) 4)
+ (eq? (vector-ref j-19008 0)
'syntax-object)
#f)
#f)
- (vector-ref j-20260 1)
- j-20260))
- (if (let ((bi-20336
+ (vector-ref j-19008 1)
+ j-19008))
+ (if (let ((bi-19084
(module-variable
- (if mi-20261
- (resolve-module (cdr mi-20261))
+ (if mi-19009
+ (resolve-module (cdr mi-19009))
(current-module))
- (if (if (vector? i-20259)
- (if (= (vector-length i-20259) 4)
- (eq? (vector-ref i-20259 0)
+ (if (if (vector? i-19007)
+ (if (= (vector-length i-19007) 4)
+ (eq? (vector-ref i-19007 0)
'syntax-object)
#f)
#f)
- (vector-ref i-20259 1)
- i-20259))))
- (if bi-20336
- (eq? bi-20336
+ (vector-ref i-19007 1)
+ i-19007))))
+ (if bi-19084
+ (eq? bi-19084
(module-variable
- (if mj-20262
- (resolve-module (cdr mj-20262))
+ (if mj-19010
+ (resolve-module (cdr mj-19010))
(current-module))
- (if (if (vector? j-20260)
- (if (= (vector-length j-20260) 4)
- (eq? (vector-ref j-20260 0)
+ (if (if (vector? j-19008)
+ (if (= (vector-length j-19008) 4)
+ (eq? (vector-ref j-19008 0)
'syntax-object)
#f)
#f)
- (vector-ref j-20260 1)
- j-20260)))
+ (vector-ref j-19008 1)
+ j-19008)))
(if (not (module-variable
- (if mj-20262
- (resolve-module (cdr mj-20262))
+ (if mj-19010
+ (resolve-module (cdr mj-19010))
(current-module))
- (if (if (vector? j-20260)
+ (if (if (vector? j-19008)
(if (= (vector-length
- j-20260)
+ j-19008)
4)
- (eq? (vector-ref j-20260 0)
+ (eq? (vector-ref j-19008 0)
'syntax-object)
#f)
#f)
- (vector-ref j-20260 1)
- j-20260)))
- (eq? ni-20263 nj-20264)
+ (vector-ref j-19008 1)
+ j-19008)))
+ (eq? ni-19011 nj-19012)
#f)))
(eq? (module-variable
- (if mi-20261
- (resolve-module (cdr mi-20261))
+ (if mi-19009
+ (resolve-module (cdr mi-19009))
(current-module))
- (if (if (vector? i-20259)
- (if (= (vector-length i-20259) 4)
- (eq? (vector-ref i-20259 0)
+ (if (if (vector? i-19007)
+ (if (= (vector-length i-19007) 4)
+ (eq? (vector-ref i-19007 0)
'syntax-object)
#f)
#f)
- (vector-ref i-20259 1)
- i-20259))
+ (vector-ref i-19007 1)
+ i-19007))
(module-variable
- (if mj-20262
- (resolve-module (cdr mj-20262))
+ (if mj-19010
+ (resolve-module (cdr mj-19010))
(current-module))
- (if (if (vector? j-20260)
- (if (= (vector-length j-20260) 4)
- (eq? (vector-ref j-20260 0)
+ (if (if (vector? j-19008)
+ (if (= (vector-length j-19008) 4)
+ (eq? (vector-ref j-19008 0)
'syntax-object)
#f)
#f)
- (vector-ref j-20260 1)
- j-20260)))
+ (vector-ref j-19008 1)
+ j-19008)))
#f)
#f)
- (equal? ni-20263 nj-20264))))))))))
- (bound-id=?-4371
- (lambda (i-20529 j-20530)
- (if (if (if (vector? i-20529)
- (if (= (vector-length i-20529) 4)
- (eq? (vector-ref i-20529 0) 'syntax-object)
+ (equal? ni-19011 nj-19012))))))))))
+ (bound-id=?-4372
+ (lambda (i-19277 j-19278)
+ (if (if (if (vector? i-19277)
+ (if (= (vector-length i-19277) 4)
+ (eq? (vector-ref i-19277 0) 'syntax-object)
#f)
#f)
- (if (vector? j-20530)
- (if (= (vector-length j-20530) 4)
- (eq? (vector-ref j-20530 0) 'syntax-object)
+ (if (vector? j-19278)
+ (if (= (vector-length j-19278) 4)
+ (eq? (vector-ref j-19278 0) 'syntax-object)
#f)
#f)
#f)
- (if (eq? (vector-ref i-20529 1)
- (vector-ref j-20530 1))
- (same-marks?-4364
- (car (vector-ref i-20529 2))
- (car (vector-ref j-20530 2)))
+ (if (eq? (vector-ref i-19277 1)
+ (vector-ref j-19278 1))
+ (same-marks?-4365
+ (car (vector-ref i-19277 2))
+ (car (vector-ref j-19278 2)))
#f)
- (eq? i-20529 j-20530))))
- (valid-bound-ids?-4372
- (lambda (ids-20699)
+ (eq? i-19277 j-19278))))
+ (valid-bound-ids?-4373
+ (lambda (ids-19447)
(if (letrec*
- ((all-ids?-20700
- (lambda (ids-20897)
- (if (null? ids-20897)
- (null? ids-20897)
- (if (let ((x-20908 (car ids-20897)))
- (if (symbol? x-20908)
+ ((all-ids?-19448
+ (lambda (ids-19645)
+ (if (null? ids-19645)
+ (null? ids-19645)
+ (if (let ((x-19656 (car ids-19645)))
+ (if (symbol? x-19656)
#t
- (if (if (vector? x-20908)
- (if (= (vector-length x-20908) 4)
- (eq? (vector-ref x-20908 0)
+ (if (if (vector? x-19656)
+ (if (= (vector-length x-19656) 4)
+ (eq? (vector-ref x-19656 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-20908 1))
+ (symbol? (vector-ref x-19656 1))
#f)))
- (all-ids?-20700 (cdr ids-20897))
+ (all-ids?-19448 (cdr ids-19645))
#f)))))
- (all-ids?-20700 ids-20699))
- (distinct-bound-ids?-4373 ids-20699)
+ (all-ids?-19448 ids-19447))
+ (distinct-bound-ids?-4374 ids-19447)
#f)))
- (distinct-bound-ids?-4373
- (lambda (ids-21029)
+ (distinct-bound-ids?-4374
+ (lambda (ids-19777)
(letrec*
- ((distinct?-21030
- (lambda (ids-21135)
- (if (null? ids-21135)
- (null? ids-21135)
- (if (not (bound-id-member?-4374
- (car ids-21135)
- (cdr ids-21135)))
- (distinct?-21030 (cdr ids-21135))
+ ((distinct?-19778
+ (lambda (ids-19883)
+ (if (null? ids-19883)
+ (null? ids-19883)
+ (if (not (bound-id-member?-4375
+ (car ids-19883)
+ (cdr ids-19883)))
+ (distinct?-19778 (cdr ids-19883))
#f)))))
- (distinct?-21030 ids-21029))))
- (bound-id-member?-4374
- (lambda (x-21231 list-21232)
- (if (not (null? list-21232))
- (let ((t-21233
- (bound-id=?-4371 x-21231 (car list-21232))))
- (if t-21233
- t-21233
- (bound-id-member?-4374 x-21231 (cdr list-21232))))
+ (distinct?-19778 ids-19777))))
+ (bound-id-member?-4375
+ (lambda (x-19979 list-19980)
+ (if (not (null? list-19980))
+ (let ((t-19981
+ (bound-id=?-4372 x-19979 (car list-19980))))
+ (if t-19981
+ t-19981
+ (bound-id-member?-4375 x-19979 (cdr list-19980))))
#f)))
- (source-wrap-4376
- (lambda (x-21411 w-21412 s-21413 defmod-21414)
- (let ((x-21418
+ (source-wrap-4377
+ (lambda (x-20159 w-20160 s-20161 defmod-20162)
+ (let ((x-20166
(begin
- (if (if (pair? x-21411) s-21413 #f)
- (set-source-properties! x-21411 s-21413))
- x-21411)))
- (if (if (null? (car w-21412))
- (null? (cdr w-21412))
+ (if (if s-20161
+ (supports-source-properties? x-20159)
+ #f)
+ (set-source-properties! x-20159 s-20161))
+ x-20159)))
+ (if (if (null? (car w-20160))
+ (null? (cdr w-20160))
#f)
- x-21418
- (if (if (vector? x-21418)
- (if (= (vector-length x-21418) 4)
- (eq? (vector-ref x-21418 0) 'syntax-object)
+ x-20166
+ (if (if (vector? x-20166)
+ (if (= (vector-length x-20166) 4)
+ (eq? (vector-ref x-20166 0) 'syntax-object)
#f)
#f)
- (let ((expression-21450 (vector-ref x-21418 1))
- (wrap-21451
- (let ((w2-21459 (vector-ref x-21418 2)))
- (let ((m1-21460 (car w-21412))
- (s1-21461 (cdr w-21412)))
- (if (null? m1-21460)
- (if (null? s1-21461)
- w2-21459
- (cons (car w2-21459)
- (let ((m2-21476 (cdr w2-21459)))
- (if (null? m2-21476)
- s1-21461
- (append s1-21461 m2-21476)))))
- (cons (let ((m2-21484 (car w2-21459)))
- (if (null? m2-21484)
- m1-21460
- (append m1-21460 m2-21484)))
- (let ((m2-21492 (cdr w2-21459)))
- (if (null? m2-21492)
- s1-21461
- (append s1-21461 m2-21492))))))))
- (module-21452 (vector-ref x-21418 3)))
+ (let ((expression-20198 (vector-ref x-20166 1))
+ (wrap-20199
+ (let ((w2-20207 (vector-ref x-20166 2)))
+ (let ((m1-20208 (car w-20160))
+ (s1-20209 (cdr w-20160)))
+ (if (null? m1-20208)
+ (if (null? s1-20209)
+ w2-20207
+ (cons (car w2-20207)
+ (let ((m2-20224 (cdr w2-20207)))
+ (if (null? m2-20224)
+ s1-20209
+ (append s1-20209 m2-20224)))))
+ (cons (let ((m2-20232 (car w2-20207)))
+ (if (null? m2-20232)
+ m1-20208
+ (append m1-20208 m2-20232)))
+ (let ((m2-20240 (cdr w2-20207)))
+ (if (null? m2-20240)
+ s1-20209
+ (append s1-20209 m2-20240))))))))
+ (module-20200 (vector-ref x-20166 3)))
(vector
'syntax-object
- expression-21450
- wrap-21451
- module-21452))
- (if (null? x-21418)
- x-21418
+ expression-20198
+ wrap-20199
+ module-20200))
+ (if (null? x-20166)
+ x-20166
(vector
'syntax-object
- x-21418
- w-21412
- defmod-21414)))))))
- (expand-sequence-4377
- (lambda (body-37161 r-37162 w-37163 s-37164 mod-37165)
- (build-sequence-4328
- s-37164
+ x-20166
+ w-20160
+ defmod-20162)))))))
+ (expand-sequence-4378
+ (lambda (body-34633 r-34634 w-34635 s-34636 mod-34637)
+ (build-sequence-4329
+ s-34636
(letrec*
- ((dobody-37253
- (lambda (body-37336 r-37337 w-37338 mod-37339)
- (if (null? body-37336)
+ ((dobody-34772
+ (lambda (body-35078 r-35079 w-35080 mod-35081)
+ (if (null? body-35078)
'()
- (let ((first-37340
- (expand-4382
- (car body-37336)
- r-37337
- w-37338
- mod-37339)))
- (cons first-37340
- (dobody-37253
- (cdr body-37336)
- r-37337
- w-37338
- mod-37339)))))))
- (dobody-37253
- body-37161
- r-37162
- w-37163
- mod-37165)))))
- (expand-top-sequence-4378
- (lambda (body-21521
- r-21522
- w-21523
- s-21524
- m-21525
- esew-21526
- mod-21527)
- (let ((r-21528
- (cons '("placeholder" placeholder) r-21522)))
- (let ((ribcage-21529 (vector 'ribcage '() '() '())))
- (let ((w-21530
- (cons (car w-21523)
- (cons ribcage-21529 (cdr w-21523)))))
+ (let ((first-35082
+ (let ((e-35086 (car body-35078)))
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-35086
+ r-35079
+ w-35080
+ (let ((props-35096
+ (source-properties
+ (if (if (vector? e-35086)
+ (if (= (vector-length
+ e-35086)
+ 4)
+ (eq? (vector-ref
+ e-35086
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref e-35086 1)
+ e-35086))))
+ (if (pair? props-35096) props-35096 #f))
+ #f
+ mod-35081
+ #f))
+ (lambda (type-35119
+ value-35120
+ form-35121
+ e-35122
+ w-35123
+ s-35124
+ mod-35125)
+ (expand-expr-4384
+ type-35119
+ value-35120
+ form-35121
+ e-35122
+ r-35079
+ w-35123
+ s-35124
+ mod-35125))))))
+ (cons first-35082
+ (dobody-34772
+ (cdr body-35078)
+ r-35079
+ w-35080
+ mod-35081)))))))
+ (dobody-34772
+ body-34633
+ r-34634
+ w-34635
+ mod-34637)))))
+ (expand-top-sequence-4379
+ (lambda (body-20269
+ r-20270
+ w-20271
+ s-20272
+ m-20273
+ esew-20274
+ mod-20275)
+ (let ((r-20276
+ (cons '("placeholder" placeholder) r-20270)))
+ (let ((ribcage-20277 (vector 'ribcage '() '() '())))
+ (let ((w-20278
+ (cons (car w-20271)
+ (cons ribcage-20277 (cdr w-20271)))))
(letrec*
- ((record-definition!-21531
- (lambda (id-24931 var-24932)
- (let ((mod-24933
+ ((record-definition!-20279
+ (lambda (id-23483 var-23484)
+ (let ((mod-23485
(cons 'hygiene (module-name (current-module)))))
- (let ((label-24939
- (cons (vector-ref id-24931 3)
- (if (if (vector? var-24932)
- (if (= (vector-length var-24932) 4)
- (eq? (vector-ref var-24932 0)
+ (let ((label-23491
+ (cons (vector-ref id-23483 3)
+ (if (if (vector? var-23484)
+ (if (= (vector-length var-23484) 4)
+ (eq? (vector-ref var-23484 0)
'syntax-object)
#f)
#f)
- (let ((expression-25001
- (vector-ref var-24932 1))
- (wrap-25002
- (let ((w2-25012
+ (let ((expression-23553
+ (vector-ref var-23484 1))
+ (wrap-23554
+ (let ((w2-23564
(vector-ref
- var-24932
+ var-23484
2)))
- (cons (let ((m2-25019
- (car
w2-25012)))
- (if (null? m2-25019)
+ (cons (let ((m2-23571
+ (car
w2-23564)))
+ (if (null? m2-23571)
'(top)
(append
'(top)
- m2-25019)))
- (let ((m2-25028
- (cdr
w2-25012)))
- (if (null? m2-25028)
+ m2-23571)))
+ (let ((m2-23580
+ (cdr
w2-23564)))
+ (if (null? m2-23580)
'()
(append
'()
- m2-25028))))))
- (module-25003
- (vector-ref var-24932 3)))
+ m2-23580))))))
+ (module-23555
+ (vector-ref var-23484 3)))
(vector
'syntax-object
- expression-25001
- wrap-25002
- module-25003))
- (if (null? var-24932)
- var-24932
+ expression-23553
+ wrap-23554
+ module-23555))
+ (if (null? var-23484)
+ var-23484
(vector
'syntax-object
- var-24932
+ var-23484
'((top))
- mod-24933))))))
+ mod-23485))))))
(begin
- (let ((update-24942
- (cons (vector-ref id-24931 1)
- (vector-ref ribcage-21529 1))))
- (vector-set! ribcage-21529 1 update-24942))
- (let ((update-24957
- (cons (car (vector-ref id-24931 2))
- (vector-ref ribcage-21529 2))))
- (vector-set! ribcage-21529 2 update-24957))
- (let ((update-24972
- (cons label-24939
- (vector-ref ribcage-21529 3))))
- (vector-set! ribcage-21529 3 update-24972)))))))
- (parse-21534
- (lambda (body-21729
- r-21730
- w-21731
- s-21732
- m-21733
- esew-21734
- mod-21735)
+ (let ((update-23494
+ (cons (vector-ref id-23483 1)
+ (vector-ref ribcage-20277 1))))
+ (vector-set! ribcage-20277 1 update-23494))
+ (let ((update-23509
+ (cons (car (vector-ref id-23483 2))
+ (vector-ref ribcage-20277 2))))
+ (vector-set! ribcage-20277 2 update-23509))
+ (let ((update-23524
+ (cons label-23491
+ (vector-ref ribcage-20277 3))))
+ (vector-set! ribcage-20277 3 update-23524)))))))
+ (parse-20282
+ (lambda (body-20479
+ r-20480
+ w-20481
+ s-20482
+ m-20483
+ esew-20484
+ mod-20485)
(letrec*
- ((lp-21736
- (lambda (body-21819 exps-21820)
- (if (null? body-21819)
- exps-21820
- (lp-21736
- (cdr body-21819)
+ ((lp-20486
+ (lambda (body-20726 exps-20727)
+ (if (null? body-20726)
+ exps-20727
+ (lp-20486
+ (cdr body-20726)
(append
- (parse1-21535
- (car body-21819)
- r-21730
- w-21731
- s-21732
- m-21733
- esew-21734
- mod-21735)
- exps-21820))))))
- (lp-21736 body-21729 '()))))
- (parse1-21535
- (lambda (x-21890
- r-21891
- w-21892
- s-21893
- m-21894
- esew-21895
- mod-21896)
+ (parse1-20283
+ (car body-20726)
+ r-20480
+ w-20481
+ s-20482
+ m-20483
+ esew-20484
+ mod-20485)
+ exps-20727))))))
+ (lp-20486 body-20479 '()))))
+ (parse1-20283
+ (lambda (x-20969
+ r-20970
+ w-20971
+ s-20972
+ m-20973
+ esew-20974
+ mod-20975)
(call-with-values
(lambda ()
- (syntax-type-4381
- x-21890
- r-21891
- w-21892
- (source-annotation-4340 x-21890)
- ribcage-21529
- mod-21896
+ (syntax-type-4382
+ x-20969
+ r-20970
+ w-20971
+ (let ((props-20982
+ (source-properties
+ (if (if (vector? x-20969)
+ (if (= (vector-length x-20969) 4)
+ (eq? (vector-ref x-20969 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref x-20969 1)
+ x-20969))))
+ (if (pair? props-20982) props-20982 #f))
+ ribcage-20277
+ mod-20975
#f))
- (lambda (type-22082
- value-22083
- form-22084
- e-22085
- w-22086
- s-22087
- mod-22088)
- (if (eqv? type-22082 'define-form)
- (let ((id-22096
- (if (if (null? (car w-22086))
- (null? (cdr w-22086))
+ (lambda (type-21005
+ value-21006
+ form-21007
+ e-21008
+ w-21009
+ s-21010
+ mod-21011)
+ (if (eqv? type-21005 'define-form)
+ (let ((id-21019
+ (if (if (null? (car w-21009))
+ (null? (cdr w-21009))
#f)
- value-22083
- (if (if (vector? value-22083)
- (if (= (vector-length value-22083)
+ value-21006
+ (if (if (vector? value-21006)
+ (if (= (vector-length value-21006)
4)
- (eq? (vector-ref value-22083 0)
+ (eq? (vector-ref value-21006 0)
'syntax-object)
#f)
#f)
- (let ((expression-22146
- (vector-ref value-22083 1))
- (wrap-22147
- (let ((w2-22157
+ (let ((expression-21069
+ (vector-ref value-21006 1))
+ (wrap-21070
+ (let ((w2-21080
(vector-ref
- value-22083
+ value-21006
2)))
- (let ((m1-22158
- (car w-22086))
- (s1-22159
- (cdr w-22086)))
- (if (null? m1-22158)
- (if (null? s1-22159)
- w2-22157
- (cons (car w2-22157)
- (let ((m2-22176
- (cdr
w2-22157)))
- (if (null?
m2-22176)
- s1-22159
+ (let ((m1-21081
+ (car w-21009))
+ (s1-21082
+ (cdr w-21009)))
+ (if (null? m1-21081)
+ (if (null? s1-21082)
+ w2-21080
+ (cons (car w2-21080)
+ (let ((m2-21099
+ (cdr
w2-21080)))
+ (if (null?
m2-21099)
+ s1-21082
(append
- s1-22159
-
m2-22176)))))
- (cons (let ((m2-22184
- (car
w2-22157)))
- (if (null?
m2-22184)
- m1-22158
+ s1-21082
+
m2-21099)))))
+ (cons (let ((m2-21107
+ (car
w2-21080)))
+ (if (null?
m2-21107)
+ m1-21081
(append
- m1-22158
- m2-22184)))
- (let ((m2-22192
- (cdr
w2-22157)))
- (if (null?
m2-22192)
- s1-22159
+ m1-21081
+ m2-21107)))
+ (let ((m2-21115
+ (cdr
w2-21080)))
+ (if (null?
m2-21115)
+ s1-21082
(append
- s1-22159
-
m2-22192))))))))
- (module-22148
- (vector-ref value-22083 3)))
+ s1-21082
+
m2-21115))))))))
+ (module-21071
+ (vector-ref value-21006 3)))
(vector
'syntax-object
- expression-22146
- wrap-22147
- module-22148))
- (if (null? value-22083)
- value-22083
+ expression-21069
+ wrap-21070
+ module-21071))
+ (if (null? value-21006)
+ value-21006
(vector
'syntax-object
- value-22083
- w-22086
- mod-22088))))))
+ value-21006
+ w-21009
+ mod-21011))))))
(begin
(string-append
"l-"
- (session-id-4307)
+ (session-id-4308)
(symbol->string (gensym "-")))
- (let ((var-22098
+ (let ((var-21021
(if (not (equal?
(car (vector-ref
- id-22096
+ id-21019
2))
'(top)))
(symbol-append
- (vector-ref id-22096 1)
+ (vector-ref id-21019 1)
'-
(string->symbol
(number->string
- (hash (syntax->datum x-21890)
+ (hash (syntax->datum x-20969)
most-positive-fixnum)
16)))
- (vector-ref id-22096 1))))
+ (vector-ref id-21019 1))))
(begin
- (record-definition!-21531
- id-22096
- var-22098)
- (list (if (eq? m-21894 'c&e)
- (let ((x-22318
-
(build-global-definition-4321
- s-22087
- var-22098
- (expand-4382
- e-22085
- r-21891
- w-22086
- mod-22088))))
+ (record-definition!-20279
+ id-21019
+ var-21021)
+ (list (if (eq? m-20973 'c&e)
+ (let ((x-21241
+ (let ((exp-21251
+ (call-with-values
+ (lambda ()
+
(syntax-type-4382
+ e-21008
+ r-20970
+ w-21009
+ (let
((props-21272
+
(source-properties
+
(if (if (vector?
+
e-21008)
+
(if (= (vector-length
+
e-21008)
+
4)
+
(eq? (vector-ref
+
e-21008
+
0)
+
'syntax-object)
+
#f)
+
#f)
+
(vector-ref
+
e-21008
+
1)
+
e-21008))))
+ (if (pair?
props-21272)
+
props-21272
+ #f))
+ #f
+ mod-21011
+ #f))
+ (lambda
(type-21305
+
value-21306
+
form-21307
+ e-21308
+ w-21309
+ s-21310
+
mod-21311)
+
(expand-expr-4384
+ type-21305
+ value-21306
+ form-21307
+ e-21308
+ r-20970
+ w-21309
+ s-21310
+
mod-21311)))))
+ (begin
+ (if (if (struct?
+ exp-21251)
+ (eq?
(struct-vtable
+ exp-21251)
+ (vector-ref
+
%expanded-vtables
+ 14))
+ #f)
+ (let ((meta-21323
+ (struct-ref
+ exp-21251
+ 1)))
+ (if (not (assq
'name
+
meta-21323))
+ (let ((v-21330
+ (cons
(cons 'name
+
var-21021)
+
meta-21323)))
+ (struct-set!
+ exp-21251
+ 1
+ v-21330)))))
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 9)
+ s-21010
+ var-21021
+ exp-21251)))))
(begin
- (top-level-eval-hook-4305
- x-22318
- mod-22088)
- (lambda () x-22318)))
+ (primitive-eval x-21241)
+ (lambda () x-21241)))
(lambda ()
- (build-global-definition-4321
- s-22087
- var-22098
- (expand-4382
- e-22085
- r-21891
- w-22086
- mod-22088)))))))))
- (if (if (eqv? type-22082 'define-syntax-form)
+ (let ((exp-21346
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-21008
+ r-20970
+ w-21009
+ (let ((props-21367
+
(source-properties
+ (if (if
(vector?
+
e-21008)
+
(if (= (vector-length
+
e-21008)
+
4)
+
(eq? (vector-ref
+
e-21008
+
0)
+
'syntax-object)
+
#f)
+ #f)
+
(vector-ref
+
e-21008
+ 1)
+
e-21008))))
+ (if (pair?
props-21367)
+ props-21367
+ #f))
+ #f
+ mod-21011
+ #f))
+ (lambda (type-21400
+ value-21401
+ form-21402
+ e-21403
+ w-21404
+ s-21405
+ mod-21406)
+ (expand-expr-4384
+ type-21400
+ value-21401
+ form-21402
+ e-21403
+ r-20970
+ w-21404
+ s-21405
+ mod-21406)))))
+ (begin
+ (if (if (struct? exp-21346)
+ (eq? (struct-vtable
+ exp-21346)
+ (vector-ref
+
%expanded-vtables
+ 14))
+ #f)
+ (let ((meta-21418
+ (struct-ref
+ exp-21346
+ 1)))
+ (if (not (assq 'name
+
meta-21418))
+ (let ((v-21425
+ (cons (cons
'name
+
var-21021)
+
meta-21418)))
+ (struct-set!
+ exp-21346
+ 1
+ v-21425)))))
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 9)
+ s-21010
+ var-21021
+ exp-21346))))))))))
+ (if (if (eqv? type-21005 'define-syntax-form)
#t
- (eqv? type-22082
+ (eqv? type-21005
'define-syntax-parameter-form))
- (let ((id-22815
- (if (if (null? (car w-22086))
- (null? (cdr w-22086))
+ (let ((id-21450
+ (if (if (null? (car w-21009))
+ (null? (cdr w-21009))
#f)
- value-22083
- (if (if (vector? value-22083)
+ value-21006
+ (if (if (vector? value-21006)
(if (= (vector-length
- value-22083)
+ value-21006)
4)
- (eq? (vector-ref value-22083 0)
+ (eq? (vector-ref value-21006 0)
'syntax-object)
#f)
#f)
- (let ((expression-22865
- (vector-ref value-22083 1))
- (wrap-22866
- (let ((w2-22876
+ (let ((expression-21500
+ (vector-ref value-21006 1))
+ (wrap-21501
+ (let ((w2-21511
(vector-ref
- value-22083
+ value-21006
2)))
- (let ((m1-22877
- (car w-22086))
- (s1-22878
- (cdr w-22086)))
- (if (null? m1-22877)
- (if (null? s1-22878)
- w2-22876
- (cons (car w2-22876)
- (let ((m2-22895
- (cdr
w2-22876)))
- (if (null?
m2-22895)
- s1-22878
+ (let ((m1-21512
+ (car w-21009))
+ (s1-21513
+ (cdr w-21009)))
+ (if (null? m1-21512)
+ (if (null? s1-21513)
+ w2-21511
+ (cons (car w2-21511)
+ (let ((m2-21530
+ (cdr
w2-21511)))
+ (if (null?
m2-21530)
+ s1-21513
(append
- s1-22878
-
m2-22895)))))
- (cons (let ((m2-22903
- (car
w2-22876)))
- (if (null?
m2-22903)
- m1-22877
+ s1-21513
+
m2-21530)))))
+ (cons (let ((m2-21538
+ (car
w2-21511)))
+ (if (null?
m2-21538)
+ m1-21512
(append
- m1-22877
- m2-22903)))
- (let ((m2-22911
- (cdr
w2-22876)))
- (if (null?
m2-22911)
- s1-22878
+ m1-21512
+ m2-21538)))
+ (let ((m2-21546
+ (cdr
w2-21511)))
+ (if (null?
m2-21546)
+ s1-21513
(append
- s1-22878
-
m2-22911))))))))
- (module-22867
- (vector-ref value-22083 3)))
+ s1-21513
+
m2-21546))))))))
+ (module-21502
+ (vector-ref value-21006 3)))
(vector
'syntax-object
- expression-22865
- wrap-22866
- module-22867))
- (if (null? value-22083)
- value-22083
+ expression-21500
+ wrap-21501
+ module-21502))
+ (if (null? value-21006)
+ value-21006
(vector
'syntax-object
- value-22083
- w-22086
- mod-22088))))))
+ value-21006
+ w-21009
+ mod-21011))))))
(begin
(string-append
"l-"
- (session-id-4307)
+ (session-id-4308)
(symbol->string (gensym "-")))
- (let ((var-22817
+ (let ((var-21452
(if (not (equal?
(car (vector-ref
- id-22815
+ id-21450
2))
'(top)))
(symbol-append
- (vector-ref id-22815 1)
+ (vector-ref id-21450 1)
'-
(string->symbol
(number->string
- (hash (syntax->datum x-21890)
+ (hash (syntax->datum x-20969)
most-positive-fixnum)
16)))
- (vector-ref id-22815 1))))
+ (vector-ref id-21450 1))))
(begin
- (record-definition!-21531
- id-22815
- var-22817)
- (if (eqv? m-21894 'c)
- (if (memq 'compile esew-21895)
- (let ((e-23044
- (expand-install-global-4379
- var-22817
- type-22082
- (expand-4382
- e-22085
- r-21891
- w-22086
- mod-22088))))
+ (record-definition!-20279
+ id-21450
+ var-21452)
+ (if (eqv? m-20973 'c)
+ (if (memq 'compile esew-20974)
+ (let ((e-21679
+ (expand-install-global-4380
+ var-21452
+ type-21005
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-21008
+ r-20970
+ w-21009
+ (let ((props-21939
+
(source-properties
+ (if (if
(vector?
+
e-21008)
+ (if
(= (vector-length
+
e-21008)
+
4)
+
(eq? (vector-ref
+
e-21008
+
0)
+
'syntax-object)
+ #f)
+ #f)
+
(vector-ref
+ e-21008
+ 1)
+
e-21008))))
+ (if (pair?
props-21939)
+ props-21939
+ #f))
+ #f
+ mod-21011
+ #f))
+ (lambda (type-21972
+ value-21973
+ form-21974
+ e-21975
+ w-21976
+ s-21977
+ mod-21978)
+ (expand-expr-4384
+ type-21972
+ value-21973
+ form-21974
+ e-21975
+ r-20970
+ w-21976
+ s-21977
+ mod-21978))))))
(begin
- (top-level-eval-hook-4305
- e-23044
- mod-22088)
- (if (memq 'load esew-21895)
- (list (lambda () e-23044))
+ (top-level-eval-hook-4306
+ e-21679
+ mod-21011)
+ (if (memq 'load esew-20974)
+ (list (lambda () e-21679))
'())))
- (if (memq 'load esew-21895)
+ (if (memq 'load esew-20974)
(list (lambda ()
- (expand-install-global-4379
- var-22817
- type-22082
- (expand-4382
- e-22085
- r-21891
- w-22086
- mod-22088))))
+ (expand-install-global-4380
+ var-21452
+ type-21005
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-21008
+ r-20970
+ w-21009
+ (let ((props-22095
+
(source-properties
+ (if (if
(vector?
+
e-21008)
+
(if (= (vector-length
+
e-21008)
+
4)
+
(eq? (vector-ref
+
e-21008
+
0)
+
'syntax-object)
+
#f)
+ #f)
+
(vector-ref
+
e-21008
+ 1)
+
e-21008))))
+ (if (pair?
props-22095)
+ props-22095
+ #f))
+ #f
+ mod-21011
+ #f))
+ (lambda (type-22128
+ value-22129
+ form-22130
+ e-22131
+ w-22132
+ s-22133
+ mod-22134)
+ (expand-expr-4384
+ type-22128
+ value-22129
+ form-22130
+ e-22131
+ r-20970
+ w-22132
+ s-22133
+ mod-22134))))))
'()))
- (if (eqv? m-21894 'c&e)
- (let ((e-23550
- (expand-install-global-4379
- var-22817
- type-22082
- (expand-4382
- e-22085
- r-21891
- w-22086
- mod-22088))))
+ (if (eqv? m-20973 'c&e)
+ (let ((e-22144
+ (expand-install-global-4380
+ var-21452
+ type-21005
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-21008
+ r-20970
+ w-21009
+ (let ((props-22404
+
(source-properties
+ (if (if
(vector?
+
e-21008)
+ (if
(= (vector-length
+
e-21008)
+
4)
+
(eq? (vector-ref
+
e-21008
+
0)
+
'syntax-object)
+ #f)
+ #f)
+
(vector-ref
+ e-21008
+ 1)
+
e-21008))))
+ (if (pair?
props-22404)
+ props-22404
+ #f))
+ #f
+ mod-21011
+ #f))
+ (lambda (type-22437
+ value-22438
+ form-22439
+ e-22440
+ w-22441
+ s-22442
+ mod-22443)
+ (expand-expr-4384
+ type-22437
+ value-22438
+ form-22439
+ e-22440
+ r-20970
+ w-22441
+ s-22442
+ mod-22443))))))
(begin
- (top-level-eval-hook-4305
- e-23550
- mod-22088)
- (list (lambda () e-23550))))
+ (top-level-eval-hook-4306
+ e-22144
+ mod-21011)
+ (list (lambda () e-22144))))
(begin
- (if (memq 'eval esew-21895)
- (top-level-eval-hook-4305
- (expand-install-global-4379
- var-22817
- type-22082
- (expand-4382
- e-22085
- r-21891
- w-22086
- mod-22088))
- mod-22088))
+ (if (memq 'eval esew-20974)
+ (top-level-eval-hook-4306
+ (expand-install-global-4380
+ var-21452
+ type-21005
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-21008
+ r-20970
+ w-21009
+ (let ((props-22662
+
(source-properties
+ (if (if
(vector?
+
e-21008)
+ (if (=
(vector-length
+
e-21008)
+
4)
+ (eq?
(vector-ref
+
e-21008
+
0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ e-21008
+ 1)
+ e-21008))))
+ (if (pair?
props-22662)
+ props-22662
+ #f))
+ #f
+ mod-21011
+ #f))
+ (lambda (type-22695
+ value-22696
+ form-22697
+ e-22698
+ w-22699
+ s-22700
+ mod-22701)
+ (expand-expr-4384
+ type-22695
+ value-22696
+ form-22697
+ e-22698
+ r-20970
+ w-22699
+ s-22700
+ mod-22701))))
+ mod-21011))
'())))))))
- (if (eqv? type-22082 'begin-form)
- (let ((tmp-24163
+ (if (eqv? type-21005 'begin-form)
+ (let ((tmp-22715
($sc-dispatch
- e-22085
+ e-21008
'(_ . each-any))))
- (if tmp-24163
+ (if tmp-22715
(@apply
- (lambda (e1-24167)
- (parse-21534
- e1-24167
- r-21891
- w-22086
- s-22087
- m-21894
- esew-21895
- mod-22088))
- tmp-24163)
+ (lambda (e1-22719)
+ (parse-20282
+ e1-22719
+ r-20970
+ w-21009
+ s-21010
+ m-20973
+ esew-20974
+ mod-21011))
+ tmp-22715)
(syntax-violation
#f
"source expression failed to match any
pattern"
- e-22085)))
- (if (eqv? type-22082 'local-syntax-form)
- (expand-local-syntax-4387
- value-22083
- e-22085
- r-21891
- w-22086
- s-22087
- mod-22088
- (lambda (forms-24213
- r-24214
- w-24215
- s-24216
- mod-24217)
- (parse-21534
- forms-24213
- r-24214
- w-24215
- s-24216
- m-21894
- esew-21895
- mod-24217)))
- (if (eqv? type-22082 'eval-when-form)
- (let ((tmp-24256
+ e-21008)))
+ (if (eqv? type-21005 'local-syntax-form)
+ (expand-local-syntax-4388
+ value-21006
+ e-21008
+ r-20970
+ w-21009
+ s-21010
+ mod-21011
+ (lambda (forms-22765
+ r-22766
+ w-22767
+ s-22768
+ mod-22769)
+ (parse-20282
+ forms-22765
+ r-22766
+ w-22767
+ s-22768
+ m-20973
+ esew-20974
+ mod-22769)))
+ (if (eqv? type-21005 'eval-when-form)
+ (let ((tmp-22808
($sc-dispatch
- e-22085
+ e-21008
'(_ each-any any . each-any))))
- (if tmp-24256
+ (if tmp-22808
(@apply
- (lambda (x-24260 e1-24261 e2-24262)
- (let ((when-list-24263
- (parse-when-list-4380
- e-22085
- x-24260))
- (body-24264
- (cons e1-24261 e2-24262)))
+ (lambda (x-22812 e1-22813 e2-22814)
+ (let ((when-list-22815
+ (parse-when-list-4381
+ e-21008
+ x-22812))
+ (body-22816
+ (cons e1-22813 e2-22814)))
(letrec*
- ((recurse-24265
- (lambda (m-24851 esew-24852)
- (parse-21534
- body-24264
- r-21891
- w-22086
- s-22087
- m-24851
- esew-24852
- mod-22088))))
- (if (eq? m-21894 'e)
+ ((recurse-22817
+ (lambda (m-23403 esew-23404)
+ (parse-20282
+ body-22816
+ r-20970
+ w-21009
+ s-21010
+ m-23403
+ esew-23404
+ mod-21011))))
+ (if (eq? m-20973 'e)
(if (memq 'eval
- when-list-24263)
- (recurse-24265
+ when-list-22815)
+ (recurse-22817
(if (memq 'expand
-
when-list-24263)
+
when-list-22815)
'c&e
'e)
'(eval))
(begin
(if (memq 'expand
-
when-list-24263)
- (let ((x-24372
-
(expand-top-sequence-4378
- body-24264
- r-21891
- w-22086
- s-22087
+
when-list-22815)
+ (let ((x-22924
+
(expand-top-sequence-4379
+ body-22816
+ r-20970
+ w-21009
+ s-21010
'e
'(eval)
- mod-22088)))
+ mod-21011)))
(primitive-eval
- x-24372)))
+ x-22924)))
'()))
(if (memq 'load
- when-list-24263)
- (if (let ((t-24400
+ when-list-22815)
+ (if (let ((t-22952
(memq 'compile
-
when-list-24263)))
- (if t-24400
- t-24400
- (let ((t-24453
+
when-list-22815)))
+ (if t-22952
+ t-22952
+ (let ((t-23005
(memq
'expand
-
when-list-24263)))
- (if t-24453
- t-24453
- (if (eq?
m-21894
+
when-list-22815)))
+ (if t-23005
+ t-23005
+ (if (eq?
m-20973
'c&e)
(memq 'eval
-
when-list-24263)
+
when-list-22815)
#f)))))
- (recurse-24265
+ (recurse-22817
'c&e
'(compile load))
- (if (if (eq? m-21894 'c)
+ (if (if (eq? m-20973 'c)
#t
- (eq? m-21894 'c&e))
- (recurse-24265
+ (eq? m-20973 'c&e))
+ (recurse-22817
'c
'(load))
'()))
- (if (let ((t-24662
+ (if (let ((t-23214
(memq 'compile
-
when-list-24263)))
- (if t-24662
- t-24662
- (let ((t-24715
+
when-list-22815)))
+ (if t-23214
+ t-23214
+ (let ((t-23267
(memq
'expand
-
when-list-24263)))
- (if t-24715
- t-24715
- (if (eq?
m-21894
+
when-list-22815)))
+ (if t-23267
+ t-23267
+ (if (eq?
m-20973
'c&e)
(memq 'eval
-
when-list-24263)
+
when-list-22815)
#f)))))
(begin
- (let ((x-24849
-
(expand-top-sequence-4378
- body-24264
- r-21891
- w-22086
- s-22087
+ (let ((x-23401
+
(expand-top-sequence-4379
+ body-22816
+ r-20970
+ w-21009
+ s-21010
'e
'(eval)
- mod-22088)))
+ mod-21011)))
(primitive-eval
- x-24849))
+ x-23401))
'())
'()))))))
- tmp-24256)
+ tmp-22808)
(syntax-violation
#f
"source expression failed to match
any pattern"
- e-22085)))
- (list (if (eq? m-21894 'c&e)
- (let ((x-24922
- (expand-expr-4383
- type-22082
- value-22083
- form-22084
- e-22085
- r-21891
- w-22086
- s-22087
- mod-22088)))
+ e-21008)))
+ (list (if (eq? m-20973 'c&e)
+ (let ((x-23474
+ (expand-expr-4384
+ type-21005
+ value-21006
+ form-21007
+ e-21008
+ r-20970
+ w-21009
+ s-21010
+ mod-21011)))
(begin
- (primitive-eval x-24922)
- (lambda () x-24922)))
+ (primitive-eval x-23474)
+ (lambda () x-23474)))
(lambda ()
- (expand-expr-4383
- type-22082
- value-22083
- form-22084
- e-22085
- r-21891
- w-22086
- s-22087
- mod-22088))))))))))))))
- (let ((exps-21536
- (map (lambda (x-21659) (x-21659))
+ (expand-expr-4384
+ type-21005
+ value-21006
+ form-21007
+ e-21008
+ r-20970
+ w-21009
+ s-21010
+ mod-21011))))))))))))))
+ (let ((exps-20284
+ (map (lambda (x-20408) (x-20408))
(reverse
- (parse-21534
- body-21521
- r-21528
- w-21530
- s-21524
- m-21525
- esew-21526
- mod-21527)))))
- (if (null? exps-21536)
+ (parse-20282
+ body-20269
+ r-20276
+ w-20278
+ s-20272
+ m-20273
+ esew-20274
+ mod-20275)))))
+ (if (null? exps-20284)
(make-struct/no-tail
(vector-ref %expanded-vtables 0)
- s-21524)
- (build-sequence-4328 s-21524 exps-21536)))))))))
- (expand-install-global-4379
- (lambda (name-25050 type-25051 e-25052)
- (let ((exp-25058
- (let ((args-25069
- (if (eq? type-25051 'define-syntax-parameter-form)
+ s-20272)
+ (build-sequence-4329 s-20272 exps-20284)))))))))
+ (expand-install-global-4380
+ (lambda (name-23602 type-23603 e-23604)
+ (let ((exp-23610
+ (let ((args-23621
+ (if (eq? type-23603 'define-syntax-parameter-form)
(list (make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
- name-25050)
+ name-23602)
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
'syntax-parameter)
- (let ((args-25092 (list e-25052)))
+ (let ((args-23644 (list e-23604)))
(make-struct/no-tail
(vector-ref %expanded-vtables 12)
#f
'list
- args-25092)))
+ args-23644)))
(list (make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
- name-25050)
+ name-23602)
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
'macro)
- e-25052))))
+ e-23604))))
(make-struct/no-tail
(vector-ref %expanded-vtables 12)
#f
'make-syntax-transformer
- args-25069))))
+ args-23621))))
(begin
- (if (if (struct? exp-25058)
- (eq? (struct-vtable exp-25058)
+ (if (if (struct? exp-23610)
+ (eq? (struct-vtable exp-23610)
(vector-ref %expanded-vtables 14))
#f)
- (let ((meta-25119 (struct-ref exp-25058 1)))
- (if (not (assq 'name meta-25119))
- (let ((v-25126
- (cons (cons 'name name-25050) meta-25119)))
- (struct-set! exp-25058 1 v-25126)))))
+ (let ((meta-23671 (struct-ref exp-23610 1)))
+ (if (not (assq 'name meta-23671))
+ (let ((v-23678
+ (cons (cons 'name name-23602) meta-23671)))
+ (struct-set! exp-23610 1 v-23678)))))
(make-struct/no-tail
(vector-ref %expanded-vtables 9)
#f
- name-25050
- exp-25058)))))
- (parse-when-list-4380
- (lambda (e-25137 when-list-25138)
- (let ((result-25139 (strip-4395 when-list-25138 '(()))))
+ name-23602
+ exp-23610)))))
+ (parse-when-list-4381
+ (lambda (e-23689 when-list-23690)
+ (let ((result-23691 (strip-4396 when-list-23690 '(()))))
(letrec*
- ((lp-25140
- (lambda (l-25206)
- (if (null? l-25206)
- result-25139
- (if (let ((t-25208 (car l-25206)))
- (if (eq? t-25208 'compile)
+ ((lp-23692
+ (lambda (l-23758)
+ (if (null? l-23758)
+ result-23691
+ (if (let ((t-23760 (car l-23758)))
+ (if (eq? t-23760 'compile)
#t
- (if (eq? t-25208 'load)
+ (if (eq? t-23760 'load)
#t
- (if (eq? t-25208 'eval)
+ (if (eq? t-23760 'eval)
#t
- (eq? t-25208 'expand)))))
- (lp-25140 (cdr l-25206))
+ (eq? t-23760 'expand)))))
+ (lp-23692 (cdr l-23758))
(syntax-violation
'eval-when
"invalid situation"
- e-25137
- (car l-25206)))))))
- (lp-25140 result-25139)))))
- (syntax-type-4381
- (lambda (e-25210
- r-25211
- w-25212
- s-25213
- rib-25214
- mod-25215
- for-car?-25216)
- (if (symbol? e-25210)
+ e-23689
+ (car l-23758)))))))
+ (lp-23692 result-23691)))))
+ (syntax-type-4382
+ (lambda (e-23762
+ r-23763
+ w-23764
+ s-23765
+ rib-23766
+ mod-23767
+ for-car?-23768)
+ (if (symbol? e-23762)
(call-with-values
(lambda ()
- (resolve-identifier-4367
- e-25210
- w-25212
- r-25211
- mod-25215
+ (resolve-identifier-4368
+ e-23762
+ w-23764
+ r-23763
+ mod-23767
#t))
- (lambda (type-25219 value-25220 mod*-25221)
- (if (eqv? type-25219 'macro)
- (if for-car?-25216
+ (lambda (type-23771 value-23772 mod*-23773)
+ (if (eqv? type-23771 'macro)
+ (if for-car?-23768
(values
- type-25219
- value-25220
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)
- (syntax-type-4381
- (expand-macro-4385
- value-25220
- e-25210
- r-25211
- w-25212
- s-25213
- rib-25214
- mod-25215)
- r-25211
+ type-23771
+ value-23772
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)
+ (syntax-type-4382
+ (expand-macro-4386
+ value-23772
+ e-23762
+ r-23763
+ w-23764
+ s-23765
+ rib-23766
+ mod-23767)
+ r-23763
'(())
- s-25213
- rib-25214
- mod-25215
+ s-23765
+ rib-23766
+ mod-23767
#f))
- (if (eqv? type-25219 'global)
+ (if (eqv? type-23771 'global)
(values
- type-25219
- value-25220
- e-25210
- value-25220
- w-25212
- s-25213
- mod*-25221)
+ type-23771
+ value-23772
+ e-23762
+ value-23772
+ w-23764
+ s-23765
+ mod*-23773)
(values
- type-25219
- value-25220
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)))))
- (if (pair? e-25210)
- (let ((first-25237 (car e-25210)))
+ type-23771
+ value-23772
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)))))
+ (if (pair? e-23762)
+ (let ((first-23789 (car e-23762)))
(call-with-values
(lambda ()
- (syntax-type-4381
- first-25237
- r-25211
- w-25212
- s-25213
- rib-25214
- mod-25215
+ (syntax-type-4382
+ first-23789
+ r-23763
+ w-23764
+ s-23765
+ rib-23766
+ mod-23767
#t))
- (lambda (ftype-25239
- fval-25240
- fform-25241
- fe-25242
- fw-25243
- fs-25244
- fmod-25245)
- (if (eqv? ftype-25239 'lexical)
+ (lambda (ftype-23791
+ fval-23792
+ fform-23793
+ fe-23794
+ fw-23795
+ fs-23796
+ fmod-23797)
+ (if (eqv? ftype-23791 'lexical)
(values
'lexical-call
- fval-25240
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)
- (if (eqv? ftype-25239 'global)
+ fval-23792
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)
+ (if (eqv? ftype-23791 'global)
(values
'global-call
(vector
'syntax-object
- fval-25240
- w-25212
- fmod-25245)
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)
- (if (eqv? ftype-25239 'macro)
- (syntax-type-4381
- (expand-macro-4385
- fval-25240
- e-25210
- r-25211
- w-25212
- s-25213
- rib-25214
- mod-25215)
- r-25211
+ fval-23792
+ w-23764
+ fmod-23797)
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)
+ (if (eqv? ftype-23791 'macro)
+ (syntax-type-4382
+ (expand-macro-4386
+ fval-23792
+ e-23762
+ r-23763
+ w-23764
+ s-23765
+ rib-23766
+ mod-23767)
+ r-23763
'(())
- s-25213
- rib-25214
- mod-25215
- for-car?-25216)
- (if (eqv? ftype-25239 'module-ref)
+ s-23765
+ rib-23766
+ mod-23767
+ for-car?-23768)
+ (if (eqv? ftype-23791 'module-ref)
(call-with-values
- (lambda () (fval-25240 e-25210 r-25211 w-25212))
- (lambda (e-25279
- r-25280
- w-25281
- s-25282
- mod-25283)
- (syntax-type-4381
- e-25279
- r-25280
- w-25281
- s-25282
- rib-25214
- mod-25283
- for-car?-25216)))
- (if (eqv? ftype-25239 'core)
+ (lambda () (fval-23792 e-23762 r-23763 w-23764))
+ (lambda (e-23831
+ r-23832
+ w-23833
+ s-23834
+ mod-23835)
+ (syntax-type-4382
+ e-23831
+ r-23832
+ w-23833
+ s-23834
+ rib-23766
+ mod-23835
+ for-car?-23768)))
+ (if (eqv? ftype-23791 'core)
(values
'core-form
- fval-25240
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)
- (if (eqv? ftype-25239 'local-syntax)
+ fval-23792
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)
+ (if (eqv? ftype-23791 'local-syntax)
(values
'local-syntax-form
- fval-25240
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)
- (if (eqv? ftype-25239 'begin)
+ fval-23792
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)
+ (if (eqv? ftype-23791 'begin)
(values
'begin-form
#f
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)
- (if (eqv? ftype-25239 'eval-when)
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)
+ (if (eqv? ftype-23791 'eval-when)
(values
'eval-when-form
#f
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)
- (if (eqv? ftype-25239 'define)
- (let ((tmp-25315
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)
+ (if (eqv? ftype-23791 'define)
+ (let ((tmp-23867
($sc-dispatch
- e-25210
+ e-23762
'(_ any any))))
- (if (if tmp-25315
+ (if (if tmp-23867
(@apply
- (lambda (name-25319 val-25320)
- (if (symbol? name-25319)
+ (lambda (name-23871 val-23872)
+ (if (symbol? name-23871)
#t
- (if (if (vector? name-25319)
+ (if (if (vector? name-23871)
(if (= (vector-length
- name-25319)
+ name-23871)
4)
(eq? (vector-ref
- name-25319
+ name-23871
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-25319
+ name-23871
1))
#f)))
- tmp-25315)
+ tmp-23867)
#f)
(@apply
- (lambda (name-25347 val-25348)
+ (lambda (name-23899 val-23900)
(values
'define-form
- name-25347
- e-25210
- val-25348
- w-25212
- s-25213
- mod-25215))
- tmp-25315)
- (let ((tmp-25349
+ name-23899
+ e-23762
+ val-23900
+ w-23764
+ s-23765
+ mod-23767))
+ tmp-23867)
+ (let ((tmp-23901
($sc-dispatch
- e-25210
+ e-23762
'(_ (any . any)
any
.
each-any))))
- (if (if tmp-25349
+ (if (if tmp-23901
(@apply
- (lambda (name-25353
- args-25354
- e1-25355
- e2-25356)
+ (lambda (name-23905
+ args-23906
+ e1-23907
+ e2-23908)
(if (if (symbol?
- name-25353)
+ name-23905)
#t
(if (if (vector?
-
name-25353)
+
name-23905)
(if (=
(vector-length
-
name-25353)
+
name-23905)
4)
(eq?
(vector-ref
-
name-25353
+
name-23905
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-25353
+ name-23905
1))
#f))
- (valid-bound-ids?-4372
- (lambda-var-list-4397
- args-25354))
+ (valid-bound-ids?-4373
+ (lambda-var-list-4398
+ args-23906))
#f))
- tmp-25349)
+ tmp-23901)
#f)
(@apply
- (lambda (name-25819
- args-25820
- e1-25821
- e2-25822)
+ (lambda (name-24371
+ args-24372
+ e1-24373
+ e2-24374)
(values
'define-form
- (if (if (null? (car
w-25212))
- (null? (cdr w-25212))
+ (if (if (null? (car
w-23764))
+ (null? (cdr w-23764))
#f)
- name-25819
+ name-24371
(if (if (vector?
- name-25819)
+ name-24371)
(if (=
(vector-length
- name-25819)
+ name-24371)
4)
(eq? (vector-ref
- name-25819
+ name-24371
0)
'syntax-object)
#f)
#f)
- (let ((expression-25852
+ (let ((expression-24404
(vector-ref
- name-25819
+ name-24371
1))
- (wrap-25853
- (let ((w2-25863
+ (wrap-24405
+ (let ((w2-24415
(vector-ref
-
name-25819
+
name-24371
2)))
- (let
((m1-25864
- (car
w-25212))
-
(s1-25865
- (cdr
w-25212)))
- (if (null?
m1-25864)
- (if
(null? s1-25865)
- w2-25863
- (cons
(car w2-25863)
-
(let ((m2-25882
-
(cdr w2-25863)))
-
(if (null? m2-25882)
-
s1-25865
+ (let
((m1-24416
+ (car
w-23764))
+
(s1-24417
+ (cdr
w-23764)))
+ (if (null?
m1-24416)
+ (if
(null? s1-24417)
+ w2-24415
+ (cons
(car w2-24415)
+
(let ((m2-24434
+
(cdr w2-24415)))
+
(if (null? m2-24434)
+
s1-24417
(append
-
s1-25865
-
m2-25882)))))
- (cons
(let ((m2-25890
-
(car w2-25863)))
-
(if (null? m2-25890)
-
m1-25864
+
s1-24417
+
m2-24434)))))
+ (cons
(let ((m2-24442
+
(car w2-24415)))
+
(if (null? m2-24442)
+
m1-24416
(append
-
m1-25864
-
m2-25890)))
-
(let ((m2-25898
-
(cdr w2-25863)))
-
(if (null? m2-25898)
-
s1-25865
+
m1-24416
+
m2-24442)))
+
(let ((m2-24450
+
(cdr w2-24415)))
+
(if (null? m2-24450)
+
s1-24417
(append
-
s1-25865
-
m2-25898))))))))
- (module-25854
+
s1-24417
+
m2-24450))))))))
+ (module-24406
(vector-ref
- name-25819
+ name-24371
3)))
(vector
'syntax-object
- expression-25852
- wrap-25853
- module-25854))
- (if (null? name-25819)
- name-25819
+ expression-24404
+ wrap-24405
+ module-24406))
+ (if (null? name-24371)
+ name-24371
(vector
'syntax-object
- name-25819
- w-25212
- mod-25215))))
- (if (if (null? (car
w-25212))
- (null? (cdr w-25212))
+ name-24371
+ w-23764
+ mod-23767))))
+ (if (if (null? (car
w-23764))
+ (null? (cdr w-23764))
#f)
- e-25210
- (if (if (vector? e-25210)
+ e-23762
+ (if (if (vector? e-23762)
(if (=
(vector-length
- e-25210)
+ e-23762)
4)
(eq? (vector-ref
- e-25210
+ e-23762
0)
'syntax-object)
#f)
#f)
- (let ((expression-25950
+ (let ((expression-24502
(vector-ref
- e-25210
+ e-23762
1))
- (wrap-25951
- (let ((w2-25961
+ (wrap-24503
+ (let ((w2-24513
(vector-ref
-
e-25210
+
e-23762
2)))
- (let
((m1-25962
- (car
w-25212))
-
(s1-25963
- (cdr
w-25212)))
- (if (null?
m1-25962)
- (if
(null? s1-25963)
- w2-25961
- (cons
(car w2-25961)
-
(let ((m2-25980
-
(cdr w2-25961)))
-
(if (null? m2-25980)
-
s1-25963
+ (let
((m1-24514
+ (car
w-23764))
+
(s1-24515
+ (cdr
w-23764)))
+ (if (null?
m1-24514)
+ (if
(null? s1-24515)
+ w2-24513
+ (cons
(car w2-24513)
+
(let ((m2-24532
+
(cdr w2-24513)))
+
(if (null? m2-24532)
+
s1-24515
(append
-
s1-25963
-
m2-25980)))))
- (cons
(let ((m2-25988
-
(car w2-25961)))
-
(if (null? m2-25988)
-
m1-25962
+
s1-24515
+
m2-24532)))))
+ (cons
(let ((m2-24540
+
(car w2-24513)))
+
(if (null? m2-24540)
+
m1-24514
(append
-
m1-25962
-
m2-25988)))
-
(let ((m2-25996
-
(cdr w2-25961)))
-
(if (null? m2-25996)
-
s1-25963
+
m1-24514
+
m2-24540)))
+
(let ((m2-24548
+
(cdr w2-24513)))
+
(if (null? m2-24548)
+
s1-24515
(append
-
s1-25963
-
m2-25996))))))))
- (module-25952
+
s1-24515
+
m2-24548))))))))
+ (module-24504
(vector-ref
- e-25210
+ e-23762
3)))
(vector
'syntax-object
- expression-25950
- wrap-25951
- module-25952))
- (if (null? e-25210)
- e-25210
+ expression-24502
+ wrap-24503
+ module-24504))
+ (if (null? e-23762)
+ e-23762
(vector
'syntax-object
- e-25210
- w-25212
- mod-25215))))
- (let ((e-26022
+ e-23762
+ w-23764
+ mod-23767))))
+ (let ((e-24574
(cons
'#(syntax-object
lambda
((top)
@@ -2183,19 +2412,19 @@
(top)
(top)
(top))
-
#("l-*-1959"
-
"l-*-1960"
+
#("l-*-1960"
"l-*-1961"
-
"l-*-1962"))
+
"l-*-1962"
+
"l-*-1963"))
#(ribcage
()
()
())
#(ribcage
#(key)
-
#((m-*-1924
+
#((m-*-1925
top))
-
#("l-*-1925"))
+
#("l-*-1926"))
#(ribcage
()
()
@@ -2219,13 +2448,13 @@
(top)
(top)
(top))
-
#("l-*-1917"
-
"l-*-1918"
+
#("l-*-1918"
"l-*-1919"
"l-*-1920"
"l-*-1921"
"l-*-1922"
-
"l-*-1923"))
+
"l-*-1923"
+
"l-*-1924"))
#(ribcage
()
()
@@ -2233,7 +2462,7 @@
#(ribcage
#(first)
#((top))
-
#("l-*-1908"))
+
#("l-*-1909"))
#(ribcage
()
()
@@ -2257,13 +2486,13 @@
(top)
(top)
(top))
-
#("l-*-1890"
-
"l-*-1891"
+
#("l-*-1891"
"l-*-1892"
"l-*-1893"
"l-*-1894"
"l-*-1895"
-
"l-*-1896"))
+
"l-*-1896"
+
"l-*-1897"))
#(ribcage
(lambda-var-list
gen-var
@@ -2704,273 +2933,274 @@
()))
(hygiene
guile))
- (let ((x-26026
- (cons
args-25820
-
(cons e1-25821
-
e2-25822))))
- (if (if
(null? (car w-25212))
-
(null? (cdr w-25212))
+ (let ((x-24580
+ (cons
args-24372
+
(cons e1-24373
+
e2-24374))))
+ (if (if
(null? (car w-23764))
+
(null? (cdr w-23764))
#f)
- x-26026
+ x-24580
(if (if
(vector?
-
x-26026)
+
x-24580)
(if
(= (vector-length
-
x-26026)
+
x-24580)
4)
(eq? (vector-ref
-
x-26026
+
x-24580
0)
'syntax-object)
#f)
#f)
- (let
((expression-26044
+ (let
((expression-24598
(vector-ref
-
x-26026
+
x-24580
1))
-
(wrap-26045
-
(let ((w2-26053
+
(wrap-24599
+
(let ((w2-24607
(vector-ref
-
x-26026
+
x-24580
2)))
-
(let ((m1-26054
-
(car w-25212))
-
(s1-26055
-
(cdr w-25212)))
-
(if (null? m1-26054)
-
(if (null? s1-26055)
-
w2-26053
-
(cons (car w2-26053)
-
(let ((m2-26070
-
(cdr w2-26053)))
-
(if (null? m2-26070)
-
s1-26055
+
(let ((m1-24608
+
(car w-23764))
+
(s1-24609
+
(cdr w-23764)))
+
(if (null? m1-24608)
+
(if (null? s1-24609)
+
w2-24607
+
(cons (car w2-24607)
+
(let ((m2-24624
+
(cdr w2-24607)))
+
(if (null? m2-24624)
+
s1-24609
(append
-
s1-26055
-
m2-26070)))))
-
(cons (let ((m2-26078
-
(car w2-26053)))
-
(if (null? m2-26078)
-
m1-26054
+
s1-24609
+
m2-24624)))))
+
(cons (let ((m2-24632
+
(car w2-24607)))
+
(if (null? m2-24632)
+
m1-24608
(append
-
m1-26054
-
m2-26078)))
-
(let ((m2-26086
-
(cdr w2-26053)))
-
(if (null? m2-26086)
-
s1-26055
+
m1-24608
+
m2-24632)))
+
(let ((m2-24640
+
(cdr w2-24607)))
+
(if (null? m2-24640)
+
s1-24609
(append
-
s1-26055
-
m2-26086))))))))
-
(module-26046
+
s1-24609
+
m2-24640))))))))
+
(module-24600
(vector-ref
-
x-26026
+
x-24580
3)))
(vector
'syntax-object
-
expression-26044
-
wrap-26045
-
module-26046))
- (if
(null? x-26026)
-
x-26026
+
expression-24598
+
wrap-24599
+
module-24600))
+ (if
(null? x-24580)
+
x-24580
(vector
'syntax-object
-
x-26026
-
w-25212
-
mod-25215))))))))
+
x-24580
+
w-23764
+
mod-23767))))))))
(begin
- (if (if (pair? e-26022)
- s-25213
+ (if (if s-23765
+
(supports-source-properties?
+ e-24574)
#f)
(set-source-properties!
- e-26022
- s-25213))
- e-26022))
+ e-24574
+ s-23765))
+ e-24574))
'(())
- s-25213
- mod-25215))
- tmp-25349)
- (let ((tmp-26105
+ s-23765
+ mod-23767))
+ tmp-23901)
+ (let ((tmp-24657
($sc-dispatch
- e-25210
+ e-23762
'(_ any))))
- (if (if tmp-26105
+ (if (if tmp-24657
(@apply
- (lambda (name-26109)
+ (lambda (name-24661)
(if (symbol?
- name-26109)
+ name-24661)
#t
(if (if (vector?
-
name-26109)
+
name-24661)
(if (=
(vector-length
-
name-26109)
+
name-24661)
4)
(eq?
(vector-ref
-
name-26109
+
name-24661
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-26109
+ name-24661
1))
#f)))
- tmp-26105)
+ tmp-24657)
#f)
(@apply
- (lambda (name-26136)
+ (lambda (name-24688)
(values
'define-form
- (if (if (null? (car
w-25212))
- (null? (cdr
w-25212))
+ (if (if (null? (car
w-23764))
+ (null? (cdr
w-23764))
#f)
- name-26136
+ name-24688
(if (if (vector?
- name-26136)
+ name-24688)
(if (=
(vector-length
-
name-26136)
+
name-24688)
4)
(eq?
(vector-ref
-
name-26136
+
name-24688
0)
'syntax-object)
#f)
#f)
- (let
((expression-26166
+ (let
((expression-24718
(vector-ref
- name-26136
+ name-24688
1))
- (wrap-26167
- (let
((w2-26177
+ (wrap-24719
+ (let
((w2-24729
(vector-ref
-
name-26136
+
name-24688
2)))
- (let
((m1-26178
-
(car w-25212))
-
(s1-26179
-
(cdr w-25212)))
- (if
(null? m1-26178)
- (if
(null? s1-26179)
-
w2-26177
-
(cons (car w2-26177)
-
(let ((m2-26196
-
(cdr w2-26177)))
-
(if (null? m2-26196)
-
s1-26179
+ (let
((m1-24730
+
(car w-23764))
+
(s1-24731
+
(cdr w-23764)))
+ (if
(null? m1-24730)
+ (if
(null? s1-24731)
+
w2-24729
+
(cons (car w2-24729)
+
(let ((m2-24748
+
(cdr w2-24729)))
+
(if (null? m2-24748)
+
s1-24731
(append
-
s1-26179
-
m2-26196)))))
- (cons
(let ((m2-26204
-
(car w2-26177)))
-
(if (null? m2-26204)
-
m1-26178
+
s1-24731
+
m2-24748)))))
+ (cons
(let ((m2-24756
+
(car w2-24729)))
+
(if (null? m2-24756)
+
m1-24730
(append
-
m1-26178
-
m2-26204)))
-
(let ((m2-26212
-
(cdr w2-26177)))
-
(if (null? m2-26212)
-
s1-26179
+
m1-24730
+
m2-24756)))
+
(let ((m2-24764
+
(cdr w2-24729)))
+
(if (null? m2-24764)
+
s1-24731
(append
-
s1-26179
-
m2-26212))))))))
- (module-26168
+
s1-24731
+
m2-24764))))))))
+ (module-24720
(vector-ref
- name-26136
+ name-24688
3)))
(vector
'syntax-object
- expression-26166
- wrap-26167
- module-26168))
- (if (null?
name-26136)
- name-26136
+ expression-24718
+ wrap-24719
+ module-24720))
+ (if (null?
name-24688)
+ name-24688
(vector
'syntax-object
- name-26136
- w-25212
- mod-25215))))
- (if (if (null? (car
w-25212))
- (null? (cdr
w-25212))
+ name-24688
+ w-23764
+ mod-23767))))
+ (if (if (null? (car
w-23764))
+ (null? (cdr
w-23764))
#f)
- e-25210
+ e-23762
(if (if (vector?
- e-25210)
+ e-23762)
(if (=
(vector-length
-
e-25210)
+
e-23762)
4)
(eq?
(vector-ref
- e-25210
+ e-23762
0)
'syntax-object)
#f)
#f)
- (let
((expression-26264
+ (let
((expression-24816
(vector-ref
- e-25210
+ e-23762
1))
- (wrap-26265
- (let
((w2-26275
+ (wrap-24817
+ (let
((w2-24827
(vector-ref
-
e-25210
+
e-23762
2)))
- (let
((m1-26276
-
(car w-25212))
-
(s1-26277
-
(cdr w-25212)))
- (if
(null? m1-26276)
- (if
(null? s1-26277)
-
w2-26275
-
(cons (car w2-26275)
-
(let ((m2-26294
-
(cdr w2-26275)))
-
(if (null? m2-26294)
-
s1-26277
+ (let
((m1-24828
+
(car w-23764))
+
(s1-24829
+
(cdr w-23764)))
+ (if
(null? m1-24828)
+ (if
(null? s1-24829)
+
w2-24827
+
(cons (car w2-24827)
+
(let ((m2-24846
+
(cdr w2-24827)))
+
(if (null? m2-24846)
+
s1-24829
(append
-
s1-26277
-
m2-26294)))))
- (cons
(let ((m2-26302
-
(car w2-26275)))
-
(if (null? m2-26302)
-
m1-26276
+
s1-24829
+
m2-24846)))))
+ (cons
(let ((m2-24854
+
(car w2-24827)))
+
(if (null? m2-24854)
+
m1-24828
(append
-
m1-26276
-
m2-26302)))
-
(let ((m2-26310
-
(cdr w2-26275)))
-
(if (null? m2-26310)
-
s1-26277
+
m1-24828
+
m2-24854)))
+
(let ((m2-24862
+
(cdr w2-24827)))
+
(if (null? m2-24862)
+
s1-24829
(append
-
s1-26277
-
m2-26310))))))))
- (module-26266
+
s1-24829
+
m2-24862))))))))
+ (module-24818
(vector-ref
- e-25210
+ e-23762
3)))
(vector
'syntax-object
- expression-26264
- wrap-26265
- module-26266))
- (if (null? e-25210)
- e-25210
+ expression-24816
+ wrap-24817
+ module-24818))
+ (if (null? e-23762)
+ e-23762
(vector
'syntax-object
- e-25210
- w-25212
- mod-25215))))
+ e-23762
+ w-23764
+ mod-23767))))
'(#(syntax-object
if
((top)
#(ribcage
#(name)
#((top))
- #("l-*-1972"))
+ #("l-*-1973"))
#(ribcage () () ())
#(ribcage
#(key)
- #((m-*-1924 top))
- #("l-*-1925"))
+ #((m-*-1925 top))
+ #("l-*-1926"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -2988,18 +3218,18 @@
(top)
(top)
(top))
- #("l-*-1917"
- "l-*-1918"
+ #("l-*-1918"
"l-*-1919"
"l-*-1920"
"l-*-1921"
"l-*-1922"
- "l-*-1923"))
+ "l-*-1923"
+ "l-*-1924"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-1908"))
+ #("l-*-1909"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -3017,13 +3247,13 @@
(top)
(top)
(top))
- #("l-*-1890"
- "l-*-1891"
+ #("l-*-1891"
"l-*-1892"
"l-*-1893"
"l-*-1894"
"l-*-1895"
- "l-*-1896"))
+ "l-*-1896"
+ "l-*-1897"))
#(ribcage
(lambda-var-list
gen-var
@@ -3469,12 +3699,12 @@
#(ribcage
#(name)
#((top))
- #("l-*-1972"))
+ #("l-*-1973"))
#(ribcage () () ())
#(ribcage
#(key)
- #((m-*-1924 top))
- #("l-*-1925"))
+ #((m-*-1925 top))
+ #("l-*-1926"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -3492,18 +3722,18 @@
(top)
(top)
(top))
- #("l-*-1917"
- "l-*-1918"
+ #("l-*-1918"
"l-*-1919"
"l-*-1920"
"l-*-1921"
"l-*-1922"
- "l-*-1923"))
+ "l-*-1923"
+ "l-*-1924"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-1908"))
+ #("l-*-1909"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -3521,13 +3751,13 @@
(top)
(top)
(top))
- #("l-*-1890"
- "l-*-1891"
+ #("l-*-1891"
"l-*-1892"
"l-*-1893"
"l-*-1894"
"l-*-1895"
- "l-*-1896"))
+ "l-*-1896"
+ "l-*-1897"))
#(ribcage
(lambda-var-list
gen-var
@@ -3973,12 +4203,12 @@
#(ribcage
#(name)
#((top))
- #("l-*-1972"))
+ #("l-*-1973"))
#(ribcage () () ())
#(ribcage
#(key)
- #((m-*-1924 top))
- #("l-*-1925"))
+ #((m-*-1925 top))
+ #("l-*-1926"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -3996,18 +4226,18 @@
(top)
(top)
(top))
- #("l-*-1917"
- "l-*-1918"
+ #("l-*-1918"
"l-*-1919"
"l-*-1920"
"l-*-1921"
"l-*-1922"
- "l-*-1923"))
+ "l-*-1923"
+ "l-*-1924"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-1908"))
+ #("l-*-1909"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -4025,13 +4255,13 @@
(top)
(top)
(top))
- #("l-*-1890"
- "l-*-1891"
+ #("l-*-1891"
"l-*-1892"
"l-*-1893"
"l-*-1894"
"l-*-1895"
- "l-*-1896"))
+ "l-*-1896"
+ "l-*-1897"))
#(ribcage
(lambda-var-list
gen-var
@@ -4472,2122 +4702,2670 @@
()))
(hygiene guile)))
'(())
- s-25213
- mod-25215))
- tmp-26105)
+ s-23765
+ mod-23767))
+ tmp-24657)
(syntax-violation
#f
"source expression failed
to match any pattern"
- e-25210)))))))
- (if (eqv? ftype-25239 'define-syntax)
- (let ((tmp-26352
+ e-23762)))))))
+ (if (eqv? ftype-23791 'define-syntax)
+ (let ((tmp-24904
($sc-dispatch
- e-25210
+ e-23762
'(_ any any))))
- (if (if tmp-26352
+ (if (if tmp-24904
(@apply
- (lambda (name-26356 val-26357)
- (if (symbol? name-26356)
+ (lambda (name-24908 val-24909)
+ (if (symbol? name-24908)
#t
(if (if (vector?
- name-26356)
+ name-24908)
(if (=
(vector-length
- name-26356)
+ name-24908)
4)
(eq? (vector-ref
- name-26356
+ name-24908
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-26356
+ name-24908
1))
#f)))
- tmp-26352)
+ tmp-24904)
#f)
(@apply
- (lambda (name-26384 val-26385)
+ (lambda (name-24936 val-24937)
(values
'define-syntax-form
- name-26384
- e-25210
- val-26385
- w-25212
- s-25213
- mod-25215))
- tmp-26352)
+ name-24936
+ e-23762
+ val-24937
+ w-23764
+ s-23765
+ mod-23767))
+ tmp-24904)
(syntax-violation
#f
"source expression failed to
match any pattern"
- e-25210)))
- (if (eqv? ftype-25239
+ e-23762)))
+ (if (eqv? ftype-23791
'define-syntax-parameter)
- (let ((tmp-26399
+ (let ((tmp-24951
($sc-dispatch
- e-25210
+ e-23762
'(_ any any))))
- (if (if tmp-26399
+ (if (if tmp-24951
(@apply
- (lambda (name-26403
- val-26404)
- (if (symbol? name-26403)
+ (lambda (name-24955
+ val-24956)
+ (if (symbol? name-24955)
#t
(if (if (vector?
- name-26403)
+ name-24955)
(if (=
(vector-length
-
name-26403)
+
name-24955)
4)
(eq? (vector-ref
-
name-26403
+
name-24955
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-26403
+ name-24955
1))
#f)))
- tmp-26399)
+ tmp-24951)
#f)
(@apply
- (lambda (name-26431 val-26432)
+ (lambda (name-24983 val-24984)
(values
'define-syntax-parameter-form
- name-26431
- e-25210
- val-26432
- w-25212
- s-25213
- mod-25215))
- tmp-26399)
+ name-24983
+ e-23762
+ val-24984
+ w-23764
+ s-23765
+ mod-23767))
+ tmp-24951)
(syntax-violation
#f
"source expression failed to
match any pattern"
- e-25210)))
+ e-23762)))
(values
'call
#f
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)))))))))))))))
- (if (if (vector? e-25210)
- (if (= (vector-length e-25210) 4)
- (eq? (vector-ref e-25210 0) 'syntax-object)
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)))))))))))))))
+ (if (if (vector? e-23762)
+ (if (= (vector-length e-23762) 4)
+ (eq? (vector-ref e-23762 0) 'syntax-object)
#f)
#f)
- (syntax-type-4381
- (vector-ref e-25210 1)
- r-25211
- (let ((w2-26457 (vector-ref e-25210 2)))
- (let ((m1-26458 (car w-25212))
- (s1-26459 (cdr w-25212)))
- (if (null? m1-26458)
- (if (null? s1-26459)
- w2-26457
- (cons (car w2-26457)
- (let ((m2-26470 (cdr w2-26457)))
- (if (null? m2-26470)
- s1-26459
- (append s1-26459 m2-26470)))))
- (cons (let ((m2-26478 (car w2-26457)))
- (if (null? m2-26478)
- m1-26458
- (append m1-26458 m2-26478)))
- (let ((m2-26486 (cdr w2-26457)))
- (if (null? m2-26486)
- s1-26459
- (append s1-26459 m2-26486)))))))
- (let ((t-26491 (source-annotation-4340 e-25210)))
- (if t-26491 t-26491 s-25213))
- rib-25214
- (let ((t-26767 (vector-ref e-25210 3)))
- (if t-26767 t-26767 mod-25215))
- for-car?-25216)
- (if (self-evaluating? e-25210)
+ (syntax-type-4382
+ (vector-ref e-23762 1)
+ r-23763
+ (let ((w2-25009 (vector-ref e-23762 2)))
+ (let ((m1-25010 (car w-23764))
+ (s1-25011 (cdr w-23764)))
+ (if (null? m1-25010)
+ (if (null? s1-25011)
+ w2-25009
+ (cons (car w2-25009)
+ (let ((m2-25022 (cdr w2-25009)))
+ (if (null? m2-25022)
+ s1-25011
+ (append s1-25011 m2-25022)))))
+ (cons (let ((m2-25030 (car w2-25009)))
+ (if (null? m2-25030)
+ m1-25010
+ (append m1-25010 m2-25030)))
+ (let ((m2-25038 (cdr w2-25009)))
+ (if (null? m2-25038)
+ s1-25011
+ (append s1-25011 m2-25038)))))))
+ (let ((t-25043
+ (let ((props-25075
+ (source-properties
+ (if (if (vector? e-23762)
+ (if (= (vector-length e-23762) 4)
+ (eq? (vector-ref e-23762 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref e-23762 1)
+ e-23762))))
+ (if (pair? props-25075) props-25075 #f))))
+ (if t-25043 t-25043 s-23765))
+ rib-23766
+ (let ((t-25098 (vector-ref e-23762 3)))
+ (if t-25098 t-25098 mod-23767))
+ for-car?-23768)
+ (if (self-evaluating? e-23762)
(values
'constant
#f
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)
(values
'other
#f
- e-25210
- e-25210
- w-25212
- s-25213
- mod-25215)))))))
- (expand-4382
- (lambda (e-26776 r-26777 w-26778 mod-26779)
+ e-23762
+ e-23762
+ w-23764
+ s-23765
+ mod-23767)))))))
+ (expand-4383
+ (lambda (e-25107 r-25108 w-25109 mod-25110)
(call-with-values
(lambda ()
- (syntax-type-4381
- e-26776
- r-26777
- w-26778
- (source-annotation-4340 e-26776)
+ (syntax-type-4382
+ e-25107
+ r-25108
+ w-25109
+ (let ((props-25117
+ (source-properties
+ (if (if (vector? e-25107)
+ (if (= (vector-length e-25107) 4)
+ (eq? (vector-ref e-25107 0) 'syntax-object)
+ #f)
+ #f)
+ (vector-ref e-25107 1)
+ e-25107))))
+ (if (pair? props-25117) props-25117 #f))
#f
- mod-26779
+ mod-25110
#f))
- (lambda (type-26965
- value-26966
- form-26967
- e-26968
- w-26969
- s-26970
- mod-26971)
- (expand-expr-4383
- type-26965
- value-26966
- form-26967
- e-26968
- r-26777
- w-26969
- s-26970
- mod-26971)))))
- (expand-expr-4383
- (lambda (type-26974
- value-26975
- form-26976
- e-26977
- r-26978
- w-26979
- s-26980
- mod-26981)
- (if (eqv? type-26974 'lexical)
+ (lambda (type-25140
+ value-25141
+ form-25142
+ e-25143
+ w-25144
+ s-25145
+ mod-25146)
+ (expand-expr-4384
+ type-25140
+ value-25141
+ form-25142
+ e-25143
+ r-25108
+ w-25144
+ s-25145
+ mod-25146)))))
+ (expand-expr-4384
+ (lambda (type-25149
+ value-25150
+ form-25151
+ e-25152
+ r-25153
+ w-25154
+ s-25155
+ mod-25156)
+ (if (eqv? type-25149 'lexical)
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
- s-26980
- e-26977
- value-26975)
- (if (if (eqv? type-26974 'core)
+ s-25155
+ e-25152
+ value-25150)
+ (if (if (eqv? type-25149 'core)
#t
- (eqv? type-26974 'core-form))
- (value-26975
- e-26977
- r-26978
- w-26979
- s-26980
- mod-26981)
- (if (eqv? type-26974 'module-ref)
+ (eqv? type-25149 'core-form))
+ (value-25150
+ e-25152
+ r-25153
+ w-25154
+ s-25155
+ mod-25156)
+ (if (eqv? type-25149 'module-ref)
(call-with-values
- (lambda () (value-26975 e-26977 r-26978 w-26979))
- (lambda (e-27017 r-27018 w-27019 s-27020 mod-27021)
- (expand-4382 e-27017 r-27018 w-27019 mod-27021)))
- (if (eqv? type-26974 'lexical-call)
- (expand-call-4384
- (let ((id-27197 (car e-26977)))
- (build-lexical-reference-4316
- 'fun
- (source-annotation-4340 id-27197)
- (if (if (vector? id-27197)
- (if (= (vector-length id-27197) 4)
- (eq? (vector-ref id-27197 0) 'syntax-object)
- #f)
- #f)
- (syntax->datum id-27197)
- id-27197)
- value-26975))
- e-26977
- r-26978
- w-26979
- s-26980
- mod-26981)
- (if (eqv? type-26974 'global-call)
- (expand-call-4384
- (build-global-reference-4319
- (source-annotation-4340 (car e-26977))
- (if (if (vector? value-26975)
- (if (= (vector-length value-26975) 4)
- (eq? (vector-ref value-26975 0) 'syntax-object)
- #f)
- #f)
- (vector-ref value-26975 1)
- value-26975)
- (if (if (vector? value-26975)
- (if (= (vector-length value-26975) 4)
- (eq? (vector-ref value-26975 0) 'syntax-object)
- #f)
- #f)
- (vector-ref value-26975 3)
- mod-26981))
- e-26977
- r-26978
- w-26979
- s-26980
- mod-26981)
- (if (eqv? type-26974 'constant)
- (let ((exp-27877
- (strip-4395
- (let ((x-27890
+ (lambda () (value-25150 e-25152 r-25153 w-25154))
+ (lambda (e-25192 r-25193 w-25194 s-25195 mod-25196)
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-25192
+ r-25193
+ w-25194
+ (let ((props-25212
+ (source-properties
+ (if (if (vector? e-25192)
+ (if (= (vector-length e-25192) 4)
+ (eq? (vector-ref e-25192 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref e-25192 1)
+ e-25192))))
+ (if (pair? props-25212) props-25212 #f))
+ #f
+ mod-25196
+ #f))
+ (lambda (type-25245
+ value-25246
+ form-25247
+ e-25248
+ w-25249
+ s-25250
+ mod-25251)
+ (expand-expr-4384
+ type-25245
+ value-25246
+ form-25247
+ e-25248
+ r-25193
+ w-25249
+ s-25250
+ mod-25251)))))
+ (if (eqv? type-25149 'lexical-call)
+ (let ((x-25263
+ (let ((id-25284 (car e-25152)))
+ (let ((source-25288
+ (let ((props-25298
+ (source-properties
+ (if (if (vector? id-25284)
+ (if (= (vector-length
+ id-25284)
+ 4)
+ (eq? (vector-ref
+ id-25284
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref id-25284 1)
+ id-25284))))
+ (if (pair? props-25298) props-25298 #f)))
+ (name-25289
+ (if (if (vector? id-25284)
+ (if (= (vector-length id-25284) 4)
+ (eq? (vector-ref id-25284 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (syntax->datum id-25284)
+ id-25284)))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 3)
+ source-25288
+ name-25289
+ value-25150)))))
+ (let ((tmp-25270
+ ($sc-dispatch e-25152 '(any . each-any))))
+ (if tmp-25270
+ (@apply
+ (lambda (e0-25273 e1-25274)
+ (let ((arg-exps-25279
+ (map (lambda (e-25330)
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-25330
+ r-25153
+ w-25154
+ (let ((props-25345
+ (source-properties
+ (if (if (vector?
+ e-25330)
+ (if (=
(vector-length
+
e-25330)
+ 4)
+ (eq?
(vector-ref
+
e-25330
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ e-25330
+ 1)
+ e-25330))))
+ (if (pair? props-25345)
+ props-25345
+ #f))
+ #f
+ mod-25156
+ #f))
+ (lambda (type-25378
+ value-25379
+ form-25380
+ e-25381
+ w-25382
+ s-25383
+ mod-25384)
+ (expand-expr-4384
+ type-25378
+ value-25379
+ form-25380
+ e-25381
+ r-25153
+ w-25382
+ s-25383
+ mod-25384))))
+ e1-25274)))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 11)
+ s-25155
+ x-25263
+ arg-exps-25279)))
+ tmp-25270)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ e-25152))))
+ (if (eqv? type-25149 'global-call)
+ (let ((x-25400
+ (let ((source-25423
+ (let ((x-25461 (car e-25152)))
+ (let ((props-25462
+ (source-properties
+ (if (if (vector? x-25461)
+ (if (= (vector-length
+ x-25461)
+ 4)
+ (eq? (vector-ref
+ x-25461
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref x-25461 1)
+ x-25461))))
+ (if (pair? props-25462)
+ props-25462
+ #f))))
+ (var-25424
+ (if (if (vector? value-25150)
+ (if (= (vector-length value-25150) 4)
+ (eq? (vector-ref value-25150 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref value-25150 1)
+ value-25150))
+ (mod-25425
+ (if (if (vector? value-25150)
+ (if (= (vector-length value-25150) 4)
+ (eq? (vector-ref value-25150 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref value-25150 3)
+ mod-25156)))
+ (analyze-variable-4319
+ mod-25425
+ var-25424
+ (lambda (mod-25451 var-25452 public?-25453)
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 5)
+ source-25423
+ mod-25451
+ var-25452
+ public?-25453))
+ (lambda (var-25475)
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 7)
+ source-25423
+ var-25475))))))
+ (let ((tmp-25407
+ ($sc-dispatch e-25152 '(any . each-any))))
+ (if tmp-25407
+ (@apply
+ (lambda (e0-25410 e1-25411)
+ (let ((arg-exps-25416
+ (map (lambda (e-25479)
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-25479
+ r-25153
+ w-25154
+ (let ((props-25494
+ (source-properties
+ (if (if (vector?
+ e-25479)
+ (if (=
(vector-length
+
e-25479)
+ 4)
+ (eq?
(vector-ref
+
e-25479
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ e-25479
+ 1)
+ e-25479))))
+ (if (pair? props-25494)
+ props-25494
+ #f))
+ #f
+ mod-25156
+ #f))
+ (lambda (type-25527
+ value-25528
+ form-25529
+ e-25530
+ w-25531
+ s-25532
+ mod-25533)
+ (expand-expr-4384
+ type-25527
+ value-25528
+ form-25529
+ e-25530
+ r-25153
+ w-25531
+ s-25532
+ mod-25533))))
+ e1-25411)))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 11)
+ s-25155
+ x-25400
+ arg-exps-25416)))
+ tmp-25407)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ e-25152))))
+ (if (eqv? type-25149 'constant)
+ (let ((exp-25550
+ (strip-4396
+ (let ((x-25563
(begin
- (if (if (pair? e-26977) s-26980 #f)
+ (if (if s-25155
+ (supports-source-properties?
+ e-25152)
+ #f)
(set-source-properties!
- e-26977
- s-26980))
- e-26977)))
- (if (if (null? (car w-26979))
- (null? (cdr w-26979))
+ e-25152
+ s-25155))
+ e-25152)))
+ (if (if (null? (car w-25154))
+ (null? (cdr w-25154))
#f)
- x-27890
- (if (if (vector? x-27890)
- (if (= (vector-length x-27890) 4)
- (eq? (vector-ref x-27890 0)
+ x-25563
+ (if (if (vector? x-25563)
+ (if (= (vector-length x-25563) 4)
+ (eq? (vector-ref x-25563 0)
'syntax-object)
#f)
#f)
- (let ((expression-27922
- (vector-ref x-27890 1))
- (wrap-27923
- (let ((w2-27931
- (vector-ref x-27890 2)))
- (let ((m1-27932 (car w-26979))
- (s1-27933 (cdr w-26979)))
- (if (null? m1-27932)
- (if (null? s1-27933)
- w2-27931
- (cons (car w2-27931)
- (let ((m2-27948
- (cdr
w2-27931)))
- (if (null?
m2-27948)
- s1-27933
+ (let ((expression-25595
+ (vector-ref x-25563 1))
+ (wrap-25596
+ (let ((w2-25604
+ (vector-ref x-25563 2)))
+ (let ((m1-25605 (car w-25154))
+ (s1-25606 (cdr w-25154)))
+ (if (null? m1-25605)
+ (if (null? s1-25606)
+ w2-25604
+ (cons (car w2-25604)
+ (let ((m2-25621
+ (cdr
w2-25604)))
+ (if (null?
m2-25621)
+ s1-25606
(append
- s1-27933
- m2-27948)))))
- (cons (let ((m2-27956
- (car
w2-27931)))
- (if (null? m2-27956)
- m1-27932
+ s1-25606
+ m2-25621)))))
+ (cons (let ((m2-25629
+ (car
w2-25604)))
+ (if (null? m2-25629)
+ m1-25605
(append
- m1-27932
- m2-27956)))
- (let ((m2-27964
- (cdr
w2-27931)))
- (if (null? m2-27964)
- s1-27933
+ m1-25605
+ m2-25629)))
+ (let ((m2-25637
+ (cdr
w2-25604)))
+ (if (null? m2-25637)
+ s1-25606
(append
- s1-27933
- m2-27964))))))))
- (module-27924
- (vector-ref x-27890 3)))
+ s1-25606
+ m2-25637))))))))
+ (module-25597
+ (vector-ref x-25563 3)))
(vector
'syntax-object
- expression-27922
- wrap-27923
- module-27924))
- (if (null? x-27890)
- x-27890
+ expression-25595
+ wrap-25596
+ module-25597))
+ (if (null? x-25563)
+ x-25563
(vector
'syntax-object
- x-27890
- w-26979
- mod-26981)))))
+ x-25563
+ w-25154
+ mod-25156)))))
'(()))))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
- s-26980
- exp-27877))
- (if (eqv? type-26974 'global)
- (analyze-variable-4318
- mod-26981
- value-26975
- (lambda (mod-27992 var-27993 public?-27994)
+ s-25155
+ exp-25550))
+ (if (eqv? type-25149 'global)
+ (analyze-variable-4319
+ mod-25156
+ value-25150
+ (lambda (mod-25665 var-25666 public?-25667)
(make-struct/no-tail
(vector-ref %expanded-vtables 5)
- s-26980
- mod-27992
- var-27993
- public?-27994))
- (lambda (var-28002)
+ s-25155
+ mod-25665
+ var-25666
+ public?-25667))
+ (lambda (var-25675)
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
- s-26980
- var-28002)))
- (if (eqv? type-26974 'call)
- (expand-call-4384
- (expand-4382
- (car e-26977)
- r-26978
- w-26979
- mod-26981)
- e-26977
- r-26978
- w-26979
- s-26980
- mod-26981)
- (if (eqv? type-26974 'begin-form)
- (let ((tmp-28178
- ($sc-dispatch e-26977 '(_ any . each-any))))
- (if tmp-28178
+ s-25155
+ var-25675)))
+ (if (eqv? type-25149 'call)
+ (let ((x-25690
+ (let ((e-25713 (car e-25152)))
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-25713
+ r-25153
+ w-25154
+ (let ((props-25723
+ (source-properties
+ (if (if (vector? e-25713)
+ (if (= (vector-length
+ e-25713)
+ 4)
+ (eq? (vector-ref
+ e-25713
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref e-25713 1)
+ e-25713))))
+ (if (pair? props-25723)
+ props-25723
+ #f))
+ #f
+ mod-25156
+ #f))
+ (lambda (type-25746
+ value-25747
+ form-25748
+ e-25749
+ w-25750
+ s-25751
+ mod-25752)
+ (expand-expr-4384
+ type-25746
+ value-25747
+ form-25748
+ e-25749
+ r-25153
+ w-25750
+ s-25751
+ mod-25752))))))
+ (let ((tmp-25697
+ ($sc-dispatch e-25152 '(any . each-any))))
+ (if tmp-25697
+ (@apply
+ (lambda (e0-25700 e1-25701)
+ (let ((arg-exps-25706
+ (map (lambda (e-25755)
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-25755
+ r-25153
+ w-25154
+ (let ((props-25770
+
(source-properties
+ (if (if
(vector?
+
e-25755)
+ (if (=
(vector-length
+
e-25755)
+
4)
+ (eq?
(vector-ref
+
e-25755
+
0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ e-25755
+ 1)
+ e-25755))))
+ (if (pair?
props-25770)
+ props-25770
+ #f))
+ #f
+ mod-25156
+ #f))
+ (lambda (type-25803
+ value-25804
+ form-25805
+ e-25806
+ w-25807
+ s-25808
+ mod-25809)
+ (expand-expr-4384
+ type-25803
+ value-25804
+ form-25805
+ e-25806
+ r-25153
+ w-25807
+ s-25808
+ mod-25809))))
+ e1-25701)))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 11)
+ s-25155
+ x-25690
+ arg-exps-25706)))
+ tmp-25697)
+ (syntax-violation
+ #f
+ "source expression failed to match any
pattern"
+ e-25152))))
+ (if (eqv? type-25149 'begin-form)
+ (let ((tmp-25823
+ ($sc-dispatch e-25152 '(_ any . each-any))))
+ (if tmp-25823
(@apply
- (lambda (e1-28182 e2-28183)
- (expand-sequence-4377
- (cons e1-28182 e2-28183)
- r-26978
- w-26979
- s-26980
- mod-26981))
- tmp-28178)
- (let ((tmp-28278 ($sc-dispatch e-26977 '(_))))
- (if tmp-28278
+ (lambda (e1-25827 e2-25828)
+ (expand-sequence-4378
+ (cons e1-25827 e2-25828)
+ r-25153
+ w-25154
+ s-25155
+ mod-25156))
+ tmp-25823)
+ (let ((tmp-25968 ($sc-dispatch e-25152 '(_))))
+ (if tmp-25968
(@apply
(lambda ()
(syntax-violation
#f
"sequence of zero expressions"
- (let ((x-28291
+ (let ((x-25981
(begin
- (if (if (pair? e-26977)
- s-26980
+ (if (if s-25155
+
(supports-source-properties?
+ e-25152)
#f)
(set-source-properties!
- e-26977
- s-26980))
- e-26977)))
- (if (if (null? (car w-26979))
- (null? (cdr w-26979))
+ e-25152
+ s-25155))
+ e-25152)))
+ (if (if (null? (car w-25154))
+ (null? (cdr w-25154))
#f)
- x-28291
- (if (if (vector? x-28291)
+ x-25981
+ (if (if (vector? x-25981)
(if (= (vector-length
- x-28291)
+ x-25981)
4)
(eq? (vector-ref
- x-28291
+ x-25981
0)
'syntax-object)
#f)
#f)
- (let ((expression-28323
- (vector-ref x-28291 1))
- (wrap-28324
- (let ((w2-28332
+ (let ((expression-26013
+ (vector-ref x-25981 1))
+ (wrap-26014
+ (let ((w2-26022
(vector-ref
- x-28291
+ x-25981
2)))
- (let ((m1-28333
- (car w-26979))
- (s1-28334
- (cdr
w-26979)))
- (if (null? m1-28333)
- (if (null?
s1-28334)
- w2-28332
- (cons (car
w2-28332)
- (let
((m2-28349
-
(cdr w2-28332)))
- (if
(null? m2-28349)
-
s1-28334
+ (let ((m1-26023
+ (car w-25154))
+ (s1-26024
+ (cdr
w-25154)))
+ (if (null? m1-26023)
+ (if (null?
s1-26024)
+ w2-26022
+ (cons (car
w2-26022)
+ (let
((m2-26039
+
(cdr w2-26022)))
+ (if
(null? m2-26039)
+
s1-26024
(append
-
s1-28334
-
m2-28349)))))
- (cons (let
((m2-28357
-
(car w2-28332)))
- (if
(null? m2-28357)
- m1-28333
+
s1-26024
+
m2-26039)))))
+ (cons (let
((m2-26047
+
(car w2-26022)))
+ (if
(null? m2-26047)
+ m1-26023
(append
-
m1-28333
-
m2-28357)))
- (let
((m2-28365
-
(cdr w2-28332)))
- (if
(null? m2-28365)
- s1-28334
+
m1-26023
+
m2-26047)))
+ (let
((m2-26055
+
(cdr w2-26022)))
+ (if
(null? m2-26055)
+ s1-26024
(append
-
s1-28334
-
m2-28365))))))))
- (module-28325
- (vector-ref x-28291 3)))
+
s1-26024
+
m2-26055))))))))
+ (module-26015
+ (vector-ref x-25981 3)))
(vector
'syntax-object
- expression-28323
- wrap-28324
- module-28325))
- (if (null? x-28291)
- x-28291
+ expression-26013
+ wrap-26014
+ module-26015))
+ (if (null? x-25981)
+ x-25981
(vector
'syntax-object
- x-28291
- w-26979
- mod-26981)))))))
- tmp-28278)
+ x-25981
+ w-25154
+ mod-25156)))))))
+ tmp-25968)
(syntax-violation
#f
"source expression failed to match any
pattern"
- e-26977)))))
- (if (eqv? type-26974 'local-syntax-form)
- (expand-local-syntax-4387
- value-26975
- e-26977
- r-26978
- w-26979
- s-26980
- mod-26981
- expand-sequence-4377)
- (if (eqv? type-26974 'eval-when-form)
- (let ((tmp-28466
+ e-25152)))))
+ (if (eqv? type-25149 'local-syntax-form)
+ (expand-local-syntax-4388
+ value-25150
+ e-25152
+ r-25153
+ w-25154
+ s-25155
+ mod-25156
+ expand-sequence-4378)
+ (if (eqv? type-25149 'eval-when-form)
+ (let ((tmp-26155
($sc-dispatch
- e-26977
+ e-25152
'(_ each-any any . each-any))))
- (if tmp-28466
+ (if tmp-26155
(@apply
- (lambda (x-28470 e1-28471 e2-28472)
- (let ((when-list-28473
- (parse-when-list-4380
- e-26977
- x-28470)))
- (if (memq 'eval when-list-28473)
- (expand-sequence-4377
- (cons e1-28471 e2-28472)
- r-26978
- w-26979
- s-26980
- mod-26981)
+ (lambda (x-26159 e1-26160 e2-26161)
+ (let ((when-list-26162
+ (parse-when-list-4381
+ e-25152
+ x-26159)))
+ (if (memq 'eval when-list-26162)
+ (expand-sequence-4378
+ (cons e1-26160 e2-26161)
+ r-25153
+ w-25154
+ s-25155
+ mod-25156)
(make-struct/no-tail
(vector-ref %expanded-vtables 0)
#f))))
- tmp-28466)
+ tmp-26155)
(syntax-violation
#f
"source expression failed to match any
pattern"
- e-26977)))
- (if (if (eqv? type-26974 'define-form)
+ e-25152)))
+ (if (if (eqv? type-25149 'define-form)
#t
- (if (eqv? type-26974 'define-syntax-form)
+ (if (eqv? type-25149 'define-syntax-form)
#t
- (eqv? type-26974
+ (eqv? type-25149
'define-syntax-parameter-form)))
(syntax-violation
#f
"definition in expression context, where
definitions are not allowed,"
- (let ((x-28662
+ (let ((x-26396
(begin
- (if (if (pair? form-26976)
- s-26980
+ (if (if s-25155
+ (supports-source-properties?
+ form-25151)
#f)
(set-source-properties!
- form-26976
- s-26980))
- form-26976)))
- (if (if (null? (car w-26979))
- (null? (cdr w-26979))
+ form-25151
+ s-25155))
+ form-25151)))
+ (if (if (null? (car w-25154))
+ (null? (cdr w-25154))
#f)
- x-28662
- (if (if (vector? x-28662)
- (if (= (vector-length x-28662) 4)
- (eq? (vector-ref x-28662 0)
+ x-26396
+ (if (if (vector? x-26396)
+ (if (= (vector-length x-26396) 4)
+ (eq? (vector-ref x-26396 0)
'syntax-object)
#f)
#f)
- (let ((expression-28694
- (vector-ref x-28662 1))
- (wrap-28695
- (let ((w2-28703
+ (let ((expression-26428
+ (vector-ref x-26396 1))
+ (wrap-26429
+ (let ((w2-26437
(vector-ref
- x-28662
+ x-26396
2)))
- (let ((m1-28704
- (car w-26979))
- (s1-28705
- (cdr w-26979)))
- (if (null? m1-28704)
- (if (null? s1-28705)
- w2-28703
- (cons (car w2-28703)
- (let ((m2-28720
- (cdr
w2-28703)))
- (if (null?
m2-28720)
- s1-28705
+ (let ((m1-26438
+ (car w-25154))
+ (s1-26439
+ (cdr w-25154)))
+ (if (null? m1-26438)
+ (if (null? s1-26439)
+ w2-26437
+ (cons (car w2-26437)
+ (let ((m2-26454
+ (cdr
w2-26437)))
+ (if (null?
m2-26454)
+ s1-26439
(append
- s1-28705
-
m2-28720)))))
- (cons (let ((m2-28728
- (car
w2-28703)))
- (if (null?
m2-28728)
- m1-28704
+ s1-26439
+
m2-26454)))))
+ (cons (let ((m2-26462
+ (car
w2-26437)))
+ (if (null?
m2-26462)
+ m1-26438
(append
- m1-28704
- m2-28728)))
- (let ((m2-28736
- (cdr
w2-28703)))
- (if (null?
m2-28736)
- s1-28705
+ m1-26438
+ m2-26462)))
+ (let ((m2-26470
+ (cdr
w2-26437)))
+ (if (null?
m2-26470)
+ s1-26439
(append
- s1-28705
-
m2-28736))))))))
- (module-28696
- (vector-ref x-28662 3)))
+ s1-26439
+
m2-26470))))))))
+ (module-26430
+ (vector-ref x-26396 3)))
(vector
'syntax-object
- expression-28694
- wrap-28695
- module-28696))
- (if (null? x-28662)
- x-28662
+ expression-26428
+ wrap-26429
+ module-26430))
+ (if (null? x-26396)
+ x-26396
(vector
'syntax-object
- x-28662
- w-26979
- mod-26981))))))
- (if (eqv? type-26974 'syntax)
+ x-26396
+ w-25154
+ mod-25156))))))
+ (if (eqv? type-25149 'syntax)
(syntax-violation
#f
"reference to pattern variable outside
syntax form"
- (let ((x-28766
+ (let ((x-26500
(begin
- (if (if (pair? e-26977)
- s-26980
+ (if (if s-25155
+
(supports-source-properties?
+ e-25152)
#f)
(set-source-properties!
- e-26977
- s-26980))
- e-26977)))
- (if (if (null? (car w-26979))
- (null? (cdr w-26979))
+ e-25152
+ s-25155))
+ e-25152)))
+ (if (if (null? (car w-25154))
+ (null? (cdr w-25154))
#f)
- x-28766
- (if (if (vector? x-28766)
- (if (= (vector-length x-28766)
+ x-26500
+ (if (if (vector? x-26500)
+ (if (= (vector-length x-26500)
4)
- (eq? (vector-ref x-28766 0)
+ (eq? (vector-ref x-26500 0)
'syntax-object)
#f)
#f)
- (let ((expression-28798
- (vector-ref x-28766 1))
- (wrap-28799
- (let ((w2-28807
+ (let ((expression-26532
+ (vector-ref x-26500 1))
+ (wrap-26533
+ (let ((w2-26541
(vector-ref
- x-28766
+ x-26500
2)))
- (let ((m1-28808
- (car w-26979))
- (s1-28809
- (cdr w-26979)))
- (if (null? m1-28808)
- (if (null? s1-28809)
- w2-28807
- (cons (car w2-28807)
- (let
((m2-28824
- (cdr
w2-28807)))
- (if (null?
m2-28824)
- s1-28809
+ (let ((m1-26542
+ (car w-25154))
+ (s1-26543
+ (cdr w-25154)))
+ (if (null? m1-26542)
+ (if (null? s1-26543)
+ w2-26541
+ (cons (car w2-26541)
+ (let
((m2-26558
+ (cdr
w2-26541)))
+ (if (null?
m2-26558)
+ s1-26543
(append
- s1-28809
-
m2-28824)))))
- (cons (let ((m2-28832
- (car
w2-28807)))
- (if (null?
m2-28832)
- m1-28808
+ s1-26543
+
m2-26558)))))
+ (cons (let ((m2-26566
+ (car
w2-26541)))
+ (if (null?
m2-26566)
+ m1-26542
(append
- m1-28808
-
m2-28832)))
- (let ((m2-28840
- (cdr
w2-28807)))
- (if (null?
m2-28840)
- s1-28809
+ m1-26542
+
m2-26566)))
+ (let ((m2-26574
+ (cdr
w2-26541)))
+ (if (null?
m2-26574)
+ s1-26543
(append
- s1-28809
-
m2-28840))))))))
- (module-28800
- (vector-ref x-28766 3)))
+ s1-26543
+
m2-26574))))))))
+ (module-26534
+ (vector-ref x-26500 3)))
(vector
'syntax-object
- expression-28798
- wrap-28799
- module-28800))
- (if (null? x-28766)
- x-28766
+ expression-26532
+ wrap-26533
+ module-26534))
+ (if (null? x-26500)
+ x-26500
(vector
'syntax-object
- x-28766
- w-26979
- mod-26981))))))
- (if (eqv? type-26974 'displaced-lexical)
+ x-26500
+ w-25154
+ mod-25156))))))
+ (if (eqv? type-25149 'displaced-lexical)
(syntax-violation
#f
"reference to identifier outside its
scope"
- (let ((x-28870
+ (let ((x-26604
(begin
- (if (if (pair? e-26977)
- s-26980
+ (if (if s-25155
+
(supports-source-properties?
+ e-25152)
#f)
(set-source-properties!
- e-26977
- s-26980))
- e-26977)))
- (if (if (null? (car w-26979))
- (null? (cdr w-26979))
+ e-25152
+ s-25155))
+ e-25152)))
+ (if (if (null? (car w-25154))
+ (null? (cdr w-25154))
#f)
- x-28870
- (if (if (vector? x-28870)
- (if (= (vector-length x-28870)
+ x-26604
+ (if (if (vector? x-26604)
+ (if (= (vector-length x-26604)
4)
- (eq? (vector-ref x-28870 0)
+ (eq? (vector-ref x-26604 0)
'syntax-object)
#f)
#f)
- (let ((expression-28902
- (vector-ref x-28870 1))
- (wrap-28903
- (let ((w2-28911
+ (let ((expression-26636
+ (vector-ref x-26604 1))
+ (wrap-26637
+ (let ((w2-26645
(vector-ref
- x-28870
+ x-26604
2)))
- (let ((m1-28912
- (car w-26979))
- (s1-28913
- (cdr w-26979)))
- (if (null? m1-28912)
- (if (null? s1-28913)
- w2-28911
- (cons (car
w2-28911)
- (let
((m2-28928
-
(cdr w2-28911)))
- (if
(null? m2-28928)
- s1-28913
+ (let ((m1-26646
+ (car w-25154))
+ (s1-26647
+ (cdr w-25154)))
+ (if (null? m1-26646)
+ (if (null? s1-26647)
+ w2-26645
+ (cons (car
w2-26645)
+ (let
((m2-26662
+
(cdr w2-26645)))
+ (if
(null? m2-26662)
+ s1-26647
(append
-
s1-28913
-
m2-28928)))))
- (cons (let
((m2-28936
- (car
w2-28911)))
- (if (null?
m2-28936)
- m1-28912
+
s1-26647
+
m2-26662)))))
+ (cons (let
((m2-26670
+ (car
w2-26645)))
+ (if (null?
m2-26670)
+ m1-26646
(append
- m1-28912
-
m2-28936)))
- (let
((m2-28944
- (cdr
w2-28911)))
- (if (null?
m2-28944)
- s1-28913
+ m1-26646
+
m2-26670)))
+ (let
((m2-26678
+ (cdr
w2-26645)))
+ (if (null?
m2-26678)
+ s1-26647
(append
- s1-28913
-
m2-28944))))))))
- (module-28904
- (vector-ref x-28870 3)))
+ s1-26647
+
m2-26678))))))))
+ (module-26638
+ (vector-ref x-26604 3)))
(vector
'syntax-object
- expression-28902
- wrap-28903
- module-28904))
- (if (null? x-28870)
- x-28870
+ expression-26636
+ wrap-26637
+ module-26638))
+ (if (null? x-26604)
+ x-26604
(vector
'syntax-object
- x-28870
- w-26979
- mod-26981))))))
+ x-26604
+ w-25154
+ mod-25156))))))
(syntax-violation
#f
"unexpected syntax"
- (let ((x-28968
+ (let ((x-26702
(begin
- (if (if (pair? e-26977)
- s-26980
+ (if (if s-25155
+
(supports-source-properties?
+ e-25152)
#f)
(set-source-properties!
- e-26977
- s-26980))
- e-26977)))
- (if (if (null? (car w-26979))
- (null? (cdr w-26979))
+ e-25152
+ s-25155))
+ e-25152)))
+ (if (if (null? (car w-25154))
+ (null? (cdr w-25154))
#f)
- x-28968
- (if (if (vector? x-28968)
- (if (= (vector-length x-28968)
+ x-26702
+ (if (if (vector? x-26702)
+ (if (= (vector-length x-26702)
4)
- (eq? (vector-ref x-28968 0)
+ (eq? (vector-ref x-26702 0)
'syntax-object)
#f)
#f)
- (let ((expression-29000
- (vector-ref x-28968 1))
- (wrap-29001
- (let ((w2-29009
+ (let ((expression-26734
+ (vector-ref x-26702 1))
+ (wrap-26735
+ (let ((w2-26743
(vector-ref
- x-28968
+ x-26702
2)))
- (let ((m1-29010
- (car w-26979))
- (s1-29011
- (cdr w-26979)))
- (if (null? m1-29010)
- (if (null? s1-29011)
- w2-29009
- (cons (car
w2-29009)
- (let
((m2-29026
-
(cdr w2-29009)))
- (if
(null? m2-29026)
- s1-29011
+ (let ((m1-26744
+ (car w-25154))
+ (s1-26745
+ (cdr w-25154)))
+ (if (null? m1-26744)
+ (if (null? s1-26745)
+ w2-26743
+ (cons (car
w2-26743)
+ (let
((m2-26760
+
(cdr w2-26743)))
+ (if
(null? m2-26760)
+ s1-26745
(append
-
s1-29011
-
m2-29026)))))
- (cons (let
((m2-29034
- (car
w2-29009)))
- (if (null?
m2-29034)
- m1-29010
+
s1-26745
+
m2-26760)))))
+ (cons (let
((m2-26768
+ (car
w2-26743)))
+ (if (null?
m2-26768)
+ m1-26744
(append
- m1-29010
-
m2-29034)))
- (let
((m2-29042
- (cdr
w2-29009)))
- (if (null?
m2-29042)
- s1-29011
+ m1-26744
+
m2-26768)))
+ (let
((m2-26776
+ (cdr
w2-26743)))
+ (if (null?
m2-26776)
+ s1-26745
(append
- s1-29011
-
m2-29042))))))))
- (module-29002
- (vector-ref x-28968 3)))
+ s1-26745
+
m2-26776))))))))
+ (module-26736
+ (vector-ref x-26702 3)))
(vector
'syntax-object
- expression-29000
- wrap-29001
- module-29002))
- (if (null? x-28968)
- x-28968
+ expression-26734
+ wrap-26735
+ module-26736))
+ (if (null? x-26702)
+ x-26702
(vector
'syntax-object
- x-28968
- w-26979
-
mod-26981))))))))))))))))))))))
- (expand-call-4384
- (lambda (x-29057
- e-29058
- r-29059
- w-29060
- s-29061
- mod-29062)
- (let ((tmp-29064
- ($sc-dispatch e-29058 '(any . each-any))))
- (if tmp-29064
- (@apply
- (lambda (e0-29068 e1-29069)
- (build-call-4313
- s-29061
- x-29057
- (map (lambda (e-29157)
- (expand-4382 e-29157 r-29059 w-29060 mod-29062))
- e1-29069)))
- tmp-29064)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-29058)))))
- (expand-macro-4385
- (lambda (p-29241
- e-29242
- r-29243
- w-29244
- s-29245
- rib-29246
- mod-29247)
+ x-26702
+ w-25154
+
mod-25156))))))))))))))))))))))
+ (expand-macro-4386
+ (lambda (p-26791
+ e-26792
+ r-26793
+ w-26794
+ s-26795
+ rib-26796
+ mod-26797)
(letrec*
- ((rebuild-macro-output-29248
- (lambda (x-29357 m-29358)
- (if (pair? x-29357)
- (let ((e-29362
- (cons (rebuild-macro-output-29248
- (car x-29357)
- m-29358)
- (rebuild-macro-output-29248
- (cdr x-29357)
- m-29358))))
+ ((rebuild-macro-output-26798
+ (lambda (x-26907 m-26908)
+ (if (pair? x-26907)
+ (let ((e-26912
+ (cons (rebuild-macro-output-26798
+ (car x-26907)
+ m-26908)
+ (rebuild-macro-output-26798
+ (cdr x-26907)
+ m-26908))))
(begin
- (if (if (pair? e-29362) s-29245 #f)
- (set-source-properties! e-29362 s-29245))
- e-29362))
- (if (if (vector? x-29357)
- (if (= (vector-length x-29357) 4)
- (eq? (vector-ref x-29357 0) 'syntax-object)
+ (if (if s-26795
+ (supports-source-properties? e-26912)
+ #f)
+ (set-source-properties! e-26912 s-26795))
+ e-26912))
+ (if (if (vector? x-26907)
+ (if (= (vector-length x-26907) 4)
+ (eq? (vector-ref x-26907 0) 'syntax-object)
#f)
#f)
- (let ((w-29378 (vector-ref x-29357 2)))
- (let ((ms-29379 (car w-29378))
- (ss-29380 (cdr w-29378)))
- (if (if (pair? ms-29379) (eq? (car ms-29379) #f) #f)
- (let ((expression-29388 (vector-ref x-29357 1))
- (wrap-29389
- (cons (cdr ms-29379)
- (if rib-29246
- (cons rib-29246 (cdr ss-29380))
- (cdr ss-29380))))
- (module-29390 (vector-ref x-29357 3)))
+ (let ((w-26928 (vector-ref x-26907 2)))
+ (let ((ms-26929 (car w-26928))
+ (ss-26930 (cdr w-26928)))
+ (if (if (pair? ms-26929) (eq? (car ms-26929) #f) #f)
+ (let ((expression-26938 (vector-ref x-26907 1))
+ (wrap-26939
+ (cons (cdr ms-26929)
+ (if rib-26796
+ (cons rib-26796 (cdr ss-26930))
+ (cdr ss-26930))))
+ (module-26940 (vector-ref x-26907 3)))
(vector
'syntax-object
- expression-29388
- wrap-29389
- module-29390))
- (let ((expression-29400
- (let ((e-29405 (vector-ref x-29357 1)))
+ expression-26938
+ wrap-26939
+ module-26940))
+ (let ((expression-26950
+ (let ((e-26955 (vector-ref x-26907 1)))
(begin
- (if (if (pair? e-29405) s-29245 #f)
+ (if (if s-26795
+ (supports-source-properties?
+ e-26955)
+ #f)
(set-source-properties!
- e-29405
- s-29245))
- e-29405)))
- (wrap-29401
- (cons (cons m-29358 ms-29379)
- (if rib-29246
- (cons rib-29246
- (cons 'shift ss-29380))
- (cons 'shift ss-29380))))
- (module-29402 (vector-ref x-29357 3)))
+ e-26955
+ s-26795))
+ e-26955)))
+ (wrap-26951
+ (cons (cons m-26908 ms-26929)
+ (if rib-26796
+ (cons rib-26796
+ (cons 'shift ss-26930))
+ (cons 'shift ss-26930))))
+ (module-26952 (vector-ref x-26907 3)))
(vector
'syntax-object
- expression-29400
- wrap-29401
- module-29402)))))
- (if (vector? x-29357)
- (let ((n-29417 (vector-length x-29357)))
- (let ((v-29418
- (let ((e-29484 (make-vector n-29417)))
+ expression-26950
+ wrap-26951
+ module-26952)))))
+ (if (vector? x-26907)
+ (let ((n-26967 (vector-length x-26907)))
+ (let ((v-26968
+ (let ((e-27033 (make-vector n-26967)))
(begin
- (if (if (pair? e-29484) s-29245 #f)
- (set-source-properties! e-29484 s-29245))
- e-29484))))
+ (if (if s-26795
+ (supports-source-properties? e-27033)
+ #f)
+ (set-source-properties! e-27033 s-26795))
+ e-27033))))
(letrec*
- ((loop-29419
- (lambda (i-29480)
- (if (= i-29480 n-29417)
- v-29418
+ ((loop-26969
+ (lambda (i-27029)
+ (if (= i-27029 n-26967)
+ v-26968
(begin
(vector-set!
- v-29418
- i-29480
- (rebuild-macro-output-29248
- (vector-ref x-29357 i-29480)
- m-29358))
- (loop-29419 (#{1+}# i-29480)))))))
- (loop-29419 0))))
- (if (symbol? x-29357)
+ v-26968
+ i-27029
+ (rebuild-macro-output-26798
+ (vector-ref x-26907 i-27029)
+ m-26908))
+ (loop-26969 (#{1+}# i-27029)))))))
+ (loop-26969 0))))
+ (if (symbol? x-26907)
(syntax-violation
#f
"encountered raw symbol in macro output"
- (let ((s-29495 (cdr w-29244)))
- (let ((x-29499
+ (let ((s-27044 (cdr w-26794)))
+ (let ((x-27048
(begin
- (if (if (pair? e-29242) s-29495 #f)
+ (if (if s-27044
+ (supports-source-properties?
+ e-26792)
+ #f)
(set-source-properties!
- e-29242
- s-29495))
- e-29242)))
- (if (if (null? (car w-29244))
- (null? (cdr w-29244))
+ e-26792
+ s-27044))
+ e-26792)))
+ (if (if (null? (car w-26794))
+ (null? (cdr w-26794))
#f)
- x-29499
- (if (if (vector? x-29499)
- (if (= (vector-length x-29499) 4)
- (eq? (vector-ref x-29499 0)
+ x-27048
+ (if (if (vector? x-27048)
+ (if (= (vector-length x-27048) 4)
+ (eq? (vector-ref x-27048 0)
'syntax-object)
#f)
#f)
- (let ((expression-29531
- (vector-ref x-29499 1))
- (wrap-29532
- (let ((w2-29540
- (vector-ref x-29499 2)))
- (let ((m1-29541 (car w-29244))
- (s1-29542 (cdr w-29244)))
- (if (null? m1-29541)
- (if (null? s1-29542)
- w2-29540
- (cons (car w2-29540)
- (let ((m2-29557
- (cdr
w2-29540)))
- (if (null? m2-29557)
- s1-29542
+ (let ((expression-27080
+ (vector-ref x-27048 1))
+ (wrap-27081
+ (let ((w2-27089
+ (vector-ref x-27048 2)))
+ (let ((m1-27090 (car w-26794))
+ (s1-27091 (cdr w-26794)))
+ (if (null? m1-27090)
+ (if (null? s1-27091)
+ w2-27089
+ (cons (car w2-27089)
+ (let ((m2-27106
+ (cdr
w2-27089)))
+ (if (null? m2-27106)
+ s1-27091
(append
- s1-29542
- m2-29557)))))
- (cons (let ((m2-29565
- (car w2-29540)))
- (if (null? m2-29565)
- m1-29541
+ s1-27091
+ m2-27106)))))
+ (cons (let ((m2-27114
+ (car w2-27089)))
+ (if (null? m2-27114)
+ m1-27090
(append
- m1-29541
- m2-29565)))
- (let ((m2-29573
- (cdr w2-29540)))
- (if (null? m2-29573)
- s1-29542
+ m1-27090
+ m2-27114)))
+ (let ((m2-27122
+ (cdr w2-27089)))
+ (if (null? m2-27122)
+ s1-27091
(append
- s1-29542
- m2-29573))))))))
- (module-29533 (vector-ref x-29499 3)))
+ s1-27091
+ m2-27122))))))))
+ (module-27082 (vector-ref x-27048 3)))
(vector
'syntax-object
- expression-29531
- wrap-29532
- module-29533))
- (if (null? x-29499)
- x-29499
+ expression-27080
+ wrap-27081
+ module-27082))
+ (if (null? x-27048)
+ x-27048
(vector
'syntax-object
- x-29499
- w-29244
- mod-29247))))))
- x-29357)
+ x-27048
+ w-26794
+ mod-26797))))))
+ x-26907)
(begin
- (if (if (pair? x-29357) s-29245 #f)
- (set-source-properties! x-29357 s-29245))
- x-29357))))))))
+ (if (if s-26795
+ (supports-source-properties? x-26907)
+ #f)
+ (set-source-properties! x-26907 s-26795))
+ x-26907))))))))
(with-fluids
- ((transformer-environment-4368
- (lambda (k-29249)
- (k-29249
- e-29242
- r-29243
- w-29244
- s-29245
- rib-29246
- mod-29247))))
- (rebuild-macro-output-29248
- (p-29241
- (let ((w-29256
- (cons (cons #f (car w-29244))
- (cons 'shift (cdr w-29244)))))
- (let ((x-29261
+ ((transformer-environment-4369
+ (lambda (k-26799)
+ (k-26799
+ e-26792
+ r-26793
+ w-26794
+ s-26795
+ rib-26796
+ mod-26797))))
+ (rebuild-macro-output-26798
+ (p-26791
+ (let ((w-26806
+ (cons (cons #f (car w-26794))
+ (cons 'shift (cdr w-26794)))))
+ (let ((x-26811
(begin
- (if (if (pair? e-29242) s-29245 #f)
- (set-source-properties! e-29242 s-29245))
- e-29242)))
- (if (if (null? (car w-29256))
- (null? (cdr w-29256))
+ (if (if s-26795
+ (supports-source-properties? e-26792)
+ #f)
+ (set-source-properties! e-26792 s-26795))
+ e-26792)))
+ (if (if (null? (car w-26806))
+ (null? (cdr w-26806))
#f)
- x-29261
- (if (if (vector? x-29261)
- (if (= (vector-length x-29261) 4)
- (eq? (vector-ref x-29261 0) 'syntax-object)
+ x-26811
+ (if (if (vector? x-26811)
+ (if (= (vector-length x-26811) 4)
+ (eq? (vector-ref x-26811 0) 'syntax-object)
#f)
#f)
- (let ((expression-29300 (vector-ref x-29261 1))
- (wrap-29301
- (let ((w2-29309 (vector-ref x-29261 2)))
- (let ((m1-29310 (car w-29256))
- (s1-29311 (cdr w-29256)))
- (if (null? m1-29310)
- (if (null? s1-29311)
- w2-29309
- (cons (car w2-29309)
- (let ((m2-29326 (cdr w2-29309)))
- (if (null? m2-29326)
- s1-29311
+ (let ((expression-26850 (vector-ref x-26811 1))
+ (wrap-26851
+ (let ((w2-26859 (vector-ref x-26811 2)))
+ (let ((m1-26860 (car w-26806))
+ (s1-26861 (cdr w-26806)))
+ (if (null? m1-26860)
+ (if (null? s1-26861)
+ w2-26859
+ (cons (car w2-26859)
+ (let ((m2-26876 (cdr w2-26859)))
+ (if (null? m2-26876)
+ s1-26861
(append
- s1-29311
- m2-29326)))))
- (cons (let ((m2-29334 (car w2-29309)))
- (if (null? m2-29334)
- m1-29310
- (append m1-29310 m2-29334)))
- (let ((m2-29342 (cdr w2-29309)))
- (if (null? m2-29342)
- s1-29311
+ s1-26861
+ m2-26876)))))
+ (cons (let ((m2-26884 (car w2-26859)))
+ (if (null? m2-26884)
+ m1-26860
+ (append m1-26860 m2-26884)))
+ (let ((m2-26892 (cdr w2-26859)))
+ (if (null? m2-26892)
+ s1-26861
(append
- s1-29311
- m2-29342))))))))
- (module-29302 (vector-ref x-29261 3)))
+ s1-26861
+ m2-26892))))))))
+ (module-26852 (vector-ref x-26811 3)))
(vector
'syntax-object
- expression-29300
- wrap-29301
- module-29302))
- (if (null? x-29261)
- x-29261
+ expression-26850
+ wrap-26851
+ module-26852))
+ (if (null? x-26811)
+ x-26811
(vector
'syntax-object
- x-29261
- w-29256
- mod-29247)))))))
+ x-26811
+ w-26806
+ mod-26797)))))))
(gensym
- (string-append "m-" (session-id-4307) "-")))))))
- (expand-body-4386
- (lambda (body-29603
- outer-form-29604
- r-29605
- w-29606
- mod-29607)
- (let ((r-29608
- (cons '("placeholder" placeholder) r-29605)))
- (let ((ribcage-29609 (vector 'ribcage '() '() '())))
- (let ((w-29610
- (cons (car w-29606)
- (cons ribcage-29609 (cdr w-29606)))))
+ (string-append "m-" (session-id-4308) "-")))))))
+ (expand-body-4387
+ (lambda (body-27152
+ outer-form-27153
+ r-27154
+ w-27155
+ mod-27156)
+ (let ((r-27157
+ (cons '("placeholder" placeholder) r-27154)))
+ (let ((ribcage-27158 (vector 'ribcage '() '() '())))
+ (let ((w-27159
+ (cons (car w-27155)
+ (cons ribcage-27158 (cdr w-27155)))))
(letrec*
- ((parse-29611
- (lambda (body-29719
- ids-29720
- labels-29721
- var-ids-29722
- vars-29723
- vals-29724
- bindings-29725)
- (if (null? body-29719)
+ ((parse-27160
+ (lambda (body-27268
+ ids-27269
+ labels-27270
+ var-ids-27271
+ vars-27272
+ vals-27273
+ bindings-27274)
+ (if (null? body-27268)
(syntax-violation
#f
"no expressions in body"
- outer-form-29604)
- (let ((e-29726 (cdr (car body-29719)))
- (er-29727 (car (car body-29719))))
+ outer-form-27153)
+ (let ((e-27275 (cdr (car body-27268)))
+ (er-27276 (car (car body-27268))))
(call-with-values
(lambda ()
- (syntax-type-4381
- e-29726
- er-29727
+ (syntax-type-4382
+ e-27275
+ er-27276
'(())
- (source-annotation-4340 er-29727)
- ribcage-29609
- mod-29607
+ (let ((props-27285
+ (source-properties
+ (if (if (vector? er-27276)
+ (if (= (vector-length er-27276)
+ 4)
+ (eq? (vector-ref er-27276 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref er-27276 1)
+ er-27276))))
+ (if (pair? props-27285) props-27285 #f))
+ ribcage-27158
+ mod-27156
#f))
- (lambda (type-29915
- value-29916
- form-29917
- e-29918
- w-29919
- s-29920
- mod-29921)
- (if (eqv? type-29915 'define-form)
- (let ((id-29929
- (if (if (null? (car w-29919))
- (null? (cdr w-29919))
+ (lambda (type-27308
+ value-27309
+ form-27310
+ e-27311
+ w-27312
+ s-27313
+ mod-27314)
+ (if (eqv? type-27308 'define-form)
+ (let ((id-27322
+ (if (if (null? (car w-27312))
+ (null? (cdr w-27312))
#f)
- value-29916
- (if (if (vector? value-29916)
+ value-27309
+ (if (if (vector? value-27309)
(if (= (vector-length
- value-29916)
+ value-27309)
4)
(eq? (vector-ref
- value-29916
+ value-27309
0)
'syntax-object)
#f)
#f)
- (let ((expression-29974
- (vector-ref value-29916 1))
- (wrap-29975
- (let ((w2-29985
+ (let ((expression-27367
+ (vector-ref value-27309 1))
+ (wrap-27368
+ (let ((w2-27378
(vector-ref
- value-29916
+ value-27309
2)))
- (let ((m1-29986
- (car w-29919))
- (s1-29987
- (cdr w-29919)))
- (if (null? m1-29986)
- (if (null? s1-29987)
- w2-29985
- (cons (car
w2-29985)
- (let
((m2-30004
- (cdr
w2-29985)))
- (if (null?
m2-30004)
- s1-29987
+ (let ((m1-27379
+ (car w-27312))
+ (s1-27380
+ (cdr w-27312)))
+ (if (null? m1-27379)
+ (if (null? s1-27380)
+ w2-27378
+ (cons (car
w2-27378)
+ (let
((m2-27397
+ (cdr
w2-27378)))
+ (if (null?
m2-27397)
+ s1-27380
(append
-
s1-29987
-
m2-30004)))))
- (cons (let ((m2-30012
- (car
w2-29985)))
- (if (null?
m2-30012)
- m1-29986
+
s1-27380
+
m2-27397)))))
+ (cons (let ((m2-27405
+ (car
w2-27378)))
+ (if (null?
m2-27405)
+ m1-27379
(append
- m1-29986
-
m2-30012)))
- (let ((m2-30020
- (cdr
w2-29985)))
- (if (null?
m2-30020)
- s1-29987
+ m1-27379
+
m2-27405)))
+ (let ((m2-27413
+ (cdr
w2-27378)))
+ (if (null?
m2-27413)
+ s1-27380
(append
- s1-29987
-
m2-30020))))))))
- (module-29976
+ s1-27380
+
m2-27413))))))))
+ (module-27369
(vector-ref
- value-29916
+ value-27309
3)))
(vector
'syntax-object
- expression-29974
- wrap-29975
- module-29976))
- (if (null? value-29916)
- value-29916
+ expression-27367
+ wrap-27368
+ module-27369))
+ (if (null? value-27309)
+ value-27309
(vector
'syntax-object
- value-29916
- w-29919
- mod-29921)))))
- (label-29930
+ value-27309
+ w-27312
+ mod-27314)))))
+ (label-27323
(string-append
"l-"
- (session-id-4307)
+ (session-id-4308)
(symbol->string (gensym "-")))))
- (let ((var-29931
- (let ((id-30081
- (if (if (vector? id-29929)
+ (let ((var-27324
+ (let ((id-27474
+ (if (if (vector? id-27322)
(if (= (vector-length
- id-29929)
+ id-27322)
4)
(eq? (vector-ref
- id-29929
+ id-27322
0)
'syntax-object)
#f)
#f)
- (vector-ref id-29929 1)
- id-29929)))
+ (vector-ref id-27322 1)
+ id-27322)))
(gensym
(string-append
- (symbol->string id-30081)
+ (symbol->string id-27474)
"-")))))
(begin
(begin
- (let ((update-29940
- (cons (vector-ref id-29929 1)
+ (let ((update-27333
+ (cons (vector-ref id-27322 1)
(vector-ref
- ribcage-29609
+ ribcage-27158
1))))
(vector-set!
- ribcage-29609
+ ribcage-27158
1
- update-29940))
- (let ((update-30052
+ update-27333))
+ (let ((update-27445
(cons (car (vector-ref
- id-29929
+ id-27322
2))
(vector-ref
- ribcage-29609
+ ribcage-27158
2))))
(vector-set!
- ribcage-29609
+ ribcage-27158
2
- update-30052))
- (let ((update-30067
- (cons label-29930
+ update-27445))
+ (let ((update-27460
+ (cons label-27323
(vector-ref
- ribcage-29609
+ ribcage-27158
3))))
(vector-set!
- ribcage-29609
+ ribcage-27158
3
- update-30067)))
- (parse-29611
- (cdr body-29719)
- (cons id-29929 ids-29720)
- (cons label-29930 labels-29721)
- (cons id-29929 var-ids-29722)
- (cons var-29931 vars-29723)
- (cons (cons er-29727
- (if (if (null? (car
w-29919))
- (null? (cdr w-29919))
+ update-27460)))
+ (parse-27160
+ (cdr body-27268)
+ (cons id-27322 ids-27269)
+ (cons label-27323 labels-27270)
+ (cons id-27322 var-ids-27271)
+ (cons var-27324 vars-27272)
+ (cons (cons er-27276
+ (if (if (null? (car
w-27312))
+ (null? (cdr w-27312))
#f)
- e-29918
- (if (if (vector? e-29918)
+ e-27311
+ (if (if (vector? e-27311)
(if (=
(vector-length
- e-29918)
+ e-27311)
4)
(eq? (vector-ref
- e-29918
+ e-27311
0)
'syntax-object)
#f)
#f)
- (let ((expression-30133
+ (let ((expression-27526
(vector-ref
- e-29918
+ e-27311
1))
- (wrap-30134
- (let ((w2-30144
+ (wrap-27527
+ (let ((w2-27537
(vector-ref
-
e-29918
+
e-27311
2)))
- (let
((m1-30145
- (car
w-29919))
-
(s1-30146
- (cdr
w-29919)))
- (if (null?
m1-30145)
- (if
(null? s1-30146)
-
w2-30144
- (cons
(car w2-30144)
-
(let ((m2-30163
-
(cdr w2-30144)))
-
(if (null? m2-30163)
-
s1-30146
+ (let
((m1-27538
+ (car
w-27312))
+
(s1-27539
+ (cdr
w-27312)))
+ (if (null?
m1-27538)
+ (if
(null? s1-27539)
+
w2-27537
+ (cons
(car w2-27537)
+
(let ((m2-27556
+
(cdr w2-27537)))
+
(if (null? m2-27556)
+
s1-27539
(append
-
s1-30146
-
m2-30163)))))
- (cons
(let ((m2-30171
-
(car w2-30144)))
-
(if (null? m2-30171)
-
m1-30145
+
s1-27539
+
m2-27556)))))
+ (cons
(let ((m2-27564
+
(car w2-27537)))
+
(if (null? m2-27564)
+
m1-27538
(append
-
m1-30145
-
m2-30171)))
-
(let ((m2-30179
-
(cdr w2-30144)))
-
(if (null? m2-30179)
-
s1-30146
+
m1-27538
+
m2-27564)))
+
(let ((m2-27572
+
(cdr w2-27537)))
+
(if (null? m2-27572)
+
s1-27539
(append
-
s1-30146
-
m2-30179))))))))
- (module-30135
+
s1-27539
+
m2-27572))))))))
+ (module-27528
(vector-ref
- e-29918
+ e-27311
3)))
(vector
'syntax-object
- expression-30133
- wrap-30134
- module-30135))
- (if (null? e-29918)
- e-29918
+ expression-27526
+ wrap-27527
+ module-27528))
+ (if (null? e-27311)
+ e-27311
(vector
'syntax-object
- e-29918
- w-29919
- mod-29921)))))
- vals-29724)
- (cons (cons 'lexical var-29931)
- bindings-29725)))))
- (if (if (eqv? type-29915 'define-syntax-form)
+ e-27311
+ w-27312
+ mod-27314)))))
+ vals-27273)
+ (cons (cons 'lexical var-27324)
+ bindings-27274)))))
+ (if (if (eqv? type-27308 'define-syntax-form)
#t
- (eqv? type-29915
+ (eqv? type-27308
'define-syntax-parameter-form))
- (let ((id-30213
- (if (if (null? (car w-29919))
- (null? (cdr w-29919))
+ (let ((id-27606
+ (if (if (null? (car w-27312))
+ (null? (cdr w-27312))
#f)
- value-29916
- (if (if (vector? value-29916)
+ value-27309
+ (if (if (vector? value-27309)
(if (= (vector-length
- value-29916)
+ value-27309)
4)
(eq? (vector-ref
- value-29916
+ value-27309
0)
'syntax-object)
#f)
#f)
- (let ((expression-30257
+ (let ((expression-27650
(vector-ref
- value-29916
+ value-27309
1))
- (wrap-30258
- (let ((w2-30268
+ (wrap-27651
+ (let ((w2-27661
(vector-ref
- value-29916
+ value-27309
2)))
- (let ((m1-30269
- (car w-29919))
- (s1-30270
- (cdr w-29919)))
- (if (null? m1-30269)
- (if (null?
s1-30270)
- w2-30268
- (cons (car
w2-30268)
- (let
((m2-30287
-
(cdr w2-30268)))
- (if
(null? m2-30287)
-
s1-30270
+ (let ((m1-27662
+ (car w-27312))
+ (s1-27663
+ (cdr w-27312)))
+ (if (null? m1-27662)
+ (if (null?
s1-27663)
+ w2-27661
+ (cons (car
w2-27661)
+ (let
((m2-27680
+
(cdr w2-27661)))
+ (if
(null? m2-27680)
+
s1-27663
(append
-
s1-30270
-
m2-30287)))))
- (cons (let
((m2-30295
- (car
w2-30268)))
- (if (null?
m2-30295)
- m1-30269
+
s1-27663
+
m2-27680)))))
+ (cons (let
((m2-27688
+ (car
w2-27661)))
+ (if (null?
m2-27688)
+ m1-27662
(append
-
m1-30269
-
m2-30295)))
- (let
((m2-30303
- (cdr
w2-30268)))
- (if (null?
m2-30303)
- s1-30270
+
m1-27662
+
m2-27688)))
+ (let
((m2-27696
+ (cdr
w2-27661)))
+ (if (null?
m2-27696)
+ s1-27663
(append
-
s1-30270
-
m2-30303))))))))
- (module-30259
+
s1-27663
+
m2-27696))))))))
+ (module-27652
(vector-ref
- value-29916
+ value-27309
3)))
(vector
'syntax-object
- expression-30257
- wrap-30258
- module-30259))
- (if (null? value-29916)
- value-29916
+ expression-27650
+ wrap-27651
+ module-27652))
+ (if (null? value-27309)
+ value-27309
(vector
'syntax-object
- value-29916
- w-29919
- mod-29921)))))
- (label-30214
+ value-27309
+ w-27312
+ mod-27314)))))
+ (label-27607
(string-append
"l-"
- (session-id-4307)
+ (session-id-4308)
(symbol->string (gensym "-")))))
(begin
(begin
- (let ((update-30223
- (cons (vector-ref id-30213 1)
+ (let ((update-27616
+ (cons (vector-ref id-27606 1)
(vector-ref
- ribcage-29609
+ ribcage-27158
1))))
(vector-set!
- ribcage-29609
+ ribcage-27158
1
- update-30223))
- (let ((update-30335
+ update-27616))
+ (let ((update-27728
(cons (car (vector-ref
- id-30213
+ id-27606
2))
(vector-ref
- ribcage-29609
+ ribcage-27158
2))))
(vector-set!
- ribcage-29609
+ ribcage-27158
2
- update-30335))
- (let ((update-30350
- (cons label-30214
+ update-27728))
+ (let ((update-27743
+ (cons label-27607
(vector-ref
- ribcage-29609
+ ribcage-27158
3))))
(vector-set!
- ribcage-29609
+ ribcage-27158
3
- update-30350)))
- (parse-29611
- (cdr body-29719)
- (cons id-30213 ids-29720)
- (cons label-30214 labels-29721)
- var-ids-29722
- vars-29723
- vals-29724
- (cons (cons (if (eq? type-29915
+ update-27743)))
+ (parse-27160
+ (cdr body-27268)
+ (cons id-27606 ids-27269)
+ (cons label-27607 labels-27270)
+ var-ids-27271
+ vars-27272
+ vals-27273
+ (cons (cons (if (eq? type-27308
'define-syntax-parameter-form)
'syntax-parameter
'macro)
- (cons er-29727
- (if (if (null? (car
w-29919))
- (null? (cdr
w-29919))
+ (cons er-27276
+ (if (if (null? (car
w-27312))
+ (null? (cdr
w-27312))
#f)
- e-29918
+ e-27311
(if (if (vector?
- e-29918)
+ e-27311)
(if (=
(vector-length
-
e-29918)
+
e-27311)
4)
(eq?
(vector-ref
-
e-29918
+
e-27311
0)
'syntax-object)
#f)
#f)
- (let
((expression-30389
+ (let
((expression-27782
(vector-ref
- e-29918
+ e-27311
1))
- (wrap-30390
- (let
((w2-30400
+ (wrap-27783
+ (let
((w2-27793
(vector-ref
-
e-29918
+
e-27311
2)))
- (let
((m1-30401
-
(car w-29919))
-
(s1-30402
-
(cdr w-29919)))
- (if
(null? m1-30401)
-
(if (null? s1-30402)
-
w2-30400
-
(cons (car w2-30400)
-
(let ((m2-30419
-
(cdr w2-30400)))
-
(if (null? m2-30419)
-
s1-30402
+ (let
((m1-27794
+
(car w-27312))
+
(s1-27795
+
(cdr w-27312)))
+ (if
(null? m1-27794)
+
(if (null? s1-27795)
+
w2-27793
+
(cons (car w2-27793)
+
(let ((m2-27812
+
(cdr w2-27793)))
+
(if (null? m2-27812)
+
s1-27795
(append
-
s1-30402
-
m2-30419)))))
-
(cons (let ((m2-30427
-
(car w2-30400)))
-
(if (null? m2-30427)
-
m1-30401
+
s1-27795
+
m2-27812)))))
+
(cons (let ((m2-27820
+
(car w2-27793)))
+
(if (null? m2-27820)
+
m1-27794
(append
-
m1-30401
-
m2-30427)))
-
(let ((m2-30435
-
(cdr w2-30400)))
-
(if (null? m2-30435)
-
s1-30402
+
m1-27794
+
m2-27820)))
+
(let ((m2-27828
+
(cdr w2-27793)))
+
(if (null? m2-27828)
+
s1-27795
(append
-
s1-30402
-
m2-30435))))))))
-
(module-30391
+
s1-27795
+
m2-27828))))))))
+
(module-27784
(vector-ref
- e-29918
+ e-27311
3)))
(vector
'syntax-object
-
expression-30389
- wrap-30390
-
module-30391))
- (if (null?
e-29918)
- e-29918
+
expression-27782
+ wrap-27783
+
module-27784))
+ (if (null?
e-27311)
+ e-27311
(vector
'syntax-object
- e-29918
- w-29919
-
mod-29921))))))
- bindings-29725))))
- (if (eqv? type-29915 'begin-form)
- (let ((tmp-30465
+ e-27311
+ w-27312
+
mod-27314))))))
+ bindings-27274))))
+ (if (eqv? type-27308 'begin-form)
+ (let ((tmp-27858
($sc-dispatch
- e-29918
+ e-27311
'(_ . each-any))))
- (if tmp-30465
+ (if tmp-27858
(@apply
- (lambda (e1-30469)
- (parse-29611
+ (lambda (e1-27862)
+ (parse-27160
(letrec*
- ((f-30470
- (lambda (forms-30671)
- (if (null? forms-30671)
- (cdr body-29719)
- (cons (cons er-29727
- (let
((x-30675
-
(car forms-30671)))
- (if (if
(null? (car w-29919))
-
(null? (cdr w-29919))
+ ((f-27863
+ (lambda (forms-28064)
+ (if (null? forms-28064)
+ (cdr body-27268)
+ (cons (cons er-27276
+ (let
((x-28068
+
(car forms-28064)))
+ (if (if
(null? (car w-27312))
+
(null? (cdr w-27312))
#f)
- x-30675
+ x-28068
(if (if
(vector?
-
x-30675)
+
x-28068)
(if (= (vector-length
-
x-30675)
+
x-28068)
4)
(eq? (vector-ref
-
x-30675
+
x-28068
0)
'syntax-object)
#f)
#f)
- (let
((expression-30693
+ (let
((expression-28086
(vector-ref
-
x-30675
+
x-28068
1))
-
(wrap-30694
-
(let ((w2-30702
+
(wrap-28087
+
(let ((w2-28095
(vector-ref
-
x-30675
+
x-28068
2)))
-
(let ((m1-30703
-
(car w-29919))
-
(s1-30704
-
(cdr w-29919)))
-
(if (null? m1-30703)
-
(if (null? s1-30704)
-
w2-30702
-
(cons (car w2-30702)
-
(let ((m2-30719
-
(cdr w2-30702)))
-
(if (null? m2-30719)
-
s1-30704
+
(let ((m1-28096
+
(car w-27312))
+
(s1-28097
+
(cdr w-27312)))
+
(if (null? m1-28096)
+
(if (null? s1-28097)
+
w2-28095
+
(cons (car w2-28095)
+
(let ((m2-28112
+
(cdr w2-28095)))
+
(if (null? m2-28112)
+
s1-28097
(append
-
s1-30704
-
m2-30719)))))
-
(cons (let ((m2-30727
-
(car w2-30702)))
-
(if (null? m2-30727)
-
m1-30703
+
s1-28097
+
m2-28112)))))
+
(cons (let ((m2-28120
+
(car w2-28095)))
+
(if (null? m2-28120)
+
m1-28096
(append
-
m1-30703
-
m2-30727)))
-
(let ((m2-30735
-
(cdr w2-30702)))
-
(if (null? m2-30735)
-
s1-30704
+
m1-28096
+
m2-28120)))
+
(let ((m2-28128
+
(cdr w2-28095)))
+
(if (null? m2-28128)
+
s1-28097
(append
-
s1-30704
-
m2-30735))))))))
-
(module-30695
+
s1-28097
+
m2-28128))))))))
+
(module-28088
(vector-ref
-
x-30675
+
x-28068
3)))
(vector
'syntax-object
-
expression-30693
-
wrap-30694
-
module-30695))
- (if
(null? x-30675)
-
x-30675
+
expression-28086
+
wrap-28087
+
module-28088))
+ (if
(null? x-28068)
+
x-28068
(vector
'syntax-object
-
x-30675
-
w-29919
-
mod-29921))))))
- (f-30470
- (cdr
forms-30671)))))))
- (f-30470 e1-30469))
- ids-29720
- labels-29721
- var-ids-29722
- vars-29723
- vals-29724
- bindings-29725))
- tmp-30465)
+
x-28068
+
w-27312
+
mod-27314))))))
+ (f-27863
+ (cdr
forms-28064)))))))
+ (f-27863 e1-27862))
+ ids-27269
+ labels-27270
+ var-ids-27271
+ vars-27272
+ vals-27273
+ bindings-27274))
+ tmp-27858)
(syntax-violation
#f
"source expression failed to match
any pattern"
- e-29918)))
- (if (eqv? type-29915 'local-syntax-form)
- (expand-local-syntax-4387
- value-29916
- e-29918
- er-29727
- w-29919
- s-29920
- mod-29921
- (lambda (forms-30764
- er-30765
- w-30766
- s-30767
- mod-30768)
- (parse-29611
+ e-27311)))
+ (if (eqv? type-27308 'local-syntax-form)
+ (expand-local-syntax-4388
+ value-27309
+ e-27311
+ er-27276
+ w-27312
+ s-27313
+ mod-27314
+ (lambda (forms-28157
+ er-28158
+ w-28159
+ s-28160
+ mod-28161)
+ (parse-27160
(letrec*
- ((f-30769
- (lambda (forms-30970)
- (if (null? forms-30970)
- (cdr body-29719)
- (cons (cons er-30765
- (let ((x-30974
- (car
forms-30970)))
- (if (if
(null? (car w-30766))
-
(null? (cdr w-30766))
+ ((f-28162
+ (lambda (forms-28363)
+ (if (null? forms-28363)
+ (cdr body-27268)
+ (cons (cons er-28158
+ (let ((x-28367
+ (car
forms-28363)))
+ (if (if
(null? (car w-28159))
+
(null? (cdr w-28159))
#f)
- x-30974
+ x-28367
(if (if
(vector?
-
x-30974)
+
x-28367)
(if
(= (vector-length
-
x-30974)
+
x-28367)
4)
(eq? (vector-ref
-
x-30974
+
x-28367
0)
'syntax-object)
#f)
#f)
- (let
((expression-30992
+ (let
((expression-28385
(vector-ref
-
x-30974
+
x-28367
1))
-
(wrap-30993
-
(let ((w2-31001
+
(wrap-28386
+
(let ((w2-28394
(vector-ref
-
x-30974
+
x-28367
2)))
-
(let ((m1-31002
-
(car w-30766))
-
(s1-31003
-
(cdr w-30766)))
-
(if (null? m1-31002)
-
(if (null? s1-31003)
-
w2-31001
-
(cons (car w2-31001)
-
(let ((m2-31018
-
(cdr w2-31001)))
-
(if (null? m2-31018)
-
s1-31003
+
(let ((m1-28395
+
(car w-28159))
+
(s1-28396
+
(cdr w-28159)))
+
(if (null? m1-28395)
+
(if (null? s1-28396)
+
w2-28394
+
(cons (car w2-28394)
+
(let ((m2-28411
+
(cdr w2-28394)))
+
(if (null? m2-28411)
+
s1-28396
(append
-
s1-31003
-
m2-31018)))))
-
(cons (let ((m2-31026
-
(car w2-31001)))
-
(if (null? m2-31026)
-
m1-31002
+
s1-28396
+
m2-28411)))))
+
(cons (let ((m2-28419
+
(car w2-28394)))
+
(if (null? m2-28419)
+
m1-28395
(append
-
m1-31002
-
m2-31026)))
-
(let ((m2-31034
-
(cdr w2-31001)))
-
(if (null? m2-31034)
-
s1-31003
+
m1-28395
+
m2-28419)))
+
(let ((m2-28427
+
(cdr w2-28394)))
+
(if (null? m2-28427)
+
s1-28396
(append
-
s1-31003
-
m2-31034))))))))
-
(module-30994
+
s1-28396
+
m2-28427))))))))
+
(module-28387
(vector-ref
-
x-30974
+
x-28367
3)))
(vector
'syntax-object
-
expression-30992
-
wrap-30993
-
module-30994))
- (if
(null? x-30974)
-
x-30974
+
expression-28385
+
wrap-28386
+
module-28387))
+ (if
(null? x-28367)
+
x-28367
(vector
'syntax-object
-
x-30974
-
w-30766
-
mod-30768))))))
- (f-30769
- (cdr
forms-30970)))))))
- (f-30769 forms-30764))
- ids-29720
- labels-29721
- var-ids-29722
- vars-29723
- vals-29724
- bindings-29725)))
- (if (null? ids-29720)
- (build-sequence-4328
+
x-28367
+
w-28159
+
mod-28161))))))
+ (f-28162
+ (cdr
forms-28363)))))))
+ (f-28162 forms-28157))
+ ids-27269
+ labels-27270
+ var-ids-27271
+ vars-27272
+ vals-27273
+ bindings-27274)))
+ (if (null? ids-27269)
+ (build-sequence-4329
#f
- (map (lambda (x-31119)
- (expand-4382
- (cdr x-31119)
- (car x-31119)
- '(())
- mod-29921))
- (cons (cons er-29727
- (let ((x-31194
+ (map (lambda (x-28620)
+ (let ((e-28624 (cdr x-28620))
+ (r-28625 (car x-28620)))
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-28624
+ r-28625
+ '(())
+ (let ((props-28632
+
(source-properties
+ (if (if
(vector?
+
e-28624)
+ (if
(= (vector-length
+
e-28624)
+
4)
+
(eq? (vector-ref
+
e-28624
+
0)
+
'syntax-object)
+ #f)
+ #f)
+
(vector-ref
+ e-28624
+ 1)
+
e-28624))))
+ (if (pair?
props-28632)
+ props-28632
+ #f))
+ #f
+ mod-27314
+ #f))
+ (lambda (type-28655
+ value-28656
+ form-28657
+ e-28658
+ w-28659
+ s-28660
+ mod-28661)
+ (expand-expr-4384
+ type-28655
+ value-28656
+ form-28657
+ e-28658
+ r-28625
+ w-28659
+ s-28660
+ mod-28661)))))
+ (cons (cons er-27276
+ (let ((x-28672
(begin
- (if (if
(pair? e-29918)
-
s-29920
+ (if (if
s-27313
+
(supports-source-properties?
+
e-27311)
#f)
(set-source-properties!
-
e-29918
-
s-29920))
- e-29918)))
- (if (if (null?
(car w-29919))
- (null? (cdr
w-29919))
+
e-27311
+
s-27313))
+ e-27311)))
+ (if (if (null?
(car w-27312))
+ (null? (cdr
w-27312))
#f)
- x-31194
+ x-28672
(if (if (vector?
-
x-31194)
+
x-28672)
(if (=
(vector-length
-
x-31194)
+
x-28672)
4)
(eq?
(vector-ref
-
x-31194
+
x-28672
0)
'syntax-object)
#f)
#f)
- (let
((expression-31226
+ (let
((expression-28704
(vector-ref
-
x-31194
+
x-28672
1))
-
(wrap-31227
- (let
((w2-31235
+
(wrap-28705
+ (let
((w2-28713
(vector-ref
-
x-31194
+
x-28672
2)))
-
(let ((m1-31236
-
(car w-29919))
-
(s1-31237
-
(cdr w-29919)))
-
(if (null? m1-31236)
-
(if (null? s1-31237)
-
w2-31235
-
(cons (car w2-31235)
-
(let ((m2-31252
-
(cdr w2-31235)))
-
(if (null? m2-31252)
-
s1-31237
+
(let ((m1-28714
+
(car w-27312))
+
(s1-28715
+
(cdr w-27312)))
+
(if (null? m1-28714)
+
(if (null? s1-28715)
+
w2-28713
+
(cons (car w2-28713)
+
(let ((m2-28730
+
(cdr w2-28713)))
+
(if (null? m2-28730)
+
s1-28715
(append
-
s1-31237
-
m2-31252)))))
-
(cons (let ((m2-31260
-
(car w2-31235)))
-
(if (null? m2-31260)
-
m1-31236
+
s1-28715
+
m2-28730)))))
+
(cons (let ((m2-28738
+
(car w2-28713)))
+
(if (null? m2-28738)
+
m1-28714
(append
-
m1-31236
-
m2-31260)))
-
(let ((m2-31268
-
(cdr w2-31235)))
-
(if (null? m2-31268)
-
s1-31237
+
m1-28714
+
m2-28738)))
+
(let ((m2-28746
+
(cdr w2-28713)))
+
(if (null? m2-28746)
+
s1-28715
(append
-
s1-31237
-
m2-31268))))))))
-
(module-31228
+
s1-28715
+
m2-28746))))))))
+
(module-28706
(vector-ref
-
x-31194
+
x-28672
3)))
(vector
'syntax-object
-
expression-31226
- wrap-31227
-
module-31228))
- (if (null?
x-31194)
- x-31194
+
expression-28704
+ wrap-28705
+
module-28706))
+ (if (null?
x-28672)
+ x-28672
(vector
'syntax-object
- x-31194
- w-29919
-
mod-29921))))))
- (cdr body-29719))))
+ x-28672
+ w-27312
+
mod-27314))))))
+ (cdr body-27268))))
(begin
- (if (not (valid-bound-ids?-4372
- ids-29720))
+ (if (not (valid-bound-ids?-4373
+ ids-27269))
(syntax-violation
#f
"invalid or duplicate identifier
in definition"
- outer-form-29604))
+ outer-form-27153))
(letrec*
- ((loop-31367
- (lambda (bs-31370
- er-cache-31371
- r-cache-31372)
- (if (not (null? bs-31370))
- (let ((b-31373
- (car bs-31370)))
- (if (let ((t-31376
- (car
b-31373)))
- (if (eq? t-31376
+ ((loop-28845
+ (lambda (bs-28848
+ er-cache-28849
+ r-cache-28850)
+ (if (not (null? bs-28848))
+ (let ((b-28851
+ (car bs-28848)))
+ (if (let ((t-28854
+ (car
b-28851)))
+ (if (eq? t-28854
'macro)
#t
- (eq? t-31376
+ (eq? t-28854
'syntax-parameter)))
- (let ((er-31378
- (car (cdr
b-31373))))
- (let ((r-cache-31379
- (if (eq?
er-31378
-
er-cache-31371)
-
r-cache-31372
-
(macros-only-env-4343
-
er-31378))))
+ (let ((er-28856
+ (car (cdr
b-28851))))
+ (let ((r-cache-28857
+ (if (eq?
er-28856
+
er-cache-28849)
+
r-cache-28850
+
(macros-only-env-4344
+
er-28856))))
(begin
(set-cdr!
- b-31373
-
(eval-local-transformer-4388
- (expand-4382
- (cdr (cdr
b-31373))
-
r-cache-31379
- '(())
- mod-29921)
- mod-29921))
- (if (eq? (car
b-31373)
+ b-28851
+
(eval-local-transformer-4389
+ (let ((e-28906
+ (cdr
(cdr b-28851))))
+
(call-with-values
+ (lambda ()
+
(syntax-type-4382
+
e-28906
+
r-cache-28857
+ '(())
+ (let
((props-28916
+
(source-properties
+
(if (if (vector?
+
e-28906)
+
(if (= (vector-length
+
e-28906)
+
4)
+
(eq? (vector-ref
+
e-28906
+
0)
+
'syntax-object)
+
#f)
+
#f)
+
(vector-ref
+
e-28906
+
1)
+
e-28906))))
+ (if
(pair? props-28916)
+
props-28916
+
#f))
+ #f
+
mod-27314
+ #f))
+ (lambda
(type-28939
+
value-28940
+
form-28941
+
e-28942
+
w-28943
+
s-28944
+
mod-28945)
+
(expand-expr-4384
+
type-28939
+
value-28940
+
form-28941
+
e-28942
+
r-cache-28857
+
w-28943
+
s-28944
+
mod-28945))))
+ mod-27314))
+ (if (eq? (car
b-28851)
'syntax-parameter)
(set-cdr!
- b-31373
- (list (cdr
b-31373))))
- (loop-31367
- (cdr bs-31370)
- er-31378
-
r-cache-31379))))
- (loop-31367
- (cdr bs-31370)
- er-cache-31371
- r-cache-31372)))))))
- (loop-31367 bindings-29725 #f #f))
+ b-28851
+ (list (cdr
b-28851))))
+ (loop-28845
+ (cdr bs-28848)
+ er-28856
+
r-cache-28857))))
+ (loop-28845
+ (cdr bs-28848)
+ er-cache-28849
+ r-cache-28850)))))))
+ (loop-28845 bindings-27274 #f #f))
(set-cdr!
- r-29608
- (extend-env-4341
- labels-29721
- bindings-29725
- (cdr r-29608)))
- (build-letrec-4331
+ r-27157
+ (extend-env-4342
+ labels-27270
+ bindings-27274
+ (cdr r-27157)))
+ (build-letrec-4332
#f
#t
(reverse
(map syntax->datum
- var-ids-29722))
- (reverse vars-29723)
- (map (lambda (x-31799)
- (expand-4382
- (cdr x-31799)
- (car x-31799)
- '(())
- mod-29921))
- (reverse vals-29724))
- (build-sequence-4328
+ var-ids-27271))
+ (reverse vars-27272)
+ (map (lambda (x-29360)
+ (let ((e-29364
+ (cdr x-29360))
+ (r-29365
+ (car x-29360)))
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-29364
+ r-29365
+ '(())
+ (let ((props-29372
+
(source-properties
+ (if (if
(vector?
+
e-29364)
+ (if
(= (vector-length
+
e-29364)
+
4)
+
(eq? (vector-ref
+
e-29364
+
0)
+
'syntax-object)
+
#f)
+ #f)
+
(vector-ref
+
e-29364
+ 1)
+
e-29364))))
+ (if (pair?
props-29372)
+ props-29372
+ #f))
+ #f
+ mod-27314
+ #f))
+ (lambda (type-29395
+ value-29396
+ form-29397
+ e-29398
+ w-29399
+ s-29400
+ mod-29401)
+ (expand-expr-4384
+ type-29395
+ value-29396
+ form-29397
+ e-29398
+ r-29365
+ w-29399
+ s-29400
+ mod-29401)))))
+ (reverse vals-27273))
+ (build-sequence-4329
#f
- (map (lambda (x-31935)
- (expand-4382
- (cdr x-31935)
- (car x-31935)
- '(())
- mod-29921))
- (cons (cons er-29727
- (let ((x-32010
+ (map (lambda (x-29581)
+ (let ((e-29585
+ (cdr x-29581))
+ (r-29586
+ (car x-29581)))
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-29585
+ r-29586
+ '(())
+ (let ((props-29593
+
(source-properties
+ (if (if
(vector?
+
e-29585)
+
(if (= (vector-length
+
e-29585)
+
4)
+
(eq? (vector-ref
+
e-29585
+
0)
+
'syntax-object)
+
#f)
+
#f)
+
(vector-ref
+
e-29585
+ 1)
+
e-29585))))
+ (if (pair?
props-29593)
+ props-29593
+ #f))
+ #f
+ mod-27314
+ #f))
+ (lambda (type-29616
+ value-29617
+ form-29618
+ e-29619
+ w-29620
+ s-29621
+ mod-29622)
+ (expand-expr-4384
+ type-29616
+ value-29617
+ form-29618
+ e-29619
+ r-29586
+ w-29620
+ s-29621
+ mod-29622)))))
+ (cons (cons er-27276
+ (let ((x-29633
(begin
- (if
(if (pair? e-29918)
-
s-29920
+ (if
(if s-27313
+
(supports-source-properties?
+
e-27311)
#f)
(set-source-properties!
-
e-29918
-
s-29920))
-
e-29918)))
- (if (if
(null? (car w-29919))
- (null?
(cdr w-29919))
+
e-27311
+
s-27313))
+
e-27311)))
+ (if (if
(null? (car w-27312))
+ (null?
(cdr w-27312))
#f)
- x-32010
+ x-29633
(if (if
(vector?
-
x-32010)
+
x-29633)
(if
(= (vector-length
-
x-32010)
+
x-29633)
4)
(eq? (vector-ref
-
x-32010
+
x-29633
0)
'syntax-object)
#f)
#f)
- (let
((expression-32042
+ (let
((expression-29665
(vector-ref
-
x-32010
+
x-29633
1))
-
(wrap-32043
-
(let ((w2-32051
+
(wrap-29666
+
(let ((w2-29674
(vector-ref
-
x-32010
+
x-29633
2)))
-
(let ((m1-32052
-
(car w-29919))
-
(s1-32053
-
(cdr w-29919)))
-
(if (null? m1-32052)
-
(if (null? s1-32053)
-
w2-32051
-
(cons (car w2-32051)
-
(let ((m2-32068
-
(cdr w2-32051)))
-
(if (null? m2-32068)
-
s1-32053
+
(let ((m1-29675
+
(car w-27312))
+
(s1-29676
+
(cdr w-27312)))
+
(if (null? m1-29675)
+
(if (null? s1-29676)
+
w2-29674
+
(cons (car w2-29674)
+
(let ((m2-29691
+
(cdr w2-29674)))
+
(if (null? m2-29691)
+
s1-29676
(append
-
s1-32053
-
m2-32068)))))
-
(cons (let ((m2-32076
-
(car w2-32051)))
-
(if (null? m2-32076)
-
m1-32052
+
s1-29676
+
m2-29691)))))
+
(cons (let ((m2-29699
+
(car w2-29674)))
+
(if (null? m2-29699)
+
m1-29675
(append
-
m1-32052
-
m2-32076)))
-
(let ((m2-32084
-
(cdr w2-32051)))
-
(if (null? m2-32084)
-
s1-32053
+
m1-29675
+
m2-29699)))
+
(let ((m2-29707
+
(cdr w2-29674)))
+
(if (null? m2-29707)
+
s1-29676
(append
-
s1-32053
-
m2-32084))))))))
-
(module-32044
+
s1-29676
+
m2-29707))))))))
+
(module-29667
(vector-ref
-
x-32010
+
x-29633
3)))
(vector
'syntax-object
-
expression-32042
-
wrap-32043
-
module-32044))
- (if
(null? x-32010)
- x-32010
+
expression-29665
+
wrap-29666
+
module-29667))
+ (if
(null? x-29633)
+ x-29633
(vector
'syntax-object
-
x-32010
-
w-29919
-
mod-29921))))))
- (cdr
body-29719))))))))))))))))))
- (parse-29611
- (map (lambda (x-29614)
- (cons r-29608
- (if (if (null? (car w-29610))
- (null? (cdr w-29610))
+
x-29633
+
w-27312
+
mod-27314))))))
+ (cdr
body-27268))))))))))))))))))
+ (parse-27160
+ (map (lambda (x-27163)
+ (cons r-27157
+ (if (if (null? (car w-27159))
+ (null? (cdr w-27159))
#f)
- x-29614
- (if (if (vector? x-29614)
- (if (= (vector-length x-29614) 4)
- (eq? (vector-ref x-29614 0)
+ x-27163
+ (if (if (vector? x-27163)
+ (if (= (vector-length x-27163) 4)
+ (eq? (vector-ref x-27163 0)
'syntax-object)
#f)
#f)
- (let ((expression-29650
- (vector-ref x-29614 1))
- (wrap-29651
- (let ((w2-29661
- (vector-ref x-29614 2)))
- (let ((m1-29662 (car w-29610))
- (s1-29663 (cdr w-29610)))
- (if (null? m1-29662)
- (if (null? s1-29663)
- w2-29661
- (cons (car w2-29661)
- (let ((m2-29680
- (cdr
w2-29661)))
- (if (null?
m2-29680)
- s1-29663
+ (let ((expression-27199
+ (vector-ref x-27163 1))
+ (wrap-27200
+ (let ((w2-27210
+ (vector-ref x-27163 2)))
+ (let ((m1-27211 (car w-27159))
+ (s1-27212 (cdr w-27159)))
+ (if (null? m1-27211)
+ (if (null? s1-27212)
+ w2-27210
+ (cons (car w2-27210)
+ (let ((m2-27229
+ (cdr
w2-27210)))
+ (if (null?
m2-27229)
+ s1-27212
(append
- s1-29663
- m2-29680)))))
- (cons (let ((m2-29688
- (car
w2-29661)))
- (if (null? m2-29688)
- m1-29662
+ s1-27212
+ m2-27229)))))
+ (cons (let ((m2-27237
+ (car
w2-27210)))
+ (if (null? m2-27237)
+ m1-27211
(append
- m1-29662
- m2-29688)))
- (let ((m2-29696
- (cdr
w2-29661)))
- (if (null? m2-29696)
- s1-29663
+ m1-27211
+ m2-27237)))
+ (let ((m2-27245
+ (cdr
w2-27210)))
+ (if (null? m2-27245)
+ s1-27212
(append
- s1-29663
- m2-29696))))))))
- (module-29652
- (vector-ref x-29614 3)))
+ s1-27212
+ m2-27245))))))))
+ (module-27201
+ (vector-ref x-27163 3)))
(vector
'syntax-object
- expression-29650
- wrap-29651
- module-29652))
- (if (null? x-29614)
- x-29614
+ expression-27199
+ wrap-27200
+ module-27201))
+ (if (null? x-27163)
+ x-27163
(vector
'syntax-object
- x-29614
- w-29610
- mod-29607))))))
- body-29603)
+ x-27163
+ w-27159
+ mod-27156))))))
+ body-27152)
'()
'()
'()
'()
'()
'())))))))
- (expand-local-syntax-4387
- (lambda (rec?-32099
- e-32100
- r-32101
- w-32102
- s-32103
- mod-32104
- k-32105)
- (let ((tmp-32107
+ (expand-local-syntax-4388
+ (lambda (rec?-29722
+ e-29723
+ r-29724
+ w-29725
+ s-29726
+ mod-29727
+ k-29728)
+ (let ((tmp-29730
($sc-dispatch
- e-32100
+ e-29723
'(_ #(each (any any)) any . each-any))))
- (if tmp-32107
+ (if tmp-29730
(@apply
- (lambda (id-32111 val-32112 e1-32113 e2-32114)
- (if (not (valid-bound-ids?-4372 id-32111))
+ (lambda (id-29734 val-29735 e1-29736 e2-29737)
+ (if (not (valid-bound-ids?-4373 id-29734))
(syntax-violation
#f
"duplicate bound keyword"
- e-32100)
- (let ((labels-32211 (gen-labels-4349 id-32111)))
- (let ((new-w-32212
- (make-binding-wrap-4360
- id-32111
- labels-32211
- w-32102)))
- (k-32105
- (cons e1-32113 e2-32114)
- (extend-env-4341
- labels-32211
- (let ((trans-r-32250
- (macros-only-env-4343 r-32101)))
+ e-29723)
+ (let ((labels-29834 (gen-labels-4350 id-29734)))
+ (let ((new-w-29835
+ (make-binding-wrap-4361
+ id-29734
+ labels-29834
+ w-29725)))
+ (k-29728
+ (cons e1-29736 e2-29737)
+ (extend-env-4342
+ labels-29834
+ (let ((trans-r-29873
+ (macros-only-env-4344 r-29724)))
(begin
- (if rec?-32099 new-w-32212 w-32102)
- (map (lambda (x-32251)
+ (if rec?-29722 new-w-29835 w-29725)
+ (map (lambda (x-29874)
(cons 'macro
- (eval-local-transformer-4388
- (expand-4382
- x-32251
- trans-r-32250
- (values
- (if rec?-32099
- new-w-32212
- w-32102))
- mod-32104)
- mod-32104)))
- val-32112)))
- r-32101)
- new-w-32212
- s-32103
- mod-32104)))))
- tmp-32107)
+ (eval-local-transformer-4389
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ x-29874
+ trans-r-29873
+ (values
+ (if rec?-29722
+ new-w-29835
+ w-29725))
+ (let ((props-29940
+ (source-properties
+ (if (if (vector?
+
x-29874)
+ (if (=
(vector-length
+
x-29874)
+ 4)
+ (eq?
(vector-ref
+
x-29874
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ x-29874
+ 1)
+ x-29874))))
+ (if (pair? props-29940)
+ props-29940
+ #f))
+ #f
+ mod-29727
+ #f))
+ (lambda (type-29973
+ value-29974
+ form-29975
+ e-29976
+ w-29977
+ s-29978
+ mod-29979)
+ (expand-expr-4384
+ type-29973
+ value-29974
+ form-29975
+ e-29976
+ trans-r-29873
+ w-29977
+ s-29978
+ mod-29979)))
+ mod-29727)))
+ val-29735)))
+ r-29724)
+ new-w-29835
+ s-29726
+ mod-29727)))))
+ tmp-29730)
(syntax-violation
#f
"bad local syntax definition"
- (let ((x-32558
+ (let ((x-30161
(begin
- (if (if (pair? e-32100) s-32103 #f)
- (set-source-properties! e-32100 s-32103))
- e-32100)))
- (if (if (null? (car w-32102))
- (null? (cdr w-32102))
+ (if (if s-29726
+ (supports-source-properties? e-29723)
+ #f)
+ (set-source-properties! e-29723 s-29726))
+ e-29723)))
+ (if (if (null? (car w-29725))
+ (null? (cdr w-29725))
#f)
- x-32558
- (if (if (vector? x-32558)
- (if (= (vector-length x-32558) 4)
- (eq? (vector-ref x-32558 0) 'syntax-object)
+ x-30161
+ (if (if (vector? x-30161)
+ (if (= (vector-length x-30161) 4)
+ (eq? (vector-ref x-30161 0) 'syntax-object)
#f)
#f)
- (let ((expression-32590 (vector-ref x-32558 1))
- (wrap-32591
- (let ((w2-32599 (vector-ref x-32558 2)))
- (let ((m1-32600 (car w-32102))
- (s1-32601 (cdr w-32102)))
- (if (null? m1-32600)
- (if (null? s1-32601)
- w2-32599
- (cons (car w2-32599)
- (let ((m2-32616 (cdr w2-32599)))
- (if (null? m2-32616)
- s1-32601
- (append s1-32601 m2-32616)))))
- (cons (let ((m2-32624 (car w2-32599)))
- (if (null? m2-32624)
- m1-32600
- (append m1-32600 m2-32624)))
- (let ((m2-32632 (cdr w2-32599)))
- (if (null? m2-32632)
- s1-32601
- (append s1-32601 m2-32632))))))))
- (module-32592 (vector-ref x-32558 3)))
+ (let ((expression-30193 (vector-ref x-30161 1))
+ (wrap-30194
+ (let ((w2-30202 (vector-ref x-30161 2)))
+ (let ((m1-30203 (car w-29725))
+ (s1-30204 (cdr w-29725)))
+ (if (null? m1-30203)
+ (if (null? s1-30204)
+ w2-30202
+ (cons (car w2-30202)
+ (let ((m2-30219 (cdr w2-30202)))
+ (if (null? m2-30219)
+ s1-30204
+ (append s1-30204 m2-30219)))))
+ (cons (let ((m2-30227 (car w2-30202)))
+ (if (null? m2-30227)
+ m1-30203
+ (append m1-30203 m2-30227)))
+ (let ((m2-30235 (cdr w2-30202)))
+ (if (null? m2-30235)
+ s1-30204
+ (append s1-30204 m2-30235))))))))
+ (module-30195 (vector-ref x-30161 3)))
(vector
'syntax-object
- expression-32590
- wrap-32591
- module-32592))
- (if (null? x-32558)
- x-32558
+ expression-30193
+ wrap-30194
+ module-30195))
+ (if (null? x-30161)
+ x-30161
(vector
'syntax-object
- x-32558
- w-32102
- mod-32104))))))))))
- (eval-local-transformer-4388
- (lambda (expanded-32650 mod-32651)
- (let ((p-32652 (primitive-eval expanded-32650)))
- (if (procedure? p-32652)
- p-32652
+ x-30161
+ w-29725
+ mod-29727))))))))))
+ (eval-local-transformer-4389
+ (lambda (expanded-30253 mod-30254)
+ (let ((p-30255 (primitive-eval expanded-30253)))
+ (if (procedure? p-30255)
+ p-30255
(syntax-violation
#f
"nonprocedure transformer"
- p-32652)))))
- (ellipsis?-4390
- (lambda (x-5943)
- (if (if (if (vector? x-5943)
- (if (= (vector-length x-5943) 4)
- (eq? (vector-ref x-5943 0) 'syntax-object)
+ p-30255)))))
+ (ellipsis?-4391
+ (lambda (x-5924)
+ (if (if (if (vector? x-5924)
+ (if (= (vector-length x-5924) 4)
+ (eq? (vector-ref x-5924 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-5943 1))
+ (symbol? (vector-ref x-5924 1))
#f)
- (free-id=?-4370
- x-5943
+ (free-id=?-4371
+ x-5924
'#(syntax-object
...
((top)
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-2324"))
+ #(ribcage #(x) #((top)) #("l-*-2325"))
#(ribcage
(lambda-var-list
gen-var
@@ -7021,315 +7799,317 @@
#(ribcage () () ()))
(hygiene guile)))
#f)))
- (lambda-formals-4391
- (lambda (orig-args-32657)
+ (lambda-formals-4392
+ (lambda (orig-args-30260)
(letrec*
- ((req-32658
- (lambda (args-32662 rreq-32663)
- (let ((tmp-32665 ($sc-dispatch args-32662 '())))
- (if tmp-32665
+ ((req-30261
+ (lambda (args-30265 rreq-30266)
+ (let ((tmp-30268 ($sc-dispatch args-30265 '())))
+ (if tmp-30268
(@apply
- (lambda () (check-32659 (reverse rreq-32663) #f))
- tmp-32665)
- (let ((tmp-32781
- ($sc-dispatch args-32662 '(any . any))))
- (if (if tmp-32781
+ (lambda () (check-30262 (reverse rreq-30266) #f))
+ tmp-30268)
+ (let ((tmp-30384
+ ($sc-dispatch args-30265 '(any . any))))
+ (if (if tmp-30384
(@apply
- (lambda (a-32785 b-32786)
- (if (symbol? a-32785)
+ (lambda (a-30388 b-30389)
+ (if (symbol? a-30388)
#t
- (if (if (vector? a-32785)
- (if (= (vector-length a-32785) 4)
- (eq? (vector-ref a-32785 0)
+ (if (if (vector? a-30388)
+ (if (= (vector-length a-30388) 4)
+ (eq? (vector-ref a-30388 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-32785 1))
+ (symbol? (vector-ref a-30388 1))
#f)))
- tmp-32781)
+ tmp-30384)
#f)
(@apply
- (lambda (a-32813 b-32814)
- (req-32658 b-32814 (cons a-32813 rreq-32663)))
- tmp-32781)
- (let ((tmp-32815 (list args-32662)))
+ (lambda (a-30416 b-30417)
+ (req-30261 b-30417 (cons a-30416 rreq-30266)))
+ tmp-30384)
+ (let ((tmp-30418 (list args-30265)))
(if (@apply
- (lambda (r-32817)
- (if (symbol? r-32817)
+ (lambda (r-30420)
+ (if (symbol? r-30420)
#t
- (if (if (vector? r-32817)
- (if (= (vector-length r-32817) 4)
- (eq? (vector-ref r-32817 0)
+ (if (if (vector? r-30420)
+ (if (= (vector-length r-30420) 4)
+ (eq? (vector-ref r-30420 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref r-32817 1))
+ (symbol? (vector-ref r-30420 1))
#f)))
- tmp-32815)
+ tmp-30418)
(@apply
- (lambda (r-32847)
- (check-32659 (reverse rreq-32663) r-32847))
- tmp-32815)
+ (lambda (r-30450)
+ (check-30262 (reverse rreq-30266) r-30450))
+ tmp-30418)
(syntax-violation
'lambda
"invalid argument list"
- orig-args-32657
- args-32662)))))))))
- (check-32659
- (lambda (req-32971 rest-32972)
- (if (distinct-bound-ids?-4373
- (if rest-32972
- (cons rest-32972 req-32971)
- req-32971))
- (values req-32971 #f rest-32972 #f)
+ orig-args-30260
+ args-30265)))))))))
+ (check-30262
+ (lambda (req-30574 rest-30575)
+ (if (distinct-bound-ids?-4374
+ (if rest-30575
+ (cons rest-30575 req-30574)
+ req-30574))
+ (values req-30574 #f rest-30575 #f)
(syntax-violation
'lambda
"duplicate identifier in argument list"
- orig-args-32657)))))
- (req-32658 orig-args-32657 '()))))
- (expand-simple-lambda-4392
- (lambda (e-33081
- r-33082
- w-33083
- s-33084
- mod-33085
- req-33086
- rest-33087
- meta-33088
- body-33089)
- (let ((ids-33090
- (if rest-33087
- (append req-33086 (list rest-33087))
- req-33086)))
- (let ((vars-33091 (map gen-var-4396 ids-33090)))
- (let ((labels-33092 (gen-labels-4349 ids-33090)))
- (build-simple-lambda-4322
- s-33084
- (map syntax->datum req-33086)
- (if rest-33087 (syntax->datum rest-33087) #f)
- vars-33091
- meta-33088
- (expand-body-4386
- body-33089
- (let ((x-33275
+ orig-args-30260)))))
+ (req-30261 orig-args-30260 '()))))
+ (expand-simple-lambda-4393
+ (lambda (e-30684
+ r-30685
+ w-30686
+ s-30687
+ mod-30688
+ req-30689
+ rest-30690
+ meta-30691
+ body-30692)
+ (let ((ids-30693
+ (if rest-30690
+ (append req-30689 (list rest-30690))
+ req-30689)))
+ (let ((vars-30694 (map gen-var-4397 ids-30693)))
+ (let ((labels-30695 (gen-labels-4350 ids-30693)))
+ (build-simple-lambda-4323
+ s-30687
+ (map syntax->datum req-30689)
+ (if rest-30690 (syntax->datum rest-30690) #f)
+ vars-30694
+ meta-30691
+ (expand-body-4387
+ body-30692
+ (let ((x-30878
(begin
- (if (if (pair? e-33081) s-33084 #f)
- (set-source-properties! e-33081 s-33084))
- e-33081)))
- (if (if (null? (car w-33083))
- (null? (cdr w-33083))
+ (if (if s-30687
+ (supports-source-properties? e-30684)
+ #f)
+ (set-source-properties! e-30684 s-30687))
+ e-30684)))
+ (if (if (null? (car w-30686))
+ (null? (cdr w-30686))
#f)
- x-33275
- (if (if (vector? x-33275)
- (if (= (vector-length x-33275) 4)
- (eq? (vector-ref x-33275 0) 'syntax-object)
+ x-30878
+ (if (if (vector? x-30878)
+ (if (= (vector-length x-30878) 4)
+ (eq? (vector-ref x-30878 0) 'syntax-object)
#f)
#f)
- (let ((expression-33307 (vector-ref x-33275 1))
- (wrap-33308
- (let ((w2-33316 (vector-ref x-33275 2)))
- (let ((m1-33317 (car w-33083))
- (s1-33318 (cdr w-33083)))
- (if (null? m1-33317)
- (if (null? s1-33318)
- w2-33316
- (cons (car w2-33316)
- (let ((m2-33333 (cdr w2-33316)))
- (if (null? m2-33333)
- s1-33318
+ (let ((expression-30910 (vector-ref x-30878 1))
+ (wrap-30911
+ (let ((w2-30919 (vector-ref x-30878 2)))
+ (let ((m1-30920 (car w-30686))
+ (s1-30921 (cdr w-30686)))
+ (if (null? m1-30920)
+ (if (null? s1-30921)
+ w2-30919
+ (cons (car w2-30919)
+ (let ((m2-30936 (cdr w2-30919)))
+ (if (null? m2-30936)
+ s1-30921
(append
- s1-33318
- m2-33333)))))
- (cons (let ((m2-33341 (car w2-33316)))
- (if (null? m2-33341)
- m1-33317
- (append m1-33317 m2-33341)))
- (let ((m2-33349 (cdr w2-33316)))
- (if (null? m2-33349)
- s1-33318
+ s1-30921
+ m2-30936)))))
+ (cons (let ((m2-30944 (car w2-30919)))
+ (if (null? m2-30944)
+ m1-30920
+ (append m1-30920 m2-30944)))
+ (let ((m2-30952 (cdr w2-30919)))
+ (if (null? m2-30952)
+ s1-30921
(append
- s1-33318
- m2-33349))))))))
- (module-33309 (vector-ref x-33275 3)))
+ s1-30921
+ m2-30952))))))))
+ (module-30912 (vector-ref x-30878 3)))
(vector
'syntax-object
- expression-33307
- wrap-33308
- module-33309))
- (if (null? x-33275)
- x-33275
+ expression-30910
+ wrap-30911
+ module-30912))
+ (if (null? x-30878)
+ x-30878
(vector
'syntax-object
- x-33275
- w-33083
- mod-33085)))))
- (extend-var-env-4342
- labels-33092
- vars-33091
- r-33082)
- (make-binding-wrap-4360
- ids-33090
- labels-33092
- w-33083)
- mod-33085)))))))
- (lambda*-formals-4393
- (lambda (orig-args-33558)
+ x-30878
+ w-30686
+ mod-30688)))))
+ (extend-var-env-4343
+ labels-30695
+ vars-30694
+ r-30685)
+ (make-binding-wrap-4361
+ ids-30693
+ labels-30695
+ w-30686)
+ mod-30688)))))))
+ (lambda*-formals-4394
+ (lambda (orig-args-31161)
(letrec*
- ((req-33559
- (lambda (args-33566 rreq-33567)
- (let ((tmp-33569 ($sc-dispatch args-33566 '())))
- (if tmp-33569
+ ((req-31162
+ (lambda (args-31169 rreq-31170)
+ (let ((tmp-31172 ($sc-dispatch args-31169 '())))
+ (if tmp-31172
(@apply
(lambda ()
- (check-33563 (reverse rreq-33567) '() #f '()))
- tmp-33569)
- (let ((tmp-33688
- ($sc-dispatch args-33566 '(any . any))))
- (if (if tmp-33688
+ (check-31166 (reverse rreq-31170) '() #f '()))
+ tmp-31172)
+ (let ((tmp-31291
+ ($sc-dispatch args-31169 '(any . any))))
+ (if (if tmp-31291
(@apply
- (lambda (a-33692 b-33693)
- (if (symbol? a-33692)
+ (lambda (a-31295 b-31296)
+ (if (symbol? a-31295)
#t
- (if (if (vector? a-33692)
- (if (= (vector-length a-33692) 4)
- (eq? (vector-ref a-33692 0)
+ (if (if (vector? a-31295)
+ (if (= (vector-length a-31295) 4)
+ (eq? (vector-ref a-31295 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-33692 1))
+ (symbol? (vector-ref a-31295 1))
#f)))
- tmp-33688)
+ tmp-31291)
#f)
(@apply
- (lambda (a-33720 b-33721)
- (req-33559 b-33721 (cons a-33720 rreq-33567)))
- tmp-33688)
- (let ((tmp-33722
- ($sc-dispatch args-33566 '(any . any))))
- (if (if tmp-33722
+ (lambda (a-31323 b-31324)
+ (req-31162 b-31324 (cons a-31323 rreq-31170)))
+ tmp-31291)
+ (let ((tmp-31325
+ ($sc-dispatch args-31169 '(any . any))))
+ (if (if tmp-31325
(@apply
- (lambda (a-33726 b-33727)
- (eq? (syntax->datum a-33726) #:optional))
- tmp-33722)
+ (lambda (a-31329 b-31330)
+ (eq? (syntax->datum a-31329) #:optional))
+ tmp-31325)
#f)
(@apply
- (lambda (a-33728 b-33729)
- (opt-33560 b-33729 (reverse rreq-33567) '()))
- tmp-33722)
- (let ((tmp-33732
- ($sc-dispatch args-33566 '(any . any))))
- (if (if tmp-33732
+ (lambda (a-31331 b-31332)
+ (opt-31163 b-31332 (reverse rreq-31170) '()))
+ tmp-31325)
+ (let ((tmp-31335
+ ($sc-dispatch args-31169 '(any . any))))
+ (if (if tmp-31335
(@apply
- (lambda (a-33736 b-33737)
- (eq? (syntax->datum a-33736) #:key))
- tmp-33732)
+ (lambda (a-31339 b-31340)
+ (eq? (syntax->datum a-31339) #:key))
+ tmp-31335)
#f)
(@apply
- (lambda (a-33738 b-33739)
- (key-33561
- b-33739
- (reverse rreq-33567)
+ (lambda (a-31341 b-31342)
+ (key-31164
+ b-31342
+ (reverse rreq-31170)
'()
'()))
- tmp-33732)
- (let ((tmp-33742
- ($sc-dispatch args-33566 '(any any))))
- (if (if tmp-33742
+ tmp-31335)
+ (let ((tmp-31345
+ ($sc-dispatch args-31169 '(any any))))
+ (if (if tmp-31345
(@apply
- (lambda (a-33746 b-33747)
- (eq? (syntax->datum a-33746)
+ (lambda (a-31349 b-31350)
+ (eq? (syntax->datum a-31349)
#:rest))
- tmp-33742)
+ tmp-31345)
#f)
(@apply
- (lambda (a-33748 b-33749)
- (rest-33562
- b-33749
- (reverse rreq-33567)
+ (lambda (a-31351 b-31352)
+ (rest-31165
+ b-31352
+ (reverse rreq-31170)
'()
'()))
- tmp-33742)
- (let ((tmp-33752 (list args-33566)))
+ tmp-31345)
+ (let ((tmp-31355 (list args-31169)))
(if (@apply
- (lambda (r-33754)
- (if (symbol? r-33754)
+ (lambda (r-31357)
+ (if (symbol? r-31357)
#t
- (if (if (vector? r-33754)
+ (if (if (vector? r-31357)
(if (= (vector-length
- r-33754)
+ r-31357)
4)
(eq? (vector-ref
- r-33754
+ r-31357
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref r-33754 1))
+ (vector-ref r-31357 1))
#f)))
- tmp-33752)
+ tmp-31355)
(@apply
- (lambda (r-33784)
- (rest-33562
- r-33784
- (reverse rreq-33567)
+ (lambda (r-31387)
+ (rest-31165
+ r-31387
+ (reverse rreq-31170)
'()
'()))
- tmp-33752)
+ tmp-31355)
(syntax-violation
'lambda*
"invalid argument list"
- orig-args-33558
- args-33566)))))))))))))))
- (opt-33560
- (lambda (args-33803 req-33804 ropt-33805)
- (let ((tmp-33807 ($sc-dispatch args-33803 '())))
- (if tmp-33807
+ orig-args-31161
+ args-31169)))))))))))))))
+ (opt-31163
+ (lambda (args-31406 req-31407 ropt-31408)
+ (let ((tmp-31410 ($sc-dispatch args-31406 '())))
+ (if tmp-31410
(@apply
(lambda ()
- (check-33563
- req-33804
- (reverse ropt-33805)
+ (check-31166
+ req-31407
+ (reverse ropt-31408)
#f
'()))
- tmp-33807)
- (let ((tmp-33928
- ($sc-dispatch args-33803 '(any . any))))
- (if (if tmp-33928
+ tmp-31410)
+ (let ((tmp-31531
+ ($sc-dispatch args-31406 '(any . any))))
+ (if (if tmp-31531
(@apply
- (lambda (a-33932 b-33933)
- (if (symbol? a-33932)
+ (lambda (a-31535 b-31536)
+ (if (symbol? a-31535)
#t
- (if (if (vector? a-33932)
- (if (= (vector-length a-33932) 4)
- (eq? (vector-ref a-33932 0)
+ (if (if (vector? a-31535)
+ (if (= (vector-length a-31535) 4)
+ (eq? (vector-ref a-31535 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-33932 1))
+ (symbol? (vector-ref a-31535 1))
#f)))
- tmp-33928)
+ tmp-31531)
#f)
(@apply
- (lambda (a-33960 b-33961)
- (opt-33560
- b-33961
- req-33804
- (cons (cons a-33960
+ (lambda (a-31563 b-31564)
+ (opt-31163
+ b-31564
+ req-31407
+ (cons (cons a-31563
'(#(syntax-object
#f
((top)
#(ribcage
#(a b)
#((top) (top))
- #("l-*-2461" "l-*-2462"))
+ #("l-*-2462" "l-*-2463"))
#(ribcage () () ())
#(ribcage
#(args req ropt)
#((top) (top) (top))
- #("l-*-2451"
- "l-*-2452"
- "l-*-2453"))
+ #("l-*-2452"
+ "l-*-2453"
+ "l-*-2454"))
#(ribcage
(check rest key opt req)
((top)
@@ -7337,15 +8117,15 @@
(top)
(top)
(top))
- ("l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"))
+ ("l-*-2398"
+ "l-*-2396"
+ "l-*-2394"
+ "l-*-2392"
+ "l-*-2390"))
#(ribcage
#(orig-args)
#((top))
- #("l-*-2388"))
+ #("l-*-2389"))
#(ribcage
(lambda-var-list
gen-var
@@ -7778,136 +8558,136 @@
("l-*-47" "l-*-46" "l-*-45"))
#(ribcage () () ()))
(hygiene guile))))
- ropt-33805)))
- tmp-33928)
- (let ((tmp-33962
- ($sc-dispatch args-33803 '((any any) . any))))
- (if (if tmp-33962
+ ropt-31408)))
+ tmp-31531)
+ (let ((tmp-31565
+ ($sc-dispatch args-31406 '((any any) . any))))
+ (if (if tmp-31565
(@apply
- (lambda (a-33966 init-33967 b-33968)
- (if (symbol? a-33966)
+ (lambda (a-31569 init-31570 b-31571)
+ (if (symbol? a-31569)
#t
- (if (if (vector? a-33966)
- (if (= (vector-length a-33966) 4)
- (eq? (vector-ref a-33966 0)
+ (if (if (vector? a-31569)
+ (if (= (vector-length a-31569) 4)
+ (eq? (vector-ref a-31569 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-33966 1))
+ (symbol? (vector-ref a-31569 1))
#f)))
- tmp-33962)
+ tmp-31565)
#f)
(@apply
- (lambda (a-33995 init-33996 b-33997)
- (opt-33560
- b-33997
- req-33804
- (cons (list a-33995 init-33996) ropt-33805)))
- tmp-33962)
- (let ((tmp-33998
- ($sc-dispatch args-33803 '(any . any))))
- (if (if tmp-33998
+ (lambda (a-31598 init-31599 b-31600)
+ (opt-31163
+ b-31600
+ req-31407
+ (cons (list a-31598 init-31599) ropt-31408)))
+ tmp-31565)
+ (let ((tmp-31601
+ ($sc-dispatch args-31406 '(any . any))))
+ (if (if tmp-31601
(@apply
- (lambda (a-34002 b-34003)
- (eq? (syntax->datum a-34002) #:key))
- tmp-33998)
+ (lambda (a-31605 b-31606)
+ (eq? (syntax->datum a-31605) #:key))
+ tmp-31601)
#f)
(@apply
- (lambda (a-34004 b-34005)
- (key-33561
- b-34005
- req-33804
- (reverse ropt-33805)
+ (lambda (a-31607 b-31608)
+ (key-31164
+ b-31608
+ req-31407
+ (reverse ropt-31408)
'()))
- tmp-33998)
- (let ((tmp-34008
- ($sc-dispatch args-33803 '(any any))))
- (if (if tmp-34008
+ tmp-31601)
+ (let ((tmp-31611
+ ($sc-dispatch args-31406 '(any any))))
+ (if (if tmp-31611
(@apply
- (lambda (a-34012 b-34013)
- (eq? (syntax->datum a-34012)
+ (lambda (a-31615 b-31616)
+ (eq? (syntax->datum a-31615)
#:rest))
- tmp-34008)
+ tmp-31611)
#f)
(@apply
- (lambda (a-34014 b-34015)
- (rest-33562
- b-34015
- req-33804
- (reverse ropt-33805)
+ (lambda (a-31617 b-31618)
+ (rest-31165
+ b-31618
+ req-31407
+ (reverse ropt-31408)
'()))
- tmp-34008)
- (let ((tmp-34018 (list args-33803)))
+ tmp-31611)
+ (let ((tmp-31621 (list args-31406)))
(if (@apply
- (lambda (r-34020)
- (if (symbol? r-34020)
+ (lambda (r-31623)
+ (if (symbol? r-31623)
#t
- (if (if (vector? r-34020)
+ (if (if (vector? r-31623)
(if (= (vector-length
- r-34020)
+ r-31623)
4)
(eq? (vector-ref
- r-34020
+ r-31623
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref r-34020 1))
+ (vector-ref r-31623 1))
#f)))
- tmp-34018)
+ tmp-31621)
(@apply
- (lambda (r-34050)
- (rest-33562
- r-34050
- req-33804
- (reverse ropt-33805)
+ (lambda (r-31653)
+ (rest-31165
+ r-31653
+ req-31407
+ (reverse ropt-31408)
'()))
- tmp-34018)
+ tmp-31621)
(syntax-violation
'lambda*
"invalid optional argument list"
- orig-args-33558
- args-33803)))))))))))))))
- (key-33561
- (lambda (args-34069 req-34070 opt-34071 rkey-34072)
- (let ((tmp-34074 ($sc-dispatch args-34069 '())))
- (if tmp-34074
+ orig-args-31161
+ args-31406)))))))))))))))
+ (key-31164
+ (lambda (args-31672 req-31673 opt-31674 rkey-31675)
+ (let ((tmp-31677 ($sc-dispatch args-31672 '())))
+ (if tmp-31677
(@apply
(lambda ()
- (check-33563
- req-34070
- opt-34071
+ (check-31166
+ req-31673
+ opt-31674
#f
- (cons #f (reverse rkey-34072))))
- tmp-34074)
- (let ((tmp-34196
- ($sc-dispatch args-34069 '(any . any))))
- (if (if tmp-34196
+ (cons #f (reverse rkey-31675))))
+ tmp-31677)
+ (let ((tmp-31799
+ ($sc-dispatch args-31672 '(any . any))))
+ (if (if tmp-31799
(@apply
- (lambda (a-34200 b-34201)
- (if (symbol? a-34200)
+ (lambda (a-31803 b-31804)
+ (if (symbol? a-31803)
#t
- (if (if (vector? a-34200)
- (if (= (vector-length a-34200) 4)
- (eq? (vector-ref a-34200 0)
+ (if (if (vector? a-31803)
+ (if (= (vector-length a-31803) 4)
+ (eq? (vector-ref a-31803 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-34200 1))
+ (symbol? (vector-ref a-31803 1))
#f)))
- tmp-34196)
+ tmp-31799)
#f)
(@apply
- (lambda (a-34228 b-34229)
- (let ((tmp-34230
- (symbol->keyword (syntax->datum a-34228))))
- (key-33561
- b-34229
- req-34070
- opt-34071
- (cons (cons tmp-34230
- (cons a-34228
+ (lambda (a-31831 b-31832)
+ (let ((tmp-31833
+ (symbol->keyword (syntax->datum a-31831))))
+ (key-31164
+ b-31832
+ req-31673
+ opt-31674
+ (cons (cons tmp-31833
+ (cons a-31831
'(#(syntax-object
#f
((top)
@@ -7915,12 +8695,12 @@
#(ribcage
#(k)
#((top))
- #("l-*-2524"))
+ #("l-*-2525"))
#(ribcage
#(a b)
#((top) (top))
- #("l-*-2518"
- "l-*-2519"))
+ #("l-*-2519"
+ "l-*-2520"))
#(ribcage () () ())
#(ribcage
#(args req opt rkey)
@@ -7928,10 +8708,10 @@
(top)
(top)
(top))
- #("l-*-2507"
- "l-*-2508"
+ #("l-*-2508"
"l-*-2509"
- "l-*-2510"))
+ "l-*-2510"
+ "l-*-2511"))
#(ribcage
(check rest
key
@@ -7942,15 +8722,15 @@
(top)
(top)
(top))
- ("l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"))
+ ("l-*-2398"
+ "l-*-2396"
+ "l-*-2394"
+ "l-*-2392"
+ "l-*-2390"))
#(ribcage
#(orig-args)
#((top))
- #("l-*-2388"))
+ #("l-*-2389"))
#(ribcage
(lambda-var-list
gen-var
@@ -8385,947 +9165,1029 @@
"l-*-45"))
#(ribcage () () ()))
(hygiene guile)))))
- rkey-34072))))
- tmp-34196)
- (let ((tmp-34233
- ($sc-dispatch args-34069 '((any any) . any))))
- (if (if tmp-34233
+ rkey-31675))))
+ tmp-31799)
+ (let ((tmp-31836
+ ($sc-dispatch args-31672 '((any any) . any))))
+ (if (if tmp-31836
(@apply
- (lambda (a-34237 init-34238 b-34239)
- (if (symbol? a-34237)
+ (lambda (a-31840 init-31841 b-31842)
+ (if (symbol? a-31840)
#t
- (if (if (vector? a-34237)
- (if (= (vector-length a-34237) 4)
- (eq? (vector-ref a-34237 0)
+ (if (if (vector? a-31840)
+ (if (= (vector-length a-31840) 4)
+ (eq? (vector-ref a-31840 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-34237 1))
+ (symbol? (vector-ref a-31840 1))
#f)))
- tmp-34233)
+ tmp-31836)
#f)
(@apply
- (lambda (a-34266 init-34267 b-34268)
- (let ((tmp-34269
+ (lambda (a-31869 init-31870 b-31871)
+ (let ((tmp-31872
(symbol->keyword
- (syntax->datum a-34266))))
- (key-33561
- b-34268
- req-34070
- opt-34071
- (cons (list tmp-34269 a-34266 init-34267)
- rkey-34072))))
- tmp-34233)
- (let ((tmp-34272
+ (syntax->datum a-31869))))
+ (key-31164
+ b-31871
+ req-31673
+ opt-31674
+ (cons (list tmp-31872 a-31869 init-31870)
+ rkey-31675))))
+ tmp-31836)
+ (let ((tmp-31875
($sc-dispatch
- args-34069
+ args-31672
'((any any any) . any))))
- (if (if tmp-34272
+ (if (if tmp-31875
(@apply
- (lambda (a-34276
- init-34277
- k-34278
- b-34279)
- (if (if (symbol? a-34276)
+ (lambda (a-31879
+ init-31880
+ k-31881
+ b-31882)
+ (if (if (symbol? a-31879)
#t
- (if (if (vector? a-34276)
+ (if (if (vector? a-31879)
(if (= (vector-length
- a-34276)
+ a-31879)
4)
(eq? (vector-ref
- a-34276
+ a-31879
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref a-34276 1))
+ (vector-ref a-31879 1))
#f))
- (keyword? (syntax->datum k-34278))
+ (keyword? (syntax->datum k-31881))
#f))
- tmp-34272)
+ tmp-31875)
#f)
(@apply
- (lambda (a-34306 init-34307 k-34308 b-34309)
- (key-33561
- b-34309
- req-34070
- opt-34071
- (cons (list k-34308 a-34306 init-34307)
- rkey-34072)))
- tmp-34272)
- (let ((tmp-34310
- ($sc-dispatch args-34069 '(any))))
- (if (if tmp-34310
+ (lambda (a-31909 init-31910 k-31911 b-31912)
+ (key-31164
+ b-31912
+ req-31673
+ opt-31674
+ (cons (list k-31911 a-31909 init-31910)
+ rkey-31675)))
+ tmp-31875)
+ (let ((tmp-31913
+ ($sc-dispatch args-31672 '(any))))
+ (if (if tmp-31913
(@apply
- (lambda (aok-34314)
- (eq? (syntax->datum aok-34314)
+ (lambda (aok-31917)
+ (eq? (syntax->datum aok-31917)
#:allow-other-keys))
- tmp-34310)
+ tmp-31913)
#f)
(@apply
- (lambda (aok-34315)
- (check-33563
- req-34070
- opt-34071
+ (lambda (aok-31918)
+ (check-31166
+ req-31673
+ opt-31674
#f
- (cons #t (reverse rkey-34072))))
- tmp-34310)
- (let ((tmp-34434
+ (cons #t (reverse rkey-31675))))
+ tmp-31913)
+ (let ((tmp-32037
($sc-dispatch
- args-34069
+ args-31672
'(any any any))))
- (if (if tmp-34434
+ (if (if tmp-32037
(@apply
- (lambda (aok-34438
- a-34439
- b-34440)
+ (lambda (aok-32041
+ a-32042
+ b-32043)
(if (eq? (syntax->datum
- aok-34438)
+ aok-32041)
#:allow-other-keys)
- (eq? (syntax->datum a-34439)
+ (eq? (syntax->datum a-32042)
#:rest)
#f))
- tmp-34434)
+ tmp-32037)
#f)
(@apply
- (lambda (aok-34441 a-34442 b-34443)
- (rest-33562
- b-34443
- req-34070
- opt-34071
- (cons #t (reverse rkey-34072))))
- tmp-34434)
- (let ((tmp-34446
+ (lambda (aok-32044 a-32045 b-32046)
+ (rest-31165
+ b-32046
+ req-31673
+ opt-31674
+ (cons #t (reverse rkey-31675))))
+ tmp-32037)
+ (let ((tmp-32049
($sc-dispatch
- args-34069
+ args-31672
'(any . any))))
- (if (if tmp-34446
+ (if (if tmp-32049
(@apply
- (lambda (aok-34450 r-34451)
+ (lambda (aok-32053 r-32054)
(if (eq? (syntax->datum
- aok-34450)
+ aok-32053)
#:allow-other-keys)
- (if (symbol? r-34451)
+ (if (symbol? r-32054)
#t
(if (if (vector?
- r-34451)
+ r-32054)
(if (=
(vector-length
- r-34451)
+ r-32054)
4)
(eq?
(vector-ref
- r-34451
+ r-32054
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- r-34451
+ r-32054
1))
#f))
#f))
- tmp-34446)
+ tmp-32049)
#f)
(@apply
- (lambda (aok-34478 r-34479)
- (rest-33562
- r-34479
- req-34070
- opt-34071
+ (lambda (aok-32081 r-32082)
+ (rest-31165
+ r-32082
+ req-31673
+ opt-31674
(cons #t
- (reverse rkey-34072))))
- tmp-34446)
- (let ((tmp-34482
+ (reverse rkey-31675))))
+ tmp-32049)
+ (let ((tmp-32085
($sc-dispatch
- args-34069
+ args-31672
'(any any))))
- (if (if tmp-34482
+ (if (if tmp-32085
(@apply
- (lambda (a-34486 b-34487)
+ (lambda (a-32089 b-32090)
(eq? (syntax->datum
- a-34486)
+ a-32089)
#:rest))
- tmp-34482)
+ tmp-32085)
#f)
(@apply
- (lambda (a-34488 b-34489)
- (rest-33562
- b-34489
- req-34070
- opt-34071
+ (lambda (a-32091 b-32092)
+ (rest-31165
+ b-32092
+ req-31673
+ opt-31674
(cons #f
(reverse
- rkey-34072))))
- tmp-34482)
- (let ((tmp-34492
- (list args-34069)))
+ rkey-31675))))
+ tmp-32085)
+ (let ((tmp-32095
+ (list args-31672)))
(if (@apply
- (lambda (r-34494)
- (if (symbol? r-34494)
+ (lambda (r-32097)
+ (if (symbol? r-32097)
#t
(if (if (vector?
- r-34494)
+ r-32097)
(if (=
(vector-length
-
r-34494)
+
r-32097)
4)
(eq?
(vector-ref
-
r-34494
+
r-32097
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- r-34494
+ r-32097
1))
#f)))
- tmp-34492)
+ tmp-32095)
(@apply
- (lambda (r-34524)
- (rest-33562
- r-34524
- req-34070
- opt-34071
+ (lambda (r-32127)
+ (rest-31165
+ r-32127
+ req-31673
+ opt-31674
(cons #f
(reverse
-
rkey-34072))))
- tmp-34492)
+
rkey-31675))))
+ tmp-32095)
(syntax-violation
'lambda*
"invalid keyword
argument list"
- orig-args-33558
-
args-34069)))))))))))))))))))))
- (rest-33562
- (lambda (args-34552 req-34553 opt-34554 kw-34555)
- (let ((tmp-34557 (list args-34552)))
+ orig-args-31161
+
args-31672)))))))))))))))))))))
+ (rest-31165
+ (lambda (args-32155 req-32156 opt-32157 kw-32158)
+ (let ((tmp-32160 (list args-32155)))
(if (@apply
- (lambda (r-34559)
- (if (symbol? r-34559)
+ (lambda (r-32162)
+ (if (symbol? r-32162)
#t
- (if (if (vector? r-34559)
- (if (= (vector-length r-34559) 4)
- (eq? (vector-ref r-34559 0) 'syntax-object)
+ (if (if (vector? r-32162)
+ (if (= (vector-length r-32162) 4)
+ (eq? (vector-ref r-32162 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref r-34559 1))
+ (symbol? (vector-ref r-32162 1))
#f)))
- tmp-34557)
+ tmp-32160)
(@apply
- (lambda (r-34589)
- (check-33563
- req-34553
- opt-34554
- r-34589
- kw-34555))
- tmp-34557)
+ (lambda (r-32192)
+ (check-31166
+ req-32156
+ opt-32157
+ r-32192
+ kw-32158))
+ tmp-32160)
(syntax-violation
'lambda*
"invalid rest argument"
- orig-args-33558
- args-34552)))))
- (check-33563
- (lambda (req-34717 opt-34718 rest-34719 kw-34720)
- (if (distinct-bound-ids?-4373
+ orig-args-31161
+ args-32155)))))
+ (check-31166
+ (lambda (req-32320 opt-32321 rest-32322 kw-32323)
+ (if (distinct-bound-ids?-4374
(append
- req-34717
- (map car opt-34718)
- (if rest-34719 (list rest-34719) '())
- (if (pair? kw-34720)
- (map cadr (cdr kw-34720))
+ req-32320
+ (map car opt-32321)
+ (if rest-32322 (list rest-32322) '())
+ (if (pair? kw-32323)
+ (map cadr (cdr kw-32323))
'())))
- (values req-34717 opt-34718 rest-34719 kw-34720)
+ (values req-32320 opt-32321 rest-32322 kw-32323)
(syntax-violation
'lambda*
"duplicate identifier in argument list"
- orig-args-33558)))))
- (req-33559 orig-args-33558 '()))))
- (expand-lambda-case-4394
- (lambda (e-34829
- r-34830
- w-34831
- s-34832
- mod-34833
- get-formals-34834
- clauses-34835)
+ orig-args-31161)))))
+ (req-31162 orig-args-31161 '()))))
+ (expand-lambda-case-4395
+ (lambda (e-32432
+ r-32433
+ w-32434
+ s-32435
+ mod-32436
+ get-formals-32437
+ clauses-32438)
(letrec*
- ((parse-req-34836
- (lambda (req-34969
- opt-34970
- rest-34971
- kw-34972
- body-34973)
- (let ((vars-34974 (map gen-var-4396 req-34969))
- (labels-34975 (gen-labels-4349 req-34969)))
- (let ((r*-34976
- (extend-var-env-4342
- labels-34975
- vars-34974
- r-34830))
- (w*-34977
- (make-binding-wrap-4360
- req-34969
- labels-34975
- w-34831)))
- (parse-opt-34837
- (map syntax->datum req-34969)
- opt-34970
- rest-34971
- kw-34972
- body-34973
- (reverse vars-34974)
- r*-34976
- w*-34977
+ ((parse-req-32439
+ (lambda (req-32572
+ opt-32573
+ rest-32574
+ kw-32575
+ body-32576)
+ (let ((vars-32577 (map gen-var-4397 req-32572))
+ (labels-32578 (gen-labels-4350 req-32572)))
+ (let ((r*-32579
+ (extend-var-env-4343
+ labels-32578
+ vars-32577
+ r-32433))
+ (w*-32580
+ (make-binding-wrap-4361
+ req-32572
+ labels-32578
+ w-32434)))
+ (parse-opt-32440
+ (map syntax->datum req-32572)
+ opt-32573
+ rest-32574
+ kw-32575
+ body-32576
+ (reverse vars-32577)
+ r*-32579
+ w*-32580
'()
'())))))
- (parse-opt-34837
- (lambda (req-35174
- opt-35175
- rest-35176
- kw-35177
- body-35178
- vars-35179
- r*-35180
- w*-35181
- out-35182
- inits-35183)
- (if (pair? opt-35175)
- (let ((tmp-35184 (car opt-35175)))
- (let ((tmp-35185 ($sc-dispatch tmp-35184 '(any any))))
- (if tmp-35185
+ (parse-opt-32440
+ (lambda (req-32777
+ opt-32778
+ rest-32779
+ kw-32780
+ body-32781
+ vars-32782
+ r*-32783
+ w*-32784
+ out-32785
+ inits-32786)
+ (if (pair? opt-32778)
+ (let ((tmp-32787 (car opt-32778)))
+ (let ((tmp-32788 ($sc-dispatch tmp-32787 '(any any))))
+ (if tmp-32788
(@apply
- (lambda (id-35187 i-35188)
- (let ((v-35189
- (let ((id-35197
- (if (if (vector? id-35187)
+ (lambda (id-32790 i-32791)
+ (let ((v-32792
+ (let ((id-32800
+ (if (if (vector? id-32790)
(if (= (vector-length
- id-35187)
+ id-32790)
4)
(eq? (vector-ref
- id-35187
+ id-32790
0)
'syntax-object)
#f)
#f)
- (vector-ref id-35187 1)
- id-35187)))
+ (vector-ref id-32790 1)
+ id-32790)))
(gensym
(string-append
- (symbol->string id-35197)
+ (symbol->string id-32800)
"-")))))
- (let ((l-35190 (gen-labels-4349 (list v-35189))))
- (let ((r**-35191
- (extend-var-env-4342
- l-35190
- (list v-35189)
- r*-35180)))
- (let ((w**-35192
- (make-binding-wrap-4360
- (list id-35187)
- l-35190
- w*-35181)))
- (parse-opt-34837
- req-35174
- (cdr opt-35175)
- rest-35176
- kw-35177
- body-35178
- (cons v-35189 vars-35179)
- r**-35191
- w**-35192
- (cons (syntax->datum id-35187) out-35182)
- (cons (expand-4382
- i-35188
- r*-35180
- w*-35181
- mod-34833)
- inits-35183)))))))
- tmp-35185)
+ (let ((l-32793 (gen-labels-4350 (list v-32792))))
+ (let ((r**-32794
+ (extend-var-env-4343
+ l-32793
+ (list v-32792)
+ r*-32783)))
+ (let ((w**-32795
+ (make-binding-wrap-4361
+ (list id-32790)
+ l-32793
+ w*-32784)))
+ (parse-opt-32440
+ req-32777
+ (cdr opt-32778)
+ rest-32779
+ kw-32780
+ body-32781
+ (cons v-32792 vars-32782)
+ r**-32794
+ w**-32795
+ (cons (syntax->datum id-32790) out-32785)
+ (cons (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ i-32791
+ r*-32783
+ w*-32784
+ (let ((props-32877
+ (source-properties
+ (if (if (vector?
+ i-32791)
+ (if (=
(vector-length
+
i-32791)
+ 4)
+ (eq?
(vector-ref
+
i-32791
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ i-32791
+ 1)
+ i-32791))))
+ (if (pair? props-32877)
+ props-32877
+ #f))
+ #f
+ mod-32436
+ #f))
+ (lambda (type-32910
+ value-32911
+ form-32912
+ e-32913
+ w-32914
+ s-32915
+ mod-32916)
+ (expand-expr-4384
+ type-32910
+ value-32911
+ form-32912
+ e-32913
+ r*-32783
+ w-32914
+ s-32915
+ mod-32916)))
+ inits-32786)))))))
+ tmp-32788)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-35184))))
- (if rest-35176
- (let ((v-35455
- (let ((id-35465
- (if (if (vector? rest-35176)
- (if (= (vector-length rest-35176) 4)
- (eq? (vector-ref rest-35176 0)
+ tmp-32787))))
+ (if rest-32779
+ (let ((v-33039
+ (let ((id-33049
+ (if (if (vector? rest-32779)
+ (if (= (vector-length rest-32779) 4)
+ (eq? (vector-ref rest-32779 0)
'syntax-object)
#f)
#f)
- (vector-ref rest-35176 1)
- rest-35176)))
+ (vector-ref rest-32779 1)
+ rest-32779)))
(gensym
(string-append
- (symbol->string id-35465)
+ (symbol->string id-33049)
"-")))))
- (let ((l-35456 (gen-labels-4349 (list v-35455))))
- (let ((r*-35457
- (extend-var-env-4342
- l-35456
- (list v-35455)
- r*-35180)))
- (let ((w*-35458
- (make-binding-wrap-4360
- (list rest-35176)
- l-35456
- w*-35181)))
- (parse-kw-34838
- req-35174
- (if (pair? out-35182) (reverse out-35182) #f)
- (syntax->datum rest-35176)
- (if (pair? kw-35177) (cdr kw-35177) kw-35177)
- body-35178
- (cons v-35455 vars-35179)
- r*-35457
- w*-35458
- (if (pair? kw-35177) (car kw-35177) #f)
+ (let ((l-33040 (gen-labels-4350 (list v-33039))))
+ (let ((r*-33041
+ (extend-var-env-4343
+ l-33040
+ (list v-33039)
+ r*-32783)))
+ (let ((w*-33042
+ (make-binding-wrap-4361
+ (list rest-32779)
+ l-33040
+ w*-32784)))
+ (parse-kw-32441
+ req-32777
+ (if (pair? out-32785) (reverse out-32785) #f)
+ (syntax->datum rest-32779)
+ (if (pair? kw-32780) (cdr kw-32780) kw-32780)
+ body-32781
+ (cons v-33039 vars-32782)
+ r*-33041
+ w*-33042
+ (if (pair? kw-32780) (car kw-32780) #f)
'()
- inits-35183)))))
- (parse-kw-34838
- req-35174
- (if (pair? out-35182) (reverse out-35182) #f)
+ inits-32786)))))
+ (parse-kw-32441
+ req-32777
+ (if (pair? out-32785) (reverse out-32785) #f)
#f
- (if (pair? kw-35177) (cdr kw-35177) kw-35177)
- body-35178
- vars-35179
- r*-35180
- w*-35181
- (if (pair? kw-35177) (car kw-35177) #f)
+ (if (pair? kw-32780) (cdr kw-32780) kw-32780)
+ body-32781
+ vars-32782
+ r*-32783
+ w*-32784
+ (if (pair? kw-32780) (car kw-32780) #f)
'()
- inits-35183)))))
- (parse-kw-34838
- (lambda (req-35648
- opt-35649
- rest-35650
- kw-35651
- body-35652
- vars-35653
- r*-35654
- w*-35655
- aok-35656
- out-35657
- inits-35658)
- (if (pair? kw-35651)
- (let ((tmp-35659 (car kw-35651)))
- (let ((tmp-35660
- ($sc-dispatch tmp-35659 '(any any any))))
- (if tmp-35660
+ inits-32786)))))
+ (parse-kw-32441
+ (lambda (req-33232
+ opt-33233
+ rest-33234
+ kw-33235
+ body-33236
+ vars-33237
+ r*-33238
+ w*-33239
+ aok-33240
+ out-33241
+ inits-33242)
+ (if (pair? kw-33235)
+ (let ((tmp-33243 (car kw-33235)))
+ (let ((tmp-33244
+ ($sc-dispatch tmp-33243 '(any any any))))
+ (if tmp-33244
(@apply
- (lambda (k-35662 id-35663 i-35664)
- (let ((v-35665
- (let ((id-35673
- (if (if (vector? id-35663)
+ (lambda (k-33246 id-33247 i-33248)
+ (let ((v-33249
+ (let ((id-33257
+ (if (if (vector? id-33247)
(if (= (vector-length
- id-35663)
+ id-33247)
4)
(eq? (vector-ref
- id-35663
+ id-33247
0)
'syntax-object)
#f)
#f)
- (vector-ref id-35663 1)
- id-35663)))
+ (vector-ref id-33247 1)
+ id-33247)))
(gensym
(string-append
- (symbol->string id-35673)
+ (symbol->string id-33257)
"-")))))
- (let ((l-35666 (gen-labels-4349 (list v-35665))))
- (let ((r**-35667
- (extend-var-env-4342
- l-35666
- (list v-35665)
- r*-35654)))
- (let ((w**-35668
- (make-binding-wrap-4360
- (list id-35663)
- l-35666
- w*-35655)))
- (parse-kw-34838
- req-35648
- opt-35649
- rest-35650
- (cdr kw-35651)
- body-35652
- (cons v-35665 vars-35653)
- r**-35667
- w**-35668
- aok-35656
- (cons (list (syntax->datum k-35662)
- (syntax->datum id-35663)
- v-35665)
- out-35657)
- (cons (expand-4382
- i-35664
- r*-35654
- w*-35655
- mod-34833)
- inits-35658)))))))
- tmp-35660)
+ (let ((l-33250 (gen-labels-4350 (list v-33249))))
+ (let ((r**-33251
+ (extend-var-env-4343
+ l-33250
+ (list v-33249)
+ r*-33238)))
+ (let ((w**-33252
+ (make-binding-wrap-4361
+ (list id-33247)
+ l-33250
+ w*-33239)))
+ (parse-kw-32441
+ req-33232
+ opt-33233
+ rest-33234
+ (cdr kw-33235)
+ body-33236
+ (cons v-33249 vars-33237)
+ r**-33251
+ w**-33252
+ aok-33240
+ (cons (list (syntax->datum k-33246)
+ (syntax->datum id-33247)
+ v-33249)
+ out-33241)
+ (cons (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ i-33248
+ r*-33238
+ w*-33239
+ (let ((props-33334
+ (source-properties
+ (if (if (vector?
+ i-33248)
+ (if (=
(vector-length
+
i-33248)
+ 4)
+ (eq?
(vector-ref
+
i-33248
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ i-33248
+ 1)
+ i-33248))))
+ (if (pair? props-33334)
+ props-33334
+ #f))
+ #f
+ mod-32436
+ #f))
+ (lambda (type-33367
+ value-33368
+ form-33369
+ e-33370
+ w-33371
+ s-33372
+ mod-33373)
+ (expand-expr-4384
+ type-33367
+ value-33368
+ form-33369
+ e-33370
+ r*-33238
+ w-33371
+ s-33372
+ mod-33373)))
+ inits-33242)))))))
+ tmp-33244)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-35659))))
- (parse-body-34839
- req-35648
- opt-35649
- rest-35650
- (if (if aok-35656 aok-35656 (pair? out-35657))
- (cons aok-35656 (reverse out-35657))
+ tmp-33243))))
+ (parse-body-32442
+ req-33232
+ opt-33233
+ rest-33234
+ (if (if aok-33240 aok-33240 (pair? out-33241))
+ (cons aok-33240 (reverse out-33241))
#f)
- body-35652
- (reverse vars-35653)
- r*-35654
- w*-35655
- (reverse inits-35658)
+ body-33236
+ (reverse vars-33237)
+ r*-33238
+ w*-33239
+ (reverse inits-33242)
'()))))
- (parse-body-34839
- (lambda (req-35940
- opt-35941
- rest-35942
- kw-35943
- body-35944
- vars-35945
- r*-35946
- w*-35947
- inits-35948
- meta-35949)
- (let ((tmp-35951
- ($sc-dispatch body-35944 '(any any . each-any))))
- (if (if tmp-35951
+ (parse-body-32442
+ (lambda (req-33505
+ opt-33506
+ rest-33507
+ kw-33508
+ body-33509
+ vars-33510
+ r*-33511
+ w*-33512
+ inits-33513
+ meta-33514)
+ (let ((tmp-33516
+ ($sc-dispatch body-33509 '(any any . each-any))))
+ (if (if tmp-33516
(@apply
- (lambda (docstring-35955 e1-35956 e2-35957)
- (string? (syntax->datum docstring-35955)))
- tmp-35951)
+ (lambda (docstring-33520 e1-33521 e2-33522)
+ (string? (syntax->datum docstring-33520)))
+ tmp-33516)
#f)
(@apply
- (lambda (docstring-35958 e1-35959 e2-35960)
- (parse-body-34839
- req-35940
- opt-35941
- rest-35942
- kw-35943
- (cons e1-35959 e2-35960)
- vars-35945
- r*-35946
- w*-35947
- inits-35948
+ (lambda (docstring-33523 e1-33524 e2-33525)
+ (parse-body-32442
+ req-33505
+ opt-33506
+ rest-33507
+ kw-33508
+ (cons e1-33524 e2-33525)
+ vars-33510
+ r*-33511
+ w*-33512
+ inits-33513
(append
- meta-35949
+ meta-33514
(list (cons 'documentation
- (syntax->datum docstring-35958))))))
- tmp-35951)
- (let ((tmp-35961
+ (syntax->datum docstring-33523))))))
+ tmp-33516)
+ (let ((tmp-33526
($sc-dispatch
- body-35944
+ body-33509
'(#(vector #(each (any . any)))
any
.
each-any))))
- (if tmp-35961
+ (if tmp-33526
(@apply
- (lambda (k-35965 v-35966 e1-35967 e2-35968)
- (parse-body-34839
- req-35940
- opt-35941
- rest-35942
- kw-35943
- (cons e1-35967 e2-35968)
- vars-35945
- r*-35946
- w*-35947
- inits-35948
+ (lambda (k-33530 v-33531 e1-33532 e2-33533)
+ (parse-body-32442
+ req-33505
+ opt-33506
+ rest-33507
+ kw-33508
+ (cons e1-33532 e2-33533)
+ vars-33510
+ r*-33511
+ w*-33512
+ inits-33513
(append
- meta-35949
- (syntax->datum (map cons k-35965 v-35966)))))
- tmp-35961)
- (let ((tmp-35969
- ($sc-dispatch body-35944 '(any . each-any))))
- (if tmp-35969
+ meta-33514
+ (syntax->datum (map cons k-33530 v-33531)))))
+ tmp-33526)
+ (let ((tmp-33534
+ ($sc-dispatch body-33509 '(any . each-any))))
+ (if tmp-33534
(@apply
- (lambda (e1-35973 e2-35974)
+ (lambda (e1-33538 e2-33539)
(values
- meta-35949
- req-35940
- opt-35941
- rest-35942
- kw-35943
- inits-35948
- vars-35945
- (expand-body-4386
- (cons e1-35973 e2-35974)
- (let ((x-35986
+ meta-33514
+ req-33505
+ opt-33506
+ rest-33507
+ kw-33508
+ inits-33513
+ vars-33510
+ (expand-body-4387
+ (cons e1-33538 e2-33539)
+ (let ((x-33551
(begin
- (if (if (pair? e-34829)
- s-34832
+ (if (if s-32435
+
(supports-source-properties?
+ e-32432)
#f)
(set-source-properties!
- e-34829
- s-34832))
- e-34829)))
- (if (if (null? (car w-34831))
- (null? (cdr w-34831))
+ e-32432
+ s-32435))
+ e-32432)))
+ (if (if (null? (car w-32434))
+ (null? (cdr w-32434))
#f)
- x-35986
- (if (if (vector? x-35986)
- (if (= (vector-length x-35986) 4)
- (eq? (vector-ref x-35986 0)
+ x-33551
+ (if (if (vector? x-33551)
+ (if (= (vector-length x-33551) 4)
+ (eq? (vector-ref x-33551 0)
'syntax-object)
#f)
#f)
- (let ((expression-36018
- (vector-ref x-35986 1))
- (wrap-36019
- (let ((w2-36027
+ (let ((expression-33583
+ (vector-ref x-33551 1))
+ (wrap-33584
+ (let ((w2-33592
(vector-ref
- x-35986
+ x-33551
2)))
- (let ((m1-36028
- (car w-34831))
- (s1-36029
- (cdr w-34831)))
- (if (null? m1-36028)
- (if (null? s1-36029)
- w2-36027
- (cons (car w2-36027)
- (let ((m2-36044
- (cdr
w2-36027)))
- (if (null?
m2-36044)
- s1-36029
+ (let ((m1-33593
+ (car w-32434))
+ (s1-33594
+ (cdr w-32434)))
+ (if (null? m1-33593)
+ (if (null? s1-33594)
+ w2-33592
+ (cons (car w2-33592)
+ (let ((m2-33609
+ (cdr
w2-33592)))
+ (if (null?
m2-33609)
+ s1-33594
(append
- s1-36029
-
m2-36044)))))
- (cons (let ((m2-36052
- (car
w2-36027)))
- (if (null?
m2-36052)
- m1-36028
+ s1-33594
+
m2-33609)))))
+ (cons (let ((m2-33617
+ (car
w2-33592)))
+ (if (null?
m2-33617)
+ m1-33593
(append
- m1-36028
- m2-36052)))
- (let ((m2-36060
- (cdr
w2-36027)))
- (if (null?
m2-36060)
- s1-36029
+ m1-33593
+ m2-33617)))
+ (let ((m2-33625
+ (cdr
w2-33592)))
+ (if (null?
m2-33625)
+ s1-33594
(append
- s1-36029
-
m2-36060))))))))
- (module-36020
- (vector-ref x-35986 3)))
+ s1-33594
+
m2-33625))))))))
+ (module-33585
+ (vector-ref x-33551 3)))
(vector
'syntax-object
- expression-36018
- wrap-36019
- module-36020))
- (if (null? x-35986)
- x-35986
+ expression-33583
+ wrap-33584
+ module-33585))
+ (if (null? x-33551)
+ x-33551
(vector
'syntax-object
- x-35986
- w-34831
- mod-34833)))))
- r*-35946
- w*-35947
- mod-34833)))
- tmp-35969)
+ x-33551
+ w-32434
+ mod-32436)))))
+ r*-33511
+ w*-33512
+ mod-32436)))
+ tmp-33534)
(syntax-violation
#f
"source expression failed to match any pattern"
- body-35944))))))))))
- (let ((tmp-34841 ($sc-dispatch clauses-34835 '())))
- (if tmp-34841
- (@apply (lambda () (values '() #f)) tmp-34841)
- (let ((tmp-34845
+ body-33509))))))))))
+ (let ((tmp-32444 ($sc-dispatch clauses-32438 '())))
+ (if tmp-32444
+ (@apply (lambda () (values '() #f)) tmp-32444)
+ (let ((tmp-32448
($sc-dispatch
- clauses-34835
+ clauses-32438
'((any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-34845
+ (if tmp-32448
(@apply
- (lambda (args-34849
- e1-34850
- e2-34851
- args*-34852
- e1*-34853
- e2*-34854)
+ (lambda (args-32452
+ e1-32453
+ e2-32454
+ args*-32455
+ e1*-32456
+ e2*-32457)
(call-with-values
- (lambda () (get-formals-34834 args-34849))
- (lambda (req-34855 opt-34856 rest-34857 kw-34858)
+ (lambda () (get-formals-32437 args-32452))
+ (lambda (req-32458 opt-32459 rest-32460 kw-32461)
(call-with-values
(lambda ()
- (parse-req-34836
- req-34855
- opt-34856
- rest-34857
- kw-34858
- (cons e1-34850 e2-34851)))
- (lambda (meta-34925
- req-34926
- opt-34927
- rest-34928
- kw-34929
- inits-34930
- vars-34931
- body-34932)
+ (parse-req-32439
+ req-32458
+ opt-32459
+ rest-32460
+ kw-32461
+ (cons e1-32453 e2-32454)))
+ (lambda (meta-32528
+ req-32529
+ opt-32530
+ rest-32531
+ kw-32532
+ inits-32533
+ vars-32534
+ body-32535)
(call-with-values
(lambda ()
- (expand-lambda-case-4394
- e-34829
- r-34830
- w-34831
- s-34832
- mod-34833
- get-formals-34834
- (map (lambda (tmp-2859-34933
- tmp-2858-34934
- tmp-2857-34935)
- (cons tmp-2857-34935
- (cons tmp-2858-34934
- tmp-2859-34933)))
- e2*-34854
- e1*-34853
- args*-34852)))
- (lambda (meta*-34936 else*-34937)
+ (expand-lambda-case-4395
+ e-32432
+ r-32433
+ w-32434
+ s-32435
+ mod-32436
+ get-formals-32437
+ (map (lambda (tmp-2860-32536
+ tmp-2859-32537
+ tmp-2858-32538)
+ (cons tmp-2858-32538
+ (cons tmp-2859-32537
+ tmp-2860-32536)))
+ e2*-32457
+ e1*-32456
+ args*-32455)))
+ (lambda (meta*-32539 else*-32540)
(values
- (append meta-34925 meta*-34936)
+ (append meta-32528 meta*-32539)
(make-struct/no-tail
(vector-ref %expanded-vtables 15)
- s-34832
- req-34926
- opt-34927
- rest-34928
- kw-34929
- inits-34930
- vars-34931
- body-34932
- else*-34937)))))))))
- tmp-34845)
+ s-32435
+ req-32529
+ opt-32530
+ rest-32531
+ kw-32532
+ inits-32533
+ vars-32534
+ body-32535
+ else*-32540)))))))))
+ tmp-32448)
(syntax-violation
#f
"source expression failed to match any pattern"
- clauses-34835))))))))
- (strip-4395
- (lambda (x-36087 w-36088)
- (if (memq 'top (car w-36088))
- x-36087
+ clauses-32438))))))))
+ (strip-4396
+ (lambda (x-33652 w-33653)
+ (if (memq 'top (car w-33653))
+ x-33652
(letrec*
- ((f-36089
- (lambda (x-36092)
- (if (if (vector? x-36092)
- (if (= (vector-length x-36092) 4)
- (eq? (vector-ref x-36092 0) 'syntax-object)
+ ((f-33654
+ (lambda (x-33657)
+ (if (if (vector? x-33657)
+ (if (= (vector-length x-33657) 4)
+ (eq? (vector-ref x-33657 0) 'syntax-object)
#f)
#f)
- (strip-4395
- (vector-ref x-36092 1)
- (vector-ref x-36092 2))
- (if (pair? x-36092)
- (let ((a-36111 (f-36089 (car x-36092)))
- (d-36112 (f-36089 (cdr x-36092))))
- (if (if (eq? a-36111 (car x-36092))
- (eq? d-36112 (cdr x-36092))
+ (strip-4396
+ (vector-ref x-33657 1)
+ (vector-ref x-33657 2))
+ (if (pair? x-33657)
+ (let ((a-33676 (f-33654 (car x-33657)))
+ (d-33677 (f-33654 (cdr x-33657))))
+ (if (if (eq? a-33676 (car x-33657))
+ (eq? d-33677 (cdr x-33657))
#f)
- x-36092
- (cons a-36111 d-36112)))
- (if (vector? x-36092)
- (let ((old-36115 (vector->list x-36092)))
- (let ((new-36116 (map f-36089 old-36115)))
+ x-33657
+ (cons a-33676 d-33677)))
+ (if (vector? x-33657)
+ (let ((old-33680 (vector->list x-33657)))
+ (let ((new-33681 (map f-33654 old-33680)))
(letrec*
- ((lp-36117
- (lambda (l1-36214 l2-36215)
- (if (null? l1-36214)
- x-36092
- (if (eq? (car l1-36214) (car l2-36215))
- (lp-36117 (cdr l1-36214) (cdr l2-36215))
- (list->vector new-36116))))))
- (lp-36117 old-36115 new-36116))))
- x-36092))))))
- (f-36089 x-36087)))))
- (gen-var-4396
- (lambda (id-34981)
- (let ((id-34982
- (if (if (vector? id-34981)
- (if (= (vector-length id-34981) 4)
- (eq? (vector-ref id-34981 0) 'syntax-object)
+ ((lp-33682
+ (lambda (l1-33779 l2-33780)
+ (if (null? l1-33779)
+ x-33657
+ (if (eq? (car l1-33779) (car l2-33780))
+ (lp-33682 (cdr l1-33779) (cdr l2-33780))
+ (list->vector new-33681))))))
+ (lp-33682 old-33680 new-33681))))
+ x-33657))))))
+ (f-33654 x-33652)))))
+ (gen-var-4397
+ (lambda (id-32584)
+ (let ((id-32585
+ (if (if (vector? id-32584)
+ (if (= (vector-length id-32584) 4)
+ (eq? (vector-ref id-32584 0) 'syntax-object)
#f)
#f)
- (vector-ref id-34981 1)
- id-34981)))
+ (vector-ref id-32584 1)
+ id-32584)))
(gensym
- (string-append (symbol->string id-34982) "-")))))
- (lambda-var-list-4397
- (lambda (vars-36216)
+ (string-append (symbol->string id-32585) "-")))))
+ (lambda-var-list-4398
+ (lambda (vars-33781)
(letrec*
- ((lvl-36217
- (lambda (vars-36220 ls-36221 w-36222)
- (if (pair? vars-36220)
- (lvl-36217
- (cdr vars-36220)
- (cons (let ((x-36226 (car vars-36220)))
- (if (if (null? (car w-36222))
- (null? (cdr w-36222))
+ ((lvl-33782
+ (lambda (vars-33785 ls-33786 w-33787)
+ (if (pair? vars-33785)
+ (lvl-33782
+ (cdr vars-33785)
+ (cons (let ((x-33791 (car vars-33785)))
+ (if (if (null? (car w-33787))
+ (null? (cdr w-33787))
#f)
- x-36226
- (if (if (vector? x-36226)
- (if (= (vector-length x-36226) 4)
- (eq? (vector-ref x-36226 0)
+ x-33791
+ (if (if (vector? x-33791)
+ (if (= (vector-length x-33791) 4)
+ (eq? (vector-ref x-33791 0)
'syntax-object)
#f)
#f)
- (let ((expression-36244 (vector-ref x-36226 1))
- (wrap-36245
- (let ((w2-36253
- (vector-ref x-36226 2)))
- (let ((m1-36254 (car w-36222))
- (s1-36255 (cdr w-36222)))
- (if (null? m1-36254)
- (if (null? s1-36255)
- w2-36253
- (cons (car w2-36253)
- (let ((m2-36270
- (cdr w2-36253)))
- (if (null? m2-36270)
- s1-36255
+ (let ((expression-33809 (vector-ref x-33791 1))
+ (wrap-33810
+ (let ((w2-33818
+ (vector-ref x-33791 2)))
+ (let ((m1-33819 (car w-33787))
+ (s1-33820 (cdr w-33787)))
+ (if (null? m1-33819)
+ (if (null? s1-33820)
+ w2-33818
+ (cons (car w2-33818)
+ (let ((m2-33835
+ (cdr w2-33818)))
+ (if (null? m2-33835)
+ s1-33820
(append
- s1-36255
- m2-36270)))))
- (cons (let ((m2-36278
- (car w2-36253)))
- (if (null? m2-36278)
- m1-36254
+ s1-33820
+ m2-33835)))))
+ (cons (let ((m2-33843
+ (car w2-33818)))
+ (if (null? m2-33843)
+ m1-33819
(append
- m1-36254
- m2-36278)))
- (let ((m2-36286
- (cdr w2-36253)))
- (if (null? m2-36286)
- s1-36255
+ m1-33819
+ m2-33843)))
+ (let ((m2-33851
+ (cdr w2-33818)))
+ (if (null? m2-33851)
+ s1-33820
(append
- s1-36255
- m2-36286))))))))
- (module-36246 (vector-ref x-36226 3)))
+ s1-33820
+ m2-33851))))))))
+ (module-33811 (vector-ref x-33791 3)))
(vector
'syntax-object
- expression-36244
- wrap-36245
- module-36246))
- (if (null? x-36226)
- x-36226
+ expression-33809
+ wrap-33810
+ module-33811))
+ (if (null? x-33791)
+ x-33791
(vector
'syntax-object
- x-36226
- w-36222
+ x-33791
+ w-33787
#f)))))
- ls-36221)
- w-36222)
- (if (if (symbol? vars-36220)
+ ls-33786)
+ w-33787)
+ (if (if (symbol? vars-33785)
#t
- (if (if (vector? vars-36220)
- (if (= (vector-length vars-36220) 4)
- (eq? (vector-ref vars-36220 0) 'syntax-object)
+ (if (if (vector? vars-33785)
+ (if (= (vector-length vars-33785) 4)
+ (eq? (vector-ref vars-33785 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref vars-36220 1))
+ (symbol? (vector-ref vars-33785 1))
#f))
- (cons (if (if (null? (car w-36222))
- (null? (cdr w-36222))
+ (cons (if (if (null? (car w-33787))
+ (null? (cdr w-33787))
#f)
- vars-36220
- (if (if (vector? vars-36220)
- (if (= (vector-length vars-36220) 4)
- (eq? (vector-ref vars-36220 0)
+ vars-33785
+ (if (if (vector? vars-33785)
+ (if (= (vector-length vars-33785) 4)
+ (eq? (vector-ref vars-33785 0)
'syntax-object)
#f)
#f)
- (let ((expression-36356
- (vector-ref vars-36220 1))
- (wrap-36357
- (let ((w2-36367
- (vector-ref vars-36220 2)))
- (let ((m1-36368 (car w-36222))
- (s1-36369 (cdr w-36222)))
- (if (null? m1-36368)
- (if (null? s1-36369)
- w2-36367
- (cons (car w2-36367)
- (let ((m2-36386
- (cdr w2-36367)))
- (if (null? m2-36386)
- s1-36369
+ (let ((expression-33921
+ (vector-ref vars-33785 1))
+ (wrap-33922
+ (let ((w2-33932
+ (vector-ref vars-33785 2)))
+ (let ((m1-33933 (car w-33787))
+ (s1-33934 (cdr w-33787)))
+ (if (null? m1-33933)
+ (if (null? s1-33934)
+ w2-33932
+ (cons (car w2-33932)
+ (let ((m2-33951
+ (cdr w2-33932)))
+ (if (null? m2-33951)
+ s1-33934
(append
- s1-36369
- m2-36386)))))
- (cons (let ((m2-36394
- (car w2-36367)))
- (if (null? m2-36394)
- m1-36368
+ s1-33934
+ m2-33951)))))
+ (cons (let ((m2-33959
+ (car w2-33932)))
+ (if (null? m2-33959)
+ m1-33933
(append
- m1-36368
- m2-36394)))
- (let ((m2-36402
- (cdr w2-36367)))
- (if (null? m2-36402)
- s1-36369
+ m1-33933
+ m2-33959)))
+ (let ((m2-33967
+ (cdr w2-33932)))
+ (if (null? m2-33967)
+ s1-33934
(append
- s1-36369
- m2-36402))))))))
- (module-36358 (vector-ref vars-36220 3)))
+ s1-33934
+ m2-33967))))))))
+ (module-33923 (vector-ref vars-33785 3)))
(vector
'syntax-object
- expression-36356
- wrap-36357
- module-36358))
- (if (null? vars-36220)
- vars-36220
+ expression-33921
+ wrap-33922
+ module-33923))
+ (if (null? vars-33785)
+ vars-33785
(vector
'syntax-object
- vars-36220
- w-36222
+ vars-33785
+ w-33787
#f))))
- ls-36221)
- (if (null? vars-36220)
- ls-36221
- (if (if (vector? vars-36220)
- (if (= (vector-length vars-36220) 4)
- (eq? (vector-ref vars-36220 0) 'syntax-object)
+ ls-33786)
+ (if (null? vars-33785)
+ ls-33786
+ (if (if (vector? vars-33785)
+ (if (= (vector-length vars-33785) 4)
+ (eq? (vector-ref vars-33785 0) 'syntax-object)
#f)
#f)
- (lvl-36217
- (vector-ref vars-36220 1)
- ls-36221
- (let ((w2-36443 (vector-ref vars-36220 2)))
- (let ((m1-36444 (car w-36222))
- (s1-36445 (cdr w-36222)))
- (if (null? m1-36444)
- (if (null? s1-36445)
- w2-36443
- (cons (car w2-36443)
- (let ((m2-36456 (cdr w2-36443)))
- (if (null? m2-36456)
- s1-36445
- (append s1-36445 m2-36456)))))
- (cons (let ((m2-36464 (car w2-36443)))
- (if (null? m2-36464)
- m1-36444
- (append m1-36444 m2-36464)))
- (let ((m2-36472 (cdr w2-36443)))
- (if (null? m2-36472)
- s1-36445
- (append s1-36445 m2-36472))))))))
- (cons vars-36220 ls-36221))))))))
- (lvl-36217 vars-36216 '() '(()))))))
+ (lvl-33782
+ (vector-ref vars-33785 1)
+ ls-33786
+ (let ((w2-34008 (vector-ref vars-33785 2)))
+ (let ((m1-34009 (car w-33787))
+ (s1-34010 (cdr w-33787)))
+ (if (null? m1-34009)
+ (if (null? s1-34010)
+ w2-34008
+ (cons (car w2-34008)
+ (let ((m2-34021 (cdr w2-34008)))
+ (if (null? m2-34021)
+ s1-34010
+ (append s1-34010 m2-34021)))))
+ (cons (let ((m2-34029 (car w2-34008)))
+ (if (null? m2-34029)
+ m1-34009
+ (append m1-34009 m2-34029)))
+ (let ((m2-34037 (cdr w2-34008)))
+ (if (null? m2-34037)
+ s1-34010
+ (append s1-34010 m2-34037))))))))
+ (cons vars-33785 ls-33786))))))))
+ (lvl-33782 vars-33781 '() '(()))))))
(begin
- (set! session-id-4307
- (let ((v-18915
+ (lambda (x-17960) (vector-ref x-17960 3))
+ (set! session-id-4308
+ (let ((v-17746
(module-variable
(current-module)
'syntax-session-id)))
- (lambda () ((variable-ref v-18915)))))
- (set! transformer-environment-4368
+ (lambda () ((variable-ref v-17746)))))
+ (set! transformer-environment-4369
(make-fluid
- (lambda (k-17548)
+ (lambda (k-16379)
(error "called outside the dynamic extent of a syntax
transformer"))))
(module-define!
(current-module)
@@ -9341,49 +10203,50 @@
'let-syntax
'local-syntax
#f))
- (global-extend-4344
+ (global-extend-4345
'core
'syntax-parameterize
- (lambda (e-4524 r-4525 w-4526 s-4527 mod-4528)
- (let ((tmp-4530
+ (lambda (e-4525 r-4526 w-4527 s-4528 mod-4529)
+ (let ((tmp-4531
($sc-dispatch
- e-4524
+ e-4525
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-4530
+ (if (if tmp-4531
(@apply
- (lambda (var-4534 val-4535 e1-4536 e2-4537)
- (valid-bound-ids?-4372 var-4534))
- tmp-4530)
+ (lambda (var-4535 val-4536 e1-4537 e2-4538)
+ (valid-bound-ids?-4373 var-4535))
+ tmp-4531)
#f)
(@apply
- (lambda (var-4622 val-4623 e1-4624 e2-4625)
- (let ((names-4626
+ (lambda (var-4623 val-4624 e1-4625 e2-4626)
+ (let ((names-4627
(map (lambda (x-4971)
(call-with-values
(lambda ()
- (resolve-identifier-4367
+ (resolve-identifier-4368
x-4971
- w-4526
- r-4525
- mod-4528
+ w-4527
+ r-4526
+ mod-4529
#f))
(lambda (type-4974 value-4975 mod-4976)
(if (eqv? type-4974 'displaced-lexical)
(syntax-violation
'syntax-parameterize
"identifier out of context"
- e-4524
+ e-4525
(let ((x-4993
(begin
- (if (if (pair? x-4971)
- s-4527
+ (if (if s-4528
+
(supports-source-properties?
+ x-4971)
#f)
(set-source-properties!
x-4971
- s-4527))
+ s-4528))
x-4971)))
- (if (if (null? (car w-4526))
- (null? (cdr w-4526))
+ (if (if (null? (car w-4527))
+ (null? (cdr w-4527))
#f)
x-4993
(if (if (vector? x-4993)
@@ -9402,9 +10265,9 @@
x-4993
2)))
(let ((m1-5035
- (car w-4526))
+ (car w-4527))
(s1-5036
- (cdr w-4526)))
+ (cdr w-4527)))
(if (null? m1-5035)
(if (null?
s1-5036)
w2-5034
@@ -9442,25 +10305,26 @@
(vector
'syntax-object
x-4993
- w-4526
+ w-4527
mod-4976))))))
(if (eqv? type-4974 'syntax-parameter)
value-4975
(syntax-violation
'syntax-parameterize
"invalid syntax parameter"
- e-4524
+ e-4525
(let ((x-5097
(begin
- (if (if (pair? x-4971)
- s-4527
+ (if (if s-4528
+
(supports-source-properties?
+ x-4971)
#f)
(set-source-properties!
x-4971
- s-4527))
+ s-4528))
x-4971)))
- (if (if (null? (car w-4526))
- (null? (cdr w-4526))
+ (if (if (null? (car w-4527))
+ (null? (cdr w-4527))
#f)
x-5097
(if (if (vector? x-5097)
@@ -9481,9 +10345,9 @@
x-5097
2)))
(let ((m1-5139
- (car
w-4526))
+ (car
w-4527))
(s1-5140
- (cdr
w-4526)))
+ (cdr
w-4527)))
(if (null?
m1-5139)
(if (null?
s1-5140)
w2-5138
@@ -9523,2208 +10387,2650 @@
(vector
'syntax-object
x-5097
- w-4526
+ w-4527
mod-4976)))))))))))
- var-4622))
- (bindings-4627
- (let ((trans-r-5186 (macros-only-env-4343 r-4525)))
+ var-4623))
+ (bindings-4628
+ (let ((trans-r-5186 (macros-only-env-4344 r-4526)))
(map (lambda (x-5187)
(cons 'macro
- (eval-local-transformer-4388
- (expand-4382
- x-5187
- trans-r-5186
- w-4526
- mod-4528)
- mod-4528)))
- val-4623))))
- (expand-body-4386
- (cons e1-4624 e2-4625)
- (let ((x-4639
+ (eval-local-transformer-4389
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ x-5187
+ trans-r-5186
+ w-4527
+ (let ((props-5250
+ (source-properties
+ (if (if (vector?
+ x-5187)
+ (if (=
(vector-length
+
x-5187)
+ 4)
+ (eq?
(vector-ref
+
x-5187
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ x-5187
+ 1)
+ x-5187))))
+ (if (pair? props-5250)
+ props-5250
+ #f))
+ #f
+ mod-4529
+ #f))
+ (lambda (type-5283
+ value-5284
+ form-5285
+ e-5286
+ w-5287
+ s-5288
+ mod-5289)
+ (expand-expr-4384
+ type-5283
+ value-5284
+ form-5285
+ e-5286
+ trans-r-5186
+ w-5287
+ s-5288
+ mod-5289)))
+ mod-4529)))
+ val-4624))))
+ (expand-body-4387
+ (cons e1-4625 e2-4626)
+ (let ((x-4640
(begin
- (if (if (pair? e-4524) s-4527 #f)
- (set-source-properties! e-4524 s-4527))
- e-4524)))
- (if (if (null? (car w-4526)) (null? (cdr w-4526)) #f)
- x-4639
- (if (if (vector? x-4639)
- (if (= (vector-length x-4639) 4)
- (eq? (vector-ref x-4639 0) 'syntax-object)
+ (if (if s-4528
+ (supports-source-properties? e-4525)
+ #f)
+ (set-source-properties! e-4525 s-4528))
+ e-4525)))
+ (if (if (null? (car w-4527)) (null? (cdr w-4527)) #f)
+ x-4640
+ (if (if (vector? x-4640)
+ (if (= (vector-length x-4640) 4)
+ (eq? (vector-ref x-4640 0) 'syntax-object)
#f)
#f)
- (let ((expression-4671 (vector-ref x-4639 1))
- (wrap-4672
- (let ((w2-4680 (vector-ref x-4639 2)))
- (let ((m1-4681 (car w-4526))
- (s1-4682 (cdr w-4526)))
- (if (null? m1-4681)
- (if (null? s1-4682)
- w2-4680
- (cons (car w2-4680)
- (let ((m2-4697
- (cdr w2-4680)))
- (if (null? m2-4697)
- s1-4682
+ (let ((expression-4672 (vector-ref x-4640 1))
+ (wrap-4673
+ (let ((w2-4681 (vector-ref x-4640 2)))
+ (let ((m1-4682 (car w-4527))
+ (s1-4683 (cdr w-4527)))
+ (if (null? m1-4682)
+ (if (null? s1-4683)
+ w2-4681
+ (cons (car w2-4681)
+ (let ((m2-4698
+ (cdr w2-4681)))
+ (if (null? m2-4698)
+ s1-4683
(append
- s1-4682
- m2-4697)))))
- (cons (let ((m2-4705 (car w2-4680)))
- (if (null? m2-4705)
- m1-4681
- (append m1-4681 m2-4705)))
- (let ((m2-4713 (cdr w2-4680)))
- (if (null? m2-4713)
- s1-4682
+ s1-4683
+ m2-4698)))))
+ (cons (let ((m2-4706 (car w2-4681)))
+ (if (null? m2-4706)
+ m1-4682
+ (append m1-4682 m2-4706)))
+ (let ((m2-4714 (cdr w2-4681)))
+ (if (null? m2-4714)
+ s1-4683
(append
- s1-4682
- m2-4713))))))))
- (module-4673 (vector-ref x-4639 3)))
+ s1-4683
+ m2-4714))))))))
+ (module-4674 (vector-ref x-4640 3)))
(vector
'syntax-object
- expression-4671
- wrap-4672
- module-4673))
- (if (null? x-4639)
- x-4639
+ expression-4672
+ wrap-4673
+ module-4674))
+ (if (null? x-4640)
+ x-4640
(vector
'syntax-object
- x-4639
- w-4526
- mod-4528)))))
- (extend-env-4341 names-4626 bindings-4627 r-4525)
- w-4526
- mod-4528)))
- tmp-4530)
+ x-4640
+ w-4527
+ mod-4529)))))
+ (extend-env-4342 names-4627 bindings-4628 r-4526)
+ w-4527
+ mod-4529)))
+ tmp-4531)
(syntax-violation
'syntax-parameterize
"bad syntax"
- (let ((x-5407
+ (let ((x-5388
(begin
- (if (if (pair? e-4524) s-4527 #f)
- (set-source-properties! e-4524 s-4527))
- e-4524)))
- (if (if (null? (car w-4526)) (null? (cdr w-4526)) #f)
- x-5407
- (if (if (vector? x-5407)
- (if (= (vector-length x-5407) 4)
- (eq? (vector-ref x-5407 0) 'syntax-object)
+ (if (if s-4528
+ (supports-source-properties? e-4525)
+ #f)
+ (set-source-properties! e-4525 s-4528))
+ e-4525)))
+ (if (if (null? (car w-4527)) (null? (cdr w-4527)) #f)
+ x-5388
+ (if (if (vector? x-5388)
+ (if (= (vector-length x-5388) 4)
+ (eq? (vector-ref x-5388 0) 'syntax-object)
#f)
#f)
- (let ((expression-5439 (vector-ref x-5407 1))
- (wrap-5440
- (let ((w2-5448 (vector-ref x-5407 2)))
- (let ((m1-5449 (car w-4526))
- (s1-5450 (cdr w-4526)))
- (if (null? m1-5449)
- (if (null? s1-5450)
- w2-5448
- (cons (car w2-5448)
- (let ((m2-5465 (cdr w2-5448)))
- (if (null? m2-5465)
- s1-5450
- (append s1-5450 m2-5465)))))
- (cons (let ((m2-5473 (car w2-5448)))
- (if (null? m2-5473)
- m1-5449
- (append m1-5449 m2-5473)))
- (let ((m2-5481 (cdr w2-5448)))
- (if (null? m2-5481)
- s1-5450
- (append s1-5450 m2-5481))))))))
- (module-5441 (vector-ref x-5407 3)))
+ (let ((expression-5420 (vector-ref x-5388 1))
+ (wrap-5421
+ (let ((w2-5429 (vector-ref x-5388 2)))
+ (let ((m1-5430 (car w-4527))
+ (s1-5431 (cdr w-4527)))
+ (if (null? m1-5430)
+ (if (null? s1-5431)
+ w2-5429
+ (cons (car w2-5429)
+ (let ((m2-5446 (cdr w2-5429)))
+ (if (null? m2-5446)
+ s1-5431
+ (append s1-5431 m2-5446)))))
+ (cons (let ((m2-5454 (car w2-5429)))
+ (if (null? m2-5454)
+ m1-5430
+ (append m1-5430 m2-5454)))
+ (let ((m2-5462 (cdr w2-5429)))
+ (if (null? m2-5462)
+ s1-5431
+ (append s1-5431 m2-5462))))))))
+ (module-5422 (vector-ref x-5388 3)))
(vector
'syntax-object
- expression-5439
- wrap-5440
- module-5441))
- (if (null? x-5407)
- x-5407
- (vector 'syntax-object x-5407 w-4526 mod-4528))))))))))
+ expression-5420
+ wrap-5421
+ module-5422))
+ (if (null? x-5388)
+ x-5388
+ (vector 'syntax-object x-5388 w-4527 mod-4529))))))))))
(module-define!
(current-module)
'quote
(make-syntax-transformer
'quote
'core
- (lambda (e-5509 r-5510 w-5511 s-5512 mod-5513)
- (let ((tmp-5515 ($sc-dispatch e-5509 '(_ any))))
- (if tmp-5515
+ (lambda (e-5490 r-5491 w-5492 s-5493 mod-5494)
+ (let ((tmp-5496 ($sc-dispatch e-5490 '(_ any))))
+ (if tmp-5496
(@apply
- (lambda (e-5518)
- (let ((exp-5522 (strip-4395 e-5518 w-5511)))
+ (lambda (e-5499)
+ (let ((exp-5503 (strip-4396 e-5499 w-5492)))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
- s-5512
- exp-5522)))
- tmp-5515)
+ s-5493
+ exp-5503)))
+ tmp-5496)
(syntax-violation
'quote
"bad syntax"
- (let ((x-5536
+ (let ((x-5517
(begin
- (if (if (pair? e-5509) s-5512 #f)
- (set-source-properties! e-5509 s-5512))
- e-5509)))
- (if (if (null? (car w-5511)) (null? (cdr w-5511)) #f)
- x-5536
- (if (if (vector? x-5536)
- (if (= (vector-length x-5536) 4)
- (eq? (vector-ref x-5536 0) 'syntax-object)
+ (if (if s-5493
+ (supports-source-properties? e-5490)
+ #f)
+ (set-source-properties! e-5490 s-5493))
+ e-5490)))
+ (if (if (null? (car w-5492)) (null? (cdr w-5492)) #f)
+ x-5517
+ (if (if (vector? x-5517)
+ (if (= (vector-length x-5517) 4)
+ (eq? (vector-ref x-5517 0) 'syntax-object)
#f)
#f)
- (let ((expression-5568 (vector-ref x-5536 1))
- (wrap-5569
- (let ((w2-5577 (vector-ref x-5536 2)))
- (let ((m1-5578 (car w-5511))
- (s1-5579 (cdr w-5511)))
- (if (null? m1-5578)
- (if (null? s1-5579)
- w2-5577
- (cons (car w2-5577)
- (let ((m2-5594 (cdr w2-5577)))
- (if (null? m2-5594)
- s1-5579
- (append s1-5579 m2-5594)))))
- (cons (let ((m2-5602 (car w2-5577)))
- (if (null? m2-5602)
- m1-5578
- (append m1-5578 m2-5602)))
- (let ((m2-5610 (cdr w2-5577)))
- (if (null? m2-5610)
- s1-5579
- (append s1-5579 m2-5610))))))))
- (module-5570 (vector-ref x-5536 3)))
+ (let ((expression-5549 (vector-ref x-5517 1))
+ (wrap-5550
+ (let ((w2-5558 (vector-ref x-5517 2)))
+ (let ((m1-5559 (car w-5492))
+ (s1-5560 (cdr w-5492)))
+ (if (null? m1-5559)
+ (if (null? s1-5560)
+ w2-5558
+ (cons (car w2-5558)
+ (let ((m2-5575 (cdr w2-5558)))
+ (if (null? m2-5575)
+ s1-5560
+ (append s1-5560 m2-5575)))))
+ (cons (let ((m2-5583 (car w2-5558)))
+ (if (null? m2-5583)
+ m1-5559
+ (append m1-5559 m2-5583)))
+ (let ((m2-5591 (cdr w2-5558)))
+ (if (null? m2-5591)
+ s1-5560
+ (append s1-5560 m2-5591))))))))
+ (module-5551 (vector-ref x-5517 3)))
(vector
'syntax-object
- expression-5568
- wrap-5569
- module-5570))
- (if (null? x-5536)
- x-5536
+ expression-5549
+ wrap-5550
+ module-5551))
+ (if (null? x-5517)
+ x-5517
(vector
'syntax-object
- x-5536
- w-5511
- mod-5513)))))))))))
- (global-extend-4344
+ x-5517
+ w-5492
+ mod-5494)))))))))))
+ (global-extend-4345
'core
'syntax
(letrec*
- ((gen-syntax-5829
- (lambda (src-6260
- e-6261
- r-6262
- maps-6263
- ellipsis?-6264
- mod-6265)
- (if (if (symbol? e-6261)
+ ((gen-syntax-5810
+ (lambda (src-6241
+ e-6242
+ r-6243
+ maps-6244
+ ellipsis?-6245
+ mod-6246)
+ (if (if (symbol? e-6242)
#t
- (if (if (vector? e-6261)
- (if (= (vector-length e-6261) 4)
- (eq? (vector-ref e-6261 0) 'syntax-object)
+ (if (if (vector? e-6242)
+ (if (= (vector-length e-6242) 4)
+ (eq? (vector-ref e-6242 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref e-6261 1))
+ (symbol? (vector-ref e-6242 1))
#f))
(call-with-values
(lambda ()
- (resolve-identifier-4367
- e-6261
+ (resolve-identifier-4368
+ e-6242
'(())
- r-6262
- mod-6265
+ r-6243
+ mod-6246
#f))
- (lambda (type-6294 value-6295 mod-6296)
- (if (eqv? type-6294 'syntax)
+ (lambda (type-6275 value-6276 mod-6277)
+ (if (eqv? type-6275 'syntax)
(call-with-values
(lambda ()
- (gen-ref-5830
- src-6260
- (car value-6295)
- (cdr value-6295)
- maps-6263))
- (lambda (var-6304 maps-6305)
- (values (list 'ref var-6304) maps-6305)))
- (if (ellipsis?-6264 e-6261)
+ (gen-ref-5811
+ src-6241
+ (car value-6276)
+ (cdr value-6276)
+ maps-6244))
+ (lambda (var-6285 maps-6286)
+ (values (list 'ref var-6285) maps-6286)))
+ (if (ellipsis?-6245 e-6242)
(syntax-violation
'syntax
"misplaced ellipsis"
- src-6260)
- (values (list 'quote e-6261) maps-6263)))))
- (let ((tmp-6307 ($sc-dispatch e-6261 '(any any))))
- (if (if tmp-6307
+ src-6241)
+ (values (list 'quote e-6242) maps-6244)))))
+ (let ((tmp-6288 ($sc-dispatch e-6242 '(any any))))
+ (if (if tmp-6288
(@apply
- (lambda (dots-6311 e-6312)
- (ellipsis?-6264 dots-6311))
- tmp-6307)
+ (lambda (dots-6292 e-6293)
+ (ellipsis?-6245 dots-6292))
+ tmp-6288)
#f)
(@apply
- (lambda (dots-6313 e-6314)
- (gen-syntax-5829
- src-6260
- e-6314
- r-6262
- maps-6263
- (lambda (x-6315) #f)
- mod-6265))
- tmp-6307)
- (let ((tmp-6316 ($sc-dispatch e-6261 '(any any . any))))
- (if (if tmp-6316
+ (lambda (dots-6294 e-6295)
+ (gen-syntax-5810
+ src-6241
+ e-6295
+ r-6243
+ maps-6244
+ (lambda (x-6296) #f)
+ mod-6246))
+ tmp-6288)
+ (let ((tmp-6297 ($sc-dispatch e-6242 '(any any . any))))
+ (if (if tmp-6297
(@apply
- (lambda (x-6320 dots-6321 y-6322)
- (ellipsis?-6264 dots-6321))
- tmp-6316)
+ (lambda (x-6301 dots-6302 y-6303)
+ (ellipsis?-6245 dots-6302))
+ tmp-6297)
#f)
(@apply
- (lambda (x-6323 dots-6324 y-6325)
+ (lambda (x-6304 dots-6305 y-6306)
(letrec*
- ((f-6326
- (lambda (y-6334 k-6335)
- (let ((tmp-6337
+ ((f-6307
+ (lambda (y-6315 k-6316)
+ (let ((tmp-6318
($sc-dispatch
- y-6334
+ y-6315
'(any . any))))
- (if (if tmp-6337
+ (if (if tmp-6318
(@apply
- (lambda (dots-6341 y-6342)
- (ellipsis?-6264 dots-6341))
- tmp-6337)
+ (lambda (dots-6322 y-6323)
+ (ellipsis?-6245 dots-6322))
+ tmp-6318)
#f)
(@apply
- (lambda (dots-6343 y-6344)
- (f-6326
- y-6344
- (lambda (maps-6345)
+ (lambda (dots-6324 y-6325)
+ (f-6307
+ y-6325
+ (lambda (maps-6326)
(call-with-values
(lambda ()
- (k-6335
- (cons '() maps-6345)))
- (lambda (x-6346 maps-6347)
- (if (null? (car maps-6347))
+ (k-6316
+ (cons '() maps-6326)))
+ (lambda (x-6327 maps-6328)
+ (if (null? (car maps-6328))
(syntax-violation
'syntax
"extra ellipsis"
- src-6260)
+ src-6241)
(values
- (let ((map-env-6351
- (car
maps-6347)))
+ (let ((map-env-6332
+ (car
maps-6328)))
(list 'apply
'(primitive
append)
- (gen-map-5832
- x-6346
-
map-env-6351)))
- (cdr maps-6347))))))))
- tmp-6337)
+ (gen-map-5813
+ x-6327
+
map-env-6332)))
+ (cdr maps-6328))))))))
+ tmp-6318)
(call-with-values
(lambda ()
- (gen-syntax-5829
- src-6260
- y-6334
- r-6262
- maps-6263
- ellipsis?-6264
- mod-6265))
- (lambda (y-6354 maps-6355)
+ (gen-syntax-5810
+ src-6241
+ y-6315
+ r-6243
+ maps-6244
+ ellipsis?-6245
+ mod-6246))
+ (lambda (y-6335 maps-6336)
(call-with-values
- (lambda () (k-6335 maps-6355))
- (lambda (x-6356 maps-6357)
+ (lambda () (k-6316 maps-6336))
+ (lambda (x-6337 maps-6338)
(values
- (if (equal? y-6354 ''())
- x-6356
+ (if (equal? y-6335 ''())
+ x-6337
(list 'append
- x-6356
- y-6354))
- maps-6357))))))))))
- (f-6326
- y-6325
- (lambda (maps-6329)
+ x-6337
+ y-6335))
+ maps-6338))))))))))
+ (f-6307
+ y-6306
+ (lambda (maps-6310)
(call-with-values
(lambda ()
- (gen-syntax-5829
- src-6260
- x-6323
- r-6262
- (cons '() maps-6329)
- ellipsis?-6264
- mod-6265))
- (lambda (x-6330 maps-6331)
- (if (null? (car maps-6331))
+ (gen-syntax-5810
+ src-6241
+ x-6304
+ r-6243
+ (cons '() maps-6310)
+ ellipsis?-6245
+ mod-6246))
+ (lambda (x-6311 maps-6312)
+ (if (null? (car maps-6312))
(syntax-violation
'syntax
"extra ellipsis"
- src-6260)
+ src-6241)
(values
- (gen-map-5832
- x-6330
- (car maps-6331))
- (cdr maps-6331)))))))))
- tmp-6316)
- (let ((tmp-6373 ($sc-dispatch e-6261 '(any . any))))
- (if tmp-6373
+ (gen-map-5813
+ x-6311
+ (car maps-6312))
+ (cdr maps-6312)))))))))
+ tmp-6297)
+ (let ((tmp-6354 ($sc-dispatch e-6242 '(any . any))))
+ (if tmp-6354
(@apply
- (lambda (x-6377 y-6378)
+ (lambda (x-6358 y-6359)
(call-with-values
(lambda ()
- (gen-syntax-5829
- src-6260
- x-6377
- r-6262
- maps-6263
- ellipsis?-6264
- mod-6265))
- (lambda (x-6379 maps-6380)
+ (gen-syntax-5810
+ src-6241
+ x-6358
+ r-6243
+ maps-6244
+ ellipsis?-6245
+ mod-6246))
+ (lambda (x-6360 maps-6361)
(call-with-values
(lambda ()
- (gen-syntax-5829
- src-6260
- y-6378
- r-6262
- maps-6380
- ellipsis?-6264
- mod-6265))
- (lambda (y-6381 maps-6382)
+ (gen-syntax-5810
+ src-6241
+ y-6359
+ r-6243
+ maps-6361
+ ellipsis?-6245
+ mod-6246))
+ (lambda (y-6362 maps-6363)
(values
- (let ((key-6387 (car y-6381)))
- (if (eqv? key-6387 'quote)
- (if (eq? (car x-6379) 'quote)
+ (let ((key-6368 (car y-6362)))
+ (if (eqv? key-6368 'quote)
+ (if (eq? (car x-6360) 'quote)
(list 'quote
- (cons (car (cdr x-6379))
- (car (cdr
y-6381))))
- (if (eq? (car (cdr y-6381))
+ (cons (car (cdr x-6360))
+ (car (cdr
y-6362))))
+ (if (eq? (car (cdr y-6362))
'())
- (list 'list x-6379)
- (list 'cons x-6379 y-6381)))
- (if (eqv? key-6387 'list)
+ (list 'list x-6360)
+ (list 'cons x-6360 y-6362)))
+ (if (eqv? key-6368 'list)
(cons 'list
- (cons x-6379
- (cdr y-6381)))
- (list 'cons x-6379 y-6381))))
- maps-6382))))))
- tmp-6373)
- (let ((tmp-6416
+ (cons x-6360
+ (cdr y-6362)))
+ (list 'cons x-6360 y-6362))))
+ maps-6363))))))
+ tmp-6354)
+ (let ((tmp-6397
($sc-dispatch
- e-6261
+ e-6242
'#(vector (any . each-any)))))
- (if tmp-6416
+ (if tmp-6397
(@apply
- (lambda (e1-6420 e2-6421)
+ (lambda (e1-6401 e2-6402)
(call-with-values
(lambda ()
- (gen-syntax-5829
- src-6260
- (cons e1-6420 e2-6421)
- r-6262
- maps-6263
- ellipsis?-6264
- mod-6265))
- (lambda (e-6422 maps-6423)
+ (gen-syntax-5810
+ src-6241
+ (cons e1-6401 e2-6402)
+ r-6243
+ maps-6244
+ ellipsis?-6245
+ mod-6246))
+ (lambda (e-6403 maps-6404)
(values
- (if (eq? (car e-6422) 'list)
- (cons 'vector (cdr e-6422))
- (if (eq? (car e-6422) 'quote)
+ (if (eq? (car e-6403) 'list)
+ (cons 'vector (cdr e-6403))
+ (if (eq? (car e-6403) 'quote)
(list 'quote
(list->vector
- (car (cdr e-6422))))
- (list 'list->vector e-6422)))
- maps-6423))))
- tmp-6416)
+ (car (cdr e-6403))))
+ (list 'list->vector e-6403)))
+ maps-6404))))
+ tmp-6397)
(values
- (list 'quote e-6261)
- maps-6263))))))))))))
- (gen-ref-5830
- (lambda (src-6450 var-6451 level-6452 maps-6453)
- (if (= level-6452 0)
- (values var-6451 maps-6453)
- (if (null? maps-6453)
+ (list 'quote e-6242)
+ maps-6244))))))))))))
+ (gen-ref-5811
+ (lambda (src-6431 var-6432 level-6433 maps-6434)
+ (if (= level-6433 0)
+ (values var-6432 maps-6434)
+ (if (null? maps-6434)
(syntax-violation
'syntax
"missing ellipsis"
- src-6450)
+ src-6431)
(call-with-values
(lambda ()
- (gen-ref-5830
- src-6450
- var-6451
- (#{1-}# level-6452)
- (cdr maps-6453)))
- (lambda (outer-var-6454 outer-maps-6455)
- (let ((b-6456 (assq outer-var-6454 (car maps-6453))))
- (if b-6456
- (values (cdr b-6456) maps-6453)
- (let ((inner-var-6458
+ (gen-ref-5811
+ src-6431
+ var-6432
+ (#{1-}# level-6433)
+ (cdr maps-6434)))
+ (lambda (outer-var-6435 outer-maps-6436)
+ (let ((b-6437 (assq outer-var-6435 (car maps-6434))))
+ (if b-6437
+ (values (cdr b-6437) maps-6434)
+ (let ((inner-var-6439
(gensym
(string-append
(symbol->string 'tmp)
"-"))))
(values
- inner-var-6458
- (cons (cons (cons outer-var-6454 inner-var-6458)
- (car maps-6453))
- outer-maps-6455)))))))))))
- (gen-map-5832
- (lambda (e-6472 map-env-6473)
- (let ((formals-6474 (map cdr map-env-6473))
- (actuals-6475
- (map (lambda (x-6477) (list 'ref (car x-6477)))
- map-env-6473)))
- (if (eq? (car e-6472) 'ref)
- (car actuals-6475)
+ inner-var-6439
+ (cons (cons (cons outer-var-6435 inner-var-6439)
+ (car maps-6434))
+ outer-maps-6436)))))))))))
+ (gen-map-5813
+ (lambda (e-6453 map-env-6454)
+ (let ((formals-6455 (map cdr map-env-6454))
+ (actuals-6456
+ (map (lambda (x-6458) (list 'ref (car x-6458)))
+ map-env-6454)))
+ (if (eq? (car e-6453) 'ref)
+ (car actuals-6456)
(if (and-map
- (lambda (x-6478)
- (if (eq? (car x-6478) 'ref)
- (memq (car (cdr x-6478)) formals-6474)
+ (lambda (x-6459)
+ (if (eq? (car x-6459) 'ref)
+ (memq (car (cdr x-6459)) formals-6455)
#f))
- (cdr e-6472))
+ (cdr e-6453))
(cons 'map
- (cons (list 'primitive (car e-6472))
- (map (let ((r-6480
+ (cons (list 'primitive (car e-6453))
+ (map (let ((r-6461
(map cons
- formals-6474
- actuals-6475)))
- (lambda (x-6481)
- (cdr (assq (car (cdr x-6481))
- r-6480))))
- (cdr e-6472))))
+ formals-6455
+ actuals-6456)))
+ (lambda (x-6462)
+ (cdr (assq (car (cdr x-6462))
+ r-6461))))
+ (cdr e-6453))))
(cons 'map
- (cons (list 'lambda formals-6474 e-6472)
- actuals-6475)))))))
- (regen-5836
- (lambda (x-6483)
- (let ((key-6484 (car x-6483)))
- (if (eqv? key-6484 'ref)
- (let ((name-6494 (car (cdr x-6483)))
- (var-6495 (car (cdr x-6483))))
+ (cons (list 'lambda formals-6455 e-6453)
+ actuals-6456)))))))
+ (regen-5817
+ (lambda (x-6464)
+ (let ((key-6465 (car x-6464)))
+ (if (eqv? key-6465 'ref)
+ (let ((name-6475 (car (cdr x-6464)))
+ (var-6476 (car (cdr x-6464))))
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
#f
- name-6494
- var-6495))
- (if (eqv? key-6484 'primitive)
- (let ((name-6506 (car (cdr x-6483))))
+ name-6475
+ var-6476))
+ (if (eqv? key-6465 'primitive)
+ (let ((name-6487 (car (cdr x-6464))))
(make-struct/no-tail
(vector-ref %expanded-vtables 2)
#f
- name-6506))
- (if (eqv? key-6484 'quote)
- (let ((exp-6517 (car (cdr x-6483))))
+ name-6487))
+ (if (eqv? key-6465 'quote)
+ (let ((exp-6498 (car (cdr x-6464))))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
- exp-6517))
- (if (eqv? key-6484 'lambda)
- (if (list? (car (cdr x-6483)))
- (let ((req-6528 (car (cdr x-6483)))
- (vars-6530 (car (cdr x-6483)))
- (exp-6532
- (regen-5836 (car (cdr (cdr x-6483))))))
- (let ((body-6537
+ exp-6498))
+ (if (eqv? key-6465 'lambda)
+ (if (list? (car (cdr x-6464)))
+ (let ((req-6509 (car (cdr x-6464)))
+ (vars-6511 (car (cdr x-6464)))
+ (exp-6513
+ (regen-5817 (car (cdr (cdr x-6464))))))
+ (let ((body-6518
(make-struct/no-tail
(vector-ref %expanded-vtables 15)
#f
- req-6528
+ req-6509
#f
#f
#f
'()
- vars-6530
- exp-6532
+ vars-6511
+ exp-6513
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
#f
'()
- body-6537)))
- (error "how did we get here" x-6483))
- (let ((name-6553 (car x-6483))
- (args-6554 (map regen-5836 (cdr x-6483))))
+ body-6518)))
+ (error "how did we get here" x-6464))
+ (let ((name-6534 (car x-6464))
+ (args-6535 (map regen-5817 (cdr x-6464))))
(make-struct/no-tail
(vector-ref %expanded-vtables 12)
#f
- name-6553
- args-6554))))))))))
- (lambda (e-5837 r-5838 w-5839 s-5840 mod-5841)
- (let ((e-5842
- (let ((x-6171
+ name-6534
+ args-6535))))))))))
+ (lambda (e-5818 r-5819 w-5820 s-5821 mod-5822)
+ (let ((e-5823
+ (let ((x-6152
(begin
- (if (if (pair? e-5837) s-5840 #f)
- (set-source-properties! e-5837 s-5840))
- e-5837)))
- (if (if (null? (car w-5839)) (null? (cdr w-5839)) #f)
- x-6171
- (if (if (vector? x-6171)
- (if (= (vector-length x-6171) 4)
- (eq? (vector-ref x-6171 0) 'syntax-object)
+ (if (if s-5821
+ (supports-source-properties? e-5818)
+ #f)
+ (set-source-properties! e-5818 s-5821))
+ e-5818)))
+ (if (if (null? (car w-5820)) (null? (cdr w-5820)) #f)
+ x-6152
+ (if (if (vector? x-6152)
+ (if (= (vector-length x-6152) 4)
+ (eq? (vector-ref x-6152 0) 'syntax-object)
#f)
#f)
- (let ((expression-6203 (vector-ref x-6171 1))
- (wrap-6204
- (let ((w2-6212 (vector-ref x-6171 2)))
- (let ((m1-6213 (car w-5839))
- (s1-6214 (cdr w-5839)))
- (if (null? m1-6213)
- (if (null? s1-6214)
- w2-6212
- (cons (car w2-6212)
- (let ((m2-6229 (cdr w2-6212)))
- (if (null? m2-6229)
- s1-6214
+ (let ((expression-6184 (vector-ref x-6152 1))
+ (wrap-6185
+ (let ((w2-6193 (vector-ref x-6152 2)))
+ (let ((m1-6194 (car w-5820))
+ (s1-6195 (cdr w-5820)))
+ (if (null? m1-6194)
+ (if (null? s1-6195)
+ w2-6193
+ (cons (car w2-6193)
+ (let ((m2-6210 (cdr w2-6193)))
+ (if (null? m2-6210)
+ s1-6195
(append
- s1-6214
- m2-6229)))))
- (cons (let ((m2-6237 (car w2-6212)))
- (if (null? m2-6237)
- m1-6213
- (append m1-6213 m2-6237)))
- (let ((m2-6245 (cdr w2-6212)))
- (if (null? m2-6245)
- s1-6214
+ s1-6195
+ m2-6210)))))
+ (cons (let ((m2-6218 (car w2-6193)))
+ (if (null? m2-6218)
+ m1-6194
+ (append m1-6194 m2-6218)))
+ (let ((m2-6226 (cdr w2-6193)))
+ (if (null? m2-6226)
+ s1-6195
(append
- s1-6214
- m2-6245))))))))
- (module-6205 (vector-ref x-6171 3)))
+ s1-6195
+ m2-6226))))))))
+ (module-6186 (vector-ref x-6152 3)))
(vector
'syntax-object
- expression-6203
- wrap-6204
- module-6205))
- (if (null? x-6171)
- x-6171
+ expression-6184
+ wrap-6185
+ module-6186))
+ (if (null? x-6152)
+ x-6152
(vector
'syntax-object
- x-6171
- w-5839
- mod-5841)))))))
- (let ((tmp-5843 e-5842))
- (let ((tmp-5844 ($sc-dispatch tmp-5843 '(_ any))))
- (if tmp-5844
+ x-6152
+ w-5820
+ mod-5822)))))))
+ (let ((tmp-5824 e-5823))
+ (let ((tmp-5825 ($sc-dispatch tmp-5824 '(_ any))))
+ (if tmp-5825
(@apply
- (lambda (x-5892)
+ (lambda (x-5873)
(call-with-values
(lambda ()
- (gen-syntax-5829
- e-5842
- x-5892
- r-5838
+ (gen-syntax-5810
+ e-5823
+ x-5873
+ r-5819
'()
- ellipsis?-4390
- mod-5841))
- (lambda (e-5969 maps-5970) (regen-5836 e-5969))))
- tmp-5844)
+ ellipsis?-4391
+ mod-5822))
+ (lambda (e-5950 maps-5951) (regen-5817 e-5950))))
+ tmp-5825)
(syntax-violation
'syntax
"bad `syntax' form"
- e-5842))))))))
- (global-extend-4344
+ e-5823))))))))
+ (global-extend-4345
'core
'lambda
- (lambda (e-6785 r-6786 w-6787 s-6788 mod-6789)
- (let ((tmp-6791
- ($sc-dispatch e-6785 '(_ any any . each-any))))
- (if tmp-6791
+ (lambda (e-6763 r-6764 w-6765 s-6766 mod-6767)
+ (let ((tmp-6769
+ ($sc-dispatch e-6763 '(_ any any . each-any))))
+ (if tmp-6769
(@apply
- (lambda (args-6795 e1-6796 e2-6797)
+ (lambda (args-6773 e1-6774 e2-6775)
(call-with-values
- (lambda () (lambda-formals-4391 args-6795))
- (lambda (req-6800 opt-6801 rest-6802 kw-6803)
+ (lambda () (lambda-formals-4392 args-6773))
+ (lambda (req-6778 opt-6779 rest-6780 kw-6781)
(letrec*
- ((lp-6804
- (lambda (body-6807 meta-6808)
- (let ((tmp-6810
+ ((lp-6782
+ (lambda (body-6785 meta-6786)
+ (let ((tmp-6788
($sc-dispatch
- body-6807
+ body-6785
'(any any . each-any))))
- (if (if tmp-6810
+ (if (if tmp-6788
(@apply
- (lambda (docstring-6814 e1-6815 e2-6816)
+ (lambda (docstring-6792 e1-6793 e2-6794)
(string?
- (syntax->datum docstring-6814)))
- tmp-6810)
+ (syntax->datum docstring-6792)))
+ tmp-6788)
#f)
(@apply
- (lambda (docstring-6817 e1-6818 e2-6819)
- (lp-6804
- (cons e1-6818 e2-6819)
+ (lambda (docstring-6795 e1-6796 e2-6797)
+ (lp-6782
+ (cons e1-6796 e2-6797)
(append
- meta-6808
+ meta-6786
(list (cons 'documentation
(syntax->datum
- docstring-6817))))))
- tmp-6810)
- (let ((tmp-6820
+ docstring-6795))))))
+ tmp-6788)
+ (let ((tmp-6798
($sc-dispatch
- body-6807
+ body-6785
'(#(vector #(each (any . any)))
any
.
each-any))))
- (if tmp-6820
+ (if tmp-6798
(@apply
- (lambda (k-6824 v-6825 e1-6826 e2-6827)
- (lp-6804
- (cons e1-6826 e2-6827)
+ (lambda (k-6802 v-6803 e1-6804 e2-6805)
+ (lp-6782
+ (cons e1-6804 e2-6805)
(append
- meta-6808
+ meta-6786
(syntax->datum
- (map cons k-6824 v-6825)))))
- tmp-6820)
- (expand-simple-lambda-4392
- e-6785
- r-6786
- w-6787
- s-6788
- mod-6789
- req-6800
- rest-6802
- meta-6808
- body-6807))))))))
- (lp-6804 (cons e1-6796 e2-6797) '())))))
- tmp-6791)
- (syntax-violation 'lambda "bad lambda" e-6785)))))
- (global-extend-4344
+ (map cons k-6802 v-6803)))))
+ tmp-6798)
+ (expand-simple-lambda-4393
+ e-6763
+ r-6764
+ w-6765
+ s-6766
+ mod-6767
+ req-6778
+ rest-6780
+ meta-6786
+ body-6785))))))))
+ (lp-6782 (cons e1-6774 e2-6775) '())))))
+ tmp-6769)
+ (syntax-violation 'lambda "bad lambda" e-6763)))))
+ (global-extend-4345
'core
'lambda*
- (lambda (e-7202 r-7203 w-7204 s-7205 mod-7206)
- (let ((tmp-7208
- ($sc-dispatch e-7202 '(_ any any . each-any))))
- (if tmp-7208
+ (lambda (e-7177 r-7178 w-7179 s-7180 mod-7181)
+ (let ((tmp-7183
+ ($sc-dispatch e-7177 '(_ any any . each-any))))
+ (if tmp-7183
(@apply
- (lambda (args-7212 e1-7213 e2-7214)
+ (lambda (args-7187 e1-7188 e2-7189)
(call-with-values
(lambda ()
- (expand-lambda-case-4394
- e-7202
- r-7203
- w-7204
- s-7205
- mod-7206
- lambda*-formals-4393
- (list (cons args-7212 (cons e1-7213 e2-7214)))))
- (lambda (meta-7217 lcase-7218)
+ (expand-lambda-case-4395
+ e-7177
+ r-7178
+ w-7179
+ s-7180
+ mod-7181
+ lambda*-formals-4394
+ (list (cons args-7187 (cons e1-7188 e2-7189)))))
+ (lambda (meta-7192 lcase-7193)
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
- s-7205
- meta-7217
- lcase-7218))))
- tmp-7208)
- (syntax-violation 'lambda "bad lambda*" e-7202)))))
- (global-extend-4344
+ s-7180
+ meta-7192
+ lcase-7193))))
+ tmp-7183)
+ (syntax-violation 'lambda "bad lambda*" e-7177)))))
+ (global-extend-4345
'core
'case-lambda
- (lambda (e-7381 r-7382 w-7383 s-7384 mod-7385)
- (let ((tmp-7387
+ (lambda (e-7356 r-7357 w-7358 s-7359 mod-7360)
+ (let ((tmp-7362
($sc-dispatch
- e-7381
+ e-7356
'(_ (any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-7387
+ (if tmp-7362
(@apply
- (lambda (args-7391
- e1-7392
- e2-7393
- args*-7394
- e1*-7395
- e2*-7396)
+ (lambda (args-7366
+ e1-7367
+ e2-7368
+ args*-7369
+ e1*-7370
+ e2*-7371)
(call-with-values
(lambda ()
- (expand-lambda-case-4394
- e-7381
- r-7382
- w-7383
- s-7384
- mod-7385
- lambda-formals-4391
- (cons (cons args-7391 (cons e1-7392 e2-7393))
- (map (lambda (tmp-3329-7399
- tmp-3328-7400
- tmp-3327-7401)
- (cons tmp-3327-7401
- (cons tmp-3328-7400 tmp-3329-7399)))
- e2*-7396
- e1*-7395
- args*-7394))))
- (lambda (meta-7402 lcase-7403)
+ (expand-lambda-case-4395
+ e-7356
+ r-7357
+ w-7358
+ s-7359
+ mod-7360
+ lambda-formals-4392
+ (cons (cons args-7366 (cons e1-7367 e2-7368))
+ (map (lambda (tmp-3330-7374
+ tmp-3329-7375
+ tmp-3328-7376)
+ (cons tmp-3328-7376
+ (cons tmp-3329-7375 tmp-3330-7374)))
+ e2*-7371
+ e1*-7370
+ args*-7369))))
+ (lambda (meta-7377 lcase-7378)
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
- s-7384
- meta-7402
- lcase-7403))))
- tmp-7387)
+ s-7359
+ meta-7377
+ lcase-7378))))
+ tmp-7362)
(syntax-violation
'case-lambda
"bad case-lambda"
- e-7381)))))
- (global-extend-4344
+ e-7356)))))
+ (global-extend-4345
'core
'case-lambda*
- (lambda (e-7572 r-7573 w-7574 s-7575 mod-7576)
- (let ((tmp-7578
+ (lambda (e-7547 r-7548 w-7549 s-7550 mod-7551)
+ (let ((tmp-7553
($sc-dispatch
- e-7572
+ e-7547
'(_ (any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-7578
+ (if tmp-7553
(@apply
- (lambda (args-7582
- e1-7583
- e2-7584
- args*-7585
- e1*-7586
- e2*-7587)
+ (lambda (args-7557
+ e1-7558
+ e2-7559
+ args*-7560
+ e1*-7561
+ e2*-7562)
(call-with-values
(lambda ()
- (expand-lambda-case-4394
- e-7572
- r-7573
- w-7574
- s-7575
- mod-7576
- lambda*-formals-4393
- (cons (cons args-7582 (cons e1-7583 e2-7584))
- (map (lambda (tmp-3364-7590
- tmp-3363-7591
- tmp-3362-7592)
- (cons tmp-3362-7592
- (cons tmp-3363-7591 tmp-3364-7590)))
- e2*-7587
- e1*-7586
- args*-7585))))
- (lambda (meta-7593 lcase-7594)
+ (expand-lambda-case-4395
+ e-7547
+ r-7548
+ w-7549
+ s-7550
+ mod-7551
+ lambda*-formals-4394
+ (cons (cons args-7557 (cons e1-7558 e2-7559))
+ (map (lambda (tmp-3365-7565
+ tmp-3364-7566
+ tmp-3363-7567)
+ (cons tmp-3363-7567
+ (cons tmp-3364-7566 tmp-3365-7565)))
+ e2*-7562
+ e1*-7561
+ args*-7560))))
+ (lambda (meta-7568 lcase-7569)
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
- s-7575
- meta-7593
- lcase-7594))))
- tmp-7578)
+ s-7550
+ meta-7568
+ lcase-7569))))
+ tmp-7553)
(syntax-violation
'case-lambda
"bad case-lambda*"
- e-7572)))))
- (global-extend-4344
+ e-7547)))))
+ (global-extend-4345
'core
'let
(letrec*
- ((expand-let-7802
- (lambda (e-8012
- r-8013
- w-8014
- s-8015
- mod-8016
- constructor-8017
- ids-8018
- vals-8019
- exps-8020)
- (if (not (valid-bound-ids?-4372 ids-8018))
+ ((expand-let-7777
+ (lambda (e-7987
+ r-7988
+ w-7989
+ s-7990
+ mod-7991
+ constructor-7992
+ ids-7993
+ vals-7994
+ exps-7995)
+ (if (not (valid-bound-ids?-4373 ids-7993))
(syntax-violation
'let
"duplicate bound variable"
- e-8012)
- (let ((labels-8105 (gen-labels-4349 ids-8018))
- (new-vars-8106 (map gen-var-4396 ids-8018)))
- (let ((nw-8107
- (make-binding-wrap-4360
- ids-8018
- labels-8105
- w-8014))
- (nr-8108
- (extend-var-env-4342
- labels-8105
- new-vars-8106
- r-8013)))
- (constructor-8017
- s-8015
- (map syntax->datum ids-8018)
- new-vars-8106
- (map (lambda (x-8125)
- (expand-4382 x-8125 r-8013 w-8014 mod-8016))
- vals-8019)
- (expand-body-4386
- exps-8020
- (source-wrap-4376 e-8012 nw-8107 s-8015 mod-8016)
- nr-8108
- nw-8107
- mod-8016))))))))
- (lambda (e-7803 r-7804 w-7805 s-7806 mod-7807)
- (let ((tmp-7809
+ e-7987)
+ (let ((labels-8080 (gen-labels-4350 ids-7993))
+ (new-vars-8081 (map gen-var-4397 ids-7993)))
+ (let ((nw-8082
+ (make-binding-wrap-4361
+ ids-7993
+ labels-8080
+ w-7989))
+ (nr-8083
+ (extend-var-env-4343
+ labels-8080
+ new-vars-8081
+ r-7988)))
+ (constructor-7992
+ s-7990
+ (map syntax->datum ids-7993)
+ new-vars-8081
+ (map (lambda (x-8100)
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ x-8100
+ r-7988
+ w-7989
+ (let ((props-8116
+ (source-properties
+ (if (if (vector? x-8100)
+ (if (= (vector-length
+ x-8100)
+ 4)
+ (eq? (vector-ref
+ x-8100
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref x-8100 1)
+ x-8100))))
+ (if (pair? props-8116) props-8116 #f))
+ #f
+ mod-7991
+ #f))
+ (lambda (type-8149
+ value-8150
+ form-8151
+ e-8152
+ w-8153
+ s-8154
+ mod-8155)
+ (expand-expr-4384
+ type-8149
+ value-8150
+ form-8151
+ e-8152
+ r-7988
+ w-8153
+ s-8154
+ mod-8155))))
+ vals-7994)
+ (expand-body-4387
+ exps-7995
+ (source-wrap-4377 e-7987 nw-8082 s-7990 mod-7991)
+ nr-8083
+ nw-8082
+ mod-7991))))))))
+ (lambda (e-7778 r-7779 w-7780 s-7781 mod-7782)
+ (let ((tmp-7784
($sc-dispatch
- e-7803
+ e-7778
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-7809
+ (if (if tmp-7784
(@apply
- (lambda (id-7813 val-7814 e1-7815 e2-7816)
- (and-map id?-4346 id-7813))
- tmp-7809)
+ (lambda (id-7788 val-7789 e1-7790 e2-7791)
+ (and-map id?-4347 id-7788))
+ tmp-7784)
#f)
(@apply
- (lambda (id-7832 val-7833 e1-7834 e2-7835)
- (expand-let-7802
- e-7803
- r-7804
- w-7805
- s-7806
- mod-7807
- (lambda (src-7839
- ids-7840
- vars-7841
- val-exps-7842
- body-exp-7843)
+ (lambda (id-7807 val-7808 e1-7809 e2-7810)
+ (expand-let-7777
+ e-7778
+ r-7779
+ w-7780
+ s-7781
+ mod-7782
+ (lambda (src-7814
+ ids-7815
+ vars-7816
+ val-exps-7817
+ body-exp-7818)
(begin
(for-each
- maybe-name-value!-4311
- ids-7840
- val-exps-7842)
- (if (null? vars-7841)
- body-exp-7843
+ maybe-name-value!-4312
+ ids-7815
+ val-exps-7817)
+ (if (null? vars-7816)
+ body-exp-7818
(make-struct/no-tail
(vector-ref %expanded-vtables 16)
- src-7839
- ids-7840
- vars-7841
- val-exps-7842
- body-exp-7843))))
- id-7832
- val-7833
- (cons e1-7834 e2-7835)))
- tmp-7809)
- (let ((tmp-7850
+ src-7814
+ ids-7815
+ vars-7816
+ val-exps-7817
+ body-exp-7818))))
+ id-7807
+ val-7808
+ (cons e1-7809 e2-7810)))
+ tmp-7784)
+ (let ((tmp-7825
($sc-dispatch
- e-7803
+ e-7778
'(_ any #(each (any any)) any . each-any))))
- (if (if tmp-7850
+ (if (if tmp-7825
(@apply
- (lambda (f-7854 id-7855 val-7856 e1-7857 e2-7858)
- (if (if (symbol? f-7854)
+ (lambda (f-7829 id-7830 val-7831 e1-7832 e2-7833)
+ (if (if (symbol? f-7829)
#t
- (if (if (vector? f-7854)
- (if (= (vector-length f-7854) 4)
- (eq? (vector-ref f-7854 0)
+ (if (if (vector? f-7829)
+ (if (= (vector-length f-7829) 4)
+ (eq? (vector-ref f-7829 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref f-7854 1))
+ (symbol? (vector-ref f-7829 1))
#f))
- (and-map id?-4346 id-7855)
+ (and-map id?-4347 id-7830)
#f))
- tmp-7850)
+ tmp-7825)
#f)
(@apply
- (lambda (f-7900 id-7901 val-7902 e1-7903 e2-7904)
- (expand-let-7802
- e-7803
- r-7804
- w-7805
- s-7806
- mod-7807
- build-named-let-4330
- (cons f-7900 id-7901)
- val-7902
- (cons e1-7903 e2-7904)))
- tmp-7850)
+ (lambda (f-7875 id-7876 val-7877 e1-7878 e2-7879)
+ (expand-let-7777
+ e-7778
+ r-7779
+ w-7780
+ s-7781
+ mod-7782
+ build-named-let-4331
+ (cons f-7875 id-7876)
+ val-7877
+ (cons e1-7878 e2-7879)))
+ tmp-7825)
(syntax-violation
'let
"bad let"
- (let ((x-7917
+ (let ((x-7892
(begin
- (if (if (pair? e-7803) s-7806 #f)
- (set-source-properties! e-7803 s-7806))
- e-7803)))
- (if (if (null? (car w-7805)) (null? (cdr w-7805)) #f)
- x-7917
- (if (if (vector? x-7917)
- (if (= (vector-length x-7917) 4)
- (eq? (vector-ref x-7917 0) 'syntax-object)
+ (if (if s-7781
+ (supports-source-properties? e-7778)
+ #f)
+ (set-source-properties! e-7778 s-7781))
+ e-7778)))
+ (if (if (null? (car w-7780)) (null? (cdr w-7780)) #f)
+ x-7892
+ (if (if (vector? x-7892)
+ (if (= (vector-length x-7892) 4)
+ (eq? (vector-ref x-7892 0) 'syntax-object)
#f)
#f)
- (let ((expression-7949 (vector-ref x-7917 1))
- (wrap-7950
- (let ((w2-7958 (vector-ref x-7917 2)))
- (let ((m1-7959 (car w-7805))
- (s1-7960 (cdr w-7805)))
- (if (null? m1-7959)
- (if (null? s1-7960)
- w2-7958
- (cons (car w2-7958)
- (let ((m2-7975
- (cdr w2-7958)))
- (if (null? m2-7975)
- s1-7960
+ (let ((expression-7924 (vector-ref x-7892 1))
+ (wrap-7925
+ (let ((w2-7933 (vector-ref x-7892 2)))
+ (let ((m1-7934 (car w-7780))
+ (s1-7935 (cdr w-7780)))
+ (if (null? m1-7934)
+ (if (null? s1-7935)
+ w2-7933
+ (cons (car w2-7933)
+ (let ((m2-7950
+ (cdr w2-7933)))
+ (if (null? m2-7950)
+ s1-7935
(append
- s1-7960
- m2-7975)))))
- (cons (let ((m2-7983 (car w2-7958)))
- (if (null? m2-7983)
- m1-7959
- (append m1-7959 m2-7983)))
- (let ((m2-7991 (cdr w2-7958)))
- (if (null? m2-7991)
- s1-7960
+ s1-7935
+ m2-7950)))))
+ (cons (let ((m2-7958 (car w2-7933)))
+ (if (null? m2-7958)
+ m1-7934
+ (append m1-7934 m2-7958)))
+ (let ((m2-7966 (cdr w2-7933)))
+ (if (null? m2-7966)
+ s1-7935
(append
- s1-7960
- m2-7991))))))))
- (module-7951 (vector-ref x-7917 3)))
+ s1-7935
+ m2-7966))))))))
+ (module-7926 (vector-ref x-7892 3)))
(vector
'syntax-object
- expression-7949
- wrap-7950
- module-7951))
- (if (null? x-7917)
- x-7917
+ expression-7924
+ wrap-7925
+ module-7926))
+ (if (null? x-7892)
+ x-7892
(vector
'syntax-object
- x-7917
- w-7805
- mod-7807)))))))))))))
- (global-extend-4344
+ x-7892
+ w-7780
+ mod-7782)))))))))))))
+ (global-extend-4345
'core
'letrec
- (lambda (e-8555 r-8556 w-8557 s-8558 mod-8559)
- (let ((tmp-8561
+ (lambda (e-8511 r-8512 w-8513 s-8514 mod-8515)
+ (let ((tmp-8517
($sc-dispatch
- e-8555
+ e-8511
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-8561
+ (if (if tmp-8517
(@apply
- (lambda (id-8565 val-8566 e1-8567 e2-8568)
- (and-map id?-4346 id-8565))
- tmp-8561)
+ (lambda (id-8521 val-8522 e1-8523 e2-8524)
+ (and-map id?-4347 id-8521))
+ tmp-8517)
#f)
(@apply
- (lambda (id-8584 val-8585 e1-8586 e2-8587)
- (if (not (valid-bound-ids?-4372 id-8584))
+ (lambda (id-8540 val-8541 e1-8542 e2-8543)
+ (if (not (valid-bound-ids?-4373 id-8540))
(syntax-violation
'letrec
"duplicate bound variable"
- e-8555)
- (let ((labels-8684 (gen-labels-4349 id-8584))
- (new-vars-8685 (map gen-var-4396 id-8584)))
- (let ((w-8686
- (make-binding-wrap-4360
- id-8584
- labels-8684
- w-8557))
- (r-8687
- (extend-var-env-4342
- labels-8684
- new-vars-8685
- r-8556)))
- (build-letrec-4331
- s-8558
+ e-8511)
+ (let ((labels-8640 (gen-labels-4350 id-8540))
+ (new-vars-8641 (map gen-var-4397 id-8540)))
+ (let ((w-8642
+ (make-binding-wrap-4361
+ id-8540
+ labels-8640
+ w-8513))
+ (r-8643
+ (extend-var-env-4343
+ labels-8640
+ new-vars-8641
+ r-8512)))
+ (build-letrec-4332
+ s-8514
#f
- (map syntax->datum id-8584)
- new-vars-8685
- (map (lambda (x-8764)
- (expand-4382 x-8764 r-8687 w-8686 mod-8559))
- val-8585)
- (expand-body-4386
- (cons e1-8586 e2-8587)
- (let ((x-8826
+ (map syntax->datum id-8540)
+ new-vars-8641
+ (map (lambda (x-8720)
+ (expand-4383 x-8720 r-8643 w-8642 mod-8515))
+ val-8541)
+ (expand-body-4387
+ (cons e1-8542 e2-8543)
+ (let ((x-8782
(begin
- (if (if (pair? e-8555) s-8558 #f)
- (set-source-properties! e-8555 s-8558))
- e-8555)))
- (if (if (null? (car w-8686))
- (null? (cdr w-8686))
+ (if (if s-8514
+ (supports-source-properties?
+ e-8511)
+ #f)
+ (set-source-properties! e-8511 s-8514))
+ e-8511)))
+ (if (if (null? (car w-8642))
+ (null? (cdr w-8642))
#f)
- x-8826
- (if (if (vector? x-8826)
- (if (= (vector-length x-8826) 4)
- (eq? (vector-ref x-8826 0)
+ x-8782
+ (if (if (vector? x-8782)
+ (if (= (vector-length x-8782) 4)
+ (eq? (vector-ref x-8782 0)
'syntax-object)
#f)
#f)
- (let ((expression-8858 (vector-ref x-8826 1))
- (wrap-8859
- (let ((w2-8867
- (vector-ref x-8826 2)))
- (let ((m1-8868 (car w-8686))
- (s1-8869 (cdr w-8686)))
- (if (null? m1-8868)
- (if (null? s1-8869)
- w2-8867
- (cons (car w2-8867)
- (let ((m2-8884
- (cdr w2-8867)))
- (if (null? m2-8884)
- s1-8869
+ (let ((expression-8814 (vector-ref x-8782 1))
+ (wrap-8815
+ (let ((w2-8823
+ (vector-ref x-8782 2)))
+ (let ((m1-8824 (car w-8642))
+ (s1-8825 (cdr w-8642)))
+ (if (null? m1-8824)
+ (if (null? s1-8825)
+ w2-8823
+ (cons (car w2-8823)
+ (let ((m2-8840
+ (cdr w2-8823)))
+ (if (null? m2-8840)
+ s1-8825
(append
- s1-8869
- m2-8884)))))
- (cons (let ((m2-8892
- (car w2-8867)))
- (if (null? m2-8892)
- m1-8868
+ s1-8825
+ m2-8840)))))
+ (cons (let ((m2-8848
+ (car w2-8823)))
+ (if (null? m2-8848)
+ m1-8824
(append
- m1-8868
- m2-8892)))
- (let ((m2-8900
- (cdr w2-8867)))
- (if (null? m2-8900)
- s1-8869
+ m1-8824
+ m2-8848)))
+ (let ((m2-8856
+ (cdr w2-8823)))
+ (if (null? m2-8856)
+ s1-8825
(append
- s1-8869
- m2-8900))))))))
- (module-8860 (vector-ref x-8826 3)))
+ s1-8825
+ m2-8856))))))))
+ (module-8816 (vector-ref x-8782 3)))
(vector
'syntax-object
- expression-8858
- wrap-8859
- module-8860))
- (if (null? x-8826)
- x-8826
+ expression-8814
+ wrap-8815
+ module-8816))
+ (if (null? x-8782)
+ x-8782
(vector
'syntax-object
- x-8826
- w-8686
- mod-8559)))))
- r-8687
- w-8686
- mod-8559))))))
- tmp-8561)
+ x-8782
+ w-8642
+ mod-8515)))))
+ r-8643
+ w-8642
+ mod-8515))))))
+ tmp-8517)
(syntax-violation
'letrec
"bad letrec"
- (let ((x-9111
+ (let ((x-9067
(begin
- (if (if (pair? e-8555) s-8558 #f)
- (set-source-properties! e-8555 s-8558))
- e-8555)))
- (if (if (null? (car w-8557)) (null? (cdr w-8557)) #f)
- x-9111
- (if (if (vector? x-9111)
- (if (= (vector-length x-9111) 4)
- (eq? (vector-ref x-9111 0) 'syntax-object)
+ (if (if s-8514
+ (supports-source-properties? e-8511)
+ #f)
+ (set-source-properties! e-8511 s-8514))
+ e-8511)))
+ (if (if (null? (car w-8513)) (null? (cdr w-8513)) #f)
+ x-9067
+ (if (if (vector? x-9067)
+ (if (= (vector-length x-9067) 4)
+ (eq? (vector-ref x-9067 0) 'syntax-object)
#f)
#f)
- (let ((expression-9143 (vector-ref x-9111 1))
- (wrap-9144
- (let ((w2-9152 (vector-ref x-9111 2)))
- (let ((m1-9153 (car w-8557))
- (s1-9154 (cdr w-8557)))
- (if (null? m1-9153)
- (if (null? s1-9154)
- w2-9152
- (cons (car w2-9152)
- (let ((m2-9169 (cdr w2-9152)))
- (if (null? m2-9169)
- s1-9154
- (append s1-9154 m2-9169)))))
- (cons (let ((m2-9177 (car w2-9152)))
- (if (null? m2-9177)
- m1-9153
- (append m1-9153 m2-9177)))
- (let ((m2-9185 (cdr w2-9152)))
- (if (null? m2-9185)
- s1-9154
- (append s1-9154 m2-9185))))))))
- (module-9145 (vector-ref x-9111 3)))
+ (let ((expression-9099 (vector-ref x-9067 1))
+ (wrap-9100
+ (let ((w2-9108 (vector-ref x-9067 2)))
+ (let ((m1-9109 (car w-8513))
+ (s1-9110 (cdr w-8513)))
+ (if (null? m1-9109)
+ (if (null? s1-9110)
+ w2-9108
+ (cons (car w2-9108)
+ (let ((m2-9125 (cdr w2-9108)))
+ (if (null? m2-9125)
+ s1-9110
+ (append s1-9110 m2-9125)))))
+ (cons (let ((m2-9133 (car w2-9108)))
+ (if (null? m2-9133)
+ m1-9109
+ (append m1-9109 m2-9133)))
+ (let ((m2-9141 (cdr w2-9108)))
+ (if (null? m2-9141)
+ s1-9110
+ (append s1-9110 m2-9141))))))))
+ (module-9101 (vector-ref x-9067 3)))
(vector
'syntax-object
- expression-9143
- wrap-9144
- module-9145))
- (if (null? x-9111)
- x-9111
- (vector 'syntax-object x-9111 w-8557 mod-8559))))))))))
- (global-extend-4344
+ expression-9099
+ wrap-9100
+ module-9101))
+ (if (null? x-9067)
+ x-9067
+ (vector 'syntax-object x-9067 w-8513 mod-8515))))))))))
+ (global-extend-4345
'core
'letrec*
- (lambda (e-9336 r-9337 w-9338 s-9339 mod-9340)
- (let ((tmp-9342
+ (lambda (e-9292 r-9293 w-9294 s-9295 mod-9296)
+ (let ((tmp-9298
($sc-dispatch
- e-9336
+ e-9292
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-9342
+ (if (if tmp-9298
(@apply
- (lambda (id-9346 val-9347 e1-9348 e2-9349)
- (and-map id?-4346 id-9346))
- tmp-9342)
+ (lambda (id-9302 val-9303 e1-9304 e2-9305)
+ (and-map id?-4347 id-9302))
+ tmp-9298)
#f)
(@apply
- (lambda (id-9365 val-9366 e1-9367 e2-9368)
- (if (not (valid-bound-ids?-4372 id-9365))
+ (lambda (id-9321 val-9322 e1-9323 e2-9324)
+ (if (not (valid-bound-ids?-4373 id-9321))
(syntax-violation
'letrec*
"duplicate bound variable"
- e-9336)
- (let ((labels-9465 (gen-labels-4349 id-9365))
- (new-vars-9466 (map gen-var-4396 id-9365)))
- (let ((w-9467
- (make-binding-wrap-4360
- id-9365
- labels-9465
- w-9338))
- (r-9468
- (extend-var-env-4342
- labels-9465
- new-vars-9466
- r-9337)))
- (build-letrec-4331
- s-9339
+ e-9292)
+ (let ((labels-9421 (gen-labels-4350 id-9321))
+ (new-vars-9422 (map gen-var-4397 id-9321)))
+ (let ((w-9423
+ (make-binding-wrap-4361
+ id-9321
+ labels-9421
+ w-9294))
+ (r-9424
+ (extend-var-env-4343
+ labels-9421
+ new-vars-9422
+ r-9293)))
+ (build-letrec-4332
+ s-9295
#t
- (map syntax->datum id-9365)
- new-vars-9466
- (map (lambda (x-9545)
- (expand-4382 x-9545 r-9468 w-9467 mod-9340))
- val-9366)
- (expand-body-4386
- (cons e1-9367 e2-9368)
- (let ((x-9607
+ (map syntax->datum id-9321)
+ new-vars-9422
+ (map (lambda (x-9501)
+ (expand-4383 x-9501 r-9424 w-9423 mod-9296))
+ val-9322)
+ (expand-body-4387
+ (cons e1-9323 e2-9324)
+ (let ((x-9563
(begin
- (if (if (pair? e-9336) s-9339 #f)
- (set-source-properties! e-9336 s-9339))
- e-9336)))
- (if (if (null? (car w-9467))
- (null? (cdr w-9467))
+ (if (if s-9295
+ (supports-source-properties?
+ e-9292)
+ #f)
+ (set-source-properties! e-9292 s-9295))
+ e-9292)))
+ (if (if (null? (car w-9423))
+ (null? (cdr w-9423))
#f)
- x-9607
- (if (if (vector? x-9607)
- (if (= (vector-length x-9607) 4)
- (eq? (vector-ref x-9607 0)
+ x-9563
+ (if (if (vector? x-9563)
+ (if (= (vector-length x-9563) 4)
+ (eq? (vector-ref x-9563 0)
'syntax-object)
#f)
#f)
- (let ((expression-9639 (vector-ref x-9607 1))
- (wrap-9640
- (let ((w2-9648
- (vector-ref x-9607 2)))
- (let ((m1-9649 (car w-9467))
- (s1-9650 (cdr w-9467)))
- (if (null? m1-9649)
- (if (null? s1-9650)
- w2-9648
- (cons (car w2-9648)
- (let ((m2-9665
- (cdr w2-9648)))
- (if (null? m2-9665)
- s1-9650
+ (let ((expression-9595 (vector-ref x-9563 1))
+ (wrap-9596
+ (let ((w2-9604
+ (vector-ref x-9563 2)))
+ (let ((m1-9605 (car w-9423))
+ (s1-9606 (cdr w-9423)))
+ (if (null? m1-9605)
+ (if (null? s1-9606)
+ w2-9604
+ (cons (car w2-9604)
+ (let ((m2-9621
+ (cdr w2-9604)))
+ (if (null? m2-9621)
+ s1-9606
(append
- s1-9650
- m2-9665)))))
- (cons (let ((m2-9673
- (car w2-9648)))
- (if (null? m2-9673)
- m1-9649
+ s1-9606
+ m2-9621)))))
+ (cons (let ((m2-9629
+ (car w2-9604)))
+ (if (null? m2-9629)
+ m1-9605
(append
- m1-9649
- m2-9673)))
- (let ((m2-9681
- (cdr w2-9648)))
- (if (null? m2-9681)
- s1-9650
+ m1-9605
+ m2-9629)))
+ (let ((m2-9637
+ (cdr w2-9604)))
+ (if (null? m2-9637)
+ s1-9606
(append
- s1-9650
- m2-9681))))))))
- (module-9641 (vector-ref x-9607 3)))
+ s1-9606
+ m2-9637))))))))
+ (module-9597 (vector-ref x-9563 3)))
(vector
'syntax-object
- expression-9639
- wrap-9640
- module-9641))
- (if (null? x-9607)
- x-9607
+ expression-9595
+ wrap-9596
+ module-9597))
+ (if (null? x-9563)
+ x-9563
(vector
'syntax-object
- x-9607
- w-9467
- mod-9340)))))
- r-9468
- w-9467
- mod-9340))))))
- tmp-9342)
+ x-9563
+ w-9423
+ mod-9296)))))
+ r-9424
+ w-9423
+ mod-9296))))))
+ tmp-9298)
(syntax-violation
'letrec*
"bad letrec*"
- (let ((x-9892
+ (let ((x-9848
(begin
- (if (if (pair? e-9336) s-9339 #f)
- (set-source-properties! e-9336 s-9339))
- e-9336)))
- (if (if (null? (car w-9338)) (null? (cdr w-9338)) #f)
- x-9892
- (if (if (vector? x-9892)
- (if (= (vector-length x-9892) 4)
- (eq? (vector-ref x-9892 0) 'syntax-object)
+ (if (if s-9295
+ (supports-source-properties? e-9292)
+ #f)
+ (set-source-properties! e-9292 s-9295))
+ e-9292)))
+ (if (if (null? (car w-9294)) (null? (cdr w-9294)) #f)
+ x-9848
+ (if (if (vector? x-9848)
+ (if (= (vector-length x-9848) 4)
+ (eq? (vector-ref x-9848 0) 'syntax-object)
#f)
#f)
- (let ((expression-9924 (vector-ref x-9892 1))
- (wrap-9925
- (let ((w2-9933 (vector-ref x-9892 2)))
- (let ((m1-9934 (car w-9338))
- (s1-9935 (cdr w-9338)))
- (if (null? m1-9934)
- (if (null? s1-9935)
- w2-9933
- (cons (car w2-9933)
- (let ((m2-9950 (cdr w2-9933)))
- (if (null? m2-9950)
- s1-9935
- (append s1-9935 m2-9950)))))
- (cons (let ((m2-9958 (car w2-9933)))
- (if (null? m2-9958)
- m1-9934
- (append m1-9934 m2-9958)))
- (let ((m2-9966 (cdr w2-9933)))
- (if (null? m2-9966)
- s1-9935
- (append s1-9935 m2-9966))))))))
- (module-9926 (vector-ref x-9892 3)))
+ (let ((expression-9880 (vector-ref x-9848 1))
+ (wrap-9881
+ (let ((w2-9889 (vector-ref x-9848 2)))
+ (let ((m1-9890 (car w-9294))
+ (s1-9891 (cdr w-9294)))
+ (if (null? m1-9890)
+ (if (null? s1-9891)
+ w2-9889
+ (cons (car w2-9889)
+ (let ((m2-9906 (cdr w2-9889)))
+ (if (null? m2-9906)
+ s1-9891
+ (append s1-9891 m2-9906)))))
+ (cons (let ((m2-9914 (car w2-9889)))
+ (if (null? m2-9914)
+ m1-9890
+ (append m1-9890 m2-9914)))
+ (let ((m2-9922 (cdr w2-9889)))
+ (if (null? m2-9922)
+ s1-9891
+ (append s1-9891 m2-9922))))))))
+ (module-9882 (vector-ref x-9848 3)))
(vector
'syntax-object
- expression-9924
- wrap-9925
- module-9926))
- (if (null? x-9892)
- x-9892
- (vector 'syntax-object x-9892 w-9338 mod-9340))))))))))
- (global-extend-4344
+ expression-9880
+ wrap-9881
+ module-9882))
+ (if (null? x-9848)
+ x-9848
+ (vector 'syntax-object x-9848 w-9294 mod-9296))))))))))
+ (global-extend-4345
'core
'set!
- (lambda (e-10128 r-10129 w-10130 s-10131 mod-10132)
- (let ((tmp-10134 ($sc-dispatch e-10128 '(_ any any))))
- (if (if tmp-10134
+ (lambda (e-10179 r-10180 w-10181 s-10182 mod-10183)
+ (let ((tmp-10185 ($sc-dispatch e-10179 '(_ any any))))
+ (if (if tmp-10185
(@apply
- (lambda (id-10138 val-10139)
- (if (symbol? id-10138)
+ (lambda (id-10189 val-10190)
+ (if (symbol? id-10189)
#t
- (if (if (vector? id-10138)
- (if (= (vector-length id-10138) 4)
- (eq? (vector-ref id-10138 0) 'syntax-object)
+ (if (if (vector? id-10189)
+ (if (= (vector-length id-10189) 4)
+ (eq? (vector-ref id-10189 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-10138 1))
+ (symbol? (vector-ref id-10189 1))
#f)))
- tmp-10134)
+ tmp-10185)
#f)
(@apply
- (lambda (id-10166 val-10167)
+ (lambda (id-10217 val-10218)
(call-with-values
(lambda ()
- (resolve-identifier-4367
- id-10166
- w-10130
- r-10129
- mod-10132
+ (resolve-identifier-4368
+ id-10217
+ w-10181
+ r-10180
+ mod-10183
#t))
- (lambda (type-10170 value-10171 id-mod-10172)
- (if (eqv? type-10170 'lexical)
- (build-lexical-assignment-4317
- s-10131
- (syntax->datum id-10166)
- value-10171
- (expand-4382 val-10167 r-10129 w-10130 mod-10132))
- (if (eqv? type-10170 'global)
- (build-global-assignment-4320
- s-10131
- value-10171
- (expand-4382 val-10167 r-10129 w-10130 mod-10132)
- id-mod-10172)
- (if (eqv? type-10170 'macro)
- (if (procedure-property
- value-10171
- 'variable-transformer)
- (expand-4382
- (expand-macro-4385
- value-10171
- e-10128
- r-10129
- w-10130
- s-10131
- #f
- mod-10132)
- r-10129
- '(())
- mod-10132)
- (syntax-violation
- 'set!
- "not a variable transformer"
- (if (if (null? (car w-10130))
- (null? (cdr w-10130))
- #f)
- e-10128
- (if (if (vector? e-10128)
- (if (= (vector-length e-10128) 4)
- (eq? (vector-ref e-10128 0)
- 'syntax-object)
- #f)
- #f)
- (let ((expression-10622
- (vector-ref e-10128 1))
- (wrap-10623
- (let ((w2-10633
- (vector-ref e-10128 2)))
- (let ((m1-10634 (car w-10130))
- (s1-10635 (cdr w-10130)))
- (if (null? m1-10634)
- (if (null? s1-10635)
- w2-10633
- (cons (car w2-10633)
- (let ((m2-10652
- (cdr
w2-10633)))
- (if (null?
m2-10652)
- s1-10635
- (append
- s1-10635
- m2-10652)))))
- (cons (let ((m2-10660
- (car
w2-10633)))
- (if (null? m2-10660)
- m1-10634
- (append
- m1-10634
- m2-10660)))
- (let ((m2-10668
- (cdr
w2-10633)))
- (if (null? m2-10668)
- s1-10635
- (append
- s1-10635
- m2-10668))))))))
- (module-10624
- (vector-ref e-10128 3)))
- (vector
- 'syntax-object
- expression-10622
- wrap-10623
- module-10624))
- (if (null? e-10128)
- e-10128
- (vector
- 'syntax-object
- e-10128
- w-10130
- mod-10132))))
- (if (if (null? (car w-10130))
- (null? (cdr w-10130))
- #f)
- id-10166
- (if (if (vector? id-10166)
- (if (= (vector-length id-10166) 4)
- (eq? (vector-ref id-10166 0)
- 'syntax-object)
- #f)
- #f)
- (let ((expression-10720
- (vector-ref id-10166 1))
- (wrap-10721
- (let ((w2-10731
- (vector-ref id-10166 2)))
- (let ((m1-10732 (car w-10130))
- (s1-10733 (cdr w-10130)))
- (if (null? m1-10732)
- (if (null? s1-10733)
- w2-10731
- (cons (car w2-10731)
- (let ((m2-10750
- (cdr
w2-10731)))
- (if (null?
m2-10750)
- s1-10733
- (append
- s1-10733
- m2-10750)))))
- (cons (let ((m2-10758
- (car
w2-10731)))
- (if (null? m2-10758)
- m1-10732
- (append
- m1-10732
- m2-10758)))
- (let ((m2-10766
- (cdr
w2-10731)))
- (if (null? m2-10766)
- s1-10733
+ (lambda (type-10221 value-10222 id-mod-10223)
+ (if (eqv? type-10221 'lexical)
+ (let ((name-10234 (syntax->datum id-10217))
+ (exp-10236
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ val-10218
+ r-10180
+ w-10181
+ (let ((props-10257
+ (source-properties
+ (if (if (vector? val-10218)
+ (if (= (vector-length
+ val-10218)
+ 4)
+ (eq? (vector-ref
+ val-10218
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref val-10218 1)
+ val-10218))))
+ (if (pair? props-10257)
+ props-10257
+ #f))
+ #f
+ mod-10183
+ #f))
+ (lambda (type-10290
+ value-10291
+ form-10292
+ e-10293
+ w-10294
+ s-10295
+ mod-10296)
+ (expand-expr-4384
+ type-10290
+ value-10291
+ form-10292
+ e-10293
+ r-10180
+ w-10294
+ s-10295
+ mod-10296)))))
+ (begin
+ (if (if (struct? exp-10236)
+ (eq? (struct-vtable exp-10236)
+ (vector-ref %expanded-vtables 14))
+ #f)
+ (let ((meta-10308 (struct-ref exp-10236 1)))
+ (if (not (assq 'name meta-10308))
+ (let ((v-10315
+ (cons (cons 'name name-10234)
+ meta-10308)))
+ (struct-set! exp-10236 1 v-10315)))))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 4)
+ s-10182
+ name-10234
+ value-10222
+ exp-10236)))
+ (if (eqv? type-10221 'global)
+ (let ((exp-10334
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ val-10218
+ r-10180
+ w-10181
+ (let ((props-10356
+ (source-properties
+ (if (if (vector? val-10218)
+ (if (= (vector-length
+ val-10218)
+ 4)
+ (eq? (vector-ref
+ val-10218
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref val-10218 1)
+ val-10218))))
+ (if (pair? props-10356)
+ props-10356
+ #f))
+ #f
+ mod-10183
+ #f))
+ (lambda (type-10389
+ value-10390
+ form-10391
+ e-10392
+ w-10393
+ s-10394
+ mod-10395)
+ (expand-expr-4384
+ type-10389
+ value-10390
+ form-10391
+ e-10392
+ r-10180
+ w-10393
+ s-10394
+ mod-10395)))))
+ (begin
+ (if (if (struct? exp-10334)
+ (eq? (struct-vtable exp-10334)
+ (vector-ref %expanded-vtables 14))
+ #f)
+ (let ((meta-10407 (struct-ref exp-10334 1)))
+ (if (not (assq 'name meta-10407))
+ (let ((v-10414
+ (cons (cons 'name value-10222)
+ meta-10407)))
+ (struct-set! exp-10334 1 v-10414)))))
+ (analyze-variable-4319
+ id-mod-10223
+ value-10222
+ (lambda (mod-10422 var-10423 public?-10424)
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 6)
+ s-10182
+ mod-10422
+ var-10423
+ public?-10424
+ exp-10334))
+ (lambda (var-10433)
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 8)
+ s-10182
+ var-10433
+ exp-10334)))))
+ (if (eqv? type-10221 'macro)
+ (if (procedure-property
+ value-10222
+ 'variable-transformer)
+ (let ((e-10449
+ (expand-macro-4386
+ value-10222
+ e-10179
+ r-10180
+ w-10181
+ s-10182
+ #f
+ mod-10183)))
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-10449
+ r-10180
+ '(())
+ (let ((props-10460
+ (source-properties
+ (if (if (vector? e-10449)
+ (if (= (vector-length
+ e-10449)
+ 4)
+ (eq? (vector-ref
+ e-10449
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref e-10449 1)
+ e-10449))))
+ (if (pair? props-10460)
+ props-10460
+ #f))
+ #f
+ mod-10183
+ #f))
+ (lambda (type-10483
+ value-10484
+ form-10485
+ e-10486
+ w-10487
+ s-10488
+ mod-10489)
+ (expand-expr-4384
+ type-10483
+ value-10484
+ form-10485
+ e-10486
+ r-10180
+ w-10487
+ s-10488
+ mod-10489))))
+ (syntax-violation
+ 'set!
+ "not a variable transformer"
+ (if (if (null? (car w-10181))
+ (null? (cdr w-10181))
+ #f)
+ e-10179
+ (if (if (vector? e-10179)
+ (if (= (vector-length e-10179) 4)
+ (eq? (vector-ref e-10179 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-10522
+ (vector-ref e-10179 1))
+ (wrap-10523
+ (let ((w2-10533
+ (vector-ref e-10179 2)))
+ (let ((m1-10534 (car w-10181))
+ (s1-10535 (cdr w-10181)))
+ (if (null? m1-10534)
+ (if (null? s1-10535)
+ w2-10533
+ (cons (car w2-10533)
+ (let ((m2-10552
+ (cdr
w2-10533)))
+ (if (null?
m2-10552)
+ s1-10535
+ (append
+ s1-10535
+ m2-10552)))))
+ (cons (let ((m2-10560
+ (car
w2-10533)))
+ (if (null? m2-10560)
+ m1-10534
+ (append
+ m1-10534
+ m2-10560)))
+ (let ((m2-10568
+ (cdr
w2-10533)))
+ (if (null? m2-10568)
+ s1-10535
+ (append
+ s1-10535
+ m2-10568))))))))
+ (module-10524
+ (vector-ref e-10179 3)))
+ (vector
+ 'syntax-object
+ expression-10522
+ wrap-10523
+ module-10524))
+ (if (null? e-10179)
+ e-10179
+ (vector
+ 'syntax-object
+ e-10179
+ w-10181
+ mod-10183))))
+ (if (if (null? (car w-10181))
+ (null? (cdr w-10181))
+ #f)
+ id-10217
+ (if (if (vector? id-10217)
+ (if (= (vector-length id-10217) 4)
+ (eq? (vector-ref id-10217 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-10620
+ (vector-ref id-10217 1))
+ (wrap-10621
+ (let ((w2-10631
+ (vector-ref id-10217 2)))
+ (let ((m1-10632 (car w-10181))
+ (s1-10633 (cdr w-10181)))
+ (if (null? m1-10632)
+ (if (null? s1-10633)
+ w2-10631
+ (cons (car w2-10631)
+ (let ((m2-10650
+ (cdr
w2-10631)))
+ (if (null?
m2-10650)
+ s1-10633
+ (append
+ s1-10633
+ m2-10650)))))
+ (cons (let ((m2-10658
+ (car
w2-10631)))
+ (if (null? m2-10658)
+ m1-10632
(append
- s1-10733
- m2-10766))))))))
- (module-10722
- (vector-ref id-10166 3)))
+ m1-10632
+ m2-10658)))
+ (let ((m2-10666
+ (cdr
w2-10631)))
+ (if (null? m2-10666)
+ s1-10633
+ (append
+ s1-10633
+ m2-10666))))))))
+ (module-10622
+ (vector-ref id-10217 3)))
(vector
'syntax-object
- expression-10720
- wrap-10721
- module-10722))
- (if (null? id-10166)
- id-10166
+ expression-10620
+ wrap-10621
+ module-10622))
+ (if (null? id-10217)
+ id-10217
(vector
'syntax-object
- id-10166
- w-10130
- id-mod-10172))))))
- (if (eqv? type-10170 'displaced-lexical)
+ id-10217
+ w-10181
+ id-mod-10223))))))
+ (if (eqv? type-10221 'displaced-lexical)
(syntax-violation
'set!
"identifier out of context"
- (if (if (null? (car w-10130))
- (null? (cdr w-10130))
+ (if (if (null? (car w-10181))
+ (null? (cdr w-10181))
#f)
- id-10166
- (if (if (vector? id-10166)
- (if (= (vector-length id-10166) 4)
- (eq? (vector-ref id-10166 0)
+ id-10217
+ (if (if (vector? id-10217)
+ (if (= (vector-length id-10217) 4)
+ (eq? (vector-ref id-10217 0)
'syntax-object)
#f)
#f)
- (let ((expression-10824
- (vector-ref id-10166 1))
- (wrap-10825
- (let ((w2-10835
- (vector-ref id-10166 2)))
- (let ((m1-10836 (car w-10130))
- (s1-10837 (cdr w-10130)))
- (if (null? m1-10836)
- (if (null? s1-10837)
- w2-10835
- (cons (car w2-10835)
- (let ((m2-10854
- (cdr
w2-10835)))
- (if (null?
m2-10854)
- s1-10837
+ (let ((expression-10724
+ (vector-ref id-10217 1))
+ (wrap-10725
+ (let ((w2-10735
+ (vector-ref id-10217 2)))
+ (let ((m1-10736 (car w-10181))
+ (s1-10737 (cdr w-10181)))
+ (if (null? m1-10736)
+ (if (null? s1-10737)
+ w2-10735
+ (cons (car w2-10735)
+ (let ((m2-10754
+ (cdr
w2-10735)))
+ (if (null?
m2-10754)
+ s1-10737
(append
- s1-10837
- m2-10854)))))
- (cons (let ((m2-10862
- (car
w2-10835)))
- (if (null? m2-10862)
- m1-10836
+ s1-10737
+ m2-10754)))))
+ (cons (let ((m2-10762
+ (car
w2-10735)))
+ (if (null? m2-10762)
+ m1-10736
(append
- m1-10836
- m2-10862)))
- (let ((m2-10870
- (cdr
w2-10835)))
- (if (null? m2-10870)
- s1-10837
+ m1-10736
+ m2-10762)))
+ (let ((m2-10770
+ (cdr
w2-10735)))
+ (if (null? m2-10770)
+ s1-10737
(append
- s1-10837
- m2-10870))))))))
- (module-10826
- (vector-ref id-10166 3)))
+ s1-10737
+ m2-10770))))))))
+ (module-10726
+ (vector-ref id-10217 3)))
(vector
'syntax-object
- expression-10824
- wrap-10825
- module-10826))
- (if (null? id-10166)
- id-10166
+ expression-10724
+ wrap-10725
+ module-10726))
+ (if (null? id-10217)
+ id-10217
(vector
'syntax-object
- id-10166
- w-10130
- mod-10132)))))
+ id-10217
+ w-10181
+ mod-10183)))))
(syntax-violation
'set!
"bad set!"
- (let ((x-10902
+ (let ((x-10802
(begin
- (if (if (pair? e-10128) s-10131 #f)
+ (if (if s-10182
+ (supports-source-properties?
+ e-10179)
+ #f)
(set-source-properties!
- e-10128
- s-10131))
- e-10128)))
- (if (if (null? (car w-10130))
- (null? (cdr w-10130))
+ e-10179
+ s-10182))
+ e-10179)))
+ (if (if (null? (car w-10181))
+ (null? (cdr w-10181))
#f)
- x-10902
- (if (if (vector? x-10902)
- (if (= (vector-length x-10902) 4)
- (eq? (vector-ref x-10902 0)
+ x-10802
+ (if (if (vector? x-10802)
+ (if (= (vector-length x-10802) 4)
+ (eq? (vector-ref x-10802 0)
'syntax-object)
#f)
#f)
- (let ((expression-10934
- (vector-ref x-10902 1))
- (wrap-10935
- (let ((w2-10943
- (vector-ref x-10902 2)))
- (let ((m1-10944 (car w-10130))
- (s1-10945 (cdr w-10130)))
- (if (null? m1-10944)
- (if (null? s1-10945)
- w2-10943
- (cons (car w2-10943)
- (let ((m2-10960
- (cdr
w2-10943)))
- (if (null?
m2-10960)
- s1-10945
+ (let ((expression-10834
+ (vector-ref x-10802 1))
+ (wrap-10835
+ (let ((w2-10843
+ (vector-ref x-10802 2)))
+ (let ((m1-10844 (car w-10181))
+ (s1-10845 (cdr w-10181)))
+ (if (null? m1-10844)
+ (if (null? s1-10845)
+ w2-10843
+ (cons (car w2-10843)
+ (let ((m2-10860
+ (cdr
w2-10843)))
+ (if (null?
m2-10860)
+ s1-10845
(append
- s1-10945
- m2-10960)))))
- (cons (let ((m2-10968
- (car
w2-10943)))
- (if (null?
m2-10968)
- m1-10944
+ s1-10845
+ m2-10860)))))
+ (cons (let ((m2-10868
+ (car
w2-10843)))
+ (if (null?
m2-10868)
+ m1-10844
(append
- m1-10944
- m2-10968)))
- (let ((m2-10976
- (cdr
w2-10943)))
- (if (null?
m2-10976)
- s1-10945
+ m1-10844
+ m2-10868)))
+ (let ((m2-10876
+ (cdr
w2-10843)))
+ (if (null?
m2-10876)
+ s1-10845
(append
- s1-10945
-
m2-10976))))))))
- (module-10936
- (vector-ref x-10902 3)))
+ s1-10845
+
m2-10876))))))))
+ (module-10836
+ (vector-ref x-10802 3)))
(vector
'syntax-object
- expression-10934
- wrap-10935
- module-10936))
- (if (null? x-10902)
- x-10902
+ expression-10834
+ wrap-10835
+ module-10836))
+ (if (null? x-10802)
+ x-10802
(vector
'syntax-object
- x-10902
- w-10130
- mod-10132)))))))))))))
- tmp-10134)
- (let ((tmp-10991
- ($sc-dispatch e-10128 '(_ (any . each-any) any))))
- (if tmp-10991
+ x-10802
+ w-10181
+ mod-10183)))))))))))))
+ tmp-10185)
+ (let ((tmp-10891
+ ($sc-dispatch e-10179 '(_ (any . each-any) any))))
+ (if tmp-10891
(@apply
- (lambda (head-10995 tail-10996 val-10997)
+ (lambda (head-10895 tail-10896 val-10897)
(call-with-values
(lambda ()
- (syntax-type-4381
- head-10995
- r-10129
+ (syntax-type-4382
+ head-10895
+ r-10180
'(())
#f
#f
- mod-10132
+ mod-10183
#t))
- (lambda (type-11000
- value-11001
- ee*-11002
- ee-11003
- ww-11004
- ss-11005
- modmod-11006)
- (if (eqv? type-11000 'module-ref)
- (let ((val-11012
- (expand-4382
- val-10997
- r-10129
- w-10130
- mod-10132)))
+ (lambda (type-10900
+ value-10901
+ ee*-10902
+ ee-10903
+ ww-10904
+ ss-10905
+ modmod-10906)
+ (if (eqv? type-10900 'module-ref)
+ (let ((val-10912
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ val-10897
+ r-10180
+ w-10181
+ (let ((props-10979
+ (source-properties
+ (if (if (vector? val-10897)
+ (if (= (vector-length
+ val-10897)
+ 4)
+ (eq? (vector-ref
+ val-10897
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref val-10897 1)
+ val-10897))))
+ (if (pair? props-10979)
+ props-10979
+ #f))
+ #f
+ mod-10183
+ #f))
+ (lambda (type-11012
+ value-11013
+ form-11014
+ e-11015
+ w-11016
+ s-11017
+ mod-11018)
+ (expand-expr-4384
+ type-11012
+ value-11013
+ form-11014
+ e-11015
+ r-10180
+ w-11016
+ s-11017
+ mod-11018)))))
(call-with-values
(lambda ()
- (value-11001
- (cons head-10995 tail-10996)
- r-10129
- w-10130))
- (lambda (e-11013
- r-11014
- w-11015
- s*-11016
- mod-11017)
- (let ((tmp-11019 (list e-11013)))
+ (value-10901
+ (cons head-10895 tail-10896)
+ r-10180
+ w-10181))
+ (lambda (e-10913
+ r-10914
+ w-10915
+ s*-10916
+ mod-10917)
+ (let ((tmp-10919 (list e-10913)))
(if (@apply
- (lambda (e-11021)
- (if (symbol? e-11021)
+ (lambda (e-10921)
+ (if (symbol? e-10921)
#t
- (if (if (vector? e-11021)
+ (if (if (vector? e-10921)
(if (= (vector-length
- e-11021)
+ e-10921)
4)
(eq? (vector-ref
- e-11021
+ e-10921
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref e-11021 1))
+ (vector-ref e-10921 1))
#f)))
- tmp-11019)
+ tmp-10919)
(@apply
- (lambda (e-11051)
- (build-global-assignment-4320
- s-10131
- (syntax->datum e-11051)
- val-11012
- mod-11017))
- tmp-11019)
+ (lambda (e-10951)
+ (let ((var-10956
+ (syntax->datum e-10951)))
+ (begin
+ (if (if (struct? val-10912)
+ (eq? (struct-vtable
+ val-10912)
+ (vector-ref
+ %expanded-vtables
+ 14))
+ #f)
+ (let ((meta-11034
+ (struct-ref
+ val-10912
+ 1)))
+ (if (not (assq 'name
+ meta-11034))
+ (let ((v-11043
+ (cons (cons 'name
+
var-10956)
+ meta-11034)))
+ (struct-set!
+ val-10912
+ 1
+ v-11043)))))
+ (analyze-variable-4319
+ mod-10917
+ var-10956
+ (lambda (mod-11049
+ var-11050
+ public?-11051)
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 6)
+ s-10182
+ mod-11049
+ var-11050
+ public?-11051
+ val-10912))
+ (lambda (var-11062)
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 8)
+ s-10182
+ var-11062
+ val-10912))))))
+ tmp-10919)
(syntax-violation
#f
"source expression failed to match any
pattern"
- e-11013))))))
- (build-call-4313
- s-10131
- (expand-4382
- (list '#(syntax-object
- setter
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(key)
- #((m-*-3608 top))
- #("l-*-3609"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(type value ee* ee ww ss modmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-3601"
- "l-*-3602"
- "l-*-3603"
- "l-*-3604"
- "l-*-3605"
- "l-*-3606"
- "l-*-3607"))
- #(ribcage
- #(head tail val)
- #((top) (top) (top))
- #("l-*-3586"
- "l-*-3587"
- "l-*-3588"))
- #(ribcage () () ())
- #(ribcage
- #(e r w s mod)
- #((top) (top) (top) (top) (top))
- #("l-*-3560"
- "l-*-3561"
- "l-*-3562"
- "l-*-3563"
- "l-*-3564"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-call
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- 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
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- 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-primcall
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-call
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-seq
- make-primcall
- make-call
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-478"
- "l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-401"
- "l-*-399"
- "l-*-396"
- "l-*-395"
- "l-*-394"
- "l-*-392"
- "l-*-391"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-372"
- "l-*-370"
- "l-*-369"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-360"
- "l-*-359"
- "l-*-358"
- "l-*-356"
- "l-*-355"
- "l-*-352"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-341"
- "l-*-340"
- "l-*-338"
- "l-*-336"
- "l-*-335"
- "l-*-332"
- "l-*-331"
- "l-*-329"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-310"
- "l-*-308"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-257"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-245"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45"))
- #(ribcage () () ()))
- (hygiene guile))
- head-10995)
- r-10129
- w-10130
- mod-10132)
- (map (lambda (e-11364)
- (expand-4382
- e-11364
- r-10129
- w-10130
- mod-10132))
- (append tail-10996 (list val-10997))))))))
- tmp-10991)
+ e-10913))))))
+ (let ((fun-exp-11078
+ (let ((e-11086
+ (list '#(syntax-object
+ setter
+ ((top)
+ #(ribcage () () ())
+ #(ribcage
+ #(key)
+ #((m-*-3609 top))
+ #("l-*-3610"))
+ #(ribcage () () ())
+ #(ribcage () () ())
+ #(ribcage
+ #(type
+ value
+ ee*
+ ee
+ ww
+ ss
+ modmod)
+ #((top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top))
+ #("l-*-3602"
+ "l-*-3603"
+ "l-*-3604"
+ "l-*-3605"
+ "l-*-3606"
+ "l-*-3607"
+ "l-*-3608"))
+ #(ribcage
+ #(head tail val)
+ #((top) (top) (top))
+ #("l-*-3587"
+ "l-*-3588"
+ "l-*-3589"))
+ #(ribcage () () ())
+ #(ribcage
+ #(e r w s mod)
+ #((top)
+ (top)
+ (top)
+ (top)
+ (top))
+ #("l-*-3561"
+ "l-*-3562"
+ "l-*-3563"
+ "l-*-3564"
+ "l-*-3565"))
+ #(ribcage
+ (lambda-var-list
+ gen-var
+ strip
+ expand-lambda-case
+ lambda*-formals
+ expand-simple-lambda
+ lambda-formals
+ ellipsis?
+ expand-void
+
eval-local-transformer
+ expand-local-syntax
+ expand-body
+ expand-macro
+ expand-call
+ expand-expr
+ expand
+ syntax-type
+ parse-when-list
+ expand-install-global
+ expand-top-sequence
+ expand-sequence
+ source-wrap
+ wrap
+ bound-id-member?
+ distinct-bound-ids?
+ valid-bound-ids?
+ bound-id=?
+ free-id=?
+
with-transformer-environment
+
transformer-environment
+ resolve-identifier
+
locally-bound-identifiers
+ 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
+ macros-only-env
+ extend-var-env
+ extend-env
+ null-env
+ binding-value
+ binding-type
+ make-binding
+ arg-check
+ source-annotation
+ no-source
+
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-primcall
+ build-lambda-case
+ build-case-lambda
+ build-simple-lambda
+
build-global-definition
+
build-global-assignment
+
build-global-reference
+ analyze-variable
+
build-lexical-assignment
+
build-lexical-reference
+ build-dynlet
+ build-conditional
+ build-call
+ build-void
+ maybe-name-value!
+ decorate-source
+
get-global-definition-hook
+
put-global-definition-hook
+ session-id
+ local-eval-hook
+ top-level-eval-hook
+ fx<
+ fx=
+ fx-
+ fx+
+ set-lambda-meta!
+ lambda-meta
+ lambda?
+ make-dynlet
+ make-letrec
+ make-let
+ make-lambda-case
+ make-lambda
+ make-seq
+ make-primcall
+ make-call
+ make-conditional
+ make-toplevel-define
+ make-toplevel-set
+ make-toplevel-ref
+ make-module-set
+ make-module-ref
+ make-lexical-set
+ make-lexical-ref
+ make-primitive-ref
+ make-const
+ make-void)
+ ((top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top))
+ ("l-*-478"
+ "l-*-476"
+ "l-*-474"
+ "l-*-472"
+ "l-*-470"
+ "l-*-468"
+ "l-*-466"
+ "l-*-464"
+ "l-*-462"
+ "l-*-460"
+ "l-*-458"
+ "l-*-456"
+ "l-*-454"
+ "l-*-452"
+ "l-*-450"
+ "l-*-448"
+ "l-*-446"
+ "l-*-444"
+ "l-*-442"
+ "l-*-440"
+ "l-*-438"
+ "l-*-436"
+ "l-*-434"
+ "l-*-432"
+ "l-*-430"
+ "l-*-428"
+ "l-*-426"
+ "l-*-424"
+ "l-*-422"
+ "l-*-420"
+ "l-*-418"
+ "l-*-416"
+ "l-*-414"
+ "l-*-412"
+ "l-*-410"
+ "l-*-408"
+ "l-*-406"
+ "l-*-404"
+ "l-*-402"
+ "l-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "l-*-306"
+ "l-*-304"
+ "l-*-302"
+ "l-*-300"
+ "l-*-298"
+ "l-*-296"
+ "l-*-294"
+ "l-*-292"
+ "l-*-290"
+ "l-*-288"
+ "l-*-286"
+ "l-*-284"
+ "l-*-282"
+ "l-*-280"
+ "l-*-278"
+ "l-*-276"
+ "l-*-274"
+ "l-*-272"
+ "l-*-270"
+ "l-*-268"
+ "l-*-266"
+ "l-*-264"
+ "l-*-262"
+ "l-*-260"
+ "l-*-258"
+ "l-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "l-*-243"
+ "l-*-241"
+ "l-*-239"
+ "l-*-237"
+ "l-*-235"
+ "l-*-233"
+ "l-*-231"
+ "l-*-229"
+ "l-*-227"
+ "l-*-225"
+ "l-*-223"
+ "l-*-221"
+ "l-*-219"
+ "l-*-217"
+ "l-*-215"
+ "l-*-213"
+ "l-*-211"
+ "l-*-209"))
+ #(ribcage
+ (define-structure
+
define-expansion-accessors
+
define-expansion-constructors)
+ ((top) (top) (top))
+ ("l-*-47"
+ "l-*-46"
+ "l-*-45"))
+ #(ribcage () () ()))
+ (hygiene guile))
+ head-10895)))
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-11086
+ r-10180
+ w-10181
+ (let ((props-11096
+ (source-properties
+ (if (if (vector? e-11086)
+ (if (=
(vector-length
+ e-11086)
+ 4)
+ (eq? (vector-ref
+ e-11086
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref e-11086 1)
+ e-11086))))
+ (if (pair? props-11096)
+ props-11096
+ #f))
+ #f
+ mod-10183
+ #f))
+ (lambda (type-11119
+ value-11120
+ form-11121
+ e-11122
+ w-11123
+ s-11124
+ mod-11125)
+ (expand-expr-4384
+ type-11119
+ value-11120
+ form-11121
+ e-11122
+ r-10180
+ w-11123
+ s-11124
+ mod-11125)))))
+ (arg-exps-11079
+ (map (lambda (e-11129)
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ e-11129
+ r-10180
+ w-10181
+ (let ((props-11144
+ (source-properties
+ (if (if (vector?
+ e-11129)
+ (if (=
(vector-length
+
e-11129)
+ 4)
+ (eq?
(vector-ref
+
e-11129
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ e-11129
+ 1)
+ e-11129))))
+ (if (pair? props-11144)
+ props-11144
+ #f))
+ #f
+ mod-10183
+ #f))
+ (lambda (type-11177
+ value-11178
+ form-11179
+ e-11180
+ w-11181
+ s-11182
+ mod-11183)
+ (expand-expr-4384
+ type-11177
+ value-11178
+ form-11179
+ e-11180
+ r-10180
+ w-11181
+ s-11182
+ mod-11183))))
+ (append
+ tail-10896
+ (list val-10897)))))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 11)
+ s-10182
+ fun-exp-11078
+ arg-exps-11079))))))
+ tmp-10891)
(syntax-violation
'set!
"bad set!"
- (let ((x-11452
+ (let ((x-11197
(begin
- (if (if (pair? e-10128) s-10131 #f)
- (set-source-properties! e-10128 s-10131))
- e-10128)))
- (if (if (null? (car w-10130))
- (null? (cdr w-10130))
+ (if (if s-10182
+ (supports-source-properties? e-10179)
+ #f)
+ (set-source-properties! e-10179 s-10182))
+ e-10179)))
+ (if (if (null? (car w-10181))
+ (null? (cdr w-10181))
#f)
- x-11452
- (if (if (vector? x-11452)
- (if (= (vector-length x-11452) 4)
- (eq? (vector-ref x-11452 0) 'syntax-object)
+ x-11197
+ (if (if (vector? x-11197)
+ (if (= (vector-length x-11197) 4)
+ (eq? (vector-ref x-11197 0) 'syntax-object)
#f)
#f)
- (let ((expression-11484 (vector-ref x-11452 1))
- (wrap-11485
- (let ((w2-11493 (vector-ref x-11452 2)))
- (let ((m1-11494 (car w-10130))
- (s1-11495 (cdr w-10130)))
- (if (null? m1-11494)
- (if (null? s1-11495)
- w2-11493
- (cons (car w2-11493)
- (let ((m2-11510
- (cdr w2-11493)))
- (if (null? m2-11510)
- s1-11495
+ (let ((expression-11229 (vector-ref x-11197 1))
+ (wrap-11230
+ (let ((w2-11238 (vector-ref x-11197 2)))
+ (let ((m1-11239 (car w-10181))
+ (s1-11240 (cdr w-10181)))
+ (if (null? m1-11239)
+ (if (null? s1-11240)
+ w2-11238
+ (cons (car w2-11238)
+ (let ((m2-11255
+ (cdr w2-11238)))
+ (if (null? m2-11255)
+ s1-11240
(append
- s1-11495
- m2-11510)))))
- (cons (let ((m2-11518 (car w2-11493)))
- (if (null? m2-11518)
- m1-11494
- (append m1-11494 m2-11518)))
- (let ((m2-11526 (cdr w2-11493)))
- (if (null? m2-11526)
- s1-11495
+ s1-11240
+ m2-11255)))))
+ (cons (let ((m2-11263 (car w2-11238)))
+ (if (null? m2-11263)
+ m1-11239
+ (append m1-11239 m2-11263)))
+ (let ((m2-11271 (cdr w2-11238)))
+ (if (null? m2-11271)
+ s1-11240
(append
- s1-11495
- m2-11526))))))))
- (module-11486 (vector-ref x-11452 3)))
+ s1-11240
+ m2-11271))))))))
+ (module-11231 (vector-ref x-11197 3)))
(vector
'syntax-object
- expression-11484
- wrap-11485
- module-11486))
- (if (null? x-11452)
- x-11452
+ expression-11229
+ wrap-11230
+ module-11231))
+ (if (null? x-11197)
+ x-11197
(vector
'syntax-object
- x-11452
- w-10130
- mod-10132))))))))))))
+ x-11197
+ w-10181
+ mod-10183))))))))))))
(module-define!
(current-module)
'@
(make-syntax-transformer
'@
'module-ref
- (lambda (e-11557 r-11558 w-11559)
- (let ((tmp-11561
- ($sc-dispatch e-11557 '(_ each-any any))))
- (if (if tmp-11561
+ (lambda (e-11302 r-11303 w-11304)
+ (let ((tmp-11306
+ ($sc-dispatch e-11302 '(_ each-any any))))
+ (if (if tmp-11306
(@apply
- (lambda (mod-11564 id-11565)
- (if (and-map id?-4346 mod-11564)
- (if (symbol? id-11565)
+ (lambda (mod-11309 id-11310)
+ (if (and-map id?-4347 mod-11309)
+ (if (symbol? id-11310)
#t
- (if (if (vector? id-11565)
- (if (= (vector-length id-11565) 4)
- (eq? (vector-ref id-11565 0)
+ (if (if (vector? id-11310)
+ (if (= (vector-length id-11310) 4)
+ (eq? (vector-ref id-11310 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-11565 1))
+ (symbol? (vector-ref id-11310 1))
#f))
#f))
- tmp-11561)
+ tmp-11306)
#f)
(@apply
- (lambda (mod-11605 id-11606)
+ (lambda (mod-11350 id-11351)
(values
- (syntax->datum id-11606)
- r-11558
- w-11559
+ (syntax->datum id-11351)
+ r-11303
+ w-11304
#f
(syntax->datum
(cons '#(syntax-object
@@ -11733,12 +13039,12 @@
#(ribcage
#(mod id)
#((top) (top))
- #("l-*-3650" "l-*-3651"))
+ #("l-*-3651" "l-*-3652"))
#(ribcage () () ())
#(ribcage
#(e r w)
#((top) (top) (top))
- #("l-*-3638" "l-*-3639" "l-*-3640"))
+ #("l-*-3639" "l-*-3640" "l-*-3641"))
#(ribcage
(lambda-var-list
gen-var
@@ -12171,66 +13477,66 @@
("l-*-47" "l-*-46" "l-*-45"))
#(ribcage () () ()))
(hygiene guile))
- mod-11605))))
- tmp-11561)
+ mod-11350))))
+ tmp-11306)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-11557))))))
- (global-extend-4344
+ e-11302))))))
+ (global-extend-4345
'module-ref
'@@
- (lambda (e-11706 r-11707 w-11708)
+ (lambda (e-11465 r-11466 w-11467)
(letrec*
- ((remodulate-11709
- (lambda (x-11927 mod-11928)
- (if (pair? x-11927)
- (cons (remodulate-11709 (car x-11927) mod-11928)
- (remodulate-11709 (cdr x-11927) mod-11928))
- (if (if (vector? x-11927)
- (if (= (vector-length x-11927) 4)
- (eq? (vector-ref x-11927 0) 'syntax-object)
+ ((remodulate-11468
+ (lambda (x-11530 mod-11531)
+ (if (pair? x-11530)
+ (cons (remodulate-11468 (car x-11530) mod-11531)
+ (remodulate-11468 (cdr x-11530) mod-11531))
+ (if (if (vector? x-11530)
+ (if (= (vector-length x-11530) 4)
+ (eq? (vector-ref x-11530 0) 'syntax-object)
#f)
#f)
- (let ((expression-11942
- (remodulate-11709
- (vector-ref x-11927 1)
- mod-11928))
- (wrap-11943 (vector-ref x-11927 2)))
+ (let ((expression-11545
+ (remodulate-11468
+ (vector-ref x-11530 1)
+ mod-11531))
+ (wrap-11546 (vector-ref x-11530 2)))
(vector
'syntax-object
- expression-11942
- wrap-11943
- mod-11928))
- (if (vector? x-11927)
- (let ((n-11951 (vector-length x-11927)))
- (let ((v-11952 (make-vector n-11951)))
+ expression-11545
+ wrap-11546
+ mod-11531))
+ (if (vector? x-11530)
+ (let ((n-11554 (vector-length x-11530)))
+ (let ((v-11555 (make-vector n-11554)))
(letrec*
- ((loop-11953
- (lambda (i-12008)
- (if (= i-12008 n-11951)
- v-11952
+ ((loop-11556
+ (lambda (i-11611)
+ (if (= i-11611 n-11554)
+ v-11555
(begin
(vector-set!
- v-11952
- i-12008
- (remodulate-11709
- (vector-ref x-11927 i-12008)
- mod-11928))
- (loop-11953 (#{1+}# i-12008)))))))
- (loop-11953 0))))
- x-11927))))))
- (let ((tmp-11711
- ($sc-dispatch e-11706 '(_ each-any any))))
- (if (if tmp-11711
+ v-11555
+ i-11611
+ (remodulate-11468
+ (vector-ref x-11530 i-11611)
+ mod-11531))
+ (loop-11556 (#{1+}# i-11611)))))))
+ (loop-11556 0))))
+ x-11530))))))
+ (let ((tmp-11470
+ ($sc-dispatch e-11465 '(_ each-any any))))
+ (if (if tmp-11470
(@apply
- (lambda (mod-11715 exp-11716)
- (and-map id?-4346 mod-11715))
- tmp-11711)
+ (lambda (mod-11474 exp-11475)
+ (and-map id?-4347 mod-11474))
+ tmp-11470)
#f)
(@apply
- (lambda (mod-11732 exp-11733)
- (let ((mod-11734
+ (lambda (mod-11491 exp-11492)
+ (let ((mod-11493
(syntax->datum
(cons '#(syntax-object
private
@@ -12238,15 +13544,15 @@
#(ribcage
#(mod exp)
#((top) (top))
- #("l-*-3688" "l-*-3689"))
+ #("l-*-3689" "l-*-3690"))
#(ribcage
(remodulate)
((top))
- ("l-*-3661"))
+ ("l-*-3662"))
#(ribcage
#(e r w)
#((top) (top) (top))
- #("l-*-3658" "l-*-3659" "l-*-3660"))
+ #("l-*-3659" "l-*-3660" "l-*-3661"))
#(ribcage
(lambda-var-list
gen-var
@@ -12679,155 +13985,443 @@
("l-*-47" "l-*-46" "l-*-45"))
#(ribcage () () ()))
(hygiene guile))
- mod-11732))))
+ mod-11491))))
(values
- (remodulate-11709 exp-11733 mod-11734)
- r-11707
- w-11708
- (source-annotation-4340 exp-11733)
- mod-11734)))
- tmp-11711)
+ (remodulate-11468 exp-11492 mod-11493)
+ r-11466
+ w-11467
+ (let ((props-11501
+ (source-properties
+ (if (if (vector? exp-11492)
+ (if (= (vector-length exp-11492) 4)
+ (eq? (vector-ref exp-11492 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref exp-11492 1)
+ exp-11492))))
+ (if (pair? props-11501) props-11501 #f))
+ mod-11493)))
+ tmp-11470)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-11706))))))
- (global-extend-4344
+ e-11465))))))
+ (global-extend-4345
'core
'if
- (lambda (e-12117 r-12118 w-12119 s-12120 mod-12121)
- (let ((tmp-12123 ($sc-dispatch e-12117 '(_ any any))))
- (if tmp-12123
+ (lambda (e-11884 r-11885 w-11886 s-11887 mod-11888)
+ (let ((tmp-11890 ($sc-dispatch e-11884 '(_ any any))))
+ (if tmp-11890
(@apply
- (lambda (test-12127 then-12128)
- (build-conditional-4314
- s-12120
- (expand-4382
- test-12127
- r-12118
- w-12119
- mod-12121)
- (expand-4382
- then-12128
- r-12118
- w-12119
- mod-12121)
+ (lambda (test-11894 then-11895)
+ (let ((test-exp-11900
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ test-11894
+ r-11885
+ w-11886
+ (let ((props-11922
+ (source-properties
+ (if (if (vector? test-11894)
+ (if (= (vector-length
+ test-11894)
+ 4)
+ (eq? (vector-ref
+ test-11894
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref test-11894 1)
+ test-11894))))
+ (if (pair? props-11922) props-11922 #f))
+ #f
+ mod-11888
+ #f))
+ (lambda (type-11955
+ value-11956
+ form-11957
+ e-11958
+ w-11959
+ s-11960
+ mod-11961)
+ (expand-expr-4384
+ type-11955
+ value-11956
+ form-11957
+ e-11958
+ r-11885
+ w-11959
+ s-11960
+ mod-11961))))
+ (then-exp-11901
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ then-11895
+ r-11885
+ w-11886
+ (let ((props-11979
+ (source-properties
+ (if (if (vector? then-11895)
+ (if (= (vector-length
+ then-11895)
+ 4)
+ (eq? (vector-ref
+ then-11895
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref then-11895 1)
+ then-11895))))
+ (if (pair? props-11979) props-11979 #f))
+ #f
+ mod-11888
+ #f))
+ (lambda (type-12012
+ value-12013
+ form-12014
+ e-12015
+ w-12016
+ s-12017
+ mod-12018)
+ (expand-expr-4384
+ type-12012
+ value-12013
+ form-12014
+ e-12015
+ r-11885
+ w-12016
+ s-12017
+ mod-12018))))
+ (else-exp-11902
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 0)
+ #f)))
(make-struct/no-tail
- (vector-ref %expanded-vtables 0)
- #f)))
- tmp-12123)
- (let ((tmp-12377
- ($sc-dispatch e-12117 '(_ any any any))))
- (if tmp-12377
+ (vector-ref %expanded-vtables 10)
+ s-11887
+ test-exp-11900
+ then-exp-11901
+ else-exp-11902)))
+ tmp-11890)
+ (let ((tmp-12027
+ ($sc-dispatch e-11884 '(_ any any any))))
+ (if tmp-12027
(@apply
- (lambda (test-12381 then-12382 else-12383)
- (build-conditional-4314
- s-12120
- (expand-4382
- test-12381
- r-12118
- w-12119
- mod-12121)
- (expand-4382
- then-12382
- r-12118
- w-12119
- mod-12121)
- (expand-4382
- else-12383
- r-12118
- w-12119
- mod-12121)))
- tmp-12377)
+ (lambda (test-12031 then-12032 else-12033)
+ (let ((test-exp-12038
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ test-12031
+ r-11885
+ w-11886
+ (let ((props-12060
+ (source-properties
+ (if (if (vector? test-12031)
+ (if (= (vector-length
+ test-12031)
+ 4)
+ (eq? (vector-ref
+ test-12031
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref test-12031 1)
+ test-12031))))
+ (if (pair? props-12060) props-12060 #f))
+ #f
+ mod-11888
+ #f))
+ (lambda (type-12093
+ value-12094
+ form-12095
+ e-12096
+ w-12097
+ s-12098
+ mod-12099)
+ (expand-expr-4384
+ type-12093
+ value-12094
+ form-12095
+ e-12096
+ r-11885
+ w-12097
+ s-12098
+ mod-12099))))
+ (then-exp-12039
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ then-12032
+ r-11885
+ w-11886
+ (let ((props-12117
+ (source-properties
+ (if (if (vector? then-12032)
+ (if (= (vector-length
+ then-12032)
+ 4)
+ (eq? (vector-ref
+ then-12032
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref then-12032 1)
+ then-12032))))
+ (if (pair? props-12117) props-12117 #f))
+ #f
+ mod-11888
+ #f))
+ (lambda (type-12150
+ value-12151
+ form-12152
+ e-12153
+ w-12154
+ s-12155
+ mod-12156)
+ (expand-expr-4384
+ type-12150
+ value-12151
+ form-12152
+ e-12153
+ r-11885
+ w-12154
+ s-12155
+ mod-12156))))
+ (else-exp-12040
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ else-12033
+ r-11885
+ w-11886
+ (let ((props-12174
+ (source-properties
+ (if (if (vector? else-12033)
+ (if (= (vector-length
+ else-12033)
+ 4)
+ (eq? (vector-ref
+ else-12033
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref else-12033 1)
+ else-12033))))
+ (if (pair? props-12174) props-12174 #f))
+ #f
+ mod-11888
+ #f))
+ (lambda (type-12207
+ value-12208
+ form-12209
+ e-12210
+ w-12211
+ s-12212
+ mod-12213)
+ (expand-expr-4384
+ type-12207
+ value-12208
+ form-12209
+ e-12210
+ r-11885
+ w-12211
+ s-12212
+ mod-12213)))))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 10)
+ s-11887
+ test-exp-12038
+ then-exp-12039
+ else-exp-12040)))
+ tmp-12027)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-12117)))))))
- (global-extend-4344
+ e-11884)))))))
+ (global-extend-4345
'core
'with-fluids
- (lambda (e-12822 r-12823 w-12824 s-12825 mod-12826)
- (let ((tmp-12828
+ (lambda (e-12466 r-12467 w-12468 s-12469 mod-12470)
+ (let ((tmp-12472
($sc-dispatch
- e-12822
+ e-12466
'(_ #(each (any any)) any . each-any))))
- (if tmp-12828
+ (if tmp-12472
(@apply
- (lambda (fluid-12832 val-12833 b-12834 b*-12835)
- (build-dynlet-4315
- s-12825
- (map (lambda (x-12924)
- (expand-4382 x-12924 r-12823 w-12824 mod-12826))
- fluid-12832)
- (map (lambda (x-13002)
- (expand-4382 x-13002 r-12823 w-12824 mod-12826))
- val-12833)
- (expand-body-4386
- (cons b-12834 b*-12835)
- (let ((x-13091
- (begin
- (if (if (pair? e-12822) s-12825 #f)
- (set-source-properties! e-12822 s-12825))
- e-12822)))
- (if (if (null? (car w-12824))
- (null? (cdr w-12824))
- #f)
- x-13091
- (if (if (vector? x-13091)
- (if (= (vector-length x-13091) 4)
- (eq? (vector-ref x-13091 0) 'syntax-object)
- #f)
- #f)
- (let ((expression-13123 (vector-ref x-13091 1))
- (wrap-13124
- (let ((w2-13132 (vector-ref x-13091 2)))
- (let ((m1-13133 (car w-12824))
- (s1-13134 (cdr w-12824)))
- (if (null? m1-13133)
- (if (null? s1-13134)
- w2-13132
- (cons (car w2-13132)
- (let ((m2-13149
- (cdr w2-13132)))
- (if (null? m2-13149)
- s1-13134
+ (lambda (fluid-12476 val-12477 b-12478 b*-12479)
+ (let ((fluids-12483
+ (map (lambda (x-12491)
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ x-12491
+ r-12467
+ w-12468
+ (let ((props-12506
+ (source-properties
+ (if (if (vector? x-12491)
+ (if (= (vector-length
+ x-12491)
+ 4)
+ (eq? (vector-ref
+ x-12491
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref x-12491 1)
+ x-12491))))
+ (if (pair? props-12506)
+ props-12506
+ #f))
+ #f
+ mod-12470
+ #f))
+ (lambda (type-12539
+ value-12540
+ form-12541
+ e-12542
+ w-12543
+ s-12544
+ mod-12545)
+ (expand-expr-4384
+ type-12539
+ value-12540
+ form-12541
+ e-12542
+ r-12467
+ w-12543
+ s-12544
+ mod-12545))))
+ fluid-12476))
+ (vals-12484
+ (map (lambda (x-12549)
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ x-12549
+ r-12467
+ w-12468
+ (let ((props-12564
+ (source-properties
+ (if (if (vector? x-12549)
+ (if (= (vector-length
+ x-12549)
+ 4)
+ (eq? (vector-ref
+ x-12549
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref x-12549 1)
+ x-12549))))
+ (if (pair? props-12564)
+ props-12564
+ #f))
+ #f
+ mod-12470
+ #f))
+ (lambda (type-12597
+ value-12598
+ form-12599
+ e-12600
+ w-12601
+ s-12602
+ mod-12603)
+ (expand-expr-4384
+ type-12597
+ value-12598
+ form-12599
+ e-12600
+ r-12467
+ w-12601
+ s-12602
+ mod-12603))))
+ val-12477))
+ (body-12485
+ (expand-body-4387
+ (cons b-12478 b*-12479)
+ (let ((x-12616
+ (begin
+ (if (if s-12469
+ (supports-source-properties?
+ e-12466)
+ #f)
+ (set-source-properties!
+ e-12466
+ s-12469))
+ e-12466)))
+ (if (if (null? (car w-12468))
+ (null? (cdr w-12468))
+ #f)
+ x-12616
+ (if (if (vector? x-12616)
+ (if (= (vector-length x-12616) 4)
+ (eq? (vector-ref x-12616 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (make-syntax-object-4333
+ (vector-ref x-12616 1)
+ (let ((w2-12652 (vector-ref x-12616 2)))
+ (let ((m1-12653 (car w-12468))
+ (s1-12654 (cdr w-12468)))
+ (if (null? m1-12653)
+ (if (null? s1-12654)
+ w2-12652
+ (cons (car w2-12652)
+ (let ((m2-12669
+ (cdr w2-12652)))
+ (if (null? m2-12669)
+ s1-12654
(append
- s1-13134
- m2-13149)))))
- (cons (let ((m2-13157
- (car w2-13132)))
- (if (null? m2-13157)
- m1-13133
+ s1-12654
+ m2-12669)))))
+ (cons (let ((m2-12677
+ (car w2-12652)))
+ (if (null? m2-12677)
+ m1-12653
(append
- m1-13133
- m2-13157)))
- (let ((m2-13165
- (cdr w2-13132)))
- (if (null? m2-13165)
- s1-13134
+ m1-12653
+ m2-12677)))
+ (let ((m2-12685
+ (cdr w2-12652)))
+ (if (null? m2-12685)
+ s1-12654
(append
- s1-13134
- m2-13165))))))))
- (module-13125 (vector-ref x-13091 3)))
- (vector
- 'syntax-object
- expression-13123
- wrap-13124
- module-13125))
- (if (null? x-13091)
- x-13091
- (vector
- 'syntax-object
- x-13091
- w-12824
- mod-12826)))))
- r-12823
- w-12824
- mod-12826)))
- tmp-12828)
+ s1-12654
+ m2-12685)))))))
+ (vector-ref x-12616 3))
+ (if (null? x-12616)
+ x-12616
+ (make-syntax-object-4333
+ x-12616
+ w-12468
+ mod-12470)))))
+ r-12467
+ w-12468
+ mod-12470)))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 18)
+ s-12469
+ fluids-12483
+ vals-12484
+ body-12485)))
+ tmp-12472)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-12822)))))
+ e-12466)))))
(module-define!
(current-module)
'begin
@@ -12857,54 +14451,54 @@
'eval-when
'eval-when
'()))
- (global-extend-4344
+ (global-extend-4345
'core
'syntax-case
(letrec*
- ((convert-pattern-13465
- (lambda (pattern-15087 keys-15088)
+ ((convert-pattern-12980
+ (lambda (pattern-14451 keys-14452)
(letrec*
- ((cvt*-15089
- (lambda (p*-15888 n-15889 ids-15890)
- (if (not (pair? p*-15888))
- (cvt-15091 p*-15888 n-15889 ids-15890)
+ ((cvt*-14453
+ (lambda (p*-15252 n-15253 ids-15254)
+ (if (not (pair? p*-15252))
+ (cvt-14455 p*-15252 n-15253 ids-15254)
(call-with-values
(lambda ()
- (cvt*-15089 (cdr p*-15888) n-15889 ids-15890))
- (lambda (y-15893 ids-15894)
+ (cvt*-14453 (cdr p*-15252) n-15253 ids-15254))
+ (lambda (y-15257 ids-15258)
(call-with-values
(lambda ()
- (cvt-15091 (car p*-15888) n-15889 ids-15894))
- (lambda (x-15897 ids-15898)
+ (cvt-14455 (car p*-15252) n-15253 ids-15258))
+ (lambda (x-15261 ids-15262)
(values
- (cons x-15897 y-15893)
- ids-15898))))))))
- (v-reverse-15090
- (lambda (x-15899)
+ (cons x-15261 y-15257)
+ ids-15262))))))))
+ (v-reverse-14454
+ (lambda (x-15263)
(letrec*
- ((loop-15900
- (lambda (r-16001 x-16002)
- (if (not (pair? x-16002))
- (values r-16001 x-16002)
- (loop-15900
- (cons (car x-16002) r-16001)
- (cdr x-16002))))))
- (loop-15900 '() x-15899))))
- (cvt-15091
- (lambda (p-15094 n-15095 ids-15096)
- (if (if (symbol? p-15094)
+ ((loop-15264
+ (lambda (r-15365 x-15366)
+ (if (not (pair? x-15366))
+ (values r-15365 x-15366)
+ (loop-15264
+ (cons (car x-15366) r-15365)
+ (cdr x-15366))))))
+ (loop-15264 '() x-15263))))
+ (cvt-14455
+ (lambda (p-14458 n-14459 ids-14460)
+ (if (if (symbol? p-14458)
#t
- (if (if (vector? p-15094)
- (if (= (vector-length p-15094) 4)
- (eq? (vector-ref p-15094 0) 'syntax-object)
+ (if (if (vector? p-14458)
+ (if (= (vector-length p-14458) 4)
+ (eq? (vector-ref p-14458 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref p-15094 1))
+ (symbol? (vector-ref p-14458 1))
#f))
- (if (bound-id-member?-4374 p-15094 keys-15088)
- (values (vector 'free-id p-15094) ids-15096)
- (if (free-id=?-4370
- p-15094
+ (if (bound-id-member?-4375 p-14458 keys-14452)
+ (values (vector 'free-id p-14458) ids-14460)
+ (if (free-id=?-4371
+ p-14458
'#(syntax-object
_
((top)
@@ -12912,25 +14506,25 @@
#(ribcage
#(p n ids)
#((top) (top) (top))
- #("l-*-3789" "l-*-3790" "l-*-3791"))
+ #("l-*-3790" "l-*-3791" "l-*-3792"))
#(ribcage
(cvt v-reverse cvt*)
((top) (top) (top))
- ("l-*-3762" "l-*-3760" "l-*-3758"))
+ ("l-*-3763" "l-*-3761" "l-*-3759"))
#(ribcage
#(pattern keys)
#((top) (top))
- #("l-*-3756" "l-*-3757"))
+ #("l-*-3757" "l-*-3758"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3752"
- "l-*-3750"
- "l-*-3748"
- "l-*-3746"))
+ ("l-*-3753"
+ "l-*-3751"
+ "l-*-3749"
+ "l-*-3747"))
#(ribcage
(lambda-var-list
gen-var
@@ -13363,25 +14957,25 @@
("l-*-47" "l-*-46" "l-*-45"))
#(ribcage () () ()))
(hygiene guile)))
- (values '_ ids-15096)
+ (values '_ ids-14460)
(values
'any
- (cons (cons p-15094 n-15095) ids-15096))))
- (let ((tmp-15228 ($sc-dispatch p-15094 '(any any))))
- (if (if tmp-15228
+ (cons (cons p-14458 n-14459) ids-14460))))
+ (let ((tmp-14592 ($sc-dispatch p-14458 '(any any))))
+ (if (if tmp-14592
(@apply
- (lambda (x-15232 dots-15233)
- (if (if (if (vector? dots-15233)
- (if (= (vector-length dots-15233)
+ (lambda (x-14596 dots-14597)
+ (if (if (if (vector? dots-14597)
+ (if (= (vector-length dots-14597)
4)
- (eq? (vector-ref dots-15233 0)
+ (eq? (vector-ref dots-14597 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref dots-15233 1))
+ (symbol? (vector-ref dots-14597 1))
#f)
- (free-id=?-4370
- dots-15233
+ (free-id=?-4371
+ dots-14597
'#(syntax-object
...
((top)
@@ -13390,7 +14984,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2324"))
+ #("l-*-2325"))
#(ribcage
(lambda-var-list
gen-var
@@ -13824,43 +15418,43 @@
#(ribcage () () ()))
(hygiene guile)))
#f))
- tmp-15228)
+ tmp-14592)
#f)
(@apply
- (lambda (x-15272 dots-15273)
+ (lambda (x-14636 dots-14637)
(call-with-values
(lambda ()
- (cvt-15091
- x-15272
- (#{1+}# n-15095)
- ids-15096))
- (lambda (p-15274 ids-15275)
+ (cvt-14455
+ x-14636
+ (#{1+}# n-14459)
+ ids-14460))
+ (lambda (p-14638 ids-14639)
(values
- (if (eq? p-15274 'any)
+ (if (eq? p-14638 'any)
'each-any
- (vector 'each p-15274))
- ids-15275))))
- tmp-15228)
- (let ((tmp-15276
- ($sc-dispatch p-15094 '(any any . any))))
- (if (if tmp-15276
+ (vector 'each p-14638))
+ ids-14639))))
+ tmp-14592)
+ (let ((tmp-14640
+ ($sc-dispatch p-14458 '(any any . any))))
+ (if (if tmp-14640
(@apply
- (lambda (x-15280 dots-15281 ys-15282)
- (if (if (if (vector? dots-15281)
+ (lambda (x-14644 dots-14645 ys-14646)
+ (if (if (if (vector? dots-14645)
(if (= (vector-length
- dots-15281)
+ dots-14645)
4)
(eq? (vector-ref
- dots-15281
+ dots-14645
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref dots-15281 1))
+ (vector-ref dots-14645 1))
#f)
- (free-id=?-4370
- dots-15281
+ (free-id=?-4371
+ dots-14645
'#(syntax-object
...
((top)
@@ -13869,7 +15463,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2324"))
+ #("l-*-2325"))
#(ribcage
(lambda-var-list
gen-var
@@ -14303,156 +15897,156 @@
#(ribcage () () ()))
(hygiene guile)))
#f))
- tmp-15276)
+ tmp-14640)
#f)
(@apply
- (lambda (x-15321 dots-15322 ys-15323)
+ (lambda (x-14685 dots-14686 ys-14687)
(call-with-values
(lambda ()
- (cvt*-15089
- ys-15323
- n-15095
- ids-15096))
- (lambda (ys-15808 ids-15809)
+ (cvt*-14453
+ ys-14687
+ n-14459
+ ids-14460))
+ (lambda (ys-15172 ids-15173)
(call-with-values
(lambda ()
- (cvt-15091
- x-15321
- (#{1+}# n-15095)
- ids-15809))
- (lambda (x-15810 ids-15811)
+ (cvt-14455
+ x-14685
+ (#{1+}# n-14459)
+ ids-15173))
+ (lambda (x-15174 ids-15175)
(call-with-values
(lambda ()
- (v-reverse-15090 ys-15808))
- (lambda (ys-15847 e-15848)
+ (v-reverse-14454 ys-15172))
+ (lambda (ys-15211 e-15212)
(values
(vector
'each+
- x-15810
- ys-15847
- e-15848)
- ids-15811))))))))
- tmp-15276)
- (let ((tmp-15849
- ($sc-dispatch p-15094 '(any . any))))
- (if tmp-15849
+ x-15174
+ ys-15211
+ e-15212)
+ ids-15175))))))))
+ tmp-14640)
+ (let ((tmp-15213
+ ($sc-dispatch p-14458 '(any . any))))
+ (if tmp-15213
(@apply
- (lambda (x-15853 y-15854)
+ (lambda (x-15217 y-15218)
(call-with-values
(lambda ()
- (cvt-15091
- y-15854
- n-15095
- ids-15096))
- (lambda (y-15855 ids-15856)
+ (cvt-14455
+ y-15218
+ n-14459
+ ids-14460))
+ (lambda (y-15219 ids-15220)
(call-with-values
(lambda ()
- (cvt-15091
- x-15853
- n-15095
- ids-15856))
- (lambda (x-15857 ids-15858)
+ (cvt-14455
+ x-15217
+ n-14459
+ ids-15220))
+ (lambda (x-15221 ids-15222)
(values
- (cons x-15857 y-15855)
- ids-15858))))))
- tmp-15849)
- (let ((tmp-15859
- ($sc-dispatch p-15094 '())))
- (if tmp-15859
+ (cons x-15221 y-15219)
+ ids-15222))))))
+ tmp-15213)
+ (let ((tmp-15223
+ ($sc-dispatch p-14458 '())))
+ (if tmp-15223
(@apply
- (lambda () (values '() ids-15096))
- tmp-15859)
- (let ((tmp-15863
+ (lambda () (values '() ids-14460))
+ tmp-15223)
+ (let ((tmp-15227
($sc-dispatch
- p-15094
+ p-14458
'#(vector each-any))))
- (if tmp-15863
+ (if tmp-15227
(@apply
- (lambda (x-15867)
+ (lambda (x-15231)
(call-with-values
(lambda ()
- (cvt-15091
- x-15867
- n-15095
- ids-15096))
- (lambda (p-15868 ids-15869)
+ (cvt-14455
+ x-15231
+ n-14459
+ ids-14460))
+ (lambda (p-15232 ids-15233)
(values
- (vector 'vector p-15868)
- ids-15869))))
- tmp-15863)
+ (vector 'vector p-15232)
+ ids-15233))))
+ tmp-15227)
(values
(vector
'atom
- (strip-4395 p-15094 '(())))
- ids-15096)))))))))))))))
- (cvt-15091 pattern-15087 0 '()))))
- (build-dispatch-call-13466
- (lambda (pvars-16003 exp-16004 y-16005 r-16006 mod-16007)
- (let ((ids-16008 (map car pvars-16003)))
+ (strip-4396 p-14458 '(())))
+ ids-14460)))))))))))))))
+ (cvt-14455 pattern-14451 0 '()))))
+ (build-dispatch-call-12981
+ (lambda (pvars-15367 exp-15368 y-15369 r-15370 mod-15371)
+ (let ((ids-15372 (map car pvars-15367)))
(begin
- (map cdr pvars-16003)
- (let ((labels-16010 (gen-labels-4349 ids-16008))
- (new-vars-16011 (map gen-var-4396 ids-16008)))
- (build-primcall-4325
+ (map cdr pvars-15367)
+ (let ((labels-15374 (gen-labels-4350 ids-15372))
+ (new-vars-15375 (map gen-var-4397 ids-15372)))
+ (build-primcall-4326
#f
'apply
- (list (build-simple-lambda-4322
+ (list (build-simple-lambda-4323
#f
- (map syntax->datum ids-16008)
+ (map syntax->datum ids-15372)
#f
- new-vars-16011
+ new-vars-15375
'()
- (expand-4382
- exp-16004
- (extend-env-4341
- labels-16010
- (map (lambda (var-16339 level-16340)
+ (expand-4383
+ exp-15368
+ (extend-env-4342
+ labels-15374
+ (map (lambda (var-15703 level-15704)
(cons 'syntax
- (cons var-16339 level-16340)))
- new-vars-16011
- (map cdr pvars-16003))
- r-16006)
- (make-binding-wrap-4360
- ids-16008
- labels-16010
+ (cons var-15703 level-15704)))
+ new-vars-15375
+ (map cdr pvars-15367))
+ r-15370)
+ (make-binding-wrap-4361
+ ids-15372
+ labels-15374
'(()))
- mod-16007))
- y-16005)))))))
- (gen-clause-13467
- (lambda (x-14671
- keys-14672
- clauses-14673
- r-14674
- pat-14675
- fender-14676
- exp-14677
- mod-14678)
+ mod-15371))
+ y-15369)))))))
+ (gen-clause-12982
+ (lambda (x-14035
+ keys-14036
+ clauses-14037
+ r-14038
+ pat-14039
+ fender-14040
+ exp-14041
+ mod-14042)
(call-with-values
(lambda ()
- (convert-pattern-13465 pat-14675 keys-14672))
- (lambda (p-14816 pvars-14817)
- (if (not (distinct-bound-ids?-4373 (map car pvars-14817)))
+ (convert-pattern-12980 pat-14039 keys-14036))
+ (lambda (p-14180 pvars-14181)
+ (if (not (distinct-bound-ids?-4374 (map car pvars-14181)))
(syntax-violation
'syntax-case
"duplicate pattern variable"
- pat-14675)
+ pat-14039)
(if (not (and-map
- (lambda (x-14926)
- (not (let ((x-14930 (car x-14926)))
- (if (if (if (vector? x-14930)
+ (lambda (x-14290)
+ (not (let ((x-14294 (car x-14290)))
+ (if (if (if (vector? x-14294)
(if (= (vector-length
- x-14930)
+ x-14294)
4)
(eq? (vector-ref
- x-14930
+ x-14294
0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-14930 1))
+ (symbol? (vector-ref x-14294 1))
#f)
- (free-id=?-4370
- x-14930
+ (free-id=?-4371
+ x-14294
'#(syntax-object
...
((top)
@@ -14461,7 +16055,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2324"))
+ #("l-*-2325"))
#(ribcage
(lambda-var-list
gen-var
@@ -14897,43 +16491,43 @@
#(ribcage () () ()))
(hygiene guile)))
#f))))
- pvars-14817))
+ pvars-14181))
(syntax-violation
'syntax-case
"misplaced ellipsis"
- pat-14675)
- (let ((y-14955
+ pat-14039)
+ (let ((y-14319
(gensym
(string-append (symbol->string 'tmp) "-"))))
- (let ((fun-exp-14960
- (let ((req-14969 (list 'tmp))
- (vars-14971 (list y-14955))
- (exp-14973
- (let ((y-15002
+ (let ((fun-exp-14324
+ (let ((req-14333 (list 'tmp))
+ (vars-14335 (list y-14319))
+ (exp-14337
+ (let ((y-14366
(make-struct/no-tail
(vector-ref
%expanded-vtables
3)
#f
'tmp
- y-14955)))
- (let ((test-exp-15006
- (let ((tmp-15015
+ y-14319)))
+ (let ((test-exp-14370
+ (let ((tmp-14379
($sc-dispatch
- fender-14676
+ fender-14040
'#(atom #t))))
- (if tmp-15015
+ (if tmp-14379
(@apply
- (lambda () y-15002)
- tmp-15015)
- (let ((then-exp-15033
-
(build-dispatch-call-13466
- pvars-14817
- fender-14676
- y-15002
- r-14674
- mod-14678))
- (else-exp-15034
+ (lambda () y-14366)
+ tmp-14379)
+ (let ((then-exp-14397
+
(build-dispatch-call-12981
+ pvars-14181
+ fender-14040
+ y-14366
+ r-14038
+ mod-14042))
+ (else-exp-14398
(make-struct/no-tail
(vector-ref
%expanded-vtables
@@ -14945,82 +16539,82 @@
%expanded-vtables
10)
#f
- y-15002
- then-exp-15033
- else-exp-15034)))))
- (then-exp-15007
- (build-dispatch-call-13466
- pvars-14817
- exp-14677
- y-15002
- r-14674
- mod-14678))
- (else-exp-15008
- (gen-syntax-case-13468
- x-14671
- keys-14672
- clauses-14673
- r-14674
- mod-14678)))
+ y-14366
+ then-exp-14397
+ else-exp-14398)))))
+ (then-exp-14371
+ (build-dispatch-call-12981
+ pvars-14181
+ exp-14041
+ y-14366
+ r-14038
+ mod-14042))
+ (else-exp-14372
+ (gen-syntax-case-12983
+ x-14035
+ keys-14036
+ clauses-14037
+ r-14038
+ mod-14042)))
(make-struct/no-tail
(vector-ref
%expanded-vtables
10)
#f
- test-exp-15006
- then-exp-15007
- else-exp-15008)))))
- (let ((body-14978
+ test-exp-14370
+ then-exp-14371
+ else-exp-14372)))))
+ (let ((body-14342
(make-struct/no-tail
(vector-ref %expanded-vtables 15)
#f
- req-14969
+ req-14333
#f
#f
#f
'()
- vars-14971
- exp-14973
+ vars-14335
+ exp-14337
#f)))
(make-struct/no-tail
(vector-ref %expanded-vtables 14)
#f
'()
- body-14978))))
- (arg-exps-14961
- (list (if (eq? p-14816 'any)
- (let ((args-15066 (list x-14671)))
+ body-14342))))
+ (arg-exps-14325
+ (list (if (eq? p-14180 'any)
+ (let ((args-14430 (list x-14035)))
(make-struct/no-tail
(vector-ref %expanded-vtables 12)
#f
'list
- args-15066))
- (let ((args-15075
- (list x-14671
+ args-14430))
+ (let ((args-14439
+ (list x-14035
(make-struct/no-tail
(vector-ref
%expanded-vtables
1)
#f
- p-14816))))
+ p-14180))))
(make-struct/no-tail
(vector-ref %expanded-vtables 12)
#f
'$sc-dispatch
- args-15075))))))
+ args-14439))))))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
#f
- fun-exp-14960
- arg-exps-14961)))))))))
- (gen-syntax-case-13468
- (lambda (x-14172
- keys-14173
- clauses-14174
- r-14175
- mod-14176)
- (if (null? clauses-14174)
- (let ((args-14182
+ fun-exp-14324
+ arg-exps-14325)))))))))
+ (gen-syntax-case-12983
+ (lambda (x-13555
+ keys-13556
+ clauses-13557
+ r-13558
+ mod-13559)
+ (if (null? clauses-13557)
+ (let ((args-13565
(list (make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
@@ -15029,56 +16623,56 @@
(vector-ref %expanded-vtables 1)
#f
"source expression failed to match any
pattern")
- x-14172)))
+ x-13555)))
(make-struct/no-tail
(vector-ref %expanded-vtables 12)
#f
'syntax-violation
- args-14182))
- (let ((tmp-14201 (car clauses-14174)))
- (let ((tmp-14202 ($sc-dispatch tmp-14201 '(any any))))
- (if tmp-14202
+ args-13565))
+ (let ((tmp-13584 (car clauses-13557)))
+ (let ((tmp-13585 ($sc-dispatch tmp-13584 '(any any))))
+ (if tmp-13585
(@apply
- (lambda (pat-14204 exp-14205)
- (if (if (if (symbol? pat-14204)
+ (lambda (pat-13587 exp-13588)
+ (if (if (if (symbol? pat-13587)
#t
- (if (if (vector? pat-14204)
- (if (= (vector-length pat-14204) 4)
- (eq? (vector-ref pat-14204 0)
+ (if (if (vector? pat-13587)
+ (if (= (vector-length pat-13587) 4)
+ (eq? (vector-ref pat-13587 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref pat-14204 1))
+ (symbol? (vector-ref pat-13587 1))
#f))
(and-map
- (lambda (x-14232)
- (not (free-id=?-4370 pat-14204 x-14232)))
+ (lambda (x-13615)
+ (not (free-id=?-4371 pat-13587 x-13615)))
(cons '#(syntax-object
...
((top)
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3941" "l-*-3942"))
+ #("l-*-3942" "l-*-3943"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
#((top) (top) (top) (top) (top))
- #("l-*-3931"
- "l-*-3932"
+ #("l-*-3932"
"l-*-3933"
"l-*-3934"
- "l-*-3935"))
+ "l-*-3935"
+ "l-*-3936"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3752"
- "l-*-3750"
- "l-*-3748"
- "l-*-3746"))
+ ("l-*-3753"
+ "l-*-3751"
+ "l-*-3749"
+ "l-*-3747"))
#(ribcage
(lambda-var-list
gen-var
@@ -15511,35 +17105,35 @@
("l-*-47" "l-*-46" "l-*-45"))
#(ribcage () () ()))
(hygiene guile))
- keys-14173))
+ keys-13556))
#f)
- (if (free-id=?-4370
+ (if (free-id=?-4371
'#(syntax-object
pad
((top)
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3941" "l-*-3942"))
+ #("l-*-3942" "l-*-3943"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
#((top) (top) (top) (top) (top))
- #("l-*-3931"
- "l-*-3932"
+ #("l-*-3932"
"l-*-3933"
"l-*-3934"
- "l-*-3935"))
+ "l-*-3935"
+ "l-*-3936"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3752"
- "l-*-3750"
- "l-*-3748"
- "l-*-3746"))
+ ("l-*-3753"
+ "l-*-3751"
+ "l-*-3749"
+ "l-*-3747"))
#(ribcage
(lambda-var-list
gen-var
@@ -15978,26 +17572,26 @@
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-3941" "l-*-3942"))
+ #("l-*-3942" "l-*-3943"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
#((top) (top) (top) (top) (top))
- #("l-*-3931"
- "l-*-3932"
+ #("l-*-3932"
"l-*-3933"
"l-*-3934"
- "l-*-3935"))
+ "l-*-3935"
+ "l-*-3936"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-3752"
- "l-*-3750"
- "l-*-3748"
- "l-*-3746"))
+ ("l-*-3753"
+ "l-*-3751"
+ "l-*-3749"
+ "l-*-3747"))
#(ribcage
(lambda-var-list
gen-var
@@ -16430,166 +18024,207 @@
("l-*-47" "l-*-46" "l-*-45"))
#(ribcage () () ()))
(hygiene guile)))
- (expand-4382 exp-14205 r-14175 '(()) mod-14176)
- (let ((labels-14314
+ (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ exp-13588
+ r-13558
+ '(())
+ (let ((props-13635
+ (source-properties
+ (if (if (vector? exp-13588)
+ (if (= (vector-length
+ exp-13588)
+ 4)
+ (eq? (vector-ref
+ exp-13588
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref exp-13588 1)
+ exp-13588))))
+ (if (pair? props-13635) props-13635 #f))
+ #f
+ mod-13559
+ #f))
+ (lambda (type-13668
+ value-13669
+ form-13670
+ e-13671
+ w-13672
+ s-13673
+ mod-13674)
+ (expand-expr-4384
+ type-13668
+ value-13669
+ form-13670
+ e-13671
+ r-13558
+ w-13672
+ s-13673
+ mod-13674)))
+ (let ((labels-13678
(list (string-append
"l-"
- (session-id-4307)
+ (session-id-4308)
(symbol->string (gensym "-")))))
- (var-14315
- (let ((id-14353
- (if (if (vector? pat-14204)
+ (var-13679
+ (let ((id-13717
+ (if (if (vector? pat-13587)
(if (= (vector-length
- pat-14204)
+ pat-13587)
4)
(eq? (vector-ref
- pat-14204
+ pat-13587
0)
'syntax-object)
#f)
#f)
- (vector-ref pat-14204 1)
- pat-14204)))
+ (vector-ref pat-13587 1)
+ pat-13587)))
(gensym
(string-append
- (symbol->string id-14353)
+ (symbol->string id-13717)
"-")))))
- (build-call-4313
+ (build-call-4314
#f
- (build-simple-lambda-4322
+ (build-simple-lambda-4323
#f
- (list (syntax->datum pat-14204))
+ (list (syntax->datum pat-13587))
#f
- (list var-14315)
+ (list var-13679)
'()
- (expand-4382
- exp-14205
- (extend-env-4341
- labels-14314
+ (expand-4383
+ exp-13588
+ (extend-env-4342
+ labels-13678
(list (cons 'syntax
- (cons var-14315 0)))
- r-14175)
- (make-binding-wrap-4360
- (list pat-14204)
- labels-14314
+ (cons var-13679 0)))
+ r-13558)
+ (make-binding-wrap-4361
+ (list pat-13587)
+ labels-13678
'(()))
- mod-14176))
- (list x-14172))))
- (gen-clause-13467
- x-14172
- keys-14173
- (cdr clauses-14174)
- r-14175
- pat-14204
+ mod-13559))
+ (list x-13555))))
+ (gen-clause-12982
+ x-13555
+ keys-13556
+ (cdr clauses-13557)
+ r-13558
+ pat-13587
#t
- exp-14205
- mod-14176)))
- tmp-14202)
- (let ((tmp-14663
- ($sc-dispatch tmp-14201 '(any any any))))
- (if tmp-14663
+ exp-13588
+ mod-13559)))
+ tmp-13585)
+ (let ((tmp-14027
+ ($sc-dispatch tmp-13584 '(any any any))))
+ (if tmp-14027
(@apply
- (lambda (pat-14665 fender-14666 exp-14667)
- (gen-clause-13467
- x-14172
- keys-14173
- (cdr clauses-14174)
- r-14175
- pat-14665
- fender-14666
- exp-14667
- mod-14176))
- tmp-14663)
+ (lambda (pat-14029 fender-14030 exp-14031)
+ (gen-clause-12982
+ x-13555
+ keys-13556
+ (cdr clauses-13557)
+ r-13558
+ pat-14029
+ fender-14030
+ exp-14031
+ mod-13559))
+ tmp-14027)
(syntax-violation
'syntax-case
"invalid clause"
- (car clauses-14174)))))))))))
- (lambda (e-13469 r-13470 w-13471 s-13472 mod-13473)
- (let ((e-13474
- (let ((x-14083
+ (car clauses-13557)))))))))))
+ (lambda (e-12984 r-12985 w-12986 s-12987 mod-12988)
+ (let ((e-12989
+ (let ((x-13466
(begin
- (if (if (pair? e-13469) s-13472 #f)
- (set-source-properties! e-13469 s-13472))
- e-13469)))
- (if (if (null? (car w-13471))
- (null? (cdr w-13471))
+ (if (if s-12987
+ (supports-source-properties? e-12984)
+ #f)
+ (set-source-properties! e-12984 s-12987))
+ e-12984)))
+ (if (if (null? (car w-12986))
+ (null? (cdr w-12986))
#f)
- x-14083
- (if (if (vector? x-14083)
- (if (= (vector-length x-14083) 4)
- (eq? (vector-ref x-14083 0) 'syntax-object)
+ x-13466
+ (if (if (vector? x-13466)
+ (if (= (vector-length x-13466) 4)
+ (eq? (vector-ref x-13466 0) 'syntax-object)
#f)
#f)
- (let ((expression-14115 (vector-ref x-14083 1))
- (wrap-14116
- (let ((w2-14124 (vector-ref x-14083 2)))
- (let ((m1-14125 (car w-13471))
- (s1-14126 (cdr w-13471)))
- (if (null? m1-14125)
- (if (null? s1-14126)
- w2-14124
- (cons (car w2-14124)
- (let ((m2-14141
- (cdr w2-14124)))
- (if (null? m2-14141)
- s1-14126
+ (let ((expression-13498 (vector-ref x-13466 1))
+ (wrap-13499
+ (let ((w2-13507 (vector-ref x-13466 2)))
+ (let ((m1-13508 (car w-12986))
+ (s1-13509 (cdr w-12986)))
+ (if (null? m1-13508)
+ (if (null? s1-13509)
+ w2-13507
+ (cons (car w2-13507)
+ (let ((m2-13524
+ (cdr w2-13507)))
+ (if (null? m2-13524)
+ s1-13509
(append
- s1-14126
- m2-14141)))))
- (cons (let ((m2-14149 (car w2-14124)))
- (if (null? m2-14149)
- m1-14125
- (append m1-14125 m2-14149)))
- (let ((m2-14157 (cdr w2-14124)))
- (if (null? m2-14157)
- s1-14126
+ s1-13509
+ m2-13524)))))
+ (cons (let ((m2-13532 (car w2-13507)))
+ (if (null? m2-13532)
+ m1-13508
+ (append m1-13508 m2-13532)))
+ (let ((m2-13540 (cdr w2-13507)))
+ (if (null? m2-13540)
+ s1-13509
(append
- s1-14126
- m2-14157))))))))
- (module-14117 (vector-ref x-14083 3)))
+ s1-13509
+ m2-13540))))))))
+ (module-13500 (vector-ref x-13466 3)))
(vector
'syntax-object
- expression-14115
- wrap-14116
- module-14117))
- (if (null? x-14083)
- x-14083
+ expression-13498
+ wrap-13499
+ module-13500))
+ (if (null? x-13466)
+ x-13466
(vector
'syntax-object
- x-14083
- w-13471
- mod-13473)))))))
- (let ((tmp-13475 e-13474))
- (let ((tmp-13476
+ x-13466
+ w-12986
+ mod-12988)))))))
+ (let ((tmp-12990 e-12989))
+ (let ((tmp-12991
($sc-dispatch
- tmp-13475
+ tmp-12990
'(_ any each-any . each-any))))
- (if tmp-13476
+ (if tmp-12991
(@apply
- (lambda (val-13524 key-13525 m-13526)
+ (lambda (val-13039 key-13040 m-13041)
(if (and-map
- (lambda (x-13527)
- (if (if (symbol? x-13527)
+ (lambda (x-13042)
+ (if (if (symbol? x-13042)
#t
- (if (if (vector? x-13527)
- (if (= (vector-length x-13527) 4)
- (eq? (vector-ref x-13527 0)
+ (if (if (vector? x-13042)
+ (if (= (vector-length x-13042) 4)
+ (eq? (vector-ref x-13042 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-13527 1))
+ (symbol? (vector-ref x-13042 1))
#f))
- (not (if (if (if (vector? x-13527)
- (if (= (vector-length x-13527)
+ (not (if (if (if (vector? x-13042)
+ (if (= (vector-length x-13042)
4)
- (eq? (vector-ref x-13527 0)
+ (eq? (vector-ref x-13042 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-13527 1))
+ (symbol? (vector-ref x-13042 1))
#f)
- (free-id=?-4370
- x-13527
+ (free-id=?-4371
+ x-13042
'#(syntax-object
...
((top)
@@ -16598,7 +18233,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-2324"))
+ #("l-*-2325"))
#(ribcage
(lambda-var-list
gen-var
@@ -17033,867 +18668,947 @@
(hygiene guile)))
#f))
#f))
- key-13525)
- (let ((x-13592
+ key-13040)
+ (let ((x-13107
(gensym
(string-append
(symbol->string 'tmp)
"-"))))
- (build-call-4313
- s-13472
- (let ((req-13730 (list 'tmp))
- (vars-13732 (list x-13592))
- (exp-13734
- (gen-syntax-case-13468
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- #f
- 'tmp
- x-13592)
- key-13525
- m-13526
- r-13470
- mod-13473)))
- (let ((body-13739
+ (let ((fun-exp-13112
+ (let ((req-13121 (list 'tmp))
+ (vars-13123 (list x-13107))
+ (exp-13125
+ (gen-syntax-case-12983
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 3)
+ #f
+ 'tmp
+ x-13107)
+ key-13040
+ m-13041
+ r-12985
+ mod-12988)))
+ (let ((body-13130
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 15)
+ #f
+ req-13121
+ #f
+ #f
+ #f
+ '()
+ vars-13123
+ exp-13125
+ #f)))
(make-struct/no-tail
- (vector-ref %expanded-vtables 15)
- #f
- req-13730
- #f
- #f
+ (vector-ref %expanded-vtables 14)
#f
'()
- vars-13732
- exp-13734
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- #f
- '()
- body-13739)))
- (list (expand-4382
- val-13524
- r-13470
- '(())
- mod-13473))))
+ body-13130))))
+ (arg-exps-13113
+ (list (call-with-values
+ (lambda ()
+ (syntax-type-4382
+ val-13039
+ r-12985
+ '(())
+ (let ((props-13179
+ (source-properties
+ (if (if (vector?
+ val-13039)
+ (if (=
(vector-length
+
val-13039)
+ 4)
+ (eq?
(vector-ref
+
val-13039
+ 0)
+
'syntax-object)
+ #f)
+ #f)
+ (vector-ref
+ val-13039
+ 1)
+ val-13039))))
+ (if (pair? props-13179)
+ props-13179
+ #f))
+ #f
+ mod-12988
+ #f))
+ (lambda (type-13212
+ value-13213
+ form-13214
+ e-13215
+ w-13216
+ s-13217
+ mod-13218)
+ (expand-expr-4384
+ type-13212
+ value-13213
+ form-13214
+ e-13215
+ r-12985
+ w-13216
+ s-13217
+ mod-13218))))))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 11)
+ s-12987
+ fun-exp-13112
+ arg-exps-13113)))
(syntax-violation
'syntax-case
"invalid literals list"
- e-13474)))
- tmp-13476)
+ e-12989)))
+ tmp-12991)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-13475))))))))
+ tmp-12990))))))))
(set! macroexpand
(lambda*
- (x-16419
+ (x-15783
#:optional
- (m-16420 'e)
- (esew-16421 '(eval)))
- (expand-top-sequence-4378
- (list x-16419)
+ (m-15784 'e)
+ (esew-15785 '(eval)))
+ (expand-top-sequence-4379
+ (list x-15783)
'()
'((top))
#f
- m-16420
- esew-16421
+ m-15784
+ esew-15785
(cons 'hygiene (module-name (current-module))))))
(set! identifier?
- (lambda (x-16424)
- (if (if (vector? x-16424)
- (if (= (vector-length x-16424) 4)
- (eq? (vector-ref x-16424 0) 'syntax-object)
+ (lambda (x-15788)
+ (if (if (vector? x-15788)
+ (if (= (vector-length x-15788) 4)
+ (eq? (vector-ref x-15788 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-16424 1))
+ (symbol? (vector-ref x-15788 1))
#f)))
(set! datum->syntax
- (lambda (id-16449 datum-16450)
- (let ((wrap-16455 (vector-ref id-16449 2))
- (module-16456 (vector-ref id-16449 3)))
+ (lambda (id-15813 datum-15814)
+ (let ((wrap-15819 (vector-ref id-15813 2))
+ (module-15820 (vector-ref id-15813 3)))
(vector
'syntax-object
- datum-16450
- wrap-16455
- module-16456))))
+ datum-15814
+ wrap-15819
+ module-15820))))
(set! syntax->datum
- (lambda (x-16463) (strip-4395 x-16463 '(()))))
+ (lambda (x-15827) (strip-4396 x-15827 '(()))))
(set! syntax-source
- (lambda (x-16466)
- (source-annotation-4340 x-16466)))
+ (lambda (x-15830)
+ (let ((props-15835
+ (source-properties
+ (if (if (vector? x-15830)
+ (if (= (vector-length x-15830) 4)
+ (eq? (vector-ref x-15830 0) 'syntax-object)
+ #f)
+ #f)
+ (vector-ref x-15830 1)
+ x-15830))))
+ (if (pair? props-15835) props-15835 #f))))
(set! generate-temporaries
- (lambda (ls-16650)
+ (lambda (ls-15858)
(begin
- (if (not (list? ls-16650))
+ (if (not (list? ls-15858))
(syntax-violation
'generate-temporaries
"invalid argument"
- ls-16650))
- (let ((mod-16658
+ ls-15858))
+ (let ((mod-15866
(cons 'hygiene (module-name (current-module)))))
- (map (lambda (x-16659)
- (let ((x-16663 (gensym "t-")))
- (if (if (vector? x-16663)
- (if (= (vector-length x-16663) 4)
- (eq? (vector-ref x-16663 0) 'syntax-object)
+ (map (lambda (x-15867)
+ (let ((x-15871 (gensym "t-")))
+ (if (if (vector? x-15871)
+ (if (= (vector-length x-15871) 4)
+ (eq? (vector-ref x-15871 0) 'syntax-object)
#f)
#f)
- (let ((expression-16678 (vector-ref x-16663 1))
- (wrap-16679
- (let ((w2-16687 (vector-ref x-16663 2)))
- (cons (let ((m2-16694 (car w2-16687)))
- (if (null? m2-16694)
+ (let ((expression-15886 (vector-ref x-15871 1))
+ (wrap-15887
+ (let ((w2-15895 (vector-ref x-15871 2)))
+ (cons (let ((m2-15902 (car w2-15895)))
+ (if (null? m2-15902)
'(top)
- (append '(top) m2-16694)))
- (let ((m2-16701 (cdr w2-16687)))
- (if (null? m2-16701)
+ (append '(top) m2-15902)))
+ (let ((m2-15909 (cdr w2-15895)))
+ (if (null? m2-15909)
'()
- (append '() m2-16701))))))
- (module-16680 (vector-ref x-16663 3)))
+ (append '() m2-15909))))))
+ (module-15888 (vector-ref x-15871 3)))
(vector
'syntax-object
- expression-16678
- wrap-16679
- module-16680))
- (if (null? x-16663)
- x-16663
+ expression-15886
+ wrap-15887
+ module-15888))
+ (if (null? x-15871)
+ x-15871
(vector
'syntax-object
- x-16663
+ x-15871
'((top))
- mod-16658)))))
- ls-16650)))))
+ mod-15866)))))
+ ls-15858)))))
(set! free-identifier=?
- (lambda (x-16710 y-16711)
+ (lambda (x-15918 y-15919)
(begin
- (if (not (if (if (vector? x-16710)
- (if (= (vector-length x-16710) 4)
- (eq? (vector-ref x-16710 0) 'syntax-object)
+ (if (not (if (if (vector? x-15918)
+ (if (= (vector-length x-15918) 4)
+ (eq? (vector-ref x-15918 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-16710 1))
+ (symbol? (vector-ref x-15918 1))
#f))
(syntax-violation
'free-identifier=?
"invalid argument"
- x-16710))
- (if (not (if (if (vector? y-16711)
- (if (= (vector-length y-16711) 4)
- (eq? (vector-ref y-16711 0) 'syntax-object)
+ x-15918))
+ (if (not (if (if (vector? y-15919)
+ (if (= (vector-length y-15919) 4)
+ (eq? (vector-ref y-15919 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref y-16711 1))
+ (symbol? (vector-ref y-15919 1))
#f))
(syntax-violation
'free-identifier=?
"invalid argument"
- y-16711))
- (free-id=?-4370 x-16710 y-16711))))
+ y-15919))
+ (free-id=?-4371 x-15918 y-15919))))
(set! bound-identifier=?
- (lambda (x-16786 y-16787)
+ (lambda (x-15994 y-15995)
(begin
- (if (not (if (if (vector? x-16786)
- (if (= (vector-length x-16786) 4)
- (eq? (vector-ref x-16786 0) 'syntax-object)
+ (if (not (if (if (vector? x-15994)
+ (if (= (vector-length x-15994) 4)
+ (eq? (vector-ref x-15994 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-16786 1))
+ (symbol? (vector-ref x-15994 1))
#f))
(syntax-violation
'bound-identifier=?
"invalid argument"
- x-16786))
- (if (not (if (if (vector? y-16787)
- (if (= (vector-length y-16787) 4)
- (eq? (vector-ref y-16787 0) 'syntax-object)
+ x-15994))
+ (if (not (if (if (vector? y-15995)
+ (if (= (vector-length y-15995) 4)
+ (eq? (vector-ref y-15995 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref y-16787 1))
+ (symbol? (vector-ref y-15995 1))
#f))
(syntax-violation
'bound-identifier=?
"invalid argument"
- y-16787))
- (bound-id=?-4371 x-16786 y-16787))))
+ y-15995))
+ (bound-id=?-4372 x-15994 y-15995))))
(set! syntax-violation
(lambda*
- (who-16953
- message-16954
- form-16955
+ (who-16161
+ message-16162
+ form-16163
#:optional
- (subform-16956 #f))
+ (subform-16164 #f))
(begin
- (if (not (if (not who-16953)
- (not who-16953)
- (let ((t-16974 (string? who-16953)))
- (if t-16974 t-16974 (symbol? who-16953)))))
+ (if (not (if (not who-16161)
+ (not who-16161)
+ (let ((t-16182 (string? who-16161)))
+ (if t-16182 t-16182 (symbol? who-16161)))))
(syntax-violation
'syntax-violation
"invalid argument"
- who-16953))
- (if (not (string? message-16954))
+ who-16161))
+ (if (not (string? message-16162))
(syntax-violation
'syntax-violation
"invalid argument"
- message-16954))
+ message-16162))
(throw 'syntax-error
- who-16953
- message-16954
- (let ((t-17005 (source-annotation-4340 subform-16956)))
- (if t-17005
- t-17005
- (source-annotation-4340 form-16955)))
- (strip-4395 form-16955 '(()))
- (if subform-16956
- (strip-4395 subform-16956 '(()))
+ who-16161
+ message-16162
+ (let ((t-16213
+ (let ((props-16272
+ (source-properties
+ (if (if (vector? subform-16164)
+ (if (= (vector-length subform-16164)
+ 4)
+ (eq? (vector-ref subform-16164 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref subform-16164 1)
+ subform-16164))))
+ (if (pair? props-16272) props-16272 #f))))
+ (if t-16213
+ t-16213
+ (let ((props-16245
+ (source-properties
+ (if (if (vector? form-16163)
+ (if (= (vector-length form-16163) 4)
+ (eq? (vector-ref form-16163 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref form-16163 1)
+ form-16163))))
+ (if (pair? props-16245) props-16245 #f))))
+ (strip-4396 form-16163 '(()))
+ (if subform-16164
+ (strip-4396 subform-16164 '(()))
#f)))))
(letrec*
- ((syntax-local-binding-17469
- (lambda (id-17609)
+ ((syntax-local-binding-16300
+ (lambda (id-16440)
(begin
- (if (not (if (if (vector? id-17609)
- (if (= (vector-length id-17609) 4)
- (eq? (vector-ref id-17609 0) 'syntax-object)
+ (if (not (if (if (vector? id-16440)
+ (if (= (vector-length id-16440) 4)
+ (eq? (vector-ref id-16440 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-17609 1))
+ (symbol? (vector-ref id-16440 1))
#f))
(syntax-violation
'syntax-local-binding
"invalid argument"
- id-17609))
- ((fluid-ref transformer-environment-4368)
- (lambda (e-17649
- r-17650
- w-17651
- s-17652
- rib-17653
- mod-17654)
+ id-16440))
+ ((fluid-ref transformer-environment-4369)
+ (lambda (e-16480
+ r-16481
+ w-16482
+ s-16483
+ rib-16484
+ mod-16485)
(call-with-values
(lambda ()
- (resolve-identifier-4367
- (vector-ref id-17609 1)
- (let ((w-17661 (vector-ref id-17609 2)))
- (let ((ms-17662 (car w-17661))
- (s-17663 (cdr w-17661)))
- (if (if (pair? ms-17662)
- (eq? (car ms-17662) #f)
+ (resolve-identifier-4368
+ (vector-ref id-16440 1)
+ (let ((w-16492 (vector-ref id-16440 2)))
+ (let ((ms-16493 (car w-16492))
+ (s-16494 (cdr w-16492)))
+ (if (if (pair? ms-16493)
+ (eq? (car ms-16493) #f)
#f)
- (cons (cdr ms-17662)
- (if rib-17653
- (cons rib-17653 (cdr s-17663))
- (cdr s-17663)))
- (cons ms-17662
- (if rib-17653
- (cons rib-17653 s-17663)
- s-17663)))))
- r-17650
- (vector-ref id-17609 3)
+ (cons (cdr ms-16493)
+ (if rib-16484
+ (cons rib-16484 (cdr s-16494))
+ (cdr s-16494)))
+ (cons ms-16493
+ (if rib-16484
+ (cons rib-16484 s-16494)
+ s-16494)))))
+ r-16481
+ (vector-ref id-16440 3)
#t))
- (lambda (type-17670 value-17671 mod-17672)
- (if (eqv? type-17670 'lexical)
- (values 'lexical value-17671)
- (if (eqv? type-17670 'macro)
- (values 'macro value-17671)
- (if (eqv? type-17670 'syntax)
- (values 'pattern-variable value-17671)
- (if (eqv? type-17670 'displaced-lexical)
+ (lambda (type-16501 value-16502 mod-16503)
+ (if (eqv? type-16501 'lexical)
+ (values 'lexical value-16502)
+ (if (eqv? type-16501 'macro)
+ (values 'macro value-16502)
+ (if (eqv? type-16501 'syntax)
+ (values 'pattern-variable value-16502)
+ (if (eqv? type-16501 'displaced-lexical)
(values 'displaced-lexical #f)
- (if (eqv? type-17670 'global)
+ (if (eqv? type-16501 'global)
(values
'global
- (cons value-17671 (cdr mod-17672)))
+ (cons value-16502 (cdr mod-16503)))
(values 'other #f)))))))))))))
- (syntax-locally-bound-identifiers-17470
- (lambda (id-17694)
+ (syntax-locally-bound-identifiers-16301
+ (lambda (id-16525)
(begin
- (if (not (if (if (vector? id-17694)
- (if (= (vector-length id-17694) 4)
- (eq? (vector-ref id-17694 0) 'syntax-object)
+ (if (not (if (if (vector? id-16525)
+ (if (= (vector-length id-16525) 4)
+ (eq? (vector-ref id-16525 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-17694 1))
+ (symbol? (vector-ref id-16525 1))
#f))
(syntax-violation
'syntax-locally-bound-identifiers
"invalid argument"
- id-17694))
- (locally-bound-identifiers-4366
- (vector-ref id-17694 2)
- (vector-ref id-17694 3))))))
+ id-16525))
+ (locally-bound-identifiers-4367
+ (vector-ref id-16525 2)
+ (vector-ref id-16525 3))))))
(begin
(define!
'syntax-module
- (lambda (id-17472)
+ (lambda (id-16303)
(begin
- (if (not (if (if (vector? id-17472)
- (if (= (vector-length id-17472) 4)
- (eq? (vector-ref id-17472 0) 'syntax-object)
+ (if (not (if (if (vector? id-16303)
+ (if (= (vector-length id-16303) 4)
+ (eq? (vector-ref id-16303 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-17472 1))
+ (symbol? (vector-ref id-16303 1))
#f))
(syntax-violation
'syntax-module
"invalid argument"
- id-17472))
- (cdr (vector-ref id-17472 3)))))
+ id-16303))
+ (cdr (vector-ref id-16303 3)))))
(define!
'syntax-local-binding
- syntax-local-binding-17469)
+ syntax-local-binding-16300)
(define!
'syntax-locally-bound-identifiers
- syntax-locally-bound-identifiers-17470)))
+ syntax-locally-bound-identifiers-16301)))
(letrec*
- ((match-each-17811
- (lambda (e-18690 p-18691 w-18692 mod-18693)
- (if (pair? e-18690)
- (let ((first-18694
- (match-17817
- (car e-18690)
- p-18691
- w-18692
+ ((match-each-16642
+ (lambda (e-17521 p-17522 w-17523 mod-17524)
+ (if (pair? e-17521)
+ (let ((first-17525
+ (match-16648
+ (car e-17521)
+ p-17522
+ w-17523
'()
- mod-18693)))
- (if first-18694
- (let ((rest-18697
- (match-each-17811
- (cdr e-18690)
- p-18691
- w-18692
- mod-18693)))
- (if rest-18697 (cons first-18694 rest-18697) #f))
+ mod-17524)))
+ (if first-17525
+ (let ((rest-17528
+ (match-each-16642
+ (cdr e-17521)
+ p-17522
+ w-17523
+ mod-17524)))
+ (if rest-17528 (cons first-17525 rest-17528) #f))
#f))
- (if (null? e-18690)
+ (if (null? e-17521)
'()
- (if (if (vector? e-18690)
- (if (= (vector-length e-18690) 4)
- (eq? (vector-ref e-18690 0) 'syntax-object)
+ (if (if (vector? e-17521)
+ (if (= (vector-length e-17521) 4)
+ (eq? (vector-ref e-17521 0) 'syntax-object)
#f)
#f)
- (match-each-17811
- (vector-ref e-18690 1)
- p-18691
- (let ((w2-18719 (vector-ref e-18690 2)))
- (let ((m1-18720 (car w-18692))
- (s1-18721 (cdr w-18692)))
- (if (null? m1-18720)
- (if (null? s1-18721)
- w2-18719
- (cons (car w2-18719)
- (let ((m2-18732 (cdr w2-18719)))
- (if (null? m2-18732)
- s1-18721
- (append s1-18721 m2-18732)))))
- (cons (let ((m2-18740 (car w2-18719)))
- (if (null? m2-18740)
- m1-18720
- (append m1-18720 m2-18740)))
- (let ((m2-18748 (cdr w2-18719)))
- (if (null? m2-18748)
- s1-18721
- (append s1-18721 m2-18748)))))))
- (vector-ref e-18690 3))
+ (match-each-16642
+ (vector-ref e-17521 1)
+ p-17522
+ (let ((w2-17550 (vector-ref e-17521 2)))
+ (let ((m1-17551 (car w-17523))
+ (s1-17552 (cdr w-17523)))
+ (if (null? m1-17551)
+ (if (null? s1-17552)
+ w2-17550
+ (cons (car w2-17550)
+ (let ((m2-17563 (cdr w2-17550)))
+ (if (null? m2-17563)
+ s1-17552
+ (append s1-17552 m2-17563)))))
+ (cons (let ((m2-17571 (car w2-17550)))
+ (if (null? m2-17571)
+ m1-17551
+ (append m1-17551 m2-17571)))
+ (let ((m2-17579 (cdr w2-17550)))
+ (if (null? m2-17579)
+ s1-17552
+ (append s1-17552 m2-17579)))))))
+ (vector-ref e-17521 3))
#f)))))
- (match-each-any-17813
- (lambda (e-18757 w-18758 mod-18759)
- (if (pair? e-18757)
- (let ((l-18760
- (match-each-any-17813
- (cdr e-18757)
- w-18758
- mod-18759)))
- (if l-18760
- (cons (let ((x-18765 (car e-18757)))
- (if (if (null? (car w-18758))
- (null? (cdr w-18758))
+ (match-each-any-16644
+ (lambda (e-17588 w-17589 mod-17590)
+ (if (pair? e-17588)
+ (let ((l-17591
+ (match-each-any-16644
+ (cdr e-17588)
+ w-17589
+ mod-17590)))
+ (if l-17591
+ (cons (let ((x-17596 (car e-17588)))
+ (if (if (null? (car w-17589))
+ (null? (cdr w-17589))
#f)
- x-18765
- (if (if (vector? x-18765)
- (if (= (vector-length x-18765) 4)
- (eq? (vector-ref x-18765 0)
+ x-17596
+ (if (if (vector? x-17596)
+ (if (= (vector-length x-17596) 4)
+ (eq? (vector-ref x-17596 0)
'syntax-object)
#f)
#f)
- (let ((expression-18783 (vector-ref x-18765 1))
- (wrap-18784
- (let ((w2-18792 (vector-ref x-18765 2)))
- (let ((m1-18793 (car w-18758))
- (s1-18794 (cdr w-18758)))
- (if (null? m1-18793)
- (if (null? s1-18794)
- w2-18792
- (cons (car w2-18792)
- (let ((m2-18809
- (cdr w2-18792)))
- (if (null? m2-18809)
- s1-18794
+ (let ((expression-17614 (vector-ref x-17596 1))
+ (wrap-17615
+ (let ((w2-17623 (vector-ref x-17596 2)))
+ (let ((m1-17624 (car w-17589))
+ (s1-17625 (cdr w-17589)))
+ (if (null? m1-17624)
+ (if (null? s1-17625)
+ w2-17623
+ (cons (car w2-17623)
+ (let ((m2-17640
+ (cdr w2-17623)))
+ (if (null? m2-17640)
+ s1-17625
(append
- s1-18794
- m2-18809)))))
- (cons (let ((m2-18817
- (car w2-18792)))
- (if (null? m2-18817)
- m1-18793
+ s1-17625
+ m2-17640)))))
+ (cons (let ((m2-17648
+ (car w2-17623)))
+ (if (null? m2-17648)
+ m1-17624
(append
- m1-18793
- m2-18817)))
- (let ((m2-18825
- (cdr w2-18792)))
- (if (null? m2-18825)
- s1-18794
+ m1-17624
+ m2-17648)))
+ (let ((m2-17656
+ (cdr w2-17623)))
+ (if (null? m2-17656)
+ s1-17625
(append
- s1-18794
- m2-18825))))))))
- (module-18785 (vector-ref x-18765 3)))
+ s1-17625
+ m2-17656))))))))
+ (module-17616 (vector-ref x-17596 3)))
(vector
'syntax-object
- expression-18783
- wrap-18784
- module-18785))
- (if (null? x-18765)
- x-18765
+ expression-17614
+ wrap-17615
+ module-17616))
+ (if (null? x-17596)
+ x-17596
(vector
'syntax-object
- x-18765
- w-18758
- mod-18759)))))
- l-18760)
+ x-17596
+ w-17589
+ mod-17590)))))
+ l-17591)
#f))
- (if (null? e-18757)
+ (if (null? e-17588)
'()
- (if (if (vector? e-18757)
- (if (= (vector-length e-18757) 4)
- (eq? (vector-ref e-18757 0) 'syntax-object)
+ (if (if (vector? e-17588)
+ (if (= (vector-length e-17588) 4)
+ (eq? (vector-ref e-17588 0) 'syntax-object)
#f)
#f)
- (match-each-any-17813
- (vector-ref e-18757 1)
- (let ((w2-18858 (vector-ref e-18757 2)))
- (let ((m1-18859 (car w-18758))
- (s1-18860 (cdr w-18758)))
- (if (null? m1-18859)
- (if (null? s1-18860)
- w2-18858
- (cons (car w2-18858)
- (let ((m2-18871 (cdr w2-18858)))
- (if (null? m2-18871)
- s1-18860
- (append s1-18860 m2-18871)))))
- (cons (let ((m2-18879 (car w2-18858)))
- (if (null? m2-18879)
- m1-18859
- (append m1-18859 m2-18879)))
- (let ((m2-18887 (cdr w2-18858)))
- (if (null? m2-18887)
- s1-18860
- (append s1-18860 m2-18887)))))))
- mod-18759)
+ (match-each-any-16644
+ (vector-ref e-17588 1)
+ (let ((w2-17689 (vector-ref e-17588 2)))
+ (let ((m1-17690 (car w-17589))
+ (s1-17691 (cdr w-17589)))
+ (if (null? m1-17690)
+ (if (null? s1-17691)
+ w2-17689
+ (cons (car w2-17689)
+ (let ((m2-17702 (cdr w2-17689)))
+ (if (null? m2-17702)
+ s1-17691
+ (append s1-17691 m2-17702)))))
+ (cons (let ((m2-17710 (car w2-17689)))
+ (if (null? m2-17710)
+ m1-17690
+ (append m1-17690 m2-17710)))
+ (let ((m2-17718 (cdr w2-17689)))
+ (if (null? m2-17718)
+ s1-17691
+ (append s1-17691 m2-17718)))))))
+ mod-17590)
#f)))))
- (match-empty-17814
- (lambda (p-18892 r-18893)
- (if (null? p-18892)
- r-18893
- (if (eq? p-18892 '_)
- r-18893
- (if (eq? p-18892 'any)
- (cons '() r-18893)
- (if (pair? p-18892)
- (match-empty-17814
- (car p-18892)
- (match-empty-17814 (cdr p-18892) r-18893))
- (if (eq? p-18892 'each-any)
- (cons '() r-18893)
- (let ((key-18894 (vector-ref p-18892 0)))
- (if (eqv? key-18894 'each)
- (match-empty-17814
- (vector-ref p-18892 1)
- r-18893)
- (if (eqv? key-18894 'each+)
- (match-empty-17814
- (vector-ref p-18892 1)
- (match-empty-17814
- (reverse (vector-ref p-18892 2))
- (match-empty-17814
- (vector-ref p-18892 3)
- r-18893)))
- (if (if (eqv? key-18894 'free-id)
+ (match-empty-16645
+ (lambda (p-17723 r-17724)
+ (if (null? p-17723)
+ r-17724
+ (if (eq? p-17723 '_)
+ r-17724
+ (if (eq? p-17723 'any)
+ (cons '() r-17724)
+ (if (pair? p-17723)
+ (match-empty-16645
+ (car p-17723)
+ (match-empty-16645 (cdr p-17723) r-17724))
+ (if (eq? p-17723 'each-any)
+ (cons '() r-17724)
+ (let ((key-17725 (vector-ref p-17723 0)))
+ (if (eqv? key-17725 'each)
+ (match-empty-16645
+ (vector-ref p-17723 1)
+ r-17724)
+ (if (eqv? key-17725 'each+)
+ (match-empty-16645
+ (vector-ref p-17723 1)
+ (match-empty-16645
+ (reverse (vector-ref p-17723 2))
+ (match-empty-16645
+ (vector-ref p-17723 3)
+ r-17724)))
+ (if (if (eqv? key-17725 'free-id)
#t
- (eqv? key-18894 'atom))
- r-18893
- (if (eqv? key-18894 'vector)
- (match-empty-17814
- (vector-ref p-18892 1)
- r-18893)))))))))))))
- (combine-17815
- (lambda (r*-18913 r-18914)
- (if (null? (car r*-18913))
- r-18914
- (cons (map car r*-18913)
- (combine-17815 (map cdr r*-18913) r-18914)))))
- (match*-17816
- (lambda (e-17846 p-17847 w-17848 r-17849 mod-17850)
- (if (null? p-17847)
- (if (null? e-17846) r-17849 #f)
- (if (pair? p-17847)
- (if (pair? e-17846)
- (match-17817
- (car e-17846)
- (car p-17847)
- w-17848
- (match-17817
- (cdr e-17846)
- (cdr p-17847)
- w-17848
- r-17849
- mod-17850)
- mod-17850)
+ (eqv? key-17725 'atom))
+ r-17724
+ (if (eqv? key-17725 'vector)
+ (match-empty-16645
+ (vector-ref p-17723 1)
+ r-17724)))))))))))))
+ (combine-16646
+ (lambda (r*-17744 r-17745)
+ (if (null? (car r*-17744))
+ r-17745
+ (cons (map car r*-17744)
+ (combine-16646 (map cdr r*-17744) r-17745)))))
+ (match*-16647
+ (lambda (e-16677 p-16678 w-16679 r-16680 mod-16681)
+ (if (null? p-16678)
+ (if (null? e-16677) r-16680 #f)
+ (if (pair? p-16678)
+ (if (pair? e-16677)
+ (match-16648
+ (car e-16677)
+ (car p-16678)
+ w-16679
+ (match-16648
+ (cdr e-16677)
+ (cdr p-16678)
+ w-16679
+ r-16680
+ mod-16681)
+ mod-16681)
#f)
- (if (eq? p-17847 'each-any)
- (let ((l-17855
- (match-each-any-17813 e-17846 w-17848 mod-17850)))
- (if l-17855 (cons l-17855 r-17849) #f))
- (let ((key-17860 (vector-ref p-17847 0)))
- (if (eqv? key-17860 'each)
- (if (null? e-17846)
- (match-empty-17814
- (vector-ref p-17847 1)
- r-17849)
- (let ((l-17867
- (match-each-17811
- e-17846
- (vector-ref p-17847 1)
- w-17848
- mod-17850)))
- (if l-17867
+ (if (eq? p-16678 'each-any)
+ (let ((l-16686
+ (match-each-any-16644 e-16677 w-16679 mod-16681)))
+ (if l-16686 (cons l-16686 r-16680) #f))
+ (let ((key-16691 (vector-ref p-16678 0)))
+ (if (eqv? key-16691 'each)
+ (if (null? e-16677)
+ (match-empty-16645
+ (vector-ref p-16678 1)
+ r-16680)
+ (let ((l-16698
+ (match-each-16642
+ e-16677
+ (vector-ref p-16678 1)
+ w-16679
+ mod-16681)))
+ (if l-16698
(letrec*
- ((collect-17870
- (lambda (l-17927)
- (if (null? (car l-17927))
- r-17849
- (cons (map car l-17927)
- (collect-17870
- (map cdr l-17927)))))))
- (collect-17870 l-17867))
+ ((collect-16701
+ (lambda (l-16758)
+ (if (null? (car l-16758))
+ r-16680
+ (cons (map car l-16758)
+ (collect-16701
+ (map cdr l-16758)))))))
+ (collect-16701 l-16698))
#f)))
- (if (eqv? key-17860 'each+)
+ (if (eqv? key-16691 'each+)
(call-with-values
(lambda ()
- (let ((x-pat-17936 (vector-ref p-17847 1))
- (y-pat-17937 (vector-ref p-17847 2))
- (z-pat-17938 (vector-ref p-17847 3)))
+ (let ((x-pat-16767 (vector-ref p-16678 1))
+ (y-pat-16768 (vector-ref p-16678 2))
+ (z-pat-16769 (vector-ref p-16678 3)))
(letrec*
- ((f-17942
- (lambda (e-17944 w-17945)
- (if (pair? e-17944)
+ ((f-16773
+ (lambda (e-16775 w-16776)
+ (if (pair? e-16775)
(call-with-values
(lambda ()
- (f-17942 (cdr e-17944) w-17945))
- (lambda (xr*-17946
- y-pat-17947
- r-17948)
- (if r-17948
- (if (null? y-pat-17947)
- (let ((xr-17949
- (match-17817
- (car e-17944)
- x-pat-17936
- w-17945
+ (f-16773 (cdr e-16775) w-16776))
+ (lambda (xr*-16777
+ y-pat-16778
+ r-16779)
+ (if r-16779
+ (if (null? y-pat-16778)
+ (let ((xr-16780
+ (match-16648
+ (car e-16775)
+ x-pat-16767
+ w-16776
'()
- mod-17850)))
- (if xr-17949
+ mod-16681)))
+ (if xr-16780
(values
- (cons xr-17949 xr*-17946)
- y-pat-17947
- r-17948)
+ (cons xr-16780 xr*-16777)
+ y-pat-16778
+ r-16779)
(values #f #f #f)))
(values
'()
- (cdr y-pat-17947)
- (match-17817
- (car e-17944)
- (car y-pat-17947)
- w-17945
- r-17948
- mod-17850)))
+ (cdr y-pat-16778)
+ (match-16648
+ (car e-16775)
+ (car y-pat-16778)
+ w-16776
+ r-16779
+ mod-16681)))
(values #f #f #f))))
- (if (if (vector? e-17944)
- (if (= (vector-length e-17944) 4)
- (eq? (vector-ref e-17944 0)
+ (if (if (vector? e-16775)
+ (if (= (vector-length e-16775) 4)
+ (eq? (vector-ref e-16775 0)
'syntax-object)
#f)
#f)
- (f-17942
- (vector-ref e-17944 1)
- (let ((m1-17975 (car w-17945))
- (s1-17976 (cdr w-17945)))
- (if (null? m1-17975)
- (if (null? s1-17976)
- e-17944
- (cons (car e-17944)
- (let ((m2-17988
- (cdr e-17944)))
- (if (null? m2-17988)
- s1-17976
+ (f-16773
+ (vector-ref e-16775 1)
+ (let ((m1-16806 (car w-16776))
+ (s1-16807 (cdr w-16776)))
+ (if (null? m1-16806)
+ (if (null? s1-16807)
+ e-16775
+ (cons (car e-16775)
+ (let ((m2-16819
+ (cdr e-16775)))
+ (if (null? m2-16819)
+ s1-16807
(append
- s1-17976
- m2-17988)))))
- (cons (let ((m2-17998
- (car e-17944)))
- (if (null? m2-17998)
- m1-17975
+ s1-16807
+ m2-16819)))))
+ (cons (let ((m2-16829
+ (car e-16775)))
+ (if (null? m2-16829)
+ m1-16806
(append
- m1-17975
- m2-17998)))
- (let ((m2-18008
- (cdr e-17944)))
- (if (null? m2-18008)
- s1-17976
+ m1-16806
+ m2-16829)))
+ (let ((m2-16839
+ (cdr e-16775)))
+ (if (null? m2-16839)
+ s1-16807
(append
- s1-17976
- m2-18008)))))))
+ s1-16807
+ m2-16839)))))))
(values
'()
- y-pat-17937
- (match-17817
- e-17944
- z-pat-17938
- w-17945
- r-17849
- mod-17850)))))))
- (f-17942 e-17846 w-17848))))
- (lambda (xr*-18018 y-pat-18019 r-18020)
- (if r-18020
- (if (null? y-pat-18019)
- (if (null? xr*-18018)
- (match-empty-17814
- (vector-ref p-17847 1)
- r-18020)
- (combine-17815 xr*-18018 r-18020))
+ y-pat-16768
+ (match-16648
+ e-16775
+ z-pat-16769
+ w-16776
+ r-16680
+ mod-16681)))))))
+ (f-16773 e-16677 w-16679))))
+ (lambda (xr*-16849 y-pat-16850 r-16851)
+ (if r-16851
+ (if (null? y-pat-16850)
+ (if (null? xr*-16849)
+ (match-empty-16645
+ (vector-ref p-16678 1)
+ r-16851)
+ (combine-16646 xr*-16849 r-16851))
#f)
#f)))
- (if (eqv? key-17860 'free-id)
- (if (if (symbol? e-17846)
+ (if (eqv? key-16691 'free-id)
+ (if (if (symbol? e-16677)
#t
- (if (if (vector? e-17846)
- (if (= (vector-length e-17846) 4)
- (eq? (vector-ref e-17846 0)
+ (if (if (vector? e-16677)
+ (if (= (vector-length e-16677) 4)
+ (eq? (vector-ref e-16677 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref e-17846 1))
+ (symbol? (vector-ref e-16677 1))
#f))
- (if (free-id=?-4370
- (if (if (null? (car w-17848))
- (null? (cdr w-17848))
+ (if (free-id=?-4371
+ (if (if (null? (car w-16679))
+ (null? (cdr w-16679))
#f)
- e-17846
- (if (if (vector? e-17846)
- (if (= (vector-length e-17846) 4)
- (eq? (vector-ref e-17846 0)
+ e-16677
+ (if (if (vector? e-16677)
+ (if (= (vector-length e-16677) 4)
+ (eq? (vector-ref e-16677 0)
'syntax-object)
#f)
#f)
- (let ((expression-18448
- (vector-ref e-17846 1))
- (wrap-18449
- (let ((w2-18459
- (vector-ref e-17846 2)))
- (let ((m1-18460 (car w-17848))
- (s1-18461
- (cdr w-17848)))
- (if (null? m1-18460)
- (if (null? s1-18461)
- w2-18459
- (cons (car w2-18459)
- (let ((m2-18478
- (cdr
w2-18459)))
- (if (null?
m2-18478)
- s1-18461
+ (let ((expression-17279
+ (vector-ref e-16677 1))
+ (wrap-17280
+ (let ((w2-17290
+ (vector-ref e-16677 2)))
+ (let ((m1-17291 (car w-16679))
+ (s1-17292
+ (cdr w-16679)))
+ (if (null? m1-17291)
+ (if (null? s1-17292)
+ w2-17290
+ (cons (car w2-17290)
+ (let ((m2-17309
+ (cdr
w2-17290)))
+ (if (null?
m2-17309)
+ s1-17292
(append
- s1-18461
-
m2-18478)))))
- (cons (let ((m2-18486
- (car
w2-18459)))
- (if (null?
m2-18486)
- m1-18460
+ s1-17292
+
m2-17309)))))
+ (cons (let ((m2-17317
+ (car
w2-17290)))
+ (if (null?
m2-17317)
+ m1-17291
(append
- m1-18460
- m2-18486)))
- (let ((m2-18494
- (cdr
w2-18459)))
- (if (null?
m2-18494)
- s1-18461
+ m1-17291
+ m2-17317)))
+ (let ((m2-17325
+ (cdr
w2-17290)))
+ (if (null?
m2-17325)
+ s1-17292
(append
- s1-18461
-
m2-18494))))))))
- (module-18450
- (vector-ref e-17846 3)))
+ s1-17292
+
m2-17325))))))))
+ (module-17281
+ (vector-ref e-16677 3)))
(vector
'syntax-object
- expression-18448
- wrap-18449
- module-18450))
- (if (null? e-17846)
- e-17846
+ expression-17279
+ wrap-17280
+ module-17281))
+ (if (null? e-16677)
+ e-16677
(vector
'syntax-object
- e-17846
- w-17848
- mod-17850))))
- (vector-ref p-17847 1))
- r-17849
+ e-16677
+ w-16679
+ mod-16681))))
+ (vector-ref p-16678 1))
+ r-16680
#f)
#f)
- (if (eqv? key-17860 'atom)
+ (if (eqv? key-16691 'atom)
(if (equal?
- (vector-ref p-17847 1)
- (strip-4395 e-17846 w-17848))
- r-17849
+ (vector-ref p-16678 1)
+ (strip-4396 e-16677 w-16679))
+ r-16680
#f)
- (if (eqv? key-17860 'vector)
- (if (vector? e-17846)
- (match-17817
- (vector->list e-17846)
- (vector-ref p-17847 1)
- w-17848
- r-17849
- mod-17850)
+ (if (eqv? key-16691 'vector)
+ (if (vector? e-16677)
+ (match-16648
+ (vector->list e-16677)
+ (vector-ref p-16678 1)
+ w-16679
+ r-16680
+ mod-16681)
#f))))))))))))
- (match-17817
- (lambda (e-18527 p-18528 w-18529 r-18530 mod-18531)
- (if (not r-18530)
+ (match-16648
+ (lambda (e-17358 p-17359 w-17360 r-17361 mod-17362)
+ (if (not r-17361)
#f
- (if (eq? p-18528 '_)
- r-18530
- (if (eq? p-18528 'any)
- (cons (if (if (null? (car w-18529))
- (null? (cdr w-18529))
+ (if (eq? p-17359 '_)
+ r-17361
+ (if (eq? p-17359 'any)
+ (cons (if (if (null? (car w-17360))
+ (null? (cdr w-17360))
#f)
- e-18527
- (if (if (vector? e-18527)
- (if (= (vector-length e-18527) 4)
- (eq? (vector-ref e-18527 0) 'syntax-object)
+ e-17358
+ (if (if (vector? e-17358)
+ (if (= (vector-length e-17358) 4)
+ (eq? (vector-ref e-17358 0) 'syntax-object)
#f)
#f)
- (let ((expression-18561 (vector-ref e-18527 1))
- (wrap-18562
- (let ((w2-18572 (vector-ref e-18527 2)))
- (let ((m1-18573 (car w-18529))
- (s1-18574 (cdr w-18529)))
- (if (null? m1-18573)
- (if (null? s1-18574)
- w2-18572
- (cons (car w2-18572)
- (let ((m2-18591
- (cdr w2-18572)))
- (if (null? m2-18591)
- s1-18574
+ (let ((expression-17392 (vector-ref e-17358 1))
+ (wrap-17393
+ (let ((w2-17403 (vector-ref e-17358 2)))
+ (let ((m1-17404 (car w-17360))
+ (s1-17405 (cdr w-17360)))
+ (if (null? m1-17404)
+ (if (null? s1-17405)
+ w2-17403
+ (cons (car w2-17403)
+ (let ((m2-17422
+ (cdr w2-17403)))
+ (if (null? m2-17422)
+ s1-17405
(append
- s1-18574
- m2-18591)))))
- (cons (let ((m2-18599
- (car w2-18572)))
- (if (null? m2-18599)
- m1-18573
+ s1-17405
+ m2-17422)))))
+ (cons (let ((m2-17430
+ (car w2-17403)))
+ (if (null? m2-17430)
+ m1-17404
(append
- m1-18573
- m2-18599)))
- (let ((m2-18607
- (cdr w2-18572)))
- (if (null? m2-18607)
- s1-18574
+ m1-17404
+ m2-17430)))
+ (let ((m2-17438
+ (cdr w2-17403)))
+ (if (null? m2-17438)
+ s1-17405
(append
- s1-18574
- m2-18607))))))))
- (module-18563 (vector-ref e-18527 3)))
+ s1-17405
+ m2-17438))))))))
+ (module-17394 (vector-ref e-17358 3)))
(vector
'syntax-object
- expression-18561
- wrap-18562
- module-18563))
- (if (null? e-18527)
- e-18527
+ expression-17392
+ wrap-17393
+ module-17394))
+ (if (null? e-17358)
+ e-17358
(vector
'syntax-object
- e-18527
- w-18529
- mod-18531))))
- r-18530)
- (if (if (vector? e-18527)
- (if (= (vector-length e-18527) 4)
- (eq? (vector-ref e-18527 0) 'syntax-object)
+ e-17358
+ w-17360
+ mod-17362))))
+ r-17361)
+ (if (if (vector? e-17358)
+ (if (= (vector-length e-17358) 4)
+ (eq? (vector-ref e-17358 0) 'syntax-object)
#f)
#f)
- (match*-17816
- (vector-ref e-18527 1)
- p-18528
- (let ((w2-18650 (vector-ref e-18527 2)))
- (let ((m1-18651 (car w-18529))
- (s1-18652 (cdr w-18529)))
- (if (null? m1-18651)
- (if (null? s1-18652)
- w2-18650
- (cons (car w2-18650)
- (let ((m2-18663 (cdr w2-18650)))
- (if (null? m2-18663)
- s1-18652
- (append s1-18652 m2-18663)))))
- (cons (let ((m2-18671 (car w2-18650)))
- (if (null? m2-18671)
- m1-18651
- (append m1-18651 m2-18671)))
- (let ((m2-18679 (cdr w2-18650)))
- (if (null? m2-18679)
- s1-18652
- (append s1-18652 m2-18679)))))))
- r-18530
- (vector-ref e-18527 3))
- (match*-17816
- e-18527
- p-18528
- w-18529
- r-18530
- mod-18531))))))))
+ (match*-16647
+ (vector-ref e-17358 1)
+ p-17359
+ (let ((w2-17481 (vector-ref e-17358 2)))
+ (let ((m1-17482 (car w-17360))
+ (s1-17483 (cdr w-17360)))
+ (if (null? m1-17482)
+ (if (null? s1-17483)
+ w2-17481
+ (cons (car w2-17481)
+ (let ((m2-17494 (cdr w2-17481)))
+ (if (null? m2-17494)
+ s1-17483
+ (append s1-17483 m2-17494)))))
+ (cons (let ((m2-17502 (car w2-17481)))
+ (if (null? m2-17502)
+ m1-17482
+ (append m1-17482 m2-17502)))
+ (let ((m2-17510 (cdr w2-17481)))
+ (if (null? m2-17510)
+ s1-17483
+ (append s1-17483 m2-17510)))))))
+ r-17361
+ (vector-ref e-17358 3))
+ (match*-16647
+ e-17358
+ p-17359
+ w-17360
+ r-17361
+ mod-17362))))))))
(set! $sc-dispatch
- (lambda (e-17818 p-17819)
- (if (eq? p-17819 'any)
- (list e-17818)
- (if (eq? p-17819 '_)
+ (lambda (e-16649 p-16650)
+ (if (eq? p-16650 'any)
+ (list e-16649)
+ (if (eq? p-16650 '_)
'()
- (if (if (vector? e-17818)
- (if (= (vector-length e-17818) 4)
- (eq? (vector-ref e-17818 0) 'syntax-object)
+ (if (if (vector? e-16649)
+ (if (= (vector-length e-16649) 4)
+ (eq? (vector-ref e-16649 0) 'syntax-object)
#f)
#f)
- (match*-17816
- (vector-ref e-17818 1)
- p-17819
- (vector-ref e-17818 2)
+ (match*-16647
+ (vector-ref e-16649 1)
+ p-16650
+ (vector-ref e-16649 2)
'()
- (vector-ref e-17818 3))
- (match*-17816 e-17818 p-17819 '(()) '() #f))))))))))
+ (vector-ref e-16649 3))
+ (match*-16647 e-16649 p-16650 '(()) '() #f))))))))))
(define with-syntax
(make-syntax-transformer
'with-syntax
'macro
- (lambda (x-37487)
- (let ((tmp-37489
- ($sc-dispatch x-37487 '(_ () any . each-any))))
- (if tmp-37489
+ (lambda (x-35161)
+ (let ((tmp-35163
+ ($sc-dispatch x-35161 '(_ () any . each-any))))
+ (if tmp-35163
(@apply
- (lambda (e1-37493 e2-37494)
+ (lambda (e1-35167 e2-35168)
(cons '#(syntax-object
let
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-37460" "l-*-37461"))
+ #("l-*-35134" "l-*-35135"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37457"))
+ #(ribcage #(x) #((top)) #("l-*-35131"))
#(ribcage
(with-syntax)
((top))
@@ -17904,27 +19619,27 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons '() (cons e1-37493 e2-37494))))
- tmp-37489)
- (let ((tmp-37495
+ (cons '() (cons e1-35167 e2-35168))))
+ tmp-35163)
+ (let ((tmp-35169
($sc-dispatch
- x-37487
+ x-35161
'(_ ((any any)) any . each-any))))
- (if tmp-37495
+ (if tmp-35169
(@apply
- (lambda (out-37499 in-37500 e1-37501 e2-37502)
+ (lambda (out-35173 in-35174 e1-35175 e2-35176)
(list '#(syntax-object
syntax-case
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-37466"
- "l-*-37467"
- "l-*-37468"
- "l-*-37469"))
+ #("l-*-35140"
+ "l-*-35141"
+ "l-*-35142"
+ "l-*-35143"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37457"))
+ #(ribcage #(x) #((top)) #("l-*-35131"))
#(ribcage
(with-syntax)
((top))
@@ -17935,21 +19650,21 @@
((top))
(hygiene guile))))))
(hygiene guile))
- in-37500
+ in-35174
'()
- (list out-37499
+ (list out-35173
(cons '#(syntax-object
let
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-37466"
- "l-*-37467"
- "l-*-37468"
- "l-*-37469"))
+ #("l-*-35140"
+ "l-*-35141"
+ "l-*-35142"
+ "l-*-35143"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37457"))
+ #(ribcage #(x) #((top)) #("l-*-35131"))
#(ribcage
(with-syntax)
((top))
@@ -17960,27 +19675,27 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons '() (cons e1-37501 e2-37502))))))
- tmp-37495)
- (let ((tmp-37503
+ (cons '() (cons e1-35175 e2-35176))))))
+ tmp-35169)
+ (let ((tmp-35177
($sc-dispatch
- x-37487
+ x-35161
'(_ #(each (any any)) any . each-any))))
- (if tmp-37503
+ (if tmp-35177
(@apply
- (lambda (out-37507 in-37508 e1-37509 e2-37510)
+ (lambda (out-35181 in-35182 e1-35183 e2-35184)
(list '#(syntax-object
syntax-case
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-37476"
- "l-*-37477"
- "l-*-37478"
- "l-*-37479"))
+ #("l-*-35150"
+ "l-*-35151"
+ "l-*-35152"
+ "l-*-35153"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37457"))
+ #(ribcage #(x) #((top)) #("l-*-35131"))
#(ribcage
(with-syntax)
((top))
@@ -17997,12 +19712,12 @@
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-37476"
- "l-*-37477"
- "l-*-37478"
- "l-*-37479"))
+ #("l-*-35150"
+ "l-*-35151"
+ "l-*-35152"
+ "l-*-35153"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37457"))
+ #(ribcage #(x) #((top)) #("l-*-35131"))
#(ribcage
(with-syntax)
((top))
@@ -18013,24 +19728,24 @@
((top))
(hygiene guile))))))
(hygiene guile))
- in-37508)
+ in-35182)
'()
- (list out-37507
+ (list out-35181
(cons '#(syntax-object
let
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-37476"
- "l-*-37477"
- "l-*-37478"
- "l-*-37479"))
+ #("l-*-35150"
+ "l-*-35151"
+ "l-*-35152"
+ "l-*-35153"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-37457"))
+ #("l-*-35131"))
#(ribcage
(with-syntax)
((top))
@@ -18041,40 +19756,40 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons '() (cons e1-37509 e2-37510))))))
- tmp-37503)
+ (cons '() (cons e1-35183 e2-35184))))))
+ tmp-35177)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-37487))))))))))
+ x-35161))))))))))
(define syntax-rules
(make-syntax-transformer
'syntax-rules
'macro
- (lambda (x-37565)
- (let ((tmp-37567
+ (lambda (x-35239)
+ (let ((tmp-35241
($sc-dispatch
- x-37565
+ x-35239
'(_ each-any . #(each ((any . any) any))))))
- (if tmp-37567
+ (if tmp-35241
(@apply
- (lambda (k-37571
- keyword-37572
- pattern-37573
- template-37574)
+ (lambda (k-35245
+ keyword-35246
+ pattern-35247
+ template-35248)
(list '#(syntax-object
lambda
((top)
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18091,12 +19806,12 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18114,12 +19829,12 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18137,12 +19852,12 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18159,12 +19874,12 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18175,19 +19890,19 @@
((top))
(hygiene guile))))))
(hygiene guile))
- pattern-37573))
+ pattern-35247))
(cons '#(syntax-object
syntax-case
((top)
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18204,12 +19919,12 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18220,9 +19935,9 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons k-37571
- (map (lambda (tmp-37539-37575
- tmp-37538-37576)
+ (cons k-35245
+ (map (lambda (tmp-35213-35249
+ tmp-35212-35250)
(list (cons '#(syntax-object
_
((top)
@@ -18235,10 +19950,10 @@
(top)
(top)
(top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage
()
()
@@ -18246,7 +19961,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-37525"))
+ #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18259,7 +19974,7 @@
(hygiene
guile))))))
(hygiene guile))
- tmp-37538-37576)
+ tmp-35212-35250)
(list '#(syntax-object
syntax
((top)
@@ -18272,10 +19987,10 @@
(top)
(top)
(top))
- #("l-*-37528"
- "l-*-37529"
- "l-*-37530"
- "l-*-37531"))
+ #("l-*-35202"
+ "l-*-35203"
+ "l-*-35204"
+ "l-*-35205"))
#(ribcage
()
()
@@ -18283,7 +19998,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-37525"))
+ #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18296,43 +20011,43 @@
(hygiene
guile))))))
(hygiene guile))
- tmp-37539-37575)))
- template-37574
- pattern-37573))))))
- tmp-37567)
- (let ((tmp-37577
+ tmp-35213-35249)))
+ template-35248
+ pattern-35247))))))
+ tmp-35241)
+ (let ((tmp-35251
($sc-dispatch
- x-37565
+ x-35239
'(_ each-any any . #(each ((any . any) any))))))
- (if (if tmp-37577
+ (if (if tmp-35251
(@apply
- (lambda (k-37581
- docstring-37582
- keyword-37583
- pattern-37584
- template-37585)
- (string? (syntax->datum docstring-37582)))
- tmp-37577)
+ (lambda (k-35255
+ docstring-35256
+ keyword-35257
+ pattern-35258
+ template-35259)
+ (string? (syntax->datum docstring-35256)))
+ tmp-35251)
#f)
(@apply
- (lambda (k-37586
- docstring-37587
- keyword-37588
- pattern-37589
- template-37590)
+ (lambda (k-35260
+ docstring-35261
+ keyword-35262
+ pattern-35263
+ template-35264)
(list '#(syntax-object
lambda
((top)
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-37551"
- "l-*-37552"
- "l-*-37553"
- "l-*-37554"
- "l-*-37555"))
+ #("l-*-35225"
+ "l-*-35226"
+ "l-*-35227"
+ "l-*-35228"
+ "l-*-35229"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18349,13 +20064,13 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-37551"
- "l-*-37552"
- "l-*-37553"
- "l-*-37554"
- "l-*-37555"))
+ #("l-*-35225"
+ "l-*-35226"
+ "l-*-35227"
+ "l-*-35228"
+ "l-*-35229"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18366,7 +20081,7 @@
((top))
(hygiene guile))))))
(hygiene guile)))
- docstring-37587
+ docstring-35261
(vector
'(#(syntax-object
macro-type
@@ -18374,13 +20089,13 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-37551"
- "l-*-37552"
- "l-*-37553"
- "l-*-37554"
- "l-*-37555"))
+ #("l-*-35225"
+ "l-*-35226"
+ "l-*-35227"
+ "l-*-35228"
+ "l-*-35229"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18398,13 +20113,13 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-37551"
- "l-*-37552"
- "l-*-37553"
- "l-*-37554"
- "l-*-37555"))
+ #("l-*-35225"
+ "l-*-35226"
+ "l-*-35227"
+ "l-*-35228"
+ "l-*-35229"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18421,13 +20136,13 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-37551"
- "l-*-37552"
- "l-*-37553"
- "l-*-37554"
- "l-*-37555"))
+ #("l-*-35225"
+ "l-*-35226"
+ "l-*-35227"
+ "l-*-35228"
+ "l-*-35229"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18438,20 +20153,20 @@
((top))
(hygiene guile))))))
(hygiene guile))
- pattern-37589))
+ pattern-35263))
(cons '#(syntax-object
syntax-case
((top)
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-37551"
- "l-*-37552"
- "l-*-37553"
- "l-*-37554"
- "l-*-37555"))
+ #("l-*-35225"
+ "l-*-35226"
+ "l-*-35227"
+ "l-*-35228"
+ "l-*-35229"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18472,13 +20187,13 @@
pattern
template)
#((top) (top) (top) (top) (top))
- #("l-*-37551"
- "l-*-37552"
- "l-*-37553"
- "l-*-37554"
- "l-*-37555"))
+ #("l-*-35225"
+ "l-*-35226"
+ "l-*-35227"
+ "l-*-35228"
+ "l-*-35229"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37525"))
+ #(ribcage #(x) #((top)) #("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18489,9 +20204,9 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons k-37586
- (map (lambda (tmp-37564-37591
- tmp-37563-37592)
+ (cons k-35260
+ (map (lambda (tmp-35238-35265
+ tmp-35237-35266)
(list (cons '#(syntax-object
_
((top)
@@ -18506,11 +20221,11 @@
(top)
(top)
(top))
-
#("l-*-37551"
-
"l-*-37552"
-
"l-*-37553"
-
"l-*-37554"
-
"l-*-37555"))
+
#("l-*-35225"
+
"l-*-35226"
+
"l-*-35227"
+
"l-*-35228"
+
"l-*-35229"))
#(ribcage
()
()
@@ -18518,7 +20233,7 @@
#(ribcage
#(x)
#((top))
-
#("l-*-37525"))
+
#("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18532,7 +20247,7 @@
guile))))))
(hygiene
guile))
- tmp-37563-37592)
+ tmp-35237-35266)
(list '#(syntax-object
syntax
((top)
@@ -18547,11 +20262,11 @@
(top)
(top)
(top))
-
#("l-*-37551"
-
"l-*-37552"
-
"l-*-37553"
-
"l-*-37554"
-
"l-*-37555"))
+
#("l-*-35225"
+
"l-*-35226"
+
"l-*-35227"
+
"l-*-35228"
+
"l-*-35229"))
#(ribcage
()
()
@@ -18559,7 +20274,7 @@
#(ribcage
#(x)
#((top))
-
#("l-*-37525"))
+
#("l-*-35199"))
#(ribcage
(syntax-rules)
((top))
@@ -18573,34 +20288,34 @@
guile))))))
(hygiene
guile))
- tmp-37564-37591)))
- template-37590
- pattern-37589))))))
- tmp-37577)
+ tmp-35238-35265)))
+ template-35264
+ pattern-35263))))))
+ tmp-35251)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-37565))))))))
+ x-35239))))))))
(define define-syntax-rule
(make-syntax-transformer
'define-syntax-rule
'macro
- (lambda (x-37630)
- (let ((tmp-37632
- ($sc-dispatch x-37630 '(_ (any . any) any))))
- (if tmp-37632
+ (lambda (x-35304)
+ (let ((tmp-35306
+ ($sc-dispatch x-35304 '(_ (any . any) any))))
+ (if tmp-35306
(@apply
- (lambda (name-37636 pattern-37637 template-37638)
+ (lambda (name-35310 pattern-35311 template-35312)
(list '#(syntax-object
define-syntax
((top)
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-37607" "l-*-37608" "l-*-37609"))
+ #("l-*-35281" "l-*-35282" "l-*-35283"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37604"))
+ #(ribcage #(x) #((top)) #("l-*-35278"))
#(ribcage
(define-syntax-rule)
((top))
@@ -18611,16 +20326,16 @@
((top))
(hygiene guile))))))
(hygiene guile))
- name-37636
+ name-35310
(list '#(syntax-object
syntax-rules
((top)
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-37607" "l-*-37608" "l-*-37609"))
+ #("l-*-35281" "l-*-35282" "l-*-35283"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37604"))
+ #(ribcage #(x) #((top)) #("l-*-35278"))
#(ribcage
(define-syntax-rule)
((top))
@@ -18638,14 +20353,14 @@
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-37607"
- "l-*-37608"
- "l-*-37609"))
+ #("l-*-35281"
+ "l-*-35282"
+ "l-*-35283"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-37604"))
+ #("l-*-35278"))
#(ribcage
(define-syntax-rule)
((top))
@@ -18656,37 +20371,37 @@
((top))
(hygiene guile))))))
(hygiene guile))
- pattern-37637)
- template-37638))))
- tmp-37632)
- (let ((tmp-37639
- ($sc-dispatch x-37630 '(_ (any . any) any any))))
- (if (if tmp-37639
+ pattern-35311)
+ template-35312))))
+ tmp-35306)
+ (let ((tmp-35313
+ ($sc-dispatch x-35304 '(_ (any . any) any any))))
+ (if (if tmp-35313
(@apply
- (lambda (name-37643
- pattern-37644
- docstring-37645
- template-37646)
- (string? (syntax->datum docstring-37645)))
- tmp-37639)
+ (lambda (name-35317
+ pattern-35318
+ docstring-35319
+ template-35320)
+ (string? (syntax->datum docstring-35319)))
+ tmp-35313)
#f)
(@apply
- (lambda (name-37647
- pattern-37648
- docstring-37649
- template-37650)
+ (lambda (name-35321
+ pattern-35322
+ docstring-35323
+ template-35324)
(list '#(syntax-object
define-syntax
((top)
#(ribcage
#(name pattern docstring template)
#((top) (top) (top) (top))
- #("l-*-37622"
- "l-*-37623"
- "l-*-37624"
- "l-*-37625"))
+ #("l-*-35296"
+ "l-*-35297"
+ "l-*-35298"
+ "l-*-35299"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37604"))
+ #(ribcage #(x) #((top)) #("l-*-35278"))
#(ribcage
(define-syntax-rule)
((top))
@@ -18697,19 +20412,19 @@
((top))
(hygiene guile))))))
(hygiene guile))
- name-37647
+ name-35321
(list '#(syntax-object
syntax-rules
((top)
#(ribcage
#(name pattern docstring template)
#((top) (top) (top) (top))
- #("l-*-37622"
- "l-*-37623"
- "l-*-37624"
- "l-*-37625"))
+ #("l-*-35296"
+ "l-*-35297"
+ "l-*-35298"
+ "l-*-35299"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37604"))
+ #(ribcage #(x) #((top)) #("l-*-35278"))
#(ribcage
(define-syntax-rule)
((top))
@@ -18721,7 +20436,7 @@
(hygiene guile))))))
(hygiene guile))
'()
- docstring-37649
+ docstring-35323
(list (cons '#(syntax-object
_
((top)
@@ -18731,15 +20446,15 @@
docstring
template)
#((top) (top) (top) (top))
- #("l-*-37622"
- "l-*-37623"
- "l-*-37624"
- "l-*-37625"))
+ #("l-*-35296"
+ "l-*-35297"
+ "l-*-35298"
+ "l-*-35299"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-37604"))
+ #("l-*-35278"))
#(ribcage
(define-syntax-rule)
((top))
@@ -18750,35 +20465,35 @@
((top))
(hygiene guile))))))
(hygiene guile))
- pattern-37648)
- template-37650))))
- tmp-37639)
+ pattern-35322)
+ template-35324))))
+ tmp-35313)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-37630))))))))
+ x-35304))))))))
(define let*
(make-syntax-transformer
'let*
'macro
- (lambda (x-37700)
- (let ((tmp-37702
+ (lambda (x-35374)
+ (let ((tmp-35376
($sc-dispatch
- x-37700
+ x-35374
'(any #(each (any any)) any . each-any))))
- (if (if tmp-37702
+ (if (if tmp-35376
(@apply
- (lambda (let*-37706 x-37707 v-37708 e1-37709 e2-37710)
- (and-map identifier? x-37707))
- tmp-37702)
+ (lambda (let*-35380 x-35381 v-35382 e1-35383 e2-35384)
+ (and-map identifier? x-35381))
+ tmp-35376)
#f)
(@apply
- (lambda (let*-37711 x-37712 v-37713 e1-37714 e2-37715)
+ (lambda (let*-35385 x-35386 v-35387 e1-35388 e2-35389)
(letrec*
- ((f-37716
- (lambda (bindings-37719)
- (if (null? bindings-37719)
+ ((f-35390
+ (lambda (bindings-35393)
+ (if (null? bindings-35393)
(cons '#(syntax-object
let
((top)
@@ -18786,17 +20501,17 @@
#(ribcage
#(f bindings)
#((top) (top))
- #("l-*-37686" "l-*-37687"))
+ #("l-*-35360" "l-*-35361"))
#(ribcage
#(let* x v e1 e2)
#((top) (top) (top) (top) (top))
- #("l-*-37676"
- "l-*-37677"
- "l-*-37678"
- "l-*-37679"
- "l-*-37680"))
+ #("l-*-35350"
+ "l-*-35351"
+ "l-*-35352"
+ "l-*-35353"
+ "l-*-35354"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-37662"))
+ #(ribcage #(x) #((top)) #("l-*-35336"))
#(ribcage
(let*)
((top))
@@ -18807,14 +20522,14 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons '() (cons e1-37714 e2-37715)))
- (let ((tmp-37720
- (list (f-37716 (cdr bindings-37719))
- (car bindings-37719))))
- (let ((tmp-37721 ($sc-dispatch tmp-37720 '(any any))))
- (if tmp-37721
+ (cons '() (cons e1-35388 e2-35389)))
+ (let ((tmp-35394
+ (list (f-35390 (cdr bindings-35393))
+ (car bindings-35393))))
+ (let ((tmp-35395 ($sc-dispatch tmp-35394 '(any any))))
+ (if tmp-35395
(@apply
- (lambda (body-37723 binding-37724)
+ (lambda (body-35397 binding-35398)
(list '#(syntax-object
let
((top)
@@ -18822,25 +20537,25 @@
#(ribcage
#(body binding)
#((top) (top))
- #("l-*-37696" "l-*-37697"))
+ #("l-*-35370" "l-*-35371"))
#(ribcage () () ())
#(ribcage
#(f bindings)
#((top) (top))
- #("l-*-37686" "l-*-37687"))
+ #("l-*-35360" "l-*-35361"))
#(ribcage
#(let* x v e1 e2)
#((top) (top) (top) (top) (top))
- #("l-*-37676"
- "l-*-37677"
- "l-*-37678"
- "l-*-37679"
- "l-*-37680"))
+ #("l-*-35350"
+ "l-*-35351"
+ "l-*-35352"
+ "l-*-35353"
+ "l-*-35354"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-37662"))
+ #("l-*-35336"))
#(ribcage
(let*)
((top))
@@ -18851,64 +20566,64 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (list binding-37724)
- body-37723))
- tmp-37721)
+ (list binding-35398)
+ body-35397))
+ tmp-35395)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-37720))))))))
- (f-37716 (map list x-37712 v-37713))))
- tmp-37702)
+ tmp-35394))))))))
+ (f-35390 (map list x-35386 v-35387))))
+ tmp-35376)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-37700))))))
+ x-35374))))))
(define do
(make-syntax-transformer
'do
'macro
- (lambda (orig-x-37783)
- (let ((tmp-37785
+ (lambda (orig-x-35457)
+ (let ((tmp-35459
($sc-dispatch
- orig-x-37783
+ orig-x-35457
'(_ #(each (any any . any))
(any . each-any)
.
each-any))))
- (if tmp-37785
+ (if tmp-35459
(@apply
- (lambda (var-37789
- init-37790
- step-37791
- e0-37792
- e1-37793
- c-37794)
- (let ((tmp-37795
- (map (lambda (v-37798 s-37799)
- (let ((tmp-37801 ($sc-dispatch s-37799 '())))
- (if tmp-37801
- (@apply (lambda () v-37798) tmp-37801)
- (let ((tmp-37804
- ($sc-dispatch s-37799 '(any))))
- (if tmp-37804
+ (lambda (var-35463
+ init-35464
+ step-35465
+ e0-35466
+ e1-35467
+ c-35468)
+ (let ((tmp-35469
+ (map (lambda (v-35472 s-35473)
+ (let ((tmp-35475 ($sc-dispatch s-35473 '())))
+ (if tmp-35475
+ (@apply (lambda () v-35472) tmp-35475)
+ (let ((tmp-35478
+ ($sc-dispatch s-35473 '(any))))
+ (if tmp-35478
(@apply
- (lambda (e-37807) e-37807)
- tmp-37804)
+ (lambda (e-35481) e-35481)
+ tmp-35478)
(syntax-violation
'do
"bad step expression"
- orig-x-37783
- s-37799))))))
- var-37789
- step-37791)))
- (let ((tmp-37796 ($sc-dispatch tmp-37795 'each-any)))
- (if tmp-37796
+ orig-x-35457
+ s-35473))))))
+ var-35463
+ step-35465)))
+ (let ((tmp-35470 ($sc-dispatch tmp-35469 'each-any)))
+ (if tmp-35470
(@apply
- (lambda (step-37813)
- (let ((tmp-37815 ($sc-dispatch e1-37793 '())))
- (if tmp-37815
+ (lambda (step-35487)
+ (let ((tmp-35489 ($sc-dispatch e1-35467 '())))
+ (if tmp-35489
(@apply
(lambda ()
(list '#(syntax-object
@@ -18918,7 +20633,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -18927,17 +20642,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -18955,7 +20670,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -18964,17 +20679,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -18985,7 +20700,7 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (map list var-37789 init-37790)
+ (map list var-35463 init-35464)
(list '#(syntax-object
if
((top)
@@ -18993,7 +20708,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -19002,17 +20717,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19030,7 +20745,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var
init
@@ -19044,17 +20759,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19066,7 +20781,7 @@
(hygiene
guile))))))
(hygiene guile))
- e0-37792)
+ e0-35466)
(cons '#(syntax-object
begin
((top)
@@ -19074,7 +20789,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var
init
@@ -19088,17 +20803,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19111,7 +20826,7 @@
guile))))))
(hygiene guile))
(append
- c-37794
+ c-35468
(list (cons
'#(syntax-object
doloop
((top)
@@ -19122,7 +20837,7 @@
#(ribcage
#(step)
#((top))
-
#("l-*-37751"))
+
#("l-*-35425"))
#(ribcage
#(var
init
@@ -19136,12 +20851,12 @@
(top)
(top)
(top))
-
#("l-*-37736"
-
"l-*-37737"
-
"l-*-37738"
-
"l-*-37739"
-
"l-*-37740"
-
"l-*-37741"))
+
#("l-*-35410"
+
"l-*-35411"
+
"l-*-35412"
+
"l-*-35413"
+
"l-*-35414"
+
"l-*-35415"))
#(ribcage
()
()
@@ -19149,7 +20864,7 @@
#(ribcage
#(orig-x)
#((top))
-
#("l-*-37733"))
+
#("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19163,25 +20878,25 @@
guile))))))
(hygiene
guile))
-
step-37813)))))))
- tmp-37815)
- (let ((tmp-37819
- ($sc-dispatch e1-37793 '(any . each-any))))
- (if tmp-37819
+
step-35487)))))))
+ tmp-35489)
+ (let ((tmp-35493
+ ($sc-dispatch e1-35467 '(any . each-any))))
+ (if tmp-35493
(@apply
- (lambda (e1-37823 e2-37824)
+ (lambda (e1-35497 e2-35498)
(list '#(syntax-object
let
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-37760" "l-*-37761"))
+ #("l-*-35434" "l-*-35435"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -19190,17 +20905,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19217,12 +20932,12 @@
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-37760" "l-*-37761"))
+ #("l-*-35434" "l-*-35435"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -19231,17 +20946,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19252,20 +20967,20 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (map list var-37789 init-37790)
+ (map list var-35463 init-35464)
(list '#(syntax-object
if
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-37760"
- "l-*-37761"))
+ #("l-*-35434"
+ "l-*-35435"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -19274,17 +20989,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19295,20 +21010,20 @@
((top))
(hygiene guile))))))
(hygiene guile))
- e0-37792
+ e0-35466
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-37760"
- "l-*-37761"))
+ #("l-*-35434"
+ "l-*-35435"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var
init
@@ -19322,17 +21037,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19344,20 +21059,20 @@
(hygiene
guile))))))
(hygiene guile))
- (cons e1-37823 e2-37824))
+ (cons e1-35497 e2-35498))
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-37760"
- "l-*-37761"))
+ #("l-*-35434"
+ "l-*-35435"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-37751"))
+ #("l-*-35425"))
#(ribcage
#(var
init
@@ -19371,17 +21086,17 @@
(top)
(top)
(top))
- #("l-*-37736"
- "l-*-37737"
- "l-*-37738"
- "l-*-37739"
- "l-*-37740"
- "l-*-37741"))
+ #("l-*-35410"
+ "l-*-35411"
+ "l-*-35412"
+ "l-*-35413"
+ "l-*-35414"
+ "l-*-35415"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-37733"))
+ #("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19394,7 +21109,7 @@
guile))))))
(hygiene guile))
(append
- c-37794
+ c-35468
(list (cons
'#(syntax-object
doloop
((top)
@@ -19403,8 +21118,8 @@
e2)
#((top)
(top))
-
#("l-*-37760"
-
"l-*-37761"))
+
#("l-*-35434"
+
"l-*-35435"))
#(ribcage
()
()
@@ -19412,7 +21127,7 @@
#(ribcage
#(step)
#((top))
-
#("l-*-37751"))
+
#("l-*-35425"))
#(ribcage
#(var
init
@@ -19426,12 +21141,12 @@
(top)
(top)
(top))
-
#("l-*-37736"
-
"l-*-37737"
-
"l-*-37738"
-
"l-*-37739"
-
"l-*-37740"
-
"l-*-37741"))
+
#("l-*-35410"
+
"l-*-35411"
+
"l-*-35412"
+
"l-*-35413"
+
"l-*-35414"
+
"l-*-35415"))
#(ribcage
()
()
@@ -19439,7 +21154,7 @@
#(ribcage
#(orig-x)
#((top))
-
#("l-*-37733"))
+
#("l-*-35407"))
#(ribcage
(do)
((top))
@@ -19453,33 +21168,33 @@
guile))))))
(hygiene
guile))
-
step-37813)))))))
- tmp-37819)
+
step-35487)))))))
+ tmp-35493)
(syntax-violation
#f
"source expression failed to match any
pattern"
- e1-37793))))))
- tmp-37796)
+ e1-35467))))))
+ tmp-35470)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-37795)))))
- tmp-37785)
+ tmp-35469)))))
+ tmp-35459)
(syntax-violation
#f
"source expression failed to match any pattern"
- orig-x-37783))))))
+ orig-x-35457))))))
(define quasiquote
(make-syntax-transformer
'quasiquote
'macro
(letrec*
- ((quasi-38105
- (lambda (p-38129 lev-38130)
- (let ((tmp-38132
+ ((quasi-35779
+ (lambda (p-35803 lev-35804)
+ (let ((tmp-35806
($sc-dispatch
- p-38129
+ p-35803
'(#(free-id
#(syntax-object
unquote
@@ -19488,7 +21203,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19497,13 +21212,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19515,19 +21230,19 @@
(hygiene guile))))))
(hygiene guile)))
any))))
- (if tmp-38132
+ (if tmp-35806
(@apply
- (lambda (p-38136)
- (if (= lev-38130 0)
+ (lambda (p-35810)
+ (if (= lev-35804 0)
(list '#(syntax-object
"value"
((top)
- #(ribcage #(p) #((top)) #("l-*-37861"))
+ #(ribcage #(p) #((top)) #("l-*-35535"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19536,13 +21251,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19553,17 +21268,17 @@
((top))
(hygiene guile))))))
(hygiene guile))
- p-38136)
- (quasicons-38107
+ p-35810)
+ (quasicons-35781
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-37861"))
+ #(ribcage #(p) #((top)) #("l-*-35535"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19572,13 +21287,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19592,12 +21307,12 @@
#(syntax-object
unquote
((top)
- #(ribcage #(p) #((top)) #("l-*-37861"))
+ #(ribcage #(p) #((top)) #("l-*-35535"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19606,13 +21321,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19623,11 +21338,11 @@
((top))
(hygiene guile))))))
(hygiene guile)))
- (quasi-38105 (list p-38136) (#{1-}# lev-38130)))))
- tmp-38132)
- (let ((tmp-38139
+ (quasi-35779 (list p-35810) (#{1-}# lev-35804)))))
+ tmp-35806)
+ (let ((tmp-35813
($sc-dispatch
- p-38129
+ p-35803
'(#(free-id
#(syntax-object
quasiquote
@@ -19636,7 +21351,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19645,13 +21360,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19663,19 +21378,19 @@
(hygiene guile))))))
(hygiene guile)))
any))))
- (if tmp-38139
+ (if tmp-35813
(@apply
- (lambda (p-38143)
- (quasicons-38107
+ (lambda (p-35817)
+ (quasicons-35781
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-37864"))
+ #(ribcage #(p) #((top)) #("l-*-35538"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19684,13 +21399,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19704,12 +21419,12 @@
#(syntax-object
quasiquote
((top)
- #(ribcage #(p) #((top)) #("l-*-37864"))
+ #(ribcage #(p) #((top)) #("l-*-35538"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19718,13 +21433,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19735,15 +21450,15 @@
((top))
(hygiene guile))))))
(hygiene guile)))
- (quasi-38105 (list p-38143) (#{1+}# lev-38130))))
- tmp-38139)
- (let ((tmp-38146 ($sc-dispatch p-38129 '(any . any))))
- (if tmp-38146
+ (quasi-35779 (list p-35817) (#{1+}# lev-35804))))
+ tmp-35813)
+ (let ((tmp-35820 ($sc-dispatch p-35803 '(any . any))))
+ (if tmp-35820
(@apply
- (lambda (p-38150 q-38151)
- (let ((tmp-38153
+ (lambda (p-35824 q-35825)
+ (let ((tmp-35827
($sc-dispatch
- p-38150
+ p-35824
'(#(free-id
#(syntax-object
unquote
@@ -19751,12 +21466,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37867" "l-*-37868"))
+ #("l-*-35541" "l-*-35542"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19771,13 +21486,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19790,30 +21505,30 @@
(hygiene guile)))
.
each-any))))
- (if tmp-38153
+ (if tmp-35827
(@apply
- (lambda (p-38157)
- (if (= lev-38130 0)
- (quasilist*-38109
- (map (lambda (tmp-37875-38196)
+ (lambda (p-35831)
+ (if (= lev-35804 0)
+ (quasilist*-35783
+ (map (lambda (tmp-35549-35870)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-37873"))
+ #("l-*-35547"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37867"
- "l-*-37868"))
+ #("l-*-35541"
+ "l-*-35542"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857"
- "l-*-37858"))
+ #("l-*-35531"
+ "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19828,13 +21543,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19846,27 +21561,27 @@
(hygiene
guile))))))
(hygiene guile))
- tmp-37875-38196))
- p-38157)
- (quasi-38105 q-38151 lev-38130))
- (quasicons-38107
- (quasicons-38107
+ tmp-35549-35870))
+ p-35831)
+ (quasi-35779 q-35825 lev-35804))
+ (quasicons-35781
+ (quasicons-35781
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-37873"))
+ #("l-*-35547"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37867" "l-*-37868"))
+ #("l-*-35541" "l-*-35542"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19881,13 +21596,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19904,16 +21619,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-37873"))
+ #("l-*-35547"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37867" "l-*-37868"))
+ #("l-*-35541" "l-*-35542"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19928,13 +21643,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19945,14 +21660,14 @@
((top))
(hygiene guile))))))
(hygiene guile)))
- (quasi-38105
- p-38157
- (#{1-}# lev-38130)))
- (quasi-38105 q-38151 lev-38130))))
- tmp-38153)
- (let ((tmp-38201
+ (quasi-35779
+ p-35831
+ (#{1-}# lev-35804)))
+ (quasi-35779 q-35825 lev-35804))))
+ tmp-35827)
+ (let ((tmp-35875
($sc-dispatch
- p-38150
+ p-35824
'(#(free-id
#(syntax-object
unquote-splicing
@@ -19960,12 +21675,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37867" "l-*-37868"))
+ #("l-*-35541" "l-*-35542"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -19980,13 +21695,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -19999,30 +21714,30 @@
(hygiene guile)))
.
each-any))))
- (if tmp-38201
+ (if tmp-35875
(@apply
- (lambda (p-38205)
- (if (= lev-38130 0)
- (quasiappend-38108
- (map (lambda (tmp-37880-38208)
+ (lambda (p-35879)
+ (if (= lev-35804 0)
+ (quasiappend-35782
+ (map (lambda (tmp-35554-35882)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-37878"))
+ #("l-*-35552"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37867"
- "l-*-37868"))
+ #("l-*-35541"
+ "l-*-35542"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857"
- "l-*-37858"))
+ #("l-*-35531"
+ "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -20037,13 +21752,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20055,27 +21770,27 @@
(hygiene
guile))))))
(hygiene guile))
- tmp-37880-38208))
- p-38205)
- (quasi-38105 q-38151 lev-38130))
- (quasicons-38107
- (quasicons-38107
+ tmp-35554-35882))
+ p-35879)
+ (quasi-35779 q-35825 lev-35804))
+ (quasicons-35781
+ (quasicons-35781
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-37878"))
+ #("l-*-35552"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37867" "l-*-37868"))
+ #("l-*-35541" "l-*-35542"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -20090,13 +21805,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20113,16 +21828,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-37878"))
+ #("l-*-35552"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37867" "l-*-37868"))
+ #("l-*-35541" "l-*-35542"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -20137,13 +21852,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20154,41 +21869,41 @@
((top))
(hygiene guile))))))
(hygiene guile)))
- (quasi-38105
- p-38205
- (#{1-}# lev-38130)))
- (quasi-38105 q-38151 lev-38130))))
- tmp-38201)
- (quasicons-38107
- (quasi-38105 p-38150 lev-38130)
- (quasi-38105 q-38151 lev-38130)))))))
- tmp-38146)
- (let ((tmp-38222
- ($sc-dispatch p-38129 '#(vector each-any))))
- (if tmp-38222
+ (quasi-35779
+ p-35879
+ (#{1-}# lev-35804)))
+ (quasi-35779 q-35825 lev-35804))))
+ tmp-35875)
+ (quasicons-35781
+ (quasi-35779 p-35824 lev-35804)
+ (quasi-35779 q-35825 lev-35804)))))))
+ tmp-35820)
+ (let ((tmp-35896
+ ($sc-dispatch p-35803 '#(vector each-any))))
+ (if tmp-35896
(@apply
- (lambda (x-38226)
- (let ((x-38229
- (vquasi-38106 x-38226 lev-38130)))
- (let ((tmp-38231
+ (lambda (x-35900)
+ (let ((x-35903
+ (vquasi-35780 x-35900 lev-35804)))
+ (let ((tmp-35905
($sc-dispatch
- x-38229
+ x-35903
'(#(atom "quote") each-any))))
- (if tmp-38231
+ (if tmp-35905
(@apply
- (lambda (x-38235)
+ (lambda (x-35909)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(x)
#((top))
- #("l-*-37979"))
+ #("l-*-35653"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-37976"))
+ #("l-*-35650"))
#(ribcage
(emit quasivector
quasilist*
@@ -20203,13 +21918,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20220,28 +21935,28 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (list->vector x-38235)))
- tmp-38231)
+ (list->vector x-35909)))
+ tmp-35905)
(letrec*
- ((f-38237
- (lambda (y-38249 k-38250)
- (let ((tmp-38252
+ ((f-35911
+ (lambda (y-35923 k-35924)
+ (let ((tmp-35926
($sc-dispatch
- y-38249
+ y-35923
'(#(atom "quote")
each-any))))
- (if tmp-38252
+ (if tmp-35926
(@apply
- (lambda (y-38255)
- (k-38250
- (map (lambda
(tmp-38004-38256)
+ (lambda (y-35929)
+ (k-35924
+ (map (lambda
(tmp-35678-35930)
(list
'#(syntax-object
"quote"
((top)
#(ribcage
#(y)
#((top))
-
#("l-*-38002"))
+
#("l-*-35676"))
#(ribcage
()
()
@@ -20253,13 +21968,13 @@
#((top)
(top)
(top))
-
#("l-*-37984"
-
"l-*-37985"
-
"l-*-37986"))
+
#("l-*-35658"
+
"l-*-35659"
+
"l-*-35660"))
#(ribcage
#(_)
#((top))
-
#("l-*-37982"))
+
#("l-*-35656"))
#(ribcage
()
()
@@ -20267,7 +21982,7 @@
#(ribcage
#(x)
#((top))
-
#("l-*-37976"))
+
#("l-*-35650"))
#(ribcage
(emit
quasivector
quasilist*
@@ -20282,13 +21997,13 @@
(top)
(top)
(top))
-
("l-*-37853"
-
"l-*-37851"
-
"l-*-37849"
-
"l-*-37847"
-
"l-*-37845"
-
"l-*-37843"
-
"l-*-37841"))
+
("l-*-35527"
+
"l-*-35525"
+
"l-*-35523"
+
"l-*-35521"
+
"l-*-35519"
+
"l-*-35517"
+
"l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20302,41 +22017,41 @@
guile))))))
(hygiene
guile))
-
tmp-38004-38256))
- y-38255)))
- tmp-38252)
- (let ((tmp-38257
+
tmp-35678-35930))
+ y-35929)))
+ tmp-35926)
+ (let ((tmp-35931
($sc-dispatch
- y-38249
+ y-35923
'(#(atom "list")
.
each-any))))
- (if tmp-38257
+ (if tmp-35931
(@apply
- (lambda (y-38260)
- (k-38250 y-38260))
- tmp-38257)
- (let ((tmp-38261
+ (lambda (y-35934)
+ (k-35924 y-35934))
+ tmp-35931)
+ (let ((tmp-35935
($sc-dispatch
- y-38249
+ y-35923
'(#(atom "list*")
.
#(each+
any
(any)
())))))
- (if tmp-38261
+ (if tmp-35935
(@apply
- (lambda (y-38264
- z-38265)
- (f-38237
- z-38265
- (lambda
(ls-38266)
- (k-38250
+ (lambda (y-35938
+ z-35939)
+ (f-35911
+ z-35939
+ (lambda
(ls-35940)
+ (k-35924
(append
- y-38264
-
ls-38266)))))
- tmp-38261)
+ y-35938
+
ls-35940)))))
+ tmp-35935)
(list '#(syntax-object
"list->vector"
((top)
@@ -20345,14 +22060,14 @@
()
())
#(ribcage
- #(t-38019)
-
#((m-*-38020
+ #(t-35693)
+
#((m-*-35694
top))
-
#("l-*-38023"))
+
#("l-*-35697"))
#(ribcage
#(else)
#((top))
-
#("l-*-38017"))
+
#("l-*-35691"))
#(ribcage
()
()
@@ -20362,13 +22077,13 @@
#((top)
(top)
(top))
-
#("l-*-37984"
-
"l-*-37985"
-
"l-*-37986"))
+
#("l-*-35658"
+
"l-*-35659"
+
"l-*-35660"))
#(ribcage
#(_)
#((top))
-
#("l-*-37982"))
+
#("l-*-35656"))
#(ribcage
()
()
@@ -20376,7 +22091,7 @@
#(ribcage
#(x)
#((top))
-
#("l-*-37976"))
+
#("l-*-35650"))
#(ribcage
(emit
quasivector
quasilist*
@@ -20391,13 +22106,13 @@
(top)
(top)
(top))
-
("l-*-37853"
-
"l-*-37851"
-
"l-*-37849"
-
"l-*-37847"
-
"l-*-37845"
-
"l-*-37843"
-
"l-*-37841"))
+
("l-*-35527"
+
"l-*-35525"
+
"l-*-35523"
+
"l-*-35521"
+
"l-*-35519"
+
"l-*-35517"
+
"l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20411,17 +22126,17 @@
guile))))))
(hygiene
guile))
- x-38229))))))))))
- (f-38237
- x-38229
- (lambda (ls-38239)
- (let ((tmp-38241
+ x-35903))))))))))
+ (f-35911
+ x-35903
+ (lambda (ls-35913)
+ (let ((tmp-35915
($sc-dispatch
- ls-38239
+ ls-35913
'each-any)))
- (if tmp-38241
+ (if tmp-35915
(@apply
- (lambda (t-37992-38244)
+ (lambda (t-35666-35918)
(cons '#(syntax-object
"vector"
((top)
@@ -20430,10 +22145,10 @@
()
())
#(ribcage
- #(t-37992)
- #((m-*-37993
+ #(t-35666)
+ #((m-*-35667
top))
- #("l-*-37997"))
+ #("l-*-35671"))
#(ribcage
()
()
@@ -20449,11 +22164,11 @@
#(ribcage
#(ls)
#((top))
- #("l-*-37991"))
+ #("l-*-35665"))
#(ribcage
#(_)
#((top))
- #("l-*-37982"))
+ #("l-*-35656"))
#(ribcage
()
()
@@ -20461,7 +22176,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-37976"))
+ #("l-*-35650"))
#(ribcage
(emit
quasivector
quasilist*
@@ -20476,13 +22191,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20495,22 +22210,22 @@
(hygiene
guile))))))
(hygiene guile))
- t-37992-38244))
- tmp-38241)
+ t-35666-35918))
+ tmp-35915)
(syntax-violation
#f
"source expression failed to
match any pattern"
- ls-38239))))))))))
- tmp-38222)
+ ls-35913))))))))))
+ tmp-35896)
(list '#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-37888"))
+ #(ribcage #(p) #((top)) #("l-*-35562"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37857" "l-*-37858"))
+ #("l-*-35531" "l-*-35532"))
#(ribcage
(emit quasivector
quasilist*
@@ -20525,13 +22240,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20542,16 +22257,16 @@
((top))
(hygiene guile))))))
(hygiene guile))
- p-38129)))))))))))
- (vquasi-38106
- (lambda (p-38294 lev-38295)
- (let ((tmp-38297 ($sc-dispatch p-38294 '(any . any))))
- (if tmp-38297
+ p-35803)))))))))))
+ (vquasi-35780
+ (lambda (p-35968 lev-35969)
+ (let ((tmp-35971 ($sc-dispatch p-35968 '(any . any))))
+ (if tmp-35971
(@apply
- (lambda (p-38301 q-38302)
- (let ((tmp-38304
+ (lambda (p-35975 q-35976)
+ (let ((tmp-35978
($sc-dispatch
- p-38301
+ p-35975
'(#(free-id
#(syntax-object
unquote
@@ -20559,12 +22274,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37896" "l-*-37897"))
+ #("l-*-35570" "l-*-35571"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892" "l-*-37893"))
+ #("l-*-35566" "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20579,13 +22294,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20598,28 +22313,28 @@
(hygiene guile)))
.
each-any))))
- (if tmp-38304
+ (if tmp-35978
(@apply
- (lambda (p-38308)
- (if (= lev-38295 0)
- (quasilist*-38109
- (map (lambda (tmp-37904-38347)
+ (lambda (p-35982)
+ (if (= lev-35969 0)
+ (quasilist*-35783
+ (map (lambda (tmp-35578-36021)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-37902"))
+ #("l-*-35576"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37896" "l-*-37897"))
+ #("l-*-35570" "l-*-35571"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892" "l-*-37893"))
+ #("l-*-35566" "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20634,13 +22349,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20651,24 +22366,24 @@
((top))
(hygiene guile))))))
(hygiene guile))
- tmp-37904-38347))
- p-38308)
- (vquasi-38106 q-38302 lev-38295))
- (quasicons-38107
- (quasicons-38107
+ tmp-35578-36021))
+ p-35982)
+ (vquasi-35780 q-35976 lev-35969))
+ (quasicons-35781
+ (quasicons-35781
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-37902"))
+ #(ribcage #(p) #((top)) #("l-*-35576"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37896" "l-*-37897"))
+ #("l-*-35570" "l-*-35571"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892" "l-*-37893"))
+ #("l-*-35566" "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20683,13 +22398,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20703,16 +22418,16 @@
#(syntax-object
unquote
((top)
- #(ribcage #(p) #((top)) #("l-*-37902"))
+ #(ribcage #(p) #((top)) #("l-*-35576"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37896" "l-*-37897"))
+ #("l-*-35570" "l-*-35571"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892" "l-*-37893"))
+ #("l-*-35566" "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20727,13 +22442,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20744,12 +22459,12 @@
((top))
(hygiene guile))))))
(hygiene guile)))
- (quasi-38105 p-38308 (#{1-}# lev-38295)))
- (vquasi-38106 q-38302 lev-38295))))
- tmp-38304)
- (let ((tmp-38354
+ (quasi-35779 p-35982 (#{1-}# lev-35969)))
+ (vquasi-35780 q-35976 lev-35969))))
+ tmp-35978)
+ (let ((tmp-36028
($sc-dispatch
- p-38301
+ p-35975
'(#(free-id
#(syntax-object
unquote-splicing
@@ -20757,12 +22472,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37896" "l-*-37897"))
+ #("l-*-35570" "l-*-35571"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892" "l-*-37893"))
+ #("l-*-35566" "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20777,13 +22492,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20796,30 +22511,30 @@
(hygiene guile)))
.
each-any))))
- (if tmp-38354
+ (if tmp-36028
(@apply
- (lambda (p-38358)
- (if (= lev-38295 0)
- (quasiappend-38108
- (map (lambda (tmp-37909-38361)
+ (lambda (p-36032)
+ (if (= lev-35969 0)
+ (quasiappend-35782
+ (map (lambda (tmp-35583-36035)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-37907"))
+ #("l-*-35581"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37896"
- "l-*-37897"))
+ #("l-*-35570"
+ "l-*-35571"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892"
- "l-*-37893"))
+ #("l-*-35566"
+ "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20834,13 +22549,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20851,27 +22566,27 @@
((top))
(hygiene guile))))))
(hygiene guile))
- tmp-37909-38361))
- p-38358)
- (vquasi-38106 q-38302 lev-38295))
- (quasicons-38107
- (quasicons-38107
+ tmp-35583-36035))
+ p-36032)
+ (vquasi-35780 q-35976 lev-35969))
+ (quasicons-35781
+ (quasicons-35781
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-37907"))
+ #("l-*-35581"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37896" "l-*-37897"))
+ #("l-*-35570" "l-*-35571"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892" "l-*-37893"))
+ #("l-*-35566" "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20886,13 +22601,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20909,16 +22624,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-37907"))
+ #("l-*-35581"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-37896" "l-*-37897"))
+ #("l-*-35570" "l-*-35571"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892" "l-*-37893"))
+ #("l-*-35566" "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20933,13 +22648,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20950,15 +22665,15 @@
((top))
(hygiene guile))))))
(hygiene guile)))
- (quasi-38105 p-38358 (#{1-}# lev-38295)))
- (vquasi-38106 q-38302 lev-38295))))
- tmp-38354)
- (quasicons-38107
- (quasi-38105 p-38301 lev-38295)
- (vquasi-38106 q-38302 lev-38295)))))))
- tmp-38297)
- (let ((tmp-38379 ($sc-dispatch p-38294 '())))
- (if tmp-38379
+ (quasi-35779 p-36032 (#{1-}# lev-35969)))
+ (vquasi-35780 q-35976 lev-35969))))
+ tmp-36028)
+ (quasicons-35781
+ (quasi-35779 p-35975 lev-35969)
+ (vquasi-35780 q-35976 lev-35969)))))))
+ tmp-35971)
+ (let ((tmp-36053 ($sc-dispatch p-35968 '())))
+ (if tmp-36053
(@apply
(lambda ()
'(#(syntax-object
@@ -20968,7 +22683,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-37892" "l-*-37893"))
+ #("l-*-35566" "l-*-35567"))
#(ribcage
(emit quasivector
quasilist*
@@ -20977,13 +22692,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -20995,52 +22710,52 @@
(hygiene guile))))))
(hygiene guile))
()))
- tmp-38379)
+ tmp-36053)
(syntax-violation
#f
"source expression failed to match any pattern"
- p-38294)))))))
- (quasicons-38107
- (lambda (x-38392 y-38393)
- (let ((tmp-38394 (list x-38392 y-38393)))
- (let ((tmp-38395 ($sc-dispatch tmp-38394 '(any any))))
- (if tmp-38395
+ p-35968)))))))
+ (quasicons-35781
+ (lambda (x-36066 y-36067)
+ (let ((tmp-36068 (list x-36066 y-36067)))
+ (let ((tmp-36069 ($sc-dispatch tmp-36068 '(any any))))
+ (if tmp-36069
(@apply
- (lambda (x-38397 y-38398)
- (let ((tmp-38400
- ($sc-dispatch y-38398 '(#(atom "quote") any))))
- (if tmp-38400
+ (lambda (x-36071 y-36072)
+ (let ((tmp-36074
+ ($sc-dispatch y-36072 '(#(atom "quote") any))))
+ (if tmp-36074
(@apply
- (lambda (dy-38404)
- (let ((tmp-38406
+ (lambda (dy-36078)
+ (let ((tmp-36080
($sc-dispatch
- x-38397
+ x-36071
'(#(atom "quote") any))))
- (if tmp-38406
+ (if tmp-36080
(@apply
- (lambda (dx-38410)
+ (lambda (dx-36084)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(dx)
#((top))
- #("l-*-37931"))
+ #("l-*-35605"))
#(ribcage
#(dy)
#((top))
- #("l-*-37927"))
+ #("l-*-35601"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37921" "l-*-37922"))
+ #("l-*-35595" "l-*-35596"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37916" "l-*-37917"))
+ #("l-*-35590" "l-*-35591"))
#(ribcage
(emit quasivector
quasilist*
@@ -21055,13 +22770,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21072,31 +22787,31 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons dx-38410 dy-38404)))
- tmp-38406)
- (if (null? dy-38404)
+ (cons dx-36084 dy-36078)))
+ tmp-36080)
+ (if (null? dy-36078)
(list '#(syntax-object
"list"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-37933"))
+ #("l-*-35607"))
#(ribcage
#(dy)
#((top))
- #("l-*-37927"))
+ #("l-*-35601"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37921" "l-*-37922"))
+ #("l-*-35595" "l-*-35596"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37916" "l-*-37917"))
+ #("l-*-35590" "l-*-35591"))
#(ribcage
(emit quasivector
quasilist*
@@ -21111,13 +22826,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21128,29 +22843,29 @@
((top))
(hygiene guile))))))
(hygiene guile))
- x-38397)
+ x-36071)
(list '#(syntax-object
"list*"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-37933"))
+ #("l-*-35607"))
#(ribcage
#(dy)
#((top))
- #("l-*-37927"))
+ #("l-*-35601"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37921" "l-*-37922"))
+ #("l-*-35595" "l-*-35596"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37916" "l-*-37917"))
+ #("l-*-35590" "l-*-35591"))
#(ribcage
(emit quasivector
quasilist*
@@ -21165,13 +22880,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21182,34 +22897,34 @@
((top))
(hygiene guile))))))
(hygiene guile))
- x-38397
- y-38398)))))
- tmp-38400)
- (let ((tmp-38415
+ x-36071
+ y-36072)))))
+ tmp-36074)
+ (let ((tmp-36089
($sc-dispatch
- y-38398
+ y-36072
'(#(atom "list") . any))))
- (if tmp-38415
+ (if tmp-36089
(@apply
- (lambda (stuff-38419)
+ (lambda (stuff-36093)
(cons '#(syntax-object
"list"
((top)
#(ribcage
#(stuff)
#((top))
- #("l-*-37936"))
+ #("l-*-35610"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37921" "l-*-37922"))
+ #("l-*-35595" "l-*-35596"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37916" "l-*-37917"))
+ #("l-*-35590" "l-*-35591"))
#(ribcage
(emit quasivector
quasilist*
@@ -21224,13 +22939,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21241,33 +22956,33 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons x-38397 stuff-38419)))
- tmp-38415)
- (let ((tmp-38420
+ (cons x-36071 stuff-36093)))
+ tmp-36089)
+ (let ((tmp-36094
($sc-dispatch
- y-38398
+ y-36072
'(#(atom "list*") . any))))
- (if tmp-38420
+ (if tmp-36094
(@apply
- (lambda (stuff-38424)
+ (lambda (stuff-36098)
(cons '#(syntax-object
"list*"
((top)
#(ribcage
#(stuff)
#((top))
- #("l-*-37939"))
+ #("l-*-35613"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37921" "l-*-37922"))
+ #("l-*-35595" "l-*-35596"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37916" "l-*-37917"))
+ #("l-*-35590" "l-*-35591"))
#(ribcage
(emit quasivector
quasilist*
@@ -21282,13 +22997,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21299,26 +23014,26 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons x-38397 stuff-38424)))
- tmp-38420)
+ (cons x-36071 stuff-36098)))
+ tmp-36094)
(list '#(syntax-object
"list*"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-37941"))
+ #("l-*-35615"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37921" "l-*-37922"))
+ #("l-*-35595" "l-*-35596"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37916" "l-*-37917"))
+ #("l-*-35590" "l-*-35591"))
#(ribcage
(emit quasivector
quasilist*
@@ -21333,13 +23048,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21350,21 +23065,21 @@
((top))
(hygiene guile))))))
(hygiene guile))
- x-38397
- y-38398))))))))
- tmp-38395)
+ x-36071
+ y-36072))))))))
+ tmp-36069)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-38394))))))
- (quasiappend-38108
- (lambda (x-38435 y-38436)
- (let ((tmp-38438
- ($sc-dispatch y-38436 '(#(atom "quote") ()))))
- (if tmp-38438
+ tmp-36068))))))
+ (quasiappend-35782
+ (lambda (x-36109 y-36110)
+ (let ((tmp-36112
+ ($sc-dispatch y-36110 '(#(atom "quote") ()))))
+ (if tmp-36112
(@apply
(lambda ()
- (if (null? x-38435)
+ (if (null? x-36109)
'(#(syntax-object
"quote"
((top)
@@ -21372,7 +23087,7 @@
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37945" "l-*-37946"))
+ #("l-*-35619" "l-*-35620"))
#(ribcage
(emit quasivector
quasilist*
@@ -21381,13 +23096,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21399,12 +23114,12 @@
(hygiene guile))))))
(hygiene guile))
())
- (if (null? (cdr x-38435))
- (car x-38435)
- (let ((tmp-38443 ($sc-dispatch x-38435 'each-any)))
- (if tmp-38443
+ (if (null? (cdr x-36109))
+ (car x-36109)
+ (let ((tmp-36117 ($sc-dispatch x-36109 'each-any)))
+ (if tmp-36117
(@apply
- (lambda (p-38447)
+ (lambda (p-36121)
(cons '#(syntax-object
"append"
((top)
@@ -21412,12 +23127,12 @@
#(ribcage
#(p)
#((top))
- #("l-*-37953"))
+ #("l-*-35627"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37945" "l-*-37946"))
+ #("l-*-35619" "l-*-35620"))
#(ribcage
(emit quasivector
quasilist*
@@ -21432,13 +23147,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21449,21 +23164,21 @@
((top))
(hygiene guile))))))
(hygiene guile))
- p-38447))
- tmp-38443)
+ p-36121))
+ tmp-36117)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-38435))))))
- tmp-38438)
- (if (null? x-38435)
- y-38436
- (let ((tmp-38455 (list x-38435 y-38436)))
- (let ((tmp-38456
- ($sc-dispatch tmp-38455 '(each-any any))))
- (if tmp-38456
+ x-36109))))))
+ tmp-36112)
+ (if (null? x-36109)
+ y-36110
+ (let ((tmp-36129 (list x-36109 y-36110)))
+ (let ((tmp-36130
+ ($sc-dispatch tmp-36129 '(each-any any))))
+ (if tmp-36130
(@apply
- (lambda (p-38458 y-38459)
+ (lambda (p-36132 y-36133)
(cons '#(syntax-object
"append"
((top)
@@ -21471,13 +23186,13 @@
#(ribcage
#(p y)
#((top) (top))
- #("l-*-37962" "l-*-37963"))
- #(ribcage #(_) #((top)) #("l-*-37956"))
+ #("l-*-35636" "l-*-35637"))
+ #(ribcage #(_) #((top)) #("l-*-35630"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-37945" "l-*-37946"))
+ #("l-*-35619" "l-*-35620"))
#(ribcage
(emit quasivector
quasilist*
@@ -21492,13 +23207,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21509,36 +23224,36 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (append p-38458 (list y-38459))))
- tmp-38456)
+ (append p-36132 (list y-36133))))
+ tmp-36130)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-38455)))))))))
- (quasilist*-38109
- (lambda (x-38463 y-38464)
+ tmp-36129)))))))))
+ (quasilist*-35783
+ (lambda (x-36137 y-36138)
(letrec*
- ((f-38465
- (lambda (x-38569)
- (if (null? x-38569)
- y-38464
- (quasicons-38107
- (car x-38569)
- (f-38465 (cdr x-38569)))))))
- (f-38465 x-38463))))
- (emit-38111
- (lambda (x-38572)
- (let ((tmp-38574
- ($sc-dispatch x-38572 '(#(atom "quote") any))))
- (if tmp-38574
+ ((f-36139
+ (lambda (x-36243)
+ (if (null? x-36243)
+ y-36138
+ (quasicons-35781
+ (car x-36243)
+ (f-36139 (cdr x-36243)))))))
+ (f-36139 x-36137))))
+ (emit-35785
+ (lambda (x-36246)
+ (let ((tmp-36248
+ ($sc-dispatch x-36246 '(#(atom "quote") any))))
+ (if tmp-36248
(@apply
- (lambda (x-38578)
+ (lambda (x-36252)
(list '#(syntax-object
quote
((top)
- #(ribcage #(x) #((top)) #("l-*-38029"))
+ #(ribcage #(x) #((top)) #("l-*-35703"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-38026"))
+ #(ribcage #(x) #((top)) #("l-*-35700"))
#(ribcage
(emit quasivector
quasilist*
@@ -21547,13 +23262,13 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21564,37 +23279,37 @@
((top))
(hygiene guile))))))
(hygiene guile))
- x-38578))
- tmp-38574)
- (let ((tmp-38579
+ x-36252))
+ tmp-36248)
+ (let ((tmp-36253
($sc-dispatch
- x-38572
+ x-36246
'(#(atom "list") . each-any))))
- (if tmp-38579
+ (if tmp-36253
(@apply
- (lambda (x-38583)
- (let ((tmp-38584 (map emit-38111 x-38583)))
- (let ((tmp-38585 ($sc-dispatch tmp-38584 'each-any)))
- (if tmp-38585
+ (lambda (x-36257)
+ (let ((tmp-36258 (map emit-35785 x-36257)))
+ (let ((tmp-36259 ($sc-dispatch tmp-36258 'each-any)))
+ (if tmp-36259
(@apply
- (lambda (t-38034-38587)
+ (lambda (t-35708-36261)
(cons '#(syntax-object
list
((top)
#(ribcage () () ())
#(ribcage
- #(t-38034)
- #((m-*-38035 top))
- #("l-*-38039"))
+ #(t-35708)
+ #((m-*-35709 top))
+ #("l-*-35713"))
#(ribcage
#(x)
#((top))
- #("l-*-38032"))
+ #("l-*-35706"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38026"))
+ #("l-*-35700"))
#(ribcage
(emit quasivector
quasilist*
@@ -21609,13 +23324,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21626,62 +23341,62 @@
((top))
(hygiene guile))))))
(hygiene guile))
- t-38034-38587))
- tmp-38585)
+ t-35708-36261))
+ tmp-36259)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-38584)))))
- tmp-38579)
- (let ((tmp-38588
+ tmp-36258)))))
+ tmp-36253)
+ (let ((tmp-36262
($sc-dispatch
- x-38572
+ x-36246
'(#(atom "list*") . #(each+ any (any) ())))))
- (if tmp-38588
+ (if tmp-36262
(@apply
- (lambda (x-38592 y-38593)
+ (lambda (x-36266 y-36267)
(letrec*
- ((f-38594
- (lambda (x*-38597)
- (if (null? x*-38597)
- (emit-38111 y-38593)
- (let ((tmp-38598
- (list (emit-38111 (car x*-38597))
- (f-38594 (cdr x*-38597)))))
- (let ((tmp-38599
+ ((f-36268
+ (lambda (x*-36271)
+ (if (null? x*-36271)
+ (emit-35785 y-36267)
+ (let ((tmp-36272
+ (list (emit-35785 (car x*-36271))
+ (f-36268 (cdr x*-36271)))))
+ (let ((tmp-36273
($sc-dispatch
- tmp-38598
+ tmp-36272
'(any any))))
- (if tmp-38599
+ (if tmp-36273
(@apply
- (lambda (t-38054-38601
- t-38053-38602)
+ (lambda (t-35728-36275
+ t-35727-36276)
(list '#(syntax-object
cons
((top)
#(ribcage () () ())
#(ribcage
- #(t-38054 t-38053)
- #((m-*-38055 top)
- (m-*-38055 top))
- #("l-*-38059"
- "l-*-38060"))
+ #(t-35728 t-35727)
+ #((m-*-35729 top)
+ (m-*-35729 top))
+ #("l-*-35733"
+ "l-*-35734"))
#(ribcage () () ())
#(ribcage
#(f x*)
#((top) (top))
- #("l-*-38048"
- "l-*-38049"))
+ #("l-*-35722"
+ "l-*-35723"))
#(ribcage
#(x y)
#((top) (top))
- #("l-*-38044"
- "l-*-38045"))
+ #("l-*-35718"
+ "l-*-35719"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38026"))
+ #("l-*-35700"))
#(ribcage
(emit quasivector
quasilist*
@@ -21696,13 +23411,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21714,45 +23429,45 @@
(hygiene
guile))))))
(hygiene guile))
- t-38054-38601
- t-38053-38602))
- tmp-38599)
+ t-35728-36275
+ t-35727-36276))
+ tmp-36273)
(syntax-violation
#f
"source expression failed to match
any pattern"
- tmp-38598))))))))
- (f-38594 x-38592)))
- tmp-38588)
- (let ((tmp-38603
+ tmp-36272))))))))
+ (f-36268 x-36266)))
+ tmp-36262)
+ (let ((tmp-36277
($sc-dispatch
- x-38572
+ x-36246
'(#(atom "append") . each-any))))
- (if tmp-38603
+ (if tmp-36277
(@apply
- (lambda (x-38607)
- (let ((tmp-38608 (map emit-38111 x-38607)))
- (let ((tmp-38609
- ($sc-dispatch tmp-38608 'each-any)))
- (if tmp-38609
+ (lambda (x-36281)
+ (let ((tmp-36282 (map emit-35785 x-36281)))
+ (let ((tmp-36283
+ ($sc-dispatch tmp-36282 'each-any)))
+ (if tmp-36283
(@apply
- (lambda (t-38066-38611)
+ (lambda (t-35740-36285)
(cons '#(syntax-object
append
((top)
#(ribcage () () ())
#(ribcage
- #(t-38066)
- #((m-*-38067 top))
- #("l-*-38071"))
+ #(t-35740)
+ #((m-*-35741 top))
+ #("l-*-35745"))
#(ribcage
#(x)
#((top))
- #("l-*-38064"))
+ #("l-*-35738"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38026"))
+ #("l-*-35700"))
#(ribcage
(emit quasivector
quasilist*
@@ -21767,13 +23482,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21784,45 +23499,45 @@
((top))
(hygiene guile))))))
(hygiene guile))
- t-38066-38611))
- tmp-38609)
+ t-35740-36285))
+ tmp-36283)
(syntax-violation
#f
"source expression failed to match any
pattern"
- tmp-38608)))))
- tmp-38603)
- (let ((tmp-38612
+ tmp-36282)))))
+ tmp-36277)
+ (let ((tmp-36286
($sc-dispatch
- x-38572
+ x-36246
'(#(atom "vector") . each-any))))
- (if tmp-38612
+ (if tmp-36286
(@apply
- (lambda (x-38616)
- (let ((tmp-38617 (map emit-38111 x-38616)))
- (let ((tmp-38618
+ (lambda (x-36290)
+ (let ((tmp-36291 (map emit-35785 x-36290)))
+ (let ((tmp-36292
($sc-dispatch
- tmp-38617
+ tmp-36291
'each-any)))
- (if tmp-38618
+ (if tmp-36292
(@apply
- (lambda (t-38078-38620)
+ (lambda (t-35752-36294)
(cons '#(syntax-object
vector
((top)
#(ribcage () () ())
#(ribcage
- #(t-38078)
- #((m-*-38079 top))
- #("l-*-38083"))
+ #(t-35752)
+ #((m-*-35753 top))
+ #("l-*-35757"))
#(ribcage
#(x)
#((top))
- #("l-*-38076"))
+ #("l-*-35750"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38026"))
+ #("l-*-35700"))
#(ribcage
(emit quasivector
quasilist*
@@ -21837,13 +23552,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21855,38 +23570,38 @@
(hygiene
guile))))))
(hygiene guile))
- t-38078-38620))
- tmp-38618)
+ t-35752-36294))
+ tmp-36292)
(syntax-violation
#f
"source expression failed to match
any pattern"
- tmp-38617)))))
- tmp-38612)
- (let ((tmp-38621
+ tmp-36291)))))
+ tmp-36286)
+ (let ((tmp-36295
($sc-dispatch
- x-38572
+ x-36246
'(#(atom "list->vector") any))))
- (if tmp-38621
+ (if tmp-36295
(@apply
- (lambda (x-38625)
- (let ((tmp-38626 (emit-38111 x-38625)))
+ (lambda (x-36299)
+ (let ((tmp-36300 (emit-35785 x-36299)))
(list '#(syntax-object
list->vector
((top)
#(ribcage () () ())
#(ribcage
- #(t-38090)
- #((m-*-38091 top))
- #("l-*-38094"))
+ #(t-35764)
+ #((m-*-35765 top))
+ #("l-*-35768"))
#(ribcage
#(x)
#((top))
- #("l-*-38088"))
+ #("l-*-35762"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38026"))
+ #("l-*-35700"))
#(ribcage
(emit quasivector
quasilist*
@@ -21901,13 +23616,13 @@
(top)
(top)
(top))
- ("l-*-37853"
- "l-*-37851"
- "l-*-37849"
- "l-*-37847"
- "l-*-37845"
- "l-*-37843"
- "l-*-37841"))
+ ("l-*-35527"
+ "l-*-35525"
+ "l-*-35523"
+ "l-*-35521"
+ "l-*-35519"
+ "l-*-35517"
+ "l-*-35515"))
#(ribcage
(quasiquote)
((top))
@@ -21918,81 +23633,81 @@
((top))
(hygiene guile))))))
(hygiene guile))
- tmp-38626)))
- tmp-38621)
- (let ((tmp-38629
+ tmp-36300)))
+ tmp-36295)
+ (let ((tmp-36303
($sc-dispatch
- x-38572
+ x-36246
'(#(atom "value") any))))
- (if tmp-38629
+ (if tmp-36303
(@apply
- (lambda (x-38633) x-38633)
- tmp-38629)
+ (lambda (x-36307) x-36307)
+ tmp-36303)
(syntax-violation
#f
"source expression failed to match
any pattern"
- x-38572))))))))))))))))))
- (lambda (x-38112)
- (let ((tmp-38114 ($sc-dispatch x-38112 '(_ any))))
- (if tmp-38114
+ x-36246))))))))))))))))))
+ (lambda (x-35786)
+ (let ((tmp-35788 ($sc-dispatch x-35786 '(_ any))))
+ (if tmp-35788
(@apply
- (lambda (e-38118)
- (emit-38111 (quasi-38105 e-38118 0)))
- tmp-38114)
+ (lambda (e-35792)
+ (emit-35785 (quasi-35779 e-35792 0)))
+ tmp-35788)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-38112)))))))
+ x-35786)))))))
(define include
(make-syntax-transformer
'include
'macro
- (lambda (x-38689)
+ (lambda (x-36363)
(letrec*
- ((read-file-38690
- (lambda (fn-38799 k-38800)
- (let ((p-38801 (open-input-file fn-38799)))
+ ((read-file-36364
+ (lambda (fn-36473 k-36474)
+ (let ((p-36475 (open-input-file fn-36473)))
(letrec*
- ((f-38802
- (lambda (x-38856 result-38857)
- (if (eof-object? x-38856)
+ ((f-36476
+ (lambda (x-36530 result-36531)
+ (if (eof-object? x-36530)
(begin
- (close-input-port p-38801)
- (reverse result-38857))
- (f-38802
- (read p-38801)
- (cons (datum->syntax k-38800 x-38856)
- result-38857))))))
- (f-38802 (read p-38801) '()))))))
- (let ((tmp-38692 ($sc-dispatch x-38689 '(any any))))
- (if tmp-38692
+ (close-input-port p-36475)
+ (reverse result-36531))
+ (f-36476
+ (read p-36475)
+ (cons (datum->syntax k-36474 x-36530)
+ result-36531))))))
+ (f-36476 (read p-36475) '()))))))
+ (let ((tmp-36366 ($sc-dispatch x-36363 '(any any))))
+ (if tmp-36366
(@apply
- (lambda (k-38696 filename-38697)
- (let ((fn-38698 (syntax->datum filename-38697)))
- (let ((tmp-38699
- (read-file-38690 fn-38698 filename-38697)))
- (let ((tmp-38700 ($sc-dispatch tmp-38699 'each-any)))
- (if tmp-38700
+ (lambda (k-36370 filename-36371)
+ (let ((fn-36372 (syntax->datum filename-36371)))
+ (let ((tmp-36373
+ (read-file-36364 fn-36372 filename-36371)))
+ (let ((tmp-36374 ($sc-dispatch tmp-36373 'each-any)))
+ (if tmp-36374
(@apply
- (lambda (exp-38718)
+ (lambda (exp-36392)
(cons '#(syntax-object
begin
((top)
#(ribcage () () ())
- #(ribcage #(exp) #((top)) #("l-*-38686"))
+ #(ribcage #(exp) #((top)) #("l-*-36360"))
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-38681"))
+ #(ribcage #(fn) #((top)) #("l-*-36355"))
#(ribcage
#(k filename)
#((top) (top))
- #("l-*-38677" "l-*-38678"))
+ #("l-*-36351" "l-*-36352"))
#(ribcage
(read-file)
((top))
- ("l-*-38661"))
- #(ribcage #(x) #((top)) #("l-*-38660"))
+ ("l-*-36335"))
+ #(ribcage #(x) #((top)) #("l-*-36334"))
#(ribcage
(include)
((top))
@@ -22003,53 +23718,53 @@
((top))
(hygiene guile))))))
(hygiene guile))
- exp-38718))
- tmp-38700)
+ exp-36392))
+ tmp-36374)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-38699))))))
- tmp-38692)
+ tmp-36373))))))
+ tmp-36366)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-38689)))))))
+ x-36363)))))))
(define include-from-path
(make-syntax-transformer
'include-from-path
'macro
- (lambda (x-38877)
- (let ((tmp-38879 ($sc-dispatch x-38877 '(any any))))
- (if tmp-38879
+ (lambda (x-36551)
+ (let ((tmp-36553 ($sc-dispatch x-36551 '(any any))))
+ (if tmp-36553
(@apply
- (lambda (k-38883 filename-38884)
- (let ((fn-38885 (syntax->datum filename-38884)))
- (let ((tmp-38886
+ (lambda (k-36557 filename-36558)
+ (let ((fn-36559 (syntax->datum filename-36558)))
+ (let ((tmp-36560
(datum->syntax
- filename-38884
- (let ((t-38889 (%search-load-path fn-38885)))
- (if t-38889
- t-38889
+ filename-36558
+ (let ((t-36563 (%search-load-path fn-36559)))
+ (if t-36563
+ t-36563
(syntax-violation
'include-from-path
"file not found in path"
- x-38877
- filename-38884))))))
+ x-36551
+ filename-36558))))))
(list '#(syntax-object
include
((top)
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-38871"))
+ #(ribcage #(fn) #((top)) #("l-*-36545"))
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-38867"))
+ #(ribcage #(fn) #((top)) #("l-*-36541"))
#(ribcage
#(k filename)
#((top) (top))
- #("l-*-38863" "l-*-38864"))
+ #("l-*-36537" "l-*-36538"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage #(x) #((top)) #("l-*-36534"))
#(ribcage
(include-from-path)
((top))
@@ -22060,51 +23775,51 @@
((top))
(hygiene guile))))))
(hygiene guile))
- tmp-38886))))
- tmp-38879)
+ tmp-36560))))
+ tmp-36553)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-38877))))))
+ x-36551))))))
(define unquote
(make-syntax-transformer
'unquote
'macro
- (lambda (x-38899)
+ (lambda (x-36573)
(syntax-violation
'unquote
"expression not valid outside of quasiquote"
- x-38899))))
+ x-36573))))
(define unquote-splicing
(make-syntax-transformer
'unquote-splicing
'macro
- (lambda (x-38903)
+ (lambda (x-36577)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
- x-38903))))
+ x-36577))))
(define case
(make-syntax-transformer
'case
'macro
- (lambda (x-38960)
- (let ((tmp-38962
- ($sc-dispatch x-38960 '(_ any any . each-any))))
- (if tmp-38962
+ (lambda (x-36634)
+ (let ((tmp-36636
+ ($sc-dispatch x-36634 '(_ any any . each-any))))
+ (if tmp-36636
(@apply
- (lambda (e-38966 m1-38967 m2-38968)
- (let ((tmp-38969
+ (lambda (e-36640 m1-36641 m2-36642)
+ (let ((tmp-36643
(letrec*
- ((f-39023
- (lambda (clause-39026 clauses-39027)
- (if (null? clauses-39027)
- (let ((tmp-39029
+ ((f-36697
+ (lambda (clause-36700 clauses-36701)
+ (if (null? clauses-36701)
+ (let ((tmp-36703
($sc-dispatch
- clause-39026
+ clause-36700
'(#(free-id
#(syntax-object
else
@@ -22113,20 +23828,20 @@
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22140,34 +23855,34 @@
any
.
each-any))))
- (if tmp-39029
+ (if tmp-36703
(@apply
- (lambda (e1-39033 e2-39034)
+ (lambda (e1-36707 e2-36708)
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-38928" "l-*-38929"))
+ #("l-*-36602" "l-*-36603"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22178,42 +23893,42 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons e1-39033 e2-39034)))
- tmp-39029)
- (let ((tmp-39035
+ (cons e1-36707 e2-36708)))
+ tmp-36703)
+ (let ((tmp-36709
($sc-dispatch
- clause-39026
+ clause-36700
'(each-any any . each-any))))
- (if tmp-39035
+ (if tmp-36709
(@apply
- (lambda (k-39039 e1-39040 e2-39041)
+ (lambda (k-36713 e1-36714 e2-36715)
(list '#(syntax-object
if
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-38934"
- "l-*-38935"
- "l-*-38936"))
+ #("l-*-36608"
+ "l-*-36609"
+ "l-*-36610"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22232,9 +23947,9 @@
#((top)
(top)
(top))
- #("l-*-38934"
- "l-*-38935"
- "l-*-38936"))
+ #("l-*-36608"
+ "l-*-36609"
+ "l-*-36610"))
#(ribcage () () ())
#(ribcage
#(f
@@ -22243,22 +23958,22 @@
#((top)
(top)
(top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22278,9 +23993,9 @@
#((top)
(top)
(top))
- #("l-*-38934"
- "l-*-38935"
- "l-*-38936"))
+ #("l-*-36608"
+ "l-*-36609"
+ "l-*-36610"))
#(ribcage () () ())
#(ribcage
#(f
@@ -22289,22 +24004,22 @@
#((top)
(top)
(top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22324,9 +24039,9 @@
#((top)
(top)
(top))
-
#("l-*-38934"
-
"l-*-38935"
-
"l-*-38936"))
+
#("l-*-36608"
+
"l-*-36609"
+
"l-*-36610"))
#(ribcage
()
()
@@ -22338,17 +24053,17 @@
#((top)
(top)
(top))
-
#("l-*-38919"
-
"l-*-38920"
-
"l-*-38921"))
+
#("l-*-36593"
+
"l-*-36594"
+
"l-*-36595"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
-
#("l-*-38909"
-
"l-*-38910"
-
"l-*-38911"))
+
#("l-*-36583"
+
"l-*-36584"
+
"l-*-36585"))
#(ribcage
()
()
@@ -22356,7 +24071,7 @@
#(ribcage
#(x)
#((top))
-
#("l-*-38906"))
+
#("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22370,7 +24085,7 @@
guile))))))
(hygiene
guile))
- k-39039))
+ k-36713))
(cons '#(syntax-object
begin
((top)
@@ -22379,9 +24094,9 @@
#((top)
(top)
(top))
- #("l-*-38934"
- "l-*-38935"
- "l-*-38936"))
+ #("l-*-36608"
+ "l-*-36609"
+ "l-*-36610"))
#(ribcage () () ())
#(ribcage
#(f
@@ -22390,22 +24105,22 @@
#((top)
(top)
(top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22417,57 +24132,57 @@
(hygiene
guile))))))
(hygiene guile))
- (cons e1-39040
- e2-39041))))
- tmp-39035)
+ (cons e1-36714
+ e2-36715))))
+ tmp-36709)
(syntax-violation
'case
"bad clause"
- x-38960
- clause-39026)))))
- (let ((tmp-39049
- (f-39023
- (car clauses-39027)
- (cdr clauses-39027))))
- (let ((tmp-39052
+ x-36634
+ clause-36700)))))
+ (let ((tmp-36723
+ (f-36697
+ (car clauses-36701)
+ (cdr clauses-36701))))
+ (let ((tmp-36726
($sc-dispatch
- clause-39026
+ clause-36700
'(each-any any . each-any))))
- (if tmp-39052
+ (if tmp-36726
(@apply
- (lambda (k-39056 e1-39057 e2-39058)
+ (lambda (k-36730 e1-36731 e2-36732)
(list '#(syntax-object
if
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-38950"
- "l-*-38951"
- "l-*-38952"))
+ #("l-*-36624"
+ "l-*-36625"
+ "l-*-36626"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-38946"))
+ #("l-*-36620"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22484,32 +24199,32 @@
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-38950"
- "l-*-38951"
- "l-*-38952"))
+ #("l-*-36624"
+ "l-*-36625"
+ "l-*-36626"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-38946"))
+ #("l-*-36620"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22527,32 +24242,32 @@
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-38950"
- "l-*-38951"
- "l-*-38952"))
+ #("l-*-36624"
+ "l-*-36625"
+ "l-*-36626"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-38946"))
+ #("l-*-36620"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22572,9 +24287,9 @@
#((top)
(top)
(top))
- #("l-*-38950"
- "l-*-38951"
-
"l-*-38952"))
+ #("l-*-36624"
+ "l-*-36625"
+
"l-*-36626"))
#(ribcage
()
()
@@ -22582,7 +24297,7 @@
#(ribcage
#(rest)
#((top))
-
#("l-*-38946"))
+
#("l-*-36620"))
#(ribcage
()
()
@@ -22594,17 +24309,17 @@
#((top)
(top)
(top))
- #("l-*-38919"
- "l-*-38920"
-
"l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+
"l-*-36595"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-38909"
- "l-*-38910"
-
"l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+
"l-*-36585"))
#(ribcage
()
()
@@ -22612,7 +24327,7 @@
#(ribcage
#(x)
#((top))
-
#("l-*-38906"))
+
#("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22625,39 +24340,39 @@
(hygiene
guile))))))
(hygiene guile))
- k-39056))
+ k-36730))
(cons '#(syntax-object
begin
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-38950"
- "l-*-38951"
- "l-*-38952"))
+ #("l-*-36624"
+ "l-*-36625"
+ "l-*-36626"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-38946"))
+ #("l-*-36620"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-38919"
- "l-*-38920"
- "l-*-38921"))
+ #("l-*-36593"
+ "l-*-36594"
+ "l-*-36595"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-38906"))
+ #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22669,27 +24384,27 @@
(hygiene
guile))))))
(hygiene guile))
- (cons e1-39057 e2-39058))
- tmp-39049))
- tmp-39052)
+ (cons e1-36731 e2-36732))
+ tmp-36723))
+ tmp-36726)
(syntax-violation
'case
"bad clause"
- x-38960
- clause-39026))))))))
- (f-39023 m1-38967 m2-38968))))
- (let ((body-38970 tmp-38969))
+ x-36634
+ clause-36700))))))))
+ (f-36697 m1-36641 m2-36642))))
+ (let ((body-36644 tmp-36643))
(list '#(syntax-object
let
((top)
#(ribcage () () ())
- #(ribcage #(body) #((top)) #("l-*-38917"))
+ #(ribcage #(body) #((top)) #("l-*-36591"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909" "l-*-38910" "l-*-38911"))
+ #("l-*-36583" "l-*-36584" "l-*-36585"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-38906"))
+ #(ribcage #(x) #((top)) #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22707,15 +24422,15 @@
#(ribcage
#(body)
#((top))
- #("l-*-38917"))
+ #("l-*-36591"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-38909"
- "l-*-38910"
- "l-*-38911"))
+ #("l-*-36583"
+ "l-*-36584"
+ "l-*-36585"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-38906"))
+ #(ribcage #(x) #((top)) #("l-*-36580"))
#(ribcage
(case)
((top))
@@ -22726,44 +24441,44 @@
((top))
(hygiene guile))))))
(hygiene guile))
- e-38966))
- body-38970))))
- tmp-38962)
+ e-36640))
+ body-36644))))
+ tmp-36636)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-38960))))))
+ x-36634))))))
(define make-variable-transformer
- (lambda (proc-39077)
- (if (procedure? proc-39077)
+ (lambda (proc-36751)
+ (if (procedure? proc-36751)
(letrec*
- ((trans-39078
- (lambda (x-39080) (proc-39077 x-39080))))
+ ((trans-36752
+ (lambda (x-36754) (proc-36751 x-36754))))
(begin
(set-procedure-property!
- trans-39078
+ trans-36752
'variable-transformer
#t)
- trans-39078))
+ trans-36752))
(error "variable transformer not a procedure"
- proc-39077))))
+ proc-36751))))
(define identifier-syntax
(make-syntax-transformer
'identifier-syntax
'macro
- (lambda (x-39117)
- (let ((tmp-39119 ($sc-dispatch x-39117 '(_ any))))
- (if tmp-39119
+ (lambda (x-36791)
+ (let ((tmp-36793 ($sc-dispatch x-36791 '(_ any))))
+ (if tmp-36793
(@apply
- (lambda (e-39123)
+ (lambda (e-36797)
(list '#(syntax-object
lambda
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22777,9 +24492,9 @@
'(#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22793,9 +24508,9 @@
'#((#(syntax-object
macro-type
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22810,9 +24525,9 @@
#(syntax-object
identifier-syntax
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22826,9 +24541,9 @@
(list '#(syntax-object
syntax-case
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22842,9 +24557,9 @@
'#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22859,9 +24574,9 @@
(list '#(syntax-object
id
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22875,9 +24590,9 @@
'(#(syntax-object
identifier?
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22891,9 +24606,9 @@
(#(syntax-object
syntax
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22907,9 +24622,9 @@
#(syntax-object
id
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22926,12 +24641,12 @@
#(ribcage
#(e)
#((top))
- #("l-*-39092"))
+ #("l-*-36766"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22942,13 +24657,13 @@
((top))
(hygiene guile))))))
(hygiene guile))
- e-39123))
+ e-36797))
(list '(#(syntax-object
_
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22962,9 +24677,9 @@
#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22978,9 +24693,9 @@
#(syntax-object
...
((top)
- #(ribcage #(e) #((top)) #("l-*-39092"))
+ #(ribcage #(e) #((top)) #("l-*-36766"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -22997,12 +24712,12 @@
#(ribcage
#(e)
#((top))
- #("l-*-39092"))
+ #("l-*-36766"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23013,19 +24728,19 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons e-39123
+ (cons e-36797
'(#(syntax-object
x
((top)
#(ribcage
#(e)
#((top))
- #("l-*-39092"))
+ #("l-*-36766"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23042,12 +24757,12 @@
#(ribcage
#(e)
#((top))
- #("l-*-39092"))
+ #("l-*-36766"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23058,17 +24773,17 @@
((top))
(hygiene guile))))))
(hygiene guile)))))))))
- tmp-39119)
- (let ((tmp-39124
+ tmp-36793)
+ (let ((tmp-36798
($sc-dispatch
- x-39117
+ x-36791
'(_ (any any)
((#(free-id
#(syntax-object
set!
((top)
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23082,37 +24797,37 @@
any
any)
any)))))
- (if (if tmp-39124
+ (if (if tmp-36798
(@apply
- (lambda (id-39128
- exp1-39129
- var-39130
- val-39131
- exp2-39132)
- (if (identifier? id-39128)
- (identifier? var-39130)
+ (lambda (id-36802
+ exp1-36803
+ var-36804
+ val-36805
+ exp2-36806)
+ (if (identifier? id-36802)
+ (identifier? var-36804)
#f))
- tmp-39124)
+ tmp-36798)
#f)
(@apply
- (lambda (id-39133
- exp1-39134
- var-39135
- val-39136
- exp2-39137)
+ (lambda (id-36807
+ exp1-36808
+ var-36809
+ val-36810
+ exp2-36811)
(list '#(syntax-object
make-variable-transformer
((top)
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23129,13 +24844,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23152,13 +24867,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23175,13 +24890,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23199,13 +24914,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23222,13 +24937,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23245,13 +24960,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39089"))
+ #(ribcage #(x) #((top)) #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23268,16 +24983,16 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23298,16 +25013,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23318,8 +25033,8 @@
((top))
(hygiene guile))))))
(hygiene guile))
- var-39135
- val-39136)
+ var-36809
+ val-36810)
(list '#(syntax-object
syntax
((top)
@@ -23330,16 +25045,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23350,8 +25065,8 @@
((top))
(hygiene guile))))))
(hygiene guile))
- exp2-39137))
- (list (cons id-39133
+ exp2-36811))
+ (list (cons id-36807
'(#(syntax-object
x
((top)
@@ -23362,16 +25077,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23392,16 +25107,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23422,16 +25137,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23442,7 +25157,7 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons exp1-39134
+ (cons exp1-36808
'(#(syntax-object
x
((top)
@@ -23457,16 +25172,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23492,16 +25207,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23513,7 +25228,7 @@
(hygiene
guile))))))
(hygiene guile))))))
- (list id-39133
+ (list id-36807
(list '#(syntax-object
identifier?
((top)
@@ -23524,16 +25239,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23558,16 +25273,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23579,7 +25294,7 @@
(hygiene
guile))))))
(hygiene guile))
- id-39133))
+ id-36807))
(list '#(syntax-object
syntax
((top)
@@ -23590,16 +25305,16 @@
(top)
(top)
(top))
- #("l-*-39107"
- "l-*-39108"
- "l-*-39109"
- "l-*-39110"
- "l-*-39111"))
+ #("l-*-36781"
+ "l-*-36782"
+ "l-*-36783"
+ "l-*-36784"
+ "l-*-36785"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-39089"))
+ #("l-*-36763"))
#(ribcage
(identifier-syntax)
((top))
@@ -23610,37 +25325,37 @@
((top))
(hygiene guile))))))
(hygiene guile))
- exp1-39134))))))
- tmp-39124)
+ exp1-36808))))))
+ tmp-36798)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-39117))))))))
+ x-36791))))))))
(define define*
(make-syntax-transformer
'define*
'macro
- (lambda (x-39170)
- (let ((tmp-39172
+ (lambda (x-36844)
+ (let ((tmp-36846
($sc-dispatch
- x-39170
+ x-36844
'(_ (any . any) any . each-any))))
- (if tmp-39172
+ (if tmp-36846
(@apply
- (lambda (id-39176 args-39177 b0-39178 b1-39179)
+ (lambda (id-36850 args-36851 b0-36852 b1-36853)
(list '#(syntax-object
define
((top)
#(ribcage
#(id args b0 b1)
#((top) (top) (top) (top))
- #("l-*-39152"
- "l-*-39153"
- "l-*-39154"
- "l-*-39155"))
+ #("l-*-36826"
+ "l-*-36827"
+ "l-*-36828"
+ "l-*-36829"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39149"))
+ #(ribcage #(x) #((top)) #("l-*-36823"))
#(ribcage
(define*)
((top))
@@ -23651,19 +25366,19 @@
((top))
(hygiene guile))))))
(hygiene guile))
- id-39176
+ id-36850
(cons '#(syntax-object
lambda*
((top)
#(ribcage
#(id args b0 b1)
#((top) (top) (top) (top))
- #("l-*-39152"
- "l-*-39153"
- "l-*-39154"
- "l-*-39155"))
+ #("l-*-36826"
+ "l-*-36827"
+ "l-*-36828"
+ "l-*-36829"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39149"))
+ #(ribcage #(x) #((top)) #("l-*-36823"))
#(ribcage
(define*)
((top))
@@ -23674,12 +25389,12 @@
((top))
(hygiene guile))))))
(hygiene guile))
- (cons args-39177 (cons b0-39178 b1-39179)))))
- tmp-39172)
- (let ((tmp-39180 ($sc-dispatch x-39170 '(_ any any))))
- (if (if tmp-39180
+ (cons args-36851 (cons b0-36852 b1-36853)))))
+ tmp-36846)
+ (let ((tmp-36854 ($sc-dispatch x-36844 '(_ any any))))
+ (if (if tmp-36854
(@apply
- (lambda (id-39184 val-39185)
+ (lambda (id-36858 val-36859)
(identifier?
'#(syntax-object
x
@@ -23687,9 +25402,9 @@
#(ribcage
#(id val)
#((top) (top))
- #("l-*-39162" "l-*-39163"))
+ #("l-*-36836" "l-*-36837"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39149"))
+ #(ribcage #(x) #((top)) #("l-*-36823"))
#(ribcage
(define*)
((top))
@@ -23700,19 +25415,19 @@
((top))
(hygiene guile))))))
(hygiene guile))))
- tmp-39180)
+ tmp-36854)
#f)
(@apply
- (lambda (id-39186 val-39187)
+ (lambda (id-36860 val-36861)
(list '#(syntax-object
define
((top)
#(ribcage
#(id val)
#((top) (top))
- #("l-*-39166" "l-*-39167"))
+ #("l-*-36840" "l-*-36841"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-39149"))
+ #(ribcage #(x) #((top)) #("l-*-36823"))
#(ribcage
(define*)
((top))
@@ -23723,11 +25438,11 @@
((top))
(hygiene guile))))))
(hygiene guile))
- id-39186
- val-39187))
- tmp-39180)
+ id-36860
+ val-36861))
+ tmp-36854)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-39170))))))))
+ x-36844))))))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index b2f7c54..0323c1e 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -301,7 +301,7 @@
(define (decorate-source e s)
- (if (and (pair? e) s)
+ (if (and s (supports-source-properties? e))
(set-source-properties! e s))
e)
@@ -463,14 +463,11 @@
(define source-annotation
(lambda (x)
- (cond
- ((syntax-object? x)
- (source-annotation (syntax-object-expression x)))
- ((pair? x) (let ((props (source-properties x)))
- (if (pair? props)
- props
- #f)))
- (else #f))))
+ (let ((props (source-properties
+ (if (syntax-object? x)
+ (syntax-object-expression x)
+ x))))
+ (and (pair? props) props))))
(define-syntax-rule (arg-check pred? e who)
(let ((x e))
diff --git a/test-suite/tests/srcprop.test b/test-suite/tests/srcprop.test
index 0ca11b3..4afc318 100644
--- a/test-suite/tests/srcprop.test
+++ b/test-suite/tests/srcprop.test
@@ -25,15 +25,51 @@
;;;
(with-test-prefix "source-properties"
-
+
(pass-if "no props"
(null? (source-properties (list 1 2 3))))
-
+
(read-enable 'positions)
- (let ((s (read (open-input-string "(1 . 2)"))))
-
- (pass-if "read properties"
- (not (null? (source-properties s))))))
+ (with-test-prefix "read properties"
+ (define (reads-with-srcprops? str)
+ (let ((x (read (open-input-string str))))
+ (not (null? (source-properties x)))))
+
+ (pass-if "pairs" (reads-with-srcprops? "(1 . 2)"))
+ (pass-if "vectors" (reads-with-srcprops? "#(1 2 3)"))
+ (pass-if "bytevectors" (reads-with-srcprops? "#vu8(1 2 3)"))
+ (pass-if "bitvectors" (reads-with-srcprops? "#*101011"))
+ (pass-if "srfi4 vectors" (reads-with-srcprops? "#f64(3.1415 2.71)"))
+ (pass-if "arrays" (reads-with-srcprops? "address@hidden@3((1 2)
(2 3))"))
+ (pass-if "strings" (reads-with-srcprops? "\"hello\""))
+ (pass-if "null string" (reads-with-srcprops? "\"\""))
+
+ (pass-if "floats" (reads-with-srcprops? "3.1415"))
+ (pass-if "fractions" (reads-with-srcprops? "1/2"))
+ (pass-if "complex numbers" (reads-with-srcprops? "1+1i"))
+ (pass-if "bignums"
+ (and (reads-with-srcprops? (number->string (1+ most-positive-fixnum)))
+ (reads-with-srcprops? (number->string (1- most-negative-fixnum)))))
+
+ (pass-if "fixnums (should have none)"
+ (not (or (reads-with-srcprops? "0")
+ (reads-with-srcprops? "1")
+ (reads-with-srcprops? "-1")
+ (reads-with-srcprops? (number->string most-positive-fixnum))
+ (reads-with-srcprops? (number->string most-negative-fixnum)))))
+
+ (pass-if "symbols (should have none)"
+ (not (reads-with-srcprops? "foo")))
+
+ (pass-if "keywords (should have none)"
+ (not (reads-with-srcprops? "#:foo")))
+
+ (pass-if "characters (should have none)"
+ (not (reads-with-srcprops? "#\\c")))
+
+ (pass-if "booleans (should have none)"
+ (not (or (reads-with-srcprops? "#t")
+ (reads-with-srcprops? "#f"))))))
;;;
;;; set-source-property!
hooks/post-receive
--
GNU Guile
| [Prev in Thread] | Current Thread | [Next in Thread] |