|
| From: | Andy Wingo |
| Subject: | [Guile-commits] GNU Guile branch, master, updated. release_1-9-4-128-gb10d933 |
| Date: | Sun, 15 Nov 2009 20:13:21 +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=b10d93309b4c96caa5d399716c9b09a862c8ce0e
The branch, master has been updated
via b10d93309b4c96caa5d399716c9b09a862c8ce0e (commit)
via aec4a84ac8bb3270e6f68f8299e76c49857e24d4 (commit)
via b4a595a5d6447ef41d57690e841c545aa45d3a08 (commit)
via 0e249fd35912fabb7678a395753f315e0302515a (commit)
via 1e2a8edb8b0cd0818e1ea3ffdf05b8fc7c7f507d (commit)
via e161c9f85cfac9aead3728b4d1239bd973600a7a (commit)
via 4d34fbe1815be52cd669b53e03158ab931d9e80b (commit)
via 092d7704bef29a999a6f861fae461e9662b6fb98 (commit)
via b8187a71cb2cdb103aad10e75dc2947b06617ca9 (commit)
via b7bff2ba9bc7b1b131b8e08059dd2870f76500be (commit)
via ceedcfaa0c273b466a371b9bef7c84ce27ec27fb (commit)
via fb0f1a40e72217861bb420cb20707618028b7a10 (commit)
via 26fe6af140fd7e3042bfc628e5fb60b382d6a126 (commit)
via efcebb5b56a315f42c32e8bbc682d218a38c9428 (commit)
via 11561496bad94481cc2b3d8acba1a154e3c052fc (commit)
via 521ac49bdea053227c973a92e37fcc0879fa20d0 (commit)
via 48c7c44e70e6ba80fe16bfb179320cffb6a03996 (commit)
via 730d8ad9e64c3d4b31871a50a4c790b7548bc478 (commit)
via 352c87d7e4c8845b935f8439432d28d80bf06879 (commit)
via 9e759da10b8ec9334239d6ce40e19bf45c2d00e7 (commit)
via ee7ef600b99465387fafff05adb99cab25d3685e (commit)
from cb65f76c7408569d72ed82b77a154acd79d29c69 (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 -----------------------------------------------------------------
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-procedures.texi | 19 -
libguile.h | 1 -
libguile/Makefile.am | 4 -
libguile/debug.c | 3 +-
libguile/eq.c | 1 -
libguile/eval.c | 7 -
libguile/eval.i.c | 185 +-
libguile/goops.c | 251 +-
libguile/goops.h | 58 +-
libguile/init.c | 2 -
libguile/objects.c | 371 -
libguile/objects.h | 219 -
libguile/ports.c | 1 -
libguile/print.c | 1 -
libguile/procprop.c | 11 +-
libguile/procs.c | 12 +-
libguile/smob.c | 1 -
libguile/struct.c | 2 +-
libguile/struct.h | 6 +-
libguile/validate.h | 3 +-
libguile/values.c | 9 +-
libguile/vm-i-scheme.c | 49 +
libguile/vm-i-system.c | 34 +
module/ice-9/optargs.scm | 17 +-
module/ice-9/psyntax-pp.scm | 9255 ++++++++++++------------
module/ice-9/psyntax.scm | 112 +-
module/language/brainfuck/compile-tree-il.scm | 2 +-
module/language/ecmascript/compile-tree-il.scm | 14 +-
module/language/tree-il.scm | 53 +-
module/language/tree-il/analyze.scm | 9 +-
module/language/tree-il/compile-glil.scm | 84 +-
module/language/tree-il/inline.scm | 6 +-
module/language/tree-il/primitives.scm | 5 +-
module/oop/goops.scm | 21 +-
module/srfi/srfi-35.scm | 6 +-
module/system/vm/program.scm | 2 +-
test-suite/tests/structs.test | 4 +-
test-suite/tests/tree-il.test | 18 +-
38 files changed, 5033 insertions(+), 5825 deletions(-)
delete mode 100644 libguile/objects.c
delete mode 100644 libguile/objects.h
diff --git a/doc/ref/api-procedures.texi b/doc/ref/api-procedures.texi
index 972ce2e..9609fef 100644
--- a/doc/ref/api-procedures.texi
+++ b/doc/ref/api-procedures.texi
@@ -594,25 +594,6 @@ A @code{case-lambda*} clause matches if the arguments fill
the
required arguments, but are not too many for the optional and/or rest
arguments.
address@hidden is particularly useful in combination with an
-obscure @code{lambda*} feature, @code{#:predicate}. @code{lambda*}
-argument lists may contain a @code{#:predicate @var{expr}} clause at
-the end -- before the rest argument, if any. This expression is
-evaluated in the context of all of the arguments, and if false, causes
-the @code{case-lambda*} expression not to match. This can be used to
-make a simple form of type dispatch:
-
address@hidden
-(define type-of
- (case-lambda*
- ((a #:predicate (symbol? a)) 'symbol)
- ((a #:predicate (string? a)) 'string)
- ((a) 'unknown)))
-(type-of 'foo) @result{} symbol
-(type-of "foo") @result{} string
-(type-of '(foo)) @result{} unknown
address@hidden lisp
-
Keyword arguments are possible with @code{case-lambda*}, but they do
not contribute to the ``matching'' behavior. That is to say,
@code{case-lambda*} matches only on required, optional, and rest
diff --git a/libguile.h b/libguile.h
index 73b3de7..3b2f695 100644
--- a/libguile.h
+++ b/libguile.h
@@ -73,7 +73,6 @@ extern "C" {
#include "libguile/modules.h"
#include "libguile/net_db.h"
#include "libguile/numbers.h"
-#include "libguile/objects.h"
#include "libguile/objprop.h"
#include "libguile/options.h"
#include "libguile/pairs.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 96c66a7..fc6bb6f 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -158,7 +158,6 @@ libguile_la_SOURCES = \
null-threads.c \
numbers.c \
objcodes.c \
- objects.c \
objprop.c \
options.c \
pairs.c \
@@ -251,7 +250,6 @@ DOT_X_FILES = \
mallocs.x \
modules.x \
numbers.x \
- objects.x \
objprop.x \
options.x \
pairs.x \
@@ -347,7 +345,6 @@ DOT_DOC_FILES = \
mallocs.doc \
modules.doc \
numbers.doc \
- objects.doc \
objprop.doc \
options.doc \
pairs.doc \
@@ -509,7 +506,6 @@ modinclude_HEADERS = \
null-threads.h \
numbers.h \
objcodes.h \
- objects.h \
objprop.h \
options.h \
pairs.h \
diff --git a/libguile/debug.c b/libguile/debug.c
index 5b42ddd..a6de84a 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -47,7 +47,6 @@
#include "libguile/ports.h"
#include "libguile/root.h"
#include "libguile/fluids.h"
-#include "libguile/objects.h"
#include "libguile/programs.h"
#include "libguile/validate.h"
@@ -356,7 +355,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0,
0,
}
}
case scm_tcs_struct:
- if (!SCM_I_OPERATORP (proc))
+ if (!(SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC))
break;
goto procprop;
case scm_tc7_smob:
diff --git a/libguile/eq.c b/libguile/eq.c
index fadd756..2db4ac0 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -34,7 +34,6 @@
#include "libguile/struct.h"
#include "libguile/goops.h"
-#include "libguile/objects.h"
#include "libguile/validate.h"
#include "libguile/eq.h"
diff --git a/libguile/eval.c b/libguile/eval.c
index cdb9042..df9e5ab 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -48,7 +48,6 @@
#include "libguile/list.h"
#include "libguile/macros.h"
#include "libguile/modules.h"
-#include "libguile/objects.h"
#include "libguile/ports.h"
#include "libguile/print.h"
#include "libguile/procprop.h"
@@ -3270,8 +3269,6 @@ scm_trampoline_0 (SCM proc)
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
trampoline = scm_call_generic_0;
- else if (SCM_I_OPERATORP (proc))
- trampoline = scm_call_0;
else
return NULL;
break;
@@ -3396,8 +3393,6 @@ scm_trampoline_1 (SCM proc)
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
trampoline = scm_call_generic_1;
- else if (SCM_I_OPERATORP (proc))
- trampoline = scm_call_1;
else
return NULL;
break;
@@ -3493,8 +3488,6 @@ scm_trampoline_2 (SCM proc)
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
trampoline = scm_call_generic_2;
- else if (SCM_I_OPERATORP (proc))
- trampoline = scm_call_2;
else
return NULL;
break;
diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index 5b4604a..ccb6126 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -744,139 +744,10 @@ dispatch:
* (c.f. objects.c:scm_mcache_compute_cmethod) since that
* cuts down execution time for type dispatch to 50%. */
type_dispatch: /* inputs: x, arg1 */
- /* Type dispatch means to determine from the types of the function
- * arguments (i. e. the 'signature' of the call), which method from
- * a generic function is to be called. This process of selecting
- * the right method takes some time. To speed it up, guile uses
- * caching: Together with the macro call to dispatch the signatures
- * of some previous calls to that generic function from the same
- * place are stored (in the code!) in a cache that we call the
- * 'method cache'. This is done since it is likely, that
- * consecutive calls to dispatch from that position in the code will
- * have the same signature. Thus, the type dispatch works as
- * follows: First, determine a hash value from the signature of the
- * actual arguments. Second, use this hash value as an index to
- * find that same signature in the method cache stored at this
- * position in the code. If found, you have also found the
- * corresponding method that belongs to that signature. If the
- * signature is not found in the method cache, you have to perform a
- * full search over all signatures stored with the generic
- * function. */
- {
- unsigned long int specializers;
- unsigned long int hash_value;
- unsigned long int cache_end_pos;
- unsigned long int mask;
- SCM method_cache;
-
- {
- SCM z = SCM_CDDR (x);
- SCM tmp = SCM_CADR (z);
- specializers = scm_to_ulong (SCM_CAR (z));
-
- /* Compute a hash value for searching the method cache. There
- * are two variants for computing the hash value, a (rather)
- * complicated one, and a simple one. For the complicated one
- * explained below, tmp holds a number that is used in the
- * computation. */
- if (scm_is_simple_vector (tmp))
- {
- /* This method of determining the hash value is much
- * simpler: Set the hash value to zero and just perform a
- * linear search through the method cache. */
- method_cache = tmp;
- mask = (unsigned long int) ((long) -1);
- hash_value = 0;
- cache_end_pos = SCM_SIMPLE_VECTOR_LENGTH (method_cache);
- }
- else
- {
- /* Use the signature of the actual arguments to determine
- * the hash value. This is done as follows: Each class has
- * an array of random numbers, that are determined when the
- * class is created. The integer 'hashset' is an index into
- * that array of random numbers. Now, from all classes that
- * are part of the signature of the actual arguments, the
- * random numbers at index 'hashset' are taken and summed
- * up, giving the hash value. The value of 'hashset' is
- * stored at the call to dispatch. This allows to have
- * different 'formulas' for calculating the hash value at
- * different places where dispatch is called. This allows
- * to optimize the hash formula at every individual place
- * where dispatch is called, such that hopefully the hash
- * value that is computed will directly point to the right
- * method in the method cache. */
- unsigned long int hashset = scm_to_ulong (tmp);
- unsigned long int counter = specializers + 1;
- SCM tmp_arg = arg1;
- hash_value = 0;
- while (!scm_is_null (tmp_arg) && counter != 0)
- {
- SCM class = scm_class_of (SCM_CAR (tmp_arg));
- hash_value += SCM_INSTANCE_HASH (class, hashset);
- tmp_arg = SCM_CDR (tmp_arg);
- counter--;
- }
- z = SCM_CDDR (z);
- method_cache = SCM_CADR (z);
- mask = scm_to_ulong (SCM_CAR (z));
- hash_value &= mask;
- cache_end_pos = hash_value;
- }
- }
-
- {
- /* Search the method cache for a method with a matching
- * signature. Start the search at position 'hash_value'. The
- * hashing implementation uses linear probing for conflict
- * resolution, that is, if the signature in question is not
- * found at the starting index in the hash table, the next table
- * entry is tried, and so on, until in the worst case the whole
- * cache has been searched, but still the signature has not been
- * found. */
- SCM z;
- do
- {
- SCM args = arg1; /* list of arguments */
- z = SCM_SIMPLE_VECTOR_REF (method_cache, hash_value);
- while (!scm_is_null (args))
- {
- /* More arguments than specifiers => CLASS != ENV */
- SCM class_of_arg = scm_class_of (SCM_CAR (args));
- if (!scm_is_eq (class_of_arg, SCM_CAR (z)))
- goto next_method;
- args = SCM_CDR (args);
- z = SCM_CDR (z);
- }
- /* Fewer arguments than specifiers => CAR != CLASS */
- if (!scm_is_pair (z))
- goto apply_vm_cmethod;
- else if (!SCM_CLASSP (SCM_CAR (z))
- && !scm_is_symbol (SCM_CAR (z)))
- goto apply_memoized_cmethod;
- next_method:
- hash_value = (hash_value + 1) & mask;
- } while (hash_value != cache_end_pos);
-
- /* No appropriate method was found in the cache. */
- z = scm_memoize_method (x, arg1);
-
- if (scm_is_pair (z))
- goto apply_memoized_cmethod;
-
- apply_vm_cmethod:
- proc = z;
- PREP_APPLY (proc, arg1);
- goto apply_proc;
-
- apply_memoized_cmethod: /* inputs: z, arg1 */
- {
- SCM formals = SCM_CMETHOD_FORMALS (z);
- env = SCM_EXTEND_ENV (formals, arg1, SCM_CMETHOD_ENV (z));
- x = SCM_CMETHOD_BODY (z);
- goto nontoplevel_begin;
- }
- }
+ {
+ proc = scm_mcache_compute_cmethod (x, arg1);
+ PREP_APPLY (proc, arg1);
+ goto apply_proc;
}
@@ -1156,22 +1027,22 @@ dispatch:
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
- x = SCM_ENTITY_PROCEDURE (proc);
+ x = SCM_GENERIC_METHOD_CACHE (proc);
arg1 = SCM_EOL;
goto type_dispatch;
}
- else if (SCM_I_OPERATORP (proc))
+#if 0
+ else if (SCM_I_ENTITYP (proc))
{
arg1 = proc;
- proc = (SCM_I_ENTITYP (proc)
- ? SCM_ENTITY_PROCEDURE (proc)
- : SCM_OPERATOR_PROCEDURE (proc));
+ proc = SCM_ENTITY_PROCEDURE (proc);
#ifdef DEVAL
debug.info->a.proc = proc;
debug.info->a.args = scm_list_1 (arg1);
#endif
goto evap1;
}
+#endif
else
goto badfun;
case scm_tc7_subr_1:
@@ -1285,7 +1156,7 @@ dispatch:
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
- x = SCM_ENTITY_PROCEDURE (proc);
+ x = SCM_GENERIC_METHOD_CACHE (proc);
#ifdef DEVAL
arg1 = debug.info->a.args;
#else
@@ -1293,19 +1164,19 @@ dispatch:
#endif
goto type_dispatch;
}
- else if (SCM_I_OPERATORP (proc))
+#if 0
+ else if (SCM_I_ENTITYP (proc))
{
arg2 = arg1;
arg1 = proc;
- proc = (SCM_I_ENTITYP (proc)
- ? SCM_ENTITY_PROCEDURE (proc)
- : SCM_OPERATOR_PROCEDURE (proc));
+ proc = SCM_ENTITY_PROCEDURE (proc);
#ifdef DEVAL
debug.info->a.args = scm_cons (arg1, debug.info->a.args);
debug.info->a.proc = proc;
#endif
goto evap2;
}
+#endif
else
goto badfun;
case scm_tc7_subr_2:
@@ -1366,7 +1237,7 @@ dispatch:
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
- x = SCM_ENTITY_PROCEDURE (proc);
+ x = SCM_GENERIC_METHOD_CACHE (proc);
#ifdef DEVAL
arg1 = debug.info->a.args;
#else
@@ -1374,19 +1245,16 @@ dispatch:
#endif
goto type_dispatch;
}
- else if (SCM_I_OPERATORP (proc))
+#if 0
+ else if (SCM_I_ENTITYP (proc))
{
operatorn:
#ifdef DEVAL
- RETURN (SCM_APPLY (SCM_I_ENTITYP (proc)
- ? SCM_ENTITY_PROCEDURE (proc)
- : SCM_OPERATOR_PROCEDURE (proc),
+ RETURN (SCM_APPLY (SCM_ENTITY_PROCEDURE (proc),
scm_cons (proc, debug.info->a.args),
SCM_EOL));
#else
- RETURN (SCM_APPLY (SCM_I_ENTITYP (proc)
- ? SCM_ENTITY_PROCEDURE (proc)
- : SCM_OPERATOR_PROCEDURE (proc),
+ RETURN (SCM_APPLY (SCM_ENTITY_PROCEDURE (proc),
scm_cons2 (proc, arg1,
scm_cons (arg2,
scm_ceval_args (x,
@@ -1395,6 +1263,7 @@ dispatch:
SCM_EOL));
#endif
}
+#endif
else
goto badfun;
case scm_tc7_subr_0:
@@ -1601,11 +1470,13 @@ dispatch:
#else
arg1 = scm_cons2 (arg1, arg2, scm_ceval_args (x, env, proc));
#endif
- x = SCM_ENTITY_PROCEDURE (proc);
+ x = SCM_GENERIC_METHOD_CACHE (proc);
goto type_dispatch;
}
- else if (SCM_I_OPERATORP (proc))
+#if 0
+ else if (SCM_I_ENTITYP (proc))
goto operatorn;
+#endif
else
goto badfun;
case scm_tc7_subr_2:
@@ -1909,7 +1780,8 @@ tail:
#endif
RETURN (scm_apply_generic (proc, args));
}
- else if (SCM_I_OPERATORP (proc))
+#if 0
+ else if (SCM_I_ENTITYP (proc))
{
/* operator */
#ifdef DEVAL
@@ -1918,9 +1790,7 @@ tail:
args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
#endif
arg1 = proc;
- proc = (SCM_I_ENTITYP (proc)
- ? SCM_ENTITY_PROCEDURE (proc)
- : SCM_OPERATOR_PROCEDURE (proc));
+ proc = SCM_ENTITY_PROCEDURE (proc);
#ifdef DEVAL
debug.vect[0].a.proc = proc;
debug.vect[0].a.args = scm_cons (arg1, args);
@@ -1930,6 +1800,7 @@ tail:
else
goto badproc;
}
+#endif
else
goto badproc;
default:
diff --git a/libguile/goops.c b/libguile/goops.c
index 24a823f..33e1c6e 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -44,9 +44,9 @@
#include "libguile/keywords.h"
#include "libguile/macros.h"
#include "libguile/modules.h"
-#include "libguile/objects.h"
#include "libguile/ports.h"
#include "libguile/procprop.h"
+#include "libguile/programs.h"
#include "libguile/random.h"
#include "libguile/root.h"
#include "libguile/smob.h"
@@ -54,12 +54,23 @@
#include "libguile/strports.h"
#include "libguile/vectors.h"
#include "libguile/weaks.h"
+#include "libguile/vm.h"
#include "libguile/validate.h"
#include "libguile/goops.h"
#define SPEC_OF(x) SCM_SLOT (x, scm_si_specializers)
+#define SCM_CMETHOD_CODE(cmethod) SCM_CDR (cmethod)
+#define SCM_CMETHOD_FORMALS(cmethod) SCM_CAR (SCM_CMETHOD_CODE (cmethod))
+#define SCM_CMETHOD_BODY(cmethod) SCM_CDR (SCM_CMETHOD_CODE (cmethod))
+#define SCM_CMETHOD_ENV(cmethod) SCM_CAR (cmethod)
+
+/* Port classes */
+#define SCM_IN_PCLASS_INDEX 0
+#define SCM_OUT_PCLASS_INDEX SCM_I_MAX_PORT_TYPE_COUNT
+#define SCM_INOUT_PCLASS_INDEX (2 * SCM_I_MAX_PORT_TYPE_COUNT)
+
/* this file is a mess. in theory, though, we shouldn't have many SCM
references
-- most of the references should be to vars. */
@@ -105,10 +116,6 @@ SCM_VARIABLE (scm_var_make_extended_generic,
"make-extended-generic");
h1.
*/
-/* The following definition is located in libguile/objects.h:
-#define SCM_OBJ_CLASS_REDEF(x) (SCM_STRUCT_VTABLE_DATA(x)[scm_si_redefined])
-*/
-
#define TEST_CHANGE_CLASS(obj, class) \
{ \
class = SCM_CLASS_OF (obj); \
@@ -145,7 +152,6 @@ SCM scm_class_extended_accessor;
SCM scm_class_method;
SCM scm_class_simple_method, scm_class_accessor_method;
SCM scm_class_procedure_class;
-SCM scm_class_operator_class, scm_class_operator_with_setter_class;
SCM scm_class_entity_class;
SCM scm_class_number, scm_class_list;
SCM scm_class_keyword;
@@ -288,9 +294,9 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
if (!scm_is_symbol (name))
name = scm_string_to_symbol (scm_nullstr);
+ /* FIXME APPLICABLE structs */
class =
- scm_make_extended_class_from_symbol (name,
- SCM_I_OPERATORP (x));
+ scm_make_extended_class_from_symbol (name, 0);
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
return class;
}
@@ -754,7 +760,7 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2,
0, 0,
}
flags &= SCM_CLASSF_INHERIT;
- if (! (flags & SCM_CLASSF_ENTITY))
+ if (! (flags & SCM_CLASSF_PURE_GENERIC))
{
long n = SCM_I_INUM (SCM_SLOT (class, scm_si_nfields));
#if 0
@@ -769,8 +775,7 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2,
0, 0,
#endif
if (n > 0 && !(flags & SCM_CLASSF_METACLASS))
{
- /* NOTE: The following depends on scm_struct_i_size. */
- flags |= SCM_STRUCTF_LIGHT + n * sizeof (SCM); /* use light
representation */
+ flags |= SCM_STRUCTF_LIGHT; /* use light representation */
}
}
SCM_SET_CLASS_FLAGS (class, flags);
@@ -786,7 +791,7 @@ prep_hashsets (SCM class)
{
unsigned int i;
- for (i = 0; i < 7; ++i)
+ for (i = 0; i < 8; ++i)
SCM_SET_HASHSET (class, i, scm_c_uniform32 (goops_rstate));
}
@@ -829,13 +834,8 @@ scm_basic_basic_make_class (SCM class, SCM name, SCM
dsupers, SCM dslots)
}
/* Support for the underlying structs: */
- SCM_SET_CLASS_FLAGS (z, (class == scm_class_entity_class
- ? (SCM_CLASSF_GOOPS_OR_VALID
- | SCM_CLASSF_OPERATOR
- | SCM_CLASSF_ENTITY)
- : class == scm_class_operator_class
- ? SCM_CLASSF_GOOPS_OR_VALID | SCM_CLASSF_OPERATOR
- : SCM_CLASSF_GOOPS_OR_VALID));
+ /* FIXME: set entity flag on z if class == entity_class ? */
+ SCM_SET_CLASS_FLAGS (z, SCM_CLASSF_GOOPS_OR_VALID);
return z;
}
@@ -1166,15 +1166,6 @@ SCM_DEFINE (scm_accessor_method_slot_definition,
"accessor-method-slot-definitio
}
#undef FUNC_NAME
-SCM_DEFINE (scm_sys_tag_body, "%tag-body", 1, 0, 0,
- (SCM body),
- "Internal GOOPS magic---don't use this function!")
-#define FUNC_NAME s_scm_sys_tag_body
-{
- return scm_cons (SCM_IM_LAMBDA, body);
-}
-#undef FUNC_NAME
-
/******************************************************************************
*
* S l o t a c c e s s
@@ -1569,22 +1560,18 @@ SCM_DEFINE (scm_sys_allocate_instance,
"%allocate-instance", 2, 0, 0,
n = SCM_I_INUM (SCM_SLOT (class, scm_si_nfields));
- /* Entities */
- if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_ENTITY)
+ /* FIXME applicable structs */
+ /* Generic functions */
+ if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_PURE_GENERIC)
{
+ SCM gf;
m = (SCM *) scm_alloc_struct (n, scm_struct_entity_n_extra_words,
- "entity struct");
+ "generic function");
m[scm_struct_i_setter] = SCM_BOOL_F;
m[scm_struct_i_procedure] = SCM_BOOL_F;
- /* Generic functions */
- if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_PURE_GENERIC)
- {
- SCM gf = wrap_init (class, m, n);
- clear_method_cache (gf);
- return gf;
- }
- else
- return wrap_init (class, m, n);
+ gf = wrap_init (class, m, n);
+ clear_method_cache (gf);
+ return gf;
}
/* Class objects */
@@ -1599,10 +1586,7 @@ SCM_DEFINE (scm_sys_allocate_instance,
"%allocate-instance", 2, 0, 0,
for (i = scm_si_goops_fields; i < n; i++)
SCM_SET_SLOT (z, i, SCM_GOOPS_UNBOUND);
- if (SCM_SUBCLASSP (class, scm_class_entity_class))
- SCM_SET_CLASS_FLAGS (z, SCM_CLASSF_OPERATOR | SCM_CLASSF_ENTITY);
- else if (SCM_SUBCLASSP (class, scm_class_operator_class))
- SCM_SET_CLASS_FLAGS (z, SCM_CLASSF_OPERATOR);
+ /* FIXME propagate applicable struct flag */
return z;
}
@@ -1621,15 +1605,11 @@ SCM_DEFINE (scm_sys_set_object_setter_x,
"%set-object-setter!", 2, 0, 0,
#define FUNC_NAME s_scm_sys_set_object_setter_x
{
SCM_ASSERT (SCM_STRUCTP (obj)
- && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR)
- || SCM_I_ENTITYP (obj)),
+ && (SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_PURE_GENERIC),
obj,
SCM_ARG1,
FUNC_NAME);
- if (SCM_I_ENTITYP (obj))
- SCM_SET_ENTITY_SETTER (obj, setter);
- else
- SCM_OPERATOR_CLASS (obj)->setter = setter;
+ SCM_SET_GENERIC_SETTER (obj, setter);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -1794,6 +1774,154 @@ static SCM list_of_no_method;
SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
+/* The cache argument for scm_mcache_lookup_cmethod has one of two possible
+ * formats:
+ *
+ * Format #1:
+ * (SCM_IM_DISPATCH ARGS N-SPECIALIZED
+ * #((TYPE1 ... ENV FORMALS FORM ...) ...)
+ * GF)
+ *
+ * Format #2:
+ * (SCM_IM_HASH_DISPATCH ARGS N-SPECIALIZED HASHSET MASK
+ * #((TYPE1 ... ENV FORMALS FORM ...) ...)
+ * GF)
+ *
+ * ARGS is either a list of expressions, in which case they
+ * are interpreted as the arguments of an application, or
+ * a non-pair, which is interpreted as a single expression
+ * yielding all arguments.
+ *
+ * SCM_IM_DISPATCH expressions in generic functions always
+ * have ARGS = the symbol `args' or the iloc address@hidden
+ *
+ * Need FORMALS in order to support varying arity. This
+ * also avoids the need for renaming of bindings.
+ *
+ * We should probably not complicate this mechanism by
+ * introducing "optimizations" for getters and setters or
+ * primitive methods. Getters and setter will normally be
+ * compiled into @slot-[ref|set!] or a procedure call.
+ * They rely on the dispatch performed before executing
+ * the code which contains them.
+ *
+ * We might want to use a more efficient representation of
+ * this form in the future, perhaps after we have introduced
+ * low-level support for syntax-case macros.
+ */
+
+SCM
+scm_mcache_lookup_cmethod (SCM cache, SCM args)
+{
+ unsigned long i, mask, n, end;
+ SCM ls, methods, z = SCM_CDDR (cache);
+ n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */
+ methods = SCM_CADR (z);
+
+ if (scm_is_simple_vector (methods))
+ {
+ /* cache format #1: prepare for linear search */
+ mask = -1;
+ i = 0;
+ end = SCM_SIMPLE_VECTOR_LENGTH (methods);
+ }
+ else
+ {
+ /* cache format #2: compute a hash value */
+ unsigned long hashset = scm_to_ulong (methods);
+ long j = n;
+ z = SCM_CDDR (z);
+ mask = scm_to_ulong (SCM_CAR (z));
+ methods = SCM_CADR (z);
+ i = 0;
+ ls = args;
+ if (!scm_is_null (ls))
+ do
+ {
+ i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
+ [scm_si_hashsets + hashset];
+ ls = SCM_CDR (ls);
+ }
+ while (j-- && !scm_is_null (ls));
+ i &= mask;
+ end = i;
+ }
+
+ /* Search for match */
+ do
+ {
+ long j = n;
+ z = SCM_SIMPLE_VECTOR_REF (methods, i);
+ ls = args; /* list of arguments */
+ if (!scm_is_null (ls))
+ do
+ {
+ /* More arguments than specifiers => CLASS != ENV */
+ if (! scm_is_eq (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
+ goto next_method;
+ ls = SCM_CDR (ls);
+ z = SCM_CDR (z);
+ }
+ while (j-- && !scm_is_null (ls));
+ /* Fewer arguments than specifiers => CAR != CLASS or `no-method' */
+ if (!scm_is_pair (z)
+ || (!SCM_CLASSP (SCM_CAR (z)) && !scm_is_symbol (SCM_CAR (z))))
+ return z;
+ next_method:
+ i = (i + 1) & mask;
+ } while (i != end);
+ return SCM_BOOL_F;
+}
+
+SCM
+scm_mcache_compute_cmethod (SCM cache, SCM args)
+{
+ SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
+ if (scm_is_false (cmethod))
+ /* No match - memoize */
+ return scm_memoize_method (cache, args);
+ return cmethod;
+}
+
+SCM
+scm_apply_generic (SCM gf, SCM args)
+{
+ SCM cmethod = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (gf),
args);
+ if (SCM_PROGRAM_P (cmethod))
+ return scm_vm_apply (scm_the_vm (), cmethod, args);
+ else if (scm_is_pair (cmethod))
+ return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
+ SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
+ args,
+ SCM_CMETHOD_ENV (cmethod)));
+ else
+ return scm_apply (cmethod, args, SCM_EOL);
+}
+
+SCM
+scm_call_generic_0 (SCM gf)
+{
+ return scm_apply_generic (gf, SCM_EOL);
+}
+
+SCM
+scm_call_generic_1 (SCM gf, SCM a1)
+{
+ return scm_apply_generic (gf, scm_list_1 (a1));
+}
+
+SCM
+scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
+{
+ return scm_apply_generic (gf, scm_list_2 (a1, a2));
+}
+
+SCM
+scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
+{
+ return scm_apply_generic (gf, scm_list_3 (a1, a2, a3));
+}
+
SCM
scm_make_method_cache (SCM gf)
{
@@ -1809,7 +1937,7 @@ static void
clear_method_cache (SCM gf)
{
SCM cache = scm_make_method_cache (gf);
- SCM_SET_ENTITY_PROCEDURE (gf, cache);
+ SCM_SET_GENERIC_METHOD_CACHE (gf, cache);
SCM_SET_SLOT (gf, scm_si_used_by, SCM_BOOL_F);
}
@@ -1833,7 +1961,7 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x,
"%invalidate-method-cache!", 1, 0
{
SCM n = SCM_SLOT (gf, scm_si_n_specialized);
/* The sign of n is a flag indicating rest args. */
- SCM_SET_MCACHE_N_SPECIALIZED (SCM_ENTITY_PROCEDURE (gf), n);
+ SCM_SET_MCACHE_N_SPECIALIZED (SCM_GENERIC_METHOD_CACHE (gf), n);
}
return SCM_UNSPECIFIED;
}
@@ -2557,11 +2685,6 @@ create_standard_classes (void)
scm_class_class, scm_class_class, SCM_EOL);
make_stdcls (&scm_class_entity_class, "<entity-class>",
scm_class_class, scm_class_procedure_class, SCM_EOL);
- make_stdcls (&scm_class_operator_class, "<operator-class>",
- scm_class_class, scm_class_procedure_class, SCM_EOL);
- make_stdcls (&scm_class_operator_with_setter_class,
- "<operator-with-setter-class>",
- scm_class_class, scm_class_operator_class, SCM_EOL);
make_stdcls (&scm_class_method, "<method>",
scm_class_class, scm_class_object, method_slots);
make_stdcls (&scm_class_simple_method, "<simple-method>",
@@ -2576,21 +2699,27 @@ create_standard_classes (void)
scm_class_entity_class,
scm_list_2 (scm_class_object, scm_class_applicable),
SCM_EOL);
+ SCM_CLEAR_CLASS_FLAGS (scm_class_entity, SCM_STRUCTF_LIGHT);
make_stdcls (&scm_class_entity_with_setter, "<entity-with-setter>",
scm_class_entity_class, scm_class_entity, SCM_EOL);
+ SCM_CLEAR_CLASS_FLAGS (scm_class_entity_with_setter, SCM_STRUCTF_LIGHT);
make_stdcls (&scm_class_generic, "<generic>",
scm_class_entity_class, scm_class_entity, gf_slots);
+ SCM_CLEAR_CLASS_FLAGS (scm_class_generic, SCM_STRUCTF_LIGHT);
SCM_SET_CLASS_FLAGS (scm_class_generic, SCM_CLASSF_PURE_GENERIC);
make_stdcls (&scm_class_extended_generic, "<extended-generic>",
scm_class_entity_class, scm_class_generic, egf_slots);
+ SCM_CLEAR_CLASS_FLAGS (scm_class_extended_generic, SCM_STRUCTF_LIGHT);
SCM_SET_CLASS_FLAGS (scm_class_extended_generic, SCM_CLASSF_PURE_GENERIC);
make_stdcls (&scm_class_generic_with_setter, "<generic-with-setter>",
scm_class_entity_class,
scm_list_2 (scm_class_generic, scm_class_entity_with_setter),
SCM_EOL);
+ SCM_CLEAR_CLASS_FLAGS (scm_class_generic_with_setter, SCM_STRUCTF_LIGHT);
SCM_SET_CLASS_FLAGS (scm_class_generic_with_setter, SCM_CLASSF_PURE_GENERIC);
make_stdcls (&scm_class_accessor, "<accessor>",
scm_class_entity_class, scm_class_generic_with_setter, SCM_EOL);
+ SCM_CLEAR_CLASS_FLAGS (scm_class_accessor, SCM_STRUCTF_LIGHT);
SCM_SET_CLASS_FLAGS (scm_class_accessor, SCM_CLASSF_PURE_GENERIC);
make_stdcls (&scm_class_extended_generic_with_setter,
"<extended-generic-with-setter>",
@@ -2598,6 +2727,7 @@ create_standard_classes (void)
scm_list_2 (scm_class_generic_with_setter,
scm_class_extended_generic),
SCM_EOL);
+ SCM_CLEAR_CLASS_FLAGS (scm_class_extended_generic_with_setter,
SCM_STRUCTF_LIGHT);
SCM_SET_CLASS_FLAGS (scm_class_extended_generic_with_setter,
SCM_CLASSF_PURE_GENERIC);
make_stdcls (&scm_class_extended_accessor, "<extended-accessor>",
@@ -2607,6 +2737,7 @@ create_standard_classes (void)
SCM_EOL);
fix_cpl (scm_class_extended_accessor,
scm_class_extended_generic, scm_class_generic);
+ SCM_CLEAR_CLASS_FLAGS (scm_class_extended_accessor, SCM_STRUCTF_LIGHT);
SCM_SET_CLASS_FLAGS (scm_class_extended_accessor, SCM_CLASSF_PURE_GENERIC);
/* Primitive types classes */
@@ -2835,7 +2966,7 @@ make_struct_class (void *closure SCM_UNUSED,
SCM sym = SCM_STRUCT_TABLE_NAME (data);
if (scm_is_true (sym))
{
- int applicablep = SCM_CLASS_FLAGS (vtable) & SCM_CLASSF_OPERATOR;
+ int applicablep = 0; /* FIXME SCM_CLASS_FLAGS (vtable) &
SCM_CLASSF_ENTITY */
SCM_SET_STRUCT_TABLE_CLASS (data,
scm_make_extended_class_from_symbol (sym,
applicablep));
@@ -2903,10 +3034,6 @@ scm_make_class (SCM meta, char *s_name, SCM supers,
size_t size,
SCM_SET_SLOT (class, scm_si_destructor, (SCM) destructor);
SCM_SET_CLASS_DESTRUCTOR (class, scm_free_foreign_object);
}
- else if (size > 0)
- {
- SCM_SET_CLASS_INSTANCE_SIZE (class, size);
- }
SCM_SET_SLOT (class, scm_si_layout, scm_from_locale_symbol (""));
SCM_SET_SLOT (class, scm_si_constructor, (SCM) constructor);
diff --git a/libguile/goops.h b/libguile/goops.h
index 8d13823..153aace 100644
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -47,11 +47,9 @@
#define scm_si_setter 4
#define scm_si_goops_fields 5
-
-/* Defined in libguile/objects.h:
-#define scm_si_redefined 5 The class to which class was redefined.
+#define scm_si_redefined 5 /* The class to which class was
redefined. */
#define scm_si_hashsets 6
-*/
+
#define scm_si_name 14 /* a symbol */
#define scm_si_direct_supers 15 /* (class ...) */
#define scm_si_direct_slots 16 /* ((name . options) ...) */
@@ -61,6 +59,7 @@
#define scm_si_slotdef_class 20
#define scm_si_slots 21 /* ((name . options) ...) */
#define scm_si_name_access 22
+#define scm_si_getters_n_setters scm_si_name_access
#define scm_si_keyword_access 23
#define scm_si_nfields 24 /* an integer */
#define scm_si_environment 25 /* The environment in which class is built
*/
@@ -74,18 +73,25 @@ typedef struct scm_t_method {
#define SCM_METHOD(obj) ((scm_t_method *) SCM_STRUCT_DATA (obj))
+/* {Class flags}
+ *
+ * These are used for efficient identification of instances of a
+ * certain class or its subclasses when traversal of the inheritance
+ * graph would be too costly.
+ */
+#define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class) [scm_struct_i_flags])
+#define SCM_OBJ_CLASS_FLAGS(obj) (SCM_STRUCT_VTABLE_DATA (obj)
[scm_struct_i_flags])
+#define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f))
+#define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f))
+#define SCM_CLASSF_MASK SCM_STRUCTF_MASK
+
#define SCM_CLASSF_SIMPLE_METHOD (0x004 << 20)
#define SCM_CLASSF_ACCESSOR_METHOD (0x008 << 20)
-
-/* Defined in libguile/objects.c */
-/* #define SCM_CLASSF_PURE_GENERIC (0x010 << 20) */
-
+#define SCM_CLASSF_PURE_GENERIC SCM_STRUCTF_GOOPS_HACK
#define SCM_CLASSF_FOREIGN (0x020 << 20)
#define SCM_CLASSF_METACLASS (0x040 << 20)
-
-/* Defined in libguile/objects.c */
-/* #define SCM_CLASSF_GOOPS_VALID (0x080 << 20) */
-/* #define SCM_CLASSF_GOOPS (0x100 << 20) */
+#define SCM_CLASSF_GOOPS_VALID (0x080 << 20)
+#define SCM_CLASSF_GOOPS (0x100 << 20)
#define SCM_CLASSF_GOOPS_OR_VALID (SCM_CLASSF_GOOPS | SCM_CLASSF_GOOPS_VALID)
#define SCM_CLASSF_INHERIT (~(SCM_CLASSF_PURE_GENERIC \
@@ -94,9 +100,10 @@ typedef struct scm_t_method {
| SCM_STRUCTF_LIGHT) \
& SCM_CLASSF_MASK)
+#define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x)
+#define SCM_OBJ_CLASS_REDEF(x) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x)
[scm_si_redefined]))
#define SCM_INST(x) SCM_STRUCT_DATA (x)
-/* Also defined in libguile/objects.c */
#define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x)
#define SCM_ACCESSORS_OF(x) (SCM_PACK (SCM_STRUCT_VTABLE_DATA
(x)[scm_si_getters_n_setters]))
@@ -133,13 +140,17 @@ typedef struct scm_t_method {
(SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), scm_class_method))
#define SCM_VALIDATE_METHOD(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, METHODP,
"method")
+#define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
+
+#define SCM_GENERIC_METHOD_CACHE(G) (SCM_PACK (SCM_STRUCT_DATA (G)
[scm_struct_i_procedure]))
+#define SCM_SET_GENERIC_METHOD_CACHE(G,C) (SCM_STRUCT_DATA (G)
[scm_struct_i_procedure] = SCM_UNPACK (C))
+#define SCM_GENERIC_SETTER(G) (SCM_PACK (SCM_STRUCT_DATA (G)
[scm_struct_i_setter]))
+#define SCM_SET_GENERIC_SETTER(G,C) (SCM_STRUCT_DATA (G) [scm_struct_i_setter]
= SCM_UNPACK (C))
#define SCM_MCACHE_N_SPECIALIZED(C) SCM_CADDR (C)
#define SCM_SET_MCACHE_N_SPECIALIZED(C, X) SCM_SETCAR (SCM_CDDR (C), X)
#define SCM_INITIAL_MCACHE_SIZE 1
-#define scm_si_getters_n_setters scm_si_name_access
-
#define scm_si_constructor SCM_N_CLASS_SLOTS
#define scm_si_destructor SCM_N_CLASS_SLOTS + 1
@@ -189,8 +200,6 @@ SCM_API SCM scm_class_method;
SCM_API SCM scm_class_simple_method;
SCM_API SCM scm_class_accessor_method;
SCM_API SCM scm_class_procedure_class;
-SCM_API SCM scm_class_operator_class;
-SCM_API SCM scm_class_operator_with_setter_class;
SCM_API SCM scm_class_entity_class;
SCM_API SCM scm_class_number;
SCM_API SCM scm_class_list;
@@ -227,6 +236,8 @@ SCM_API SCM scm_make_foreign_object (SCM cls, SCM initargs);
SCM_API SCM scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
void * (*constructor) (SCM initargs),
size_t (*destructor) (void *));
+SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep);
+SCM_API void scm_make_port_classes (long ptobnum, char *type_name);
SCM_API void scm_add_slot (SCM c, char *slot, SCM slot_class,
SCM (*getter) (SCM obj),
SCM (*setter) (SCM obj, SCM x),
@@ -255,6 +266,7 @@ SCM_API SCM scm_pure_generic_p (SCM obj);
#endif
SCM_API SCM scm_sys_compute_slots (SCM c);
+SCM_INTERNAL void scm_i_inherit_applicable (SCM c);
SCM_INTERNAL SCM scm_i_get_keyword (SCM key, SCM l, long len,
SCM default_value, const char *subr);
SCM_API SCM scm_get_keyword (SCM key, SCM l, SCM default_value);
@@ -298,6 +310,18 @@ SCM_API SCM stklos_version (void);
SCM_API SCM scm_make (SCM args);
SCM_API SCM scm_find_method (SCM args);
SCM_API SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs);
+SCM_API void scm_change_object_class (SCM, SCM, SCM);
+SCM_API SCM scm_memoize_method (SCM x, SCM args);
+SCM_API SCM scm_mcache_lookup_cmethod (SCM cache, SCM args);
+SCM_API SCM scm_mcache_compute_cmethod (SCM cache, SCM args);
+/* The following are declared in __scm.h
+SCM_API SCM scm_call_generic_0 (SCM gf);
+SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
+SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
+SCM_API SCM scm_apply_generic (SCM gf, SCM args);
+*/
+SCM_API SCM scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3);
+
SCM_INTERNAL SCM scm_init_goops_builtins (void);
SCM_INTERNAL void scm_init_goops (void);
diff --git a/libguile/init.c b/libguile/init.c
index 68156ef..82c73f7 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -82,7 +82,6 @@
#include "libguile/modules.h"
#include "libguile/net_db.h"
#include "libguile/numbers.h"
-#include "libguile/objects.h"
#include "libguile/objprop.h"
#include "libguile/options.h"
#include "libguile/pairs.h"
@@ -536,7 +535,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_symbols ();
scm_init_values (); /* Requires struct */
scm_init_load (); /* Requires strings */
- scm_init_objects (); /* Requires struct */
scm_init_print (); /* Requires strings, struct */
scm_init_read ();
scm_init_stime ();
diff --git a/libguile/objects.c b/libguile/objects.c
deleted file mode 100644
index f686c3a..0000000
--- a/libguile/objects.c
+++ /dev/null
@@ -1,371 +0,0 @@
-/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008 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
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
-
-/* This file and objects.h contains those minimal pieces of the Guile
- * Object Oriented Programming System which need to be included in
- * libguile. See the comments in objects.h.
- */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include "libguile/_scm.h"
-
-#include "libguile/struct.h"
-#include "libguile/procprop.h"
-#include "libguile/chars.h"
-#include "libguile/keywords.h"
-#include "libguile/smob.h"
-#include "libguile/eval.h"
-#include "libguile/alist.h"
-#include "libguile/ports.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/programs.h"
-#include "libguile/vm.h"
-
-#include "libguile/validate.h"
-#include "libguile/objects.h"
-#include "libguile/goops.h"
-
-
-
-SCM scm_metaclass_standard;
-SCM scm_metaclass_operator;
-
-/* The cache argument for scm_mcache_lookup_cmethod has one of two possible
- * formats:
- *
- * Format #1:
- * (SCM_IM_DISPATCH ARGS N-SPECIALIZED
- * #((TYPE1 ... ENV FORMALS FORM ...) ...)
- * GF)
- *
- * Format #2:
- * (SCM_IM_HASH_DISPATCH ARGS N-SPECIALIZED HASHSET MASK
- * #((TYPE1 ... ENV FORMALS FORM ...) ...)
- * GF)
- *
- * ARGS is either a list of expressions, in which case they
- * are interpreted as the arguments of an application, or
- * a non-pair, which is interpreted as a single expression
- * yielding all arguments.
- *
- * SCM_IM_DISPATCH expressions in generic functions always
- * have ARGS = the symbol `args' or the iloc address@hidden
- *
- * Need FORMALS in order to support varying arity. This
- * also avoids the need for renaming of bindings.
- *
- * We should probably not complicate this mechanism by
- * introducing "optimizations" for getters and setters or
- * primitive methods. Getters and setter will normally be
- * compiled into @slot-[ref|set!] or a procedure call.
- * They rely on the dispatch performed before executing
- * the code which contains them.
- *
- * We might want to use a more efficient representation of
- * this form in the future, perhaps after we have introduced
- * low-level support for syntax-case macros.
- */
-
-SCM
-scm_mcache_lookup_cmethod (SCM cache, SCM args)
-{
- unsigned long i, mask, n, end;
- SCM ls, methods, z = SCM_CDDR (cache);
- n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */
- methods = SCM_CADR (z);
-
- if (scm_is_simple_vector (methods))
- {
- /* cache format #1: prepare for linear search */
- mask = -1;
- i = 0;
- end = SCM_SIMPLE_VECTOR_LENGTH (methods);
- }
- else
- {
- /* cache format #2: compute a hash value */
- unsigned long hashset = scm_to_ulong (methods);
- long j = n;
- z = SCM_CDDR (z);
- mask = scm_to_ulong (SCM_CAR (z));
- methods = SCM_CADR (z);
- i = 0;
- ls = args;
- if (!scm_is_null (ls))
- do
- {
- i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
- [scm_si_hashsets + hashset];
- ls = SCM_CDR (ls);
- }
- while (j-- && !scm_is_null (ls));
- i &= mask;
- end = i;
- }
-
- /* Search for match */
- do
- {
- long j = n;
- z = SCM_SIMPLE_VECTOR_REF (methods, i);
- ls = args; /* list of arguments */
- if (!scm_is_null (ls))
- do
- {
- /* More arguments than specifiers => CLASS != ENV */
- if (! scm_is_eq (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
- goto next_method;
- ls = SCM_CDR (ls);
- z = SCM_CDR (z);
- }
- while (j-- && !scm_is_null (ls));
- /* Fewer arguments than specifiers => CAR != CLASS or `no-method' */
- if (!scm_is_pair (z)
- || (!SCM_CLASSP (SCM_CAR (z)) && !scm_is_symbol (SCM_CAR (z))))
- return z;
- next_method:
- i = (i + 1) & mask;
- } while (i != end);
- return SCM_BOOL_F;
-}
-
-SCM
-scm_mcache_compute_cmethod (SCM cache, SCM args)
-{
- SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
- if (scm_is_false (cmethod))
- /* No match - memoize */
- return scm_memoize_method (cache, args);
- return cmethod;
-}
-
-SCM
-scm_apply_generic (SCM gf, SCM args)
-{
- SCM cmethod = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (gf), args);
- if (SCM_PROGRAM_P (cmethod))
- return scm_vm_apply (scm_the_vm (), cmethod, args);
- else if (scm_is_pair (cmethod))
- return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
- SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
- args,
- SCM_CMETHOD_ENV (cmethod)));
- else
- return scm_apply (cmethod, args, SCM_EOL);
-}
-
-SCM
-scm_call_generic_0 (SCM gf)
-{
- return scm_apply_generic (gf, SCM_EOL);
-}
-
-SCM
-scm_call_generic_1 (SCM gf, SCM a1)
-{
- return scm_apply_generic (gf, scm_list_1 (a1));
-}
-
-SCM
-scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
-{
- return scm_apply_generic (gf, scm_list_2 (a1, a2));
-}
-
-SCM
-scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
-{
- return scm_apply_generic (gf, scm_list_3 (a1, a2, a3));
-}
-
-SCM_DEFINE (scm_entity_p, "entity?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is an entity.")
-#define FUNC_NAME s_scm_entity_p
-{
- return scm_from_bool(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_operator_p, "operator?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is an operator.")
-#define FUNC_NAME s_scm_operator_p
-{
- return scm_from_bool(SCM_STRUCTP (obj)
- && SCM_I_OPERATORP (obj)
- && !SCM_I_ENTITYP (obj));
-}
-#undef FUNC_NAME
-
-/* XXX - What code requires the object procedure to be only of certain
- types? */
-
-SCM_DEFINE (scm_valid_object_procedure_p, "valid-object-procedure?", 1, 0, 0,
- (SCM proc),
- "Return @code{#t} iff @var{proc} is a procedure that can be used "
- "with @code{set-object-procedure}. It is always valid to use "
- "a closure constructed by @code{lambda}.")
-#define FUNC_NAME s_scm_valid_object_procedure_p
-{
- if (SCM_IMP (proc))
- return SCM_BOOL_F;
- switch (SCM_TYP7 (proc))
- {
- default:
- return SCM_BOOL_F;
- case scm_tcs_closures:
- case scm_tc7_subr_1:
- case scm_tc7_subr_2:
- case scm_tc7_subr_3:
- case scm_tc7_lsubr_2:
- return SCM_BOOL_T;
- }
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
- (SCM obj, SCM proc),
- "Set the object procedure of @var{obj} to @var{proc}.\n"
- "@var{obj} must be either an entity or an operator.")
-#define FUNC_NAME s_scm_set_object_procedure_x
-{
- SCM_ASSERT (SCM_STRUCTP (obj)
- && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR)
- || (SCM_I_ENTITYP (obj)
- && !(SCM_OBJ_CLASS_FLAGS (obj)
- & SCM_CLASSF_PURE_GENERIC))),
- obj,
- SCM_ARG1,
- FUNC_NAME);
- SCM_ASSERT (scm_valid_object_procedure_p (proc), proc, SCM_ARG2, FUNC_NAME);
- if (SCM_I_ENTITYP (obj))
- SCM_SET_ENTITY_PROCEDURE (obj, proc);
- else
- SCM_OPERATOR_CLASS (obj)->procedure = proc;
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-#ifdef GUILE_DEBUG
-SCM_DEFINE (scm_object_procedure, "object-procedure", 1, 0, 0,
- (SCM obj),
- "Return the object procedure of @var{obj}. @var{obj} must be\n"
- "an entity or an operator.")
-#define FUNC_NAME s_scm_object_procedure
-{
- SCM_ASSERT (SCM_STRUCTP (obj)
- && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR)
- || SCM_I_ENTITYP (obj)),
- obj, SCM_ARG1, FUNC_NAME);
- return (SCM_I_ENTITYP (obj)
- ? SCM_ENTITY_PROCEDURE (obj)
- : SCM_OPERATOR_CLASS (obj)->procedure);
-}
-#undef FUNC_NAME
-#endif /* GUILE_DEBUG */
-
-/* The following procedures are not a part of Goops but a minimal
- * object system built upon structs. They are here for those who
- * want to implement their own object system.
- */
-
-SCM
-scm_i_make_class_object (SCM meta,
- SCM layout_string,
- unsigned long flags)
-{
- SCM c;
- SCM layout = scm_make_struct_layout (layout_string);
- c = scm_make_struct (meta,
- SCM_INUM0,
- scm_list_4 (layout, SCM_BOOL_F, SCM_EOL, SCM_EOL));
- SCM_SET_CLASS_FLAGS (c, flags);
- return c;
-}
-
-SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0,
- (SCM metaclass, SCM layout),
- "Create a new class object of class @var{metaclass}, with the\n"
- "slot layout specified by @var{layout}.")
-#define FUNC_NAME s_scm_make_class_object
-{
- unsigned long flags = 0;
- SCM_VALIDATE_STRUCT (1, metaclass);
- SCM_VALIDATE_STRING (2, layout);
- if (scm_is_eq (metaclass, scm_metaclass_operator))
- flags = SCM_CLASSF_OPERATOR;
- return scm_i_make_class_object (metaclass, layout, flags);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
- (SCM class, SCM layout),
- "Create a subclass object of @var{class}, with the slot layout\n"
- "specified by @var{layout}.")
-#define FUNC_NAME s_scm_make_subclass_object
-{
- SCM pl;
- SCM_VALIDATE_STRUCT (1, class);
- SCM_VALIDATE_STRING (2, layout);
- pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
- pl = scm_symbol_to_string (pl);
- return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
- scm_string_append (scm_list_2 (pl, layout)),
- SCM_CLASS_FLAGS (class));
-}
-#undef FUNC_NAME
-
-void
-scm_init_objects ()
-{
- SCM ms = scm_from_locale_string (SCM_METACLASS_STANDARD_LAYOUT);
- SCM mt = scm_make_vtable_vtable (ms, SCM_INUM0,
- scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
-
- SCM os = scm_from_locale_string (SCM_METACLASS_OPERATOR_LAYOUT);
- SCM ot = scm_make_vtable_vtable (os, SCM_INUM0,
- scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
-
- SCM es = scm_from_locale_string (SCM_ENTITY_LAYOUT);
- SCM el = scm_make_struct_layout (es);
- SCM et = scm_make_struct (mt, SCM_INUM0,
- scm_list_4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));
-
- scm_c_define ("<class>", mt);
- scm_metaclass_standard = mt;
- scm_c_define ("<operator-class>", ot);
- scm_metaclass_operator = ot;
- SCM_SET_CLASS_FLAGS (et, SCM_CLASSF_OPERATOR | SCM_CLASSF_ENTITY);
- scm_c_define ("<entity>", et);
-
-#include "libguile/objects.x"
-}
-
-/*
- Local Variables:
- c-file-style: "gnu"
- End:
-*/
diff --git a/libguile/objects.h b/libguile/objects.h
deleted file mode 100644
index 914a7ea..0000000
--- a/libguile/objects.h
+++ /dev/null
@@ -1,219 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_OBJECTS_H
-#define SCM_OBJECTS_H
-
-/* Copyright (C) 1996,1999,2000,2001, 2003, 2006, 2008, 2009 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
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
-/* This file and objects.c contains those minimal pieces of the Guile
- * Object Oriented Programming System which need to be included in
- * libguile.
- *
- * {Objects and structs}
- *
- * Objects are currently based upon structs. Although the struct
- * implementation will change thoroughly in the future, objects will
- * still be based upon structs.
- */
-
-#include "libguile/__scm.h"
-#include "libguile/struct.h"
-
-
-
-/* {Class flags}
- *
- * These are used for efficient identification of instances of a
- * certain class or its subclasses when traversal of the inheritance
- * graph would be too costly.
- */
-#define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class) [scm_struct_i_flags])
-#define SCM_OBJ_CLASS_FLAGS(obj) (SCM_STRUCT_VTABLE_DATA (obj)
[scm_struct_i_flags])
-#define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f))
-#define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f))
-#define SCM_CLASSF_MASK SCM_STRUCTF_MASK
-
-#define SCM_CLASSF_ENTITY SCM_STRUCTF_ENTITY
-/* Operator classes need to be identified in the evaluator.
- (Entities also have SCM_CLASSF_OPERATOR set in their vtable.) */
-#define SCM_CLASSF_OPERATOR (1L << 29)
-
-#define SCM_I_OPERATORP(obj)\
- ((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR) != 0)
-#define SCM_OPERATOR_CLASS(obj)\
-((struct scm_metaclass_operator *) SCM_STRUCT_DATA (obj))
-#define SCM_OBJ_OPERATOR_CLASS(obj)\
-((struct scm_metaclass_operator *) SCM_STRUCT_VTABLE_DATA (obj))
-#define SCM_OPERATOR_PROCEDURE(obj) (SCM_OBJ_OPERATOR_CLASS (obj)->procedure)
-#define SCM_OPERATOR_SETTER(obj) (SCM_OBJ_OPERATOR_CLASS (obj)->setter)
-
-#define SCM_I_ENTITYP(obj)\
- ((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0)
-#define SCM_ENTITY_PROCEDURE(obj) \
- (SCM_PACK (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure]))
-#define SCM_SET_ENTITY_PROCEDURE(obj, v) \
- (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure] = SCM_UNPACK (v))
-#define SCM_ENTITY_SETTER(obj) (SCM_PACK (SCM_STRUCT_DATA
(obj)[scm_struct_i_setter]))
-#define SCM_SET_ENTITY_SETTER(obj, v) \
- (SCM_STRUCT_DATA (obj) [scm_struct_i_setter] = SCM_UNPACK (v))
-
-#define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
-#define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \
- (SCM_STRUCT_DATA (c)[scm_struct_i_size] \
- = (SCM_STRUCT_DATA (c) [scm_struct_i_size] & SCM_STRUCTF_MASK) | s)
-
-/* {Operator classes}
- *
- * Instances of operator classes can work as operators, i. e., they
- * can be applied to arguments just as if they were ordinary
- * procedures.
- *
- * For instances of operator classes, the procedures to be applied are
- * stored in four dedicated slots in the associated class object.
- * Which one is selected depends on the number of arguments in the
- * application.
- *
- * If zero arguments are passed, the first will be selected.
- * If one argument is passed, the second will be selected.
- * If two arguments are passed, the third will be selected.
- * If three or more arguments are passed, the fourth will be selected.
- *
- * This is complicated and may seem gratuitous but has to do with the
- * architecture of the evaluator. Using only one procedure would
- * result in a great deal less efficient application, loss of
- * tail-recursion and would be difficult to reconcile with the
- * debugging evaluator.
- *
- * Also, using this "forked" application in low-level code has the
- * advantage of speeding up some code. An example is method dispatch
- * for generic operators applied to few arguments. On the user level,
- * the "forked" application will be hidden by mechanisms in the GOOPS
- * package.
- *
- * Operator classes have the metaclass <operator-metaclass>.
- *
- * An example of an operator class is the class <tk-command>.
- */
-#define SCM_METACLASS_STANDARD_LAYOUT ""
-struct scm_metaclass_standard {
- SCM layout;
- SCM vcell;
- SCM vtable;
- SCM print;
-};
-
-#define SCM_METACLASS_OPERATOR_LAYOUT "popo"
-struct scm_metaclass_operator {
- SCM layout;
- SCM vcell;
- SCM vtable;
- SCM print;
- SCM procedure;
- SCM setter;
-};
-
-/* {Entity classes}
- *
- * For instances of entity classes (entities), the procedures to be
- * applied are stored in the instance itself rather than in the class
- * object as is the case for instances of operator classes (see above).
- *
- * An example of an entity class is the class of generic methods.
- */
-#define SCM_ENTITY_LAYOUT ""
-
-/* {Interface to Goops}
- *
- * The evaluator contains a multi-method dispatch mechanism.
- * This interface is used by that mechanism and during creation of
- * smob and struct classes.
- */
-
-/* Internal representation of Goops objects. */
-#define SCM_CLASSF_PURE_GENERIC (0x010 << 20)
-#define SCM_CLASSF_GOOPS_VALID (0x080 << 20)
-#define SCM_CLASSF_GOOPS (0x100 << 20)
-#define scm_si_redefined 5
-#define scm_si_hashsets 6
-#define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x)
-#define SCM_OBJ_CLASS_REDEF(x) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x)
[scm_si_redefined]))
-
-typedef struct scm_effective_slot_definition {
- SCM name;
- long location;
- SCM init_value;
- SCM (*get) (SCM obj, SCM slotdef);
- SCM (*set) (SCM obj, SCM slotdef, SCM value);
-} scm_effective_slot_definition;
-
-#define SCM_ESLOTDEF(x) ((scm_effective_slot_definition *) SCM_CDR (x))
-
-#define SCM_CMETHOD_CODE(cmethod) SCM_CDR (cmethod)
-#define SCM_CMETHOD_FORMALS(cmethod) SCM_CAR (SCM_CMETHOD_CODE (cmethod))
-#define SCM_CMETHOD_BODY(cmethod) SCM_CDR (SCM_CMETHOD_CODE (cmethod))
-#define SCM_CMETHOD_ENV(cmethod) SCM_CAR (cmethod)
-
-/* Port classes */
-#define SCM_IN_PCLASS_INDEX 0
-#define SCM_OUT_PCLASS_INDEX SCM_I_MAX_PORT_TYPE_COUNT
-#define SCM_INOUT_PCLASS_INDEX (2 * SCM_I_MAX_PORT_TYPE_COUNT)
-
-/* Plugin proxy classes for basic types. */
-SCM_API SCM scm_metaclass_standard;
-SCM_API SCM scm_metaclass_operator;
-
-/* Goops functions. */
-SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep);
-SCM_INTERNAL void scm_i_inherit_applicable (SCM c);
-SCM_API void scm_make_port_classes (long ptobnum, char *type_name);
-SCM_API void scm_change_object_class (SCM, SCM, SCM);
-SCM_API SCM scm_memoize_method (SCM x, SCM args);
-
-SCM_API SCM scm_mcache_lookup_cmethod (SCM cache, SCM args);
-SCM_API SCM scm_mcache_compute_cmethod (SCM cache, SCM args);
-/* The following are declared in __scm.h
-SCM_API SCM scm_call_generic_0 (SCM gf);
-SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
-SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
-SCM_API SCM scm_apply_generic (SCM gf, SCM args);
-*/
-SCM_API SCM scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3);
-SCM_API SCM scm_entity_p (SCM obj);
-SCM_API SCM scm_operator_p (SCM obj);
-SCM_API SCM scm_valid_object_procedure_p (SCM proc);
-SCM_API SCM scm_set_object_procedure_x (SCM obj, SCM proc);
-#ifdef GUILE_DEBUG
-SCM_API SCM scm_object_procedure (SCM obj);
-#endif
-SCM_API SCM scm_make_class_object (SCM metaclass, SCM layout);
-SCM_API SCM scm_make_subclass_object (SCM c, SCM layout);
-
-SCM_INTERNAL SCM scm_i_make_class_object (SCM metaclass, SCM layout_string,
- unsigned long flags);
-SCM_INTERNAL void scm_init_objects (void);
-
-#endif /* SCM_OBJECTS_H */
-
-/*
- Local Variables:
- c-file-style: "gnu"
- End:
-*/
diff --git a/libguile/ports.c b/libguile/ports.c
index 8127e98..e71ee0a 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -40,7 +40,6 @@
#include "libguile/async.h"
#include "libguile/eval.h"
#include "libguile/fports.h" /* direct access for seek and truncate */
-#include "libguile/objects.h"
#include "libguile/goops.h"
#include "libguile/smob.h"
#include "libguile/chars.h"
diff --git a/libguile/print.c b/libguile/print.c
index b07e206..fd984d3 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -38,7 +38,6 @@
#include "libguile/programs.h"
#include "libguile/alist.h"
#include "libguile/struct.h"
-#include "libguile/objects.h"
#include "libguile/ports.h"
#include "libguile/root.h"
#include "libguile/strings.h"
diff --git a/libguile/procprop.c b/libguile/procprop.c
index dcbfba7..2b67bb1 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -28,7 +28,6 @@
#include "libguile/eval.h"
#include "libguile/procs.h"
#include "libguile/gsubr.h"
-#include "libguile/objects.h"
#include "libguile/smob.h"
#include "libguile/root.h"
#include "libguile/vectors.h"
@@ -127,13 +126,13 @@ scm_i_procedure_arity (SCM proc)
r = 1;
break;
}
- else if (!SCM_I_OPERATORP (proc))
- return SCM_BOOL_F;
- proc = (SCM_I_ENTITYP (proc)
- ? SCM_ENTITY_PROCEDURE (proc)
- : SCM_OPERATOR_PROCEDURE (proc));
+ /* FIXME applicable structs */
+ return SCM_BOOL_F;
+#if 0
+ proc = SCM_ENTITY_PROCEDURE (proc);
a -= 1;
goto loop;
+#endif
default:
return SCM_BOOL_F;
}
diff --git a/libguile/procs.c b/libguile/procs.c
index 5de2f33..df62514 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -24,7 +24,6 @@
#include "libguile/_scm.h"
-#include "libguile/objects.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/smob.h"
@@ -98,7 +97,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
switch (SCM_TYP7 (obj))
{
case scm_tcs_struct:
- if (!SCM_I_OPERATORP (obj))
+ if (!(SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_PURE_GENERIC))
break;
case scm_tcs_closures:
case scm_tcs_subrs:
@@ -262,7 +261,8 @@ SCM_DEFINE (scm_procedure, "procedure", 1, 0, 0,
return SCM_PROCEDURE (proc);
else if (SCM_STRUCTP (proc))
{
- SCM_ASSERT (SCM_I_OPERATORP (proc), proc, SCM_ARG1, FUNC_NAME);
+ SCM_ASSERT (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC,
+ proc, SCM_ARG1, FUNC_NAME);
return proc;
}
SCM_WRONG_TYPE_ARG (1, proc);
@@ -281,11 +281,9 @@ scm_setter (SCM proc)
else if (SCM_STRUCTP (proc))
{
SCM setter;
- SCM_GASSERT1 (SCM_I_OPERATORP (proc),
+ SCM_GASSERT1 (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC,
g_setter, proc, SCM_ARG1, s_setter);
- setter = (SCM_I_ENTITYP (proc)
- ? SCM_ENTITY_SETTER (proc)
- : SCM_OPERATOR_SETTER (proc));
+ setter = SCM_GENERIC_SETTER (proc);
if (SCM_NIMP (setter))
return setter;
/* fall through */
diff --git a/libguile/smob.c b/libguile/smob.c
index 42a51fd..31f6dd0 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -28,7 +28,6 @@
#include "libguile/_scm.h"
#include "libguile/async.h"
-#include "libguile/objects.h"
#include "libguile/goops.h"
#include "libguile/ports.h"
diff --git a/libguile/struct.c b/libguile/struct.c
index 9dd900e..33be8ad 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -420,7 +420,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
need for a lock on the section below, as it does not access or update
any globals, so the critical section has been removed. */
- if (c_vtable[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
+ if (c_vtable[scm_struct_i_flags] & SCM_STRUCTF_GOOPS_HACK)
{
data = scm_alloc_struct (basic_size + tail_elts,
scm_struct_entity_n_extra_words,
diff --git a/libguile/struct.h b/libguile/struct.h
index a4626f3..8634659 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -38,7 +38,6 @@
#define scm_struct_i_free -4 /* Destructor */
#define scm_struct_i_ptr -3 /* Start of block (see alloc_struct) */
#define scm_struct_i_n_words -2 /* How many words allocated to this struct?
*/
-#define scm_struct_i_size -1 /* Instance size */
#define scm_struct_i_flags -1 /* Upper 12 bits used as flags */
/* These indices must correspond to required_vtable_fields in
@@ -51,7 +50,7 @@
typedef void (*scm_t_struct_free) (scm_t_bits * vtable, scm_t_bits * data);
#define SCM_STRUCTF_MASK (0xFFF << 20)
-#define SCM_STRUCTF_ENTITY (1L << 30) /* Indicates presence of proc slots */
+#define SCM_STRUCTF_GOOPS_HACK (0x010 << 20) /* FIXME -- PURE_GENERIC */
#define SCM_STRUCTF_LIGHT (1L << 31) /* Light representation
(no hidden words) */
@@ -78,9 +77,6 @@ typedef void (*scm_t_struct_free) (scm_t_bits * vtable,
scm_t_bits * data);
#define SCM_SET_STRUCT_TABLE_CLASS(X, CLASS) SCM_SETCDR (X, CLASS)
SCM_API SCM scm_struct_table;
-#define SCM_STRUCT_GC_CHAIN(X) SCM_CELL_OBJECT_3 (X)
-#define SCM_SET_STRUCT_GC_CHAIN(X, Y) SCM_SET_CELL_OBJECT_3 (X, Y)
-
SCM_API scm_t_bits * scm_alloc_struct (int n_words, int n_extra,
diff --git a/libguile/validate.h b/libguile/validate.h
index 8c79469..ec32aa6 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -377,8 +377,7 @@
#define SCM_VALIDATE_VTABLE(pos, v) \
do { \
- SCM_ASSERT (!SCM_IMP (v) && scm_is_true (scm_struct_vtable_p (v)), \
- v, pos, FUNC_NAME); \
+ SCM_ASSERT (scm_is_true (scm_struct_vtable_p (v)), v, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_VECTOR_LEN(pos, v, len) \
diff --git a/libguile/values.c b/libguile/values.c
index 81fdcf8..71cdbe2 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2000, 2001, 2006, 2008, 2009 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
@@ -80,12 +80,7 @@ scm_init_values (void)
SCM print = scm_c_define_subr ("%print-values", scm_tc7_subr_2,
print_values);
- scm_values_vtable
- = scm_permanent_object (
- scm_make_vtable_vtable (scm_from_locale_string ("pr"),
- SCM_INUM0, SCM_EOL));
-
- SCM_SET_STRUCT_PRINTER (scm_values_vtable, print);
+ scm_values_vtable = scm_make_vtable (scm_from_locale_string ("pr"), print);
scm_add_feature ("values");
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index ff963d6..b95a45a 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -281,10 +281,59 @@ VM_DEFINE_FUNCTION (126, mod, "mod", 2)
RETURN (scm_modulo (x, y));
}
+VM_DEFINE_FUNCTION (170, ash, "ash", 2)
+{
+ ARGS2 (x, y);
+ if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
+ {
+ if (SCM_I_INUM (y) < 0)
+ RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) >> -SCM_I_INUM (y)));
+ else if ((SCM_I_INUM (x) << SCM_I_INUM (y)) >> SCM_I_INUM (y)
+ == SCM_I_INUM (x))
+ RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) << SCM_I_INUM (y)));
+ /* fall through */
+ }
+ SYNC_REGISTER ();
+ RETURN (scm_ash (x, y));
+}
+
+VM_DEFINE_FUNCTION (171, logand, "logand", 2)
+{
+ ARGS2 (x, y);
+ if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
+ RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) & SCM_I_INUM (y)));
+ SYNC_REGISTER ();
+ RETURN (scm_logand (x, y));
+}
+
+VM_DEFINE_FUNCTION (172, logior, "logior", 2)
+{
+ ARGS2 (x, y);
+ if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
+ RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) | SCM_I_INUM (y)));
+ SYNC_REGISTER ();
+ RETURN (scm_logior (x, y));
+}
+
+VM_DEFINE_FUNCTION (173, logxor, "logxor", 2)
+{
+ ARGS2 (x, y);
+ if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
+ RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
+ SYNC_REGISTER ();
+ RETURN (scm_logxor (x, y));
+}
+
/*
* GOOPS support
*/
+VM_DEFINE_FUNCTION (169, class_of, "class-of", 1)
+{
+ ARGS1 (obj);
+ RETURN (SCM_INSTANCEP (obj) ? SCM_CLASS_OF (obj) : scm_class_of (obj));
+}
+
VM_DEFINE_FUNCTION (127, slot_ref, "slot-ref", 2)
{
size_t slot;
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index f58ffce..8383a12 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -749,6 +749,17 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1)
APPLY_HOOK ();
NEXT;
}
+ if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC)
+ {
+ SCM args = SCM_EOL;
+ int n = nargs;
+ SCM* walk = sp;
+ SYNC_REGISTER ();
+ while (n--)
+ args = scm_cons (*walk--, args);
+ *walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
+ goto vm_call;
+ }
/*
* Other interpreted or compiled call
*/
@@ -822,6 +833,17 @@ VM_DEFINE_INSTRUCTION (54, goto_args, "goto/args", 1, -1,
1)
APPLY_HOOK ();
NEXT;
}
+ if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC)
+ {
+ SCM args = SCM_EOL;
+ int n = nargs;
+ SCM* walk = sp;
+ SYNC_REGISTER ();
+ while (n--)
+ args = scm_cons (*walk--, args);
+ *walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
+ goto vm_goto_args;
+ }
/*
* Other interpreted or compiled call
@@ -883,6 +905,7 @@ VM_DEFINE_INSTRUCTION (57, mv_call, "mv-call", 4, -1, 1)
FETCH_OFFSET (offset);
mvra = ip + offset;
+ vm_mv_call:
x = sp[-nargs];
/*
@@ -902,6 +925,17 @@ VM_DEFINE_INSTRUCTION (57, mv_call, "mv-call", 4, -1, 1)
APPLY_HOOK ();
NEXT;
}
+ if (SCM_STRUCTP (x) && SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_PURE_GENERIC)
+ {
+ SCM args = SCM_EOL;
+ int n = nargs;
+ SCM* walk = sp;
+ SYNC_REGISTER ();
+ while (n--)
+ args = scm_cons (*walk--, args);
+ *walk = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (x), args);
+ goto vm_mv_call;
+ }
/*
* Other interpreted or compiled call
*/
diff --git a/module/ice-9/optargs.scm b/module/ice-9/optargs.scm
index 195bd1e..22dfa9f 100644
--- a/module/ice-9/optargs.scm
+++ b/module/ice-9/optargs.scm
@@ -110,7 +110,6 @@
(apply (lambda vars b0 b1 ...)
(or (parse-lambda-case '(0 n n n+1 #f '())
(list t ...)
- #f
rest-arg)
(error "sth" rest-arg)))))))))))
@@ -127,7 +126,6 @@
#'(apply (lambda vars b0 b1 ...)
(or (parse-lambda-case '(0 n n n+1 #f '())
(list (lambda vars i) ...)
- #f
rest-arg)
(error "sth" rest-arg))))))))))
@@ -166,7 +164,6 @@
(apply (lambda vars b0 b1 ...)
(or (parse-lambda-case '(0 0 #f n aok ((kw . idx) ...))
(list t ...)
- #f
rest-arg)
(error "sth" rest-arg))))))))
((_ rest-arg aok (binding ...) b0 b1 ...)
@@ -188,7 +185,6 @@
#'(apply (lambda vars b0 b1 ...)
(or (parse-lambda-case '(0 0 #f n aok ((kw . idx) ...))
(list (lambda vars i) ...)
- #f
rest-arg)
(error "sth" rest-arg)))))))
((_ rest-arg aok (binding ...) b0 b1 ...)
@@ -285,7 +281,7 @@
;;; Support for optional & keyword args with the interpreter.
(define *uninitialized* (list 'uninitialized))
-(define (parse-lambda-case spec inits predicate args)
+(define (parse-lambda-case spec inits args)
(pmatch spec
((,nreq ,nopt ,rest-idx ,nargs ,allow-other-keys? ,kw-indices)
(define (req args prev tail n)
@@ -325,12 +321,12 @@
((pair? args-tail)
#f) ;; fail
(else
- (pred slots))))
+ slots)))
(define (key slots slots-tail args-tail inits)
(cond
((null? args-tail)
(if (null? inits)
- (pred slots)
+ slots
(begin
(if (eq? (car slots-tail) *uninitialized*)
(set-car! slots-tail (apply (car inits) slots)))
@@ -351,13 +347,6 @@
allow-other-keys?)
(key slots slots-tail (cddr args-tail) inits))
(else (error "unrecognized keyword" args-tail))))
- (define (pred slots)
- (cond
- (predicate
- (if (apply predicate slots)
- slots
- #f))
- (else slots)))
(let ((args (list-copy args)))
(req args #f args nreq)))
(else (error "unexpected spec" spec))))
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index a606187..ec655ac 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -123,383 +123,340 @@
#{mod\ 325}#
#{get-formals\ 326}#
#{clauses\ 327}#)
- (letrec ((#{expand-body\ 332}#
- (lambda (#{req\ 333}#
- #{opt\ 334}#
- #{rest\ 335}#
- #{kw\ 336}#
- #{pred\ 337}#
- #{body\ 338}#
- #{vars\ 339}#
- #{r*\ 340}#
- #{w*\ 341}#
- #{inits\ 342}#)
- ((lambda (#{tmp\ 343}#)
- ((lambda (#{tmp\ 344}#)
- (if (if #{tmp\ 344}#
- (apply (lambda (#{docstring\ 345}#
- #{e1\ 346}#
- #{e2\ 347}#)
+ (letrec ((#{expand-body\ 331}#
+ (lambda (#{req\ 332}#
+ #{opt\ 333}#
+ #{rest\ 334}#
+ #{kw\ 335}#
+ #{body\ 336}#
+ #{vars\ 337}#
+ #{r*\ 338}#
+ #{w*\ 339}#
+ #{inits\ 340}#)
+ ((lambda (#{tmp\ 341}#)
+ ((lambda (#{tmp\ 342}#)
+ (if (if #{tmp\ 342}#
+ (apply (lambda (#{docstring\ 343}#
+ #{e1\ 344}#
+ #{e2\ 345}#)
(string?
(syntax->datum
- #{docstring\ 345}#)))
- #{tmp\ 344}#)
+ #{docstring\ 343}#)))
+ #{tmp\ 342}#)
#f)
- (apply (lambda (#{docstring\ 348}#
- #{e1\ 349}#
- #{e2\ 350}#)
+ (apply (lambda (#{docstring\ 346}#
+ #{e1\ 347}#
+ #{e2\ 348}#)
(values
(syntax->datum
- #{docstring\ 348}#)
- #{req\ 333}#
- #{opt\ 334}#
- #{rest\ 335}#
- #{kw\ 336}#
- #{inits\ 342}#
- #{vars\ 339}#
- #{pred\ 337}#
+ #{docstring\ 346}#)
+ #{req\ 332}#
+ #{opt\ 333}#
+ #{rest\ 334}#
+ #{kw\ 335}#
+ #{inits\ 340}#
+ #{vars\ 337}#
(#{chi-body\ 171}#
- (cons #{e1\ 349}# #{e2\ 350}#)
+ (cons #{e1\ 347}# #{e2\ 348}#)
(#{source-wrap\ 160}#
#{e\ 321}#
#{w\ 323}#
#{s\ 324}#
#{mod\ 325}#)
- #{r*\ 340}#
- #{w*\ 341}#
+ #{r*\ 338}#
+ #{w*\ 339}#
#{mod\ 325}#)))
- #{tmp\ 344}#)
- ((lambda (#{tmp\ 352}#)
- (if #{tmp\ 352}#
- (apply (lambda (#{e1\ 353}#
- #{e2\ 354}#)
+ #{tmp\ 342}#)
+ ((lambda (#{tmp\ 350}#)
+ (if #{tmp\ 350}#
+ (apply (lambda (#{e1\ 351}#
+ #{e2\ 352}#)
(values
#f
- #{req\ 333}#
- #{opt\ 334}#
- #{rest\ 335}#
- #{kw\ 336}#
- #{inits\ 342}#
- #{vars\ 339}#
- #{pred\ 337}#
+ #{req\ 332}#
+ #{opt\ 333}#
+ #{rest\ 334}#
+ #{kw\ 335}#
+ #{inits\ 340}#
+ #{vars\ 337}#
(#{chi-body\ 171}#
- (cons #{e1\ 353}#
- #{e2\ 354}#)
+ (cons #{e1\ 351}#
+ #{e2\ 352}#)
(#{source-wrap\ 160}#
#{e\ 321}#
#{w\ 323}#
#{s\ 324}#
#{mod\ 325}#)
- #{r*\ 340}#
- #{w*\ 341}#
+ #{r*\ 338}#
+ #{w*\ 339}#
#{mod\ 325}#)))
- #{tmp\ 352}#)
+ #{tmp\ 350}#)
(syntax-violation
#f
"source expression failed to match
any pattern"
- #{tmp\ 343}#)))
+ #{tmp\ 341}#)))
($sc-dispatch
- #{tmp\ 343}#
+ #{tmp\ 341}#
'(any . each-any)))))
($sc-dispatch
- #{tmp\ 343}#
+ #{tmp\ 341}#
'(any any . each-any))))
- #{body\ 338}#)))
- (#{expand-pred\ 331}#
- (lambda (#{req\ 356}#
- #{opt\ 357}#
- #{rest\ 358}#
- #{kw\ 359}#
- #{pred\ 360}#
- #{body\ 361}#
- #{vars\ 362}#
- #{r*\ 363}#
- #{w*\ 364}#
- #{inits\ 365}#)
- (#{expand-body\ 332}#
- #{req\ 356}#
- #{opt\ 357}#
- #{rest\ 358}#
- #{kw\ 359}#
- (if #{pred\ 360}#
- (#{chi\ 167}#
- #{pred\ 360}#
- #{r*\ 363}#
- #{w*\ 364}#
- #{mod\ 325}#)
- #f)
- #{body\ 361}#
- #{vars\ 362}#
- #{r*\ 363}#
- #{w*\ 364}#
- #{inits\ 365}#)))
+ #{body\ 336}#)))
(#{expand-kw\ 330}#
- (lambda (#{req\ 366}#
- #{opt\ 367}#
- #{rest\ 368}#
- #{kw\ 369}#
- #{pred\ 370}#
- #{body\ 371}#
- #{vars\ 372}#
- #{r*\ 373}#
- #{w*\ 374}#
- #{aok\ 375}#
- #{out\ 376}#
- #{inits\ 377}#)
- (if (pair? #{kw\ 369}#)
- ((lambda (#{tmp\ 378}#)
- ((lambda (#{tmp\ 379}#)
- (if #{tmp\ 379}#
- (apply (lambda (#{k\ 380}#
- #{id\ 381}#
- #{i\ 382}#)
- (let ((#{v\ 383}# (#{gen-var\
181}#
- #{id\
381}#)))
- (let ((#{l\ 384}#
(#{gen-labels\ 137}#
- (list
#{v\ 383}#))))
- (let ((#{r**\ 385}#
+ (lambda (#{req\ 354}#
+ #{opt\ 355}#
+ #{rest\ 356}#
+ #{kw\ 357}#
+ #{body\ 358}#
+ #{vars\ 359}#
+ #{r*\ 360}#
+ #{w*\ 361}#
+ #{aok\ 362}#
+ #{out\ 363}#
+ #{inits\ 364}#)
+ (if (pair? #{kw\ 357}#)
+ ((lambda (#{tmp\ 365}#)
+ ((lambda (#{tmp\ 366}#)
+ (if #{tmp\ 366}#
+ (apply (lambda (#{k\ 367}#
+ #{id\ 368}#
+ #{i\ 369}#)
+ (let ((#{v\ 370}# (#{gen-var\
181}#
+ #{id\
368}#)))
+ (let ((#{l\ 371}#
(#{gen-labels\ 137}#
+ (list
#{v\ 370}#))))
+ (let ((#{r**\ 372}#
(#{extend-var-env\
126}#
- #{l\ 384}#
- (list #{v\ 383}#)
- #{r*\ 373}#)))
- (let ((#{w**\ 386}#
+ #{l\ 371}#
+ (list #{v\ 370}#)
+ #{r*\ 360}#)))
+ (let ((#{w**\ 373}#
(#{make-binding-wrap\ 148}#
- (list #{id\
381}#)
- #{l\ 384}#
- #{w*\ 374}#)))
+ (list #{id\
368}#)
+ #{l\ 371}#
+ #{w*\ 361}#)))
(#{expand-kw\ 330}#
- #{req\ 366}#
- #{opt\ 367}#
- #{rest\ 368}#
- (cdr #{kw\ 369}#)
- #{pred\ 370}#
- #{body\ 371}#
- (cons #{v\ 383}#
- #{vars\ 372}#)
- #{r**\ 385}#
- #{w**\ 386}#
- #{aok\ 375}#
+ #{req\ 354}#
+ #{opt\ 355}#
+ #{rest\ 356}#
+ (cdr #{kw\ 357}#)
+ #{body\ 358}#
+ (cons #{v\ 370}#
+ #{vars\ 359}#)
+ #{r**\ 372}#
+ #{w**\ 373}#
+ #{aok\ 362}#
(cons (list
(syntax->datum
- #{k\
380}#)
+ #{k\
367}#)
(syntax->datum
- #{id\
381}#)
- #{v\
383}#)
- #{out\ 376}#)
+ #{id\
368}#)
+ #{v\
370}#)
+ #{out\ 363}#)
(cons (#{chi\ 167}#
- #{i\ 382}#
- #{r*\ 373}#
- #{w*\ 374}#
+ #{i\ 369}#
+ #{r*\ 360}#
+ #{w*\ 361}#
#{mod\ 325}#)
- #{inits\
377}#)))))))
- #{tmp\ 379}#)
+ #{inits\
364}#)))))))
+ #{tmp\ 366}#)
(syntax-violation
#f
"source expression failed to match any
pattern"
- #{tmp\ 378}#)))
+ #{tmp\ 365}#)))
($sc-dispatch
- #{tmp\ 378}#
+ #{tmp\ 365}#
'(any any any))))
- (car #{kw\ 369}#))
- (#{expand-pred\ 331}#
- #{req\ 366}#
- #{opt\ 367}#
- #{rest\ 368}#
- (if (let ((#{t\ 387}# #{aok\ 375}#))
- (if #{t\ 387}#
- #{t\ 387}#
- (pair? #{out\ 376}#)))
- (cons #{aok\ 375}# (reverse #{out\ 376}#))
+ (car #{kw\ 357}#))
+ (#{expand-body\ 331}#
+ #{req\ 354}#
+ #{opt\ 355}#
+ #{rest\ 356}#
+ (if (let ((#{t\ 374}# #{aok\ 362}#))
+ (if #{t\ 374}#
+ #{t\ 374}#
+ (pair? #{out\ 363}#)))
+ (cons #{aok\ 362}# (reverse #{out\ 363}#))
#f)
- #{pred\ 370}#
- #{body\ 371}#
- (reverse #{vars\ 372}#)
- #{r*\ 373}#
- #{w*\ 374}#
- (reverse #{inits\ 377}#)))))
+ #{body\ 358}#
+ (reverse #{vars\ 359}#)
+ #{r*\ 360}#
+ #{w*\ 361}#
+ (reverse #{inits\ 364}#)))))
(#{expand-opt\ 329}#
- (lambda (#{req\ 388}#
- #{opt\ 389}#
- #{rest\ 390}#
- #{kw\ 391}#
- #{pred\ 392}#
- #{body\ 393}#
- #{vars\ 394}#
- #{r*\ 395}#
- #{w*\ 396}#
- #{out\ 397}#
- #{inits\ 398}#)
- (if (pair? #{opt\ 389}#)
- ((lambda (#{tmp\ 399}#)
- ((lambda (#{tmp\ 400}#)
- (if #{tmp\ 400}#
- (apply (lambda (#{id\ 401}# #{i\ 402}#)
- (let ((#{v\ 403}# (#{gen-var\
181}#
- #{id\
401}#)))
- (let ((#{l\ 404}#
(#{gen-labels\ 137}#
- (list
#{v\ 403}#))))
- (let ((#{r**\ 405}#
+ (lambda (#{req\ 375}#
+ #{opt\ 376}#
+ #{rest\ 377}#
+ #{kw\ 378}#
+ #{body\ 379}#
+ #{vars\ 380}#
+ #{r*\ 381}#
+ #{w*\ 382}#
+ #{out\ 383}#
+ #{inits\ 384}#)
+ (if (pair? #{opt\ 376}#)
+ ((lambda (#{tmp\ 385}#)
+ ((lambda (#{tmp\ 386}#)
+ (if #{tmp\ 386}#
+ (apply (lambda (#{id\ 387}# #{i\ 388}#)
+ (let ((#{v\ 389}# (#{gen-var\
181}#
+ #{id\
387}#)))
+ (let ((#{l\ 390}#
(#{gen-labels\ 137}#
+ (list
#{v\ 389}#))))
+ (let ((#{r**\ 391}#
(#{extend-var-env\
126}#
- #{l\ 404}#
- (list #{v\ 403}#)
- #{r*\ 395}#)))
- (let ((#{w**\ 406}#
+ #{l\ 390}#
+ (list #{v\ 389}#)
+ #{r*\ 381}#)))
+ (let ((#{w**\ 392}#
(#{make-binding-wrap\ 148}#
- (list #{id\
401}#)
- #{l\ 404}#
- #{w*\ 396}#)))
+ (list #{id\
387}#)
+ #{l\ 390}#
+ #{w*\ 382}#)))
(#{expand-opt\ 329}#
- #{req\ 388}#
- (cdr #{opt\ 389}#)
- #{rest\ 390}#
- #{kw\ 391}#
- #{pred\ 392}#
- #{body\ 393}#
- (cons #{v\ 403}#
- #{vars\ 394}#)
- #{r**\ 405}#
- #{w**\ 406}#
+ #{req\ 375}#
+ (cdr #{opt\ 376}#)
+ #{rest\ 377}#
+ #{kw\ 378}#
+ #{body\ 379}#
+ (cons #{v\ 389}#
+ #{vars\ 380}#)
+ #{r**\ 391}#
+ #{w**\ 392}#
(cons (syntax->datum
- #{id\ 401}#)
- #{out\ 397}#)
+ #{id\ 387}#)
+ #{out\ 383}#)
(cons (#{chi\ 167}#
- #{i\ 402}#
- #{r*\ 395}#
- #{w*\ 396}#
+ #{i\ 388}#
+ #{r*\ 381}#
+ #{w*\ 382}#
#{mod\ 325}#)
- #{inits\
398}#)))))))
- #{tmp\ 400}#)
+ #{inits\
384}#)))))))
+ #{tmp\ 386}#)
(syntax-violation
#f
"source expression failed to match any
pattern"
- #{tmp\ 399}#)))
+ #{tmp\ 385}#)))
($sc-dispatch
- #{tmp\ 399}#
+ #{tmp\ 385}#
'(any any))))
- (car #{opt\ 389}#))
- (if #{rest\ 390}#
- (let ((#{v\ 407}# (#{gen-var\ 181}#
- #{rest\ 390}#)))
- (let ((#{l\ 408}# (#{gen-labels\ 137}#
- (list #{v\ 407}#))))
- (let ((#{r*\ 409}#
+ (car #{opt\ 376}#))
+ (if #{rest\ 377}#
+ (let ((#{v\ 393}# (#{gen-var\ 181}#
+ #{rest\ 377}#)))
+ (let ((#{l\ 394}# (#{gen-labels\ 137}#
+ (list #{v\ 393}#))))
+ (let ((#{r*\ 395}#
(#{extend-var-env\ 126}#
- #{l\ 408}#
- (list #{v\ 407}#)
- #{r*\ 395}#)))
- (let ((#{w*\ 410}#
+ #{l\ 394}#
+ (list #{v\ 393}#)
+ #{r*\ 381}#)))
+ (let ((#{w*\ 396}#
(#{make-binding-wrap\ 148}#
- (list #{rest\ 390}#)
- #{l\ 408}#
- #{w*\ 396}#)))
+ (list #{rest\ 377}#)
+ #{l\ 394}#
+ #{w*\ 382}#)))
(#{expand-kw\ 330}#
- #{req\ 388}#
- (if (pair? #{out\ 397}#)
- (reverse #{out\ 397}#)
+ #{req\ 375}#
+ (if (pair? #{out\ 383}#)
+ (reverse #{out\ 383}#)
#f)
- (syntax->datum #{rest\ 390}#)
- (if (pair? #{kw\ 391}#)
- (cdr #{kw\ 391}#)
- #{kw\ 391}#)
- #{pred\ 392}#
- #{body\ 393}#
- (cons #{v\ 407}# #{vars\ 394}#)
- #{r*\ 409}#
- #{w*\ 410}#
- (if (pair? #{kw\ 391}#)
- (car #{kw\ 391}#)
+ (syntax->datum #{rest\ 377}#)
+ (if (pair? #{kw\ 378}#)
+ (cdr #{kw\ 378}#)
+ #{kw\ 378}#)
+ #{body\ 379}#
+ (cons #{v\ 393}# #{vars\ 380}#)
+ #{r*\ 395}#
+ #{w*\ 396}#
+ (if (pair? #{kw\ 378}#)
+ (car #{kw\ 378}#)
#f)
'()
- #{inits\ 398}#)))))
+ #{inits\ 384}#)))))
(#{expand-kw\ 330}#
- #{req\ 388}#
- (if (pair? #{out\ 397}#)
- (reverse #{out\ 397}#)
+ #{req\ 375}#
+ (if (pair? #{out\ 383}#)
+ (reverse #{out\ 383}#)
#f)
#f
- (if (pair? #{kw\ 391}#)
- (cdr #{kw\ 391}#)
- #{kw\ 391}#)
- #{pred\ 392}#
- #{body\ 393}#
- #{vars\ 394}#
- #{r*\ 395}#
- #{w*\ 396}#
- (if (pair? #{kw\ 391}#) (car #{kw\ 391}#) #f)
+ (if (pair? #{kw\ 378}#)
+ (cdr #{kw\ 378}#)
+ #{kw\ 378}#)
+ #{body\ 379}#
+ #{vars\ 380}#
+ #{r*\ 381}#
+ #{w*\ 382}#
+ (if (pair? #{kw\ 378}#) (car #{kw\ 378}#) #f)
'()
- #{inits\ 398}#)))))
+ #{inits\ 384}#)))))
(#{expand-req\ 328}#
- (lambda (#{req\ 411}#
- #{opt\ 412}#
- #{rest\ 413}#
- #{kw\ 414}#
- #{pred\ 415}#
- #{body\ 416}#)
- (let ((#{vars\ 417}#
- (map #{gen-var\ 181}# #{req\ 411}#))
- (#{labels\ 418}#
- (#{gen-labels\ 137}# #{req\ 411}#)))
- (let ((#{r*\ 419}#
+ (lambda (#{req\ 397}#
+ #{opt\ 398}#
+ #{rest\ 399}#
+ #{kw\ 400}#
+ #{body\ 401}#)
+ (let ((#{vars\ 402}#
+ (map #{gen-var\ 181}# #{req\ 397}#))
+ (#{labels\ 403}#
+ (#{gen-labels\ 137}# #{req\ 397}#)))
+ (let ((#{r*\ 404}#
(#{extend-var-env\ 126}#
- #{labels\ 418}#
- #{vars\ 417}#
+ #{labels\ 403}#
+ #{vars\ 402}#
#{r\ 322}#))
- (#{w*\ 420}#
+ (#{w*\ 405}#
(#{make-binding-wrap\ 148}#
- #{req\ 411}#
- #{labels\ 418}#
+ #{req\ 397}#
+ #{labels\ 403}#
#{w\ 323}#)))
(#{expand-opt\ 329}#
- (map syntax->datum #{req\ 411}#)
- #{opt\ 412}#
- #{rest\ 413}#
- #{kw\ 414}#
- #{pred\ 415}#
- #{body\ 416}#
- (reverse #{vars\ 417}#)
- #{r*\ 419}#
- #{w*\ 420}#
+ (map syntax->datum #{req\ 397}#)
+ #{opt\ 398}#
+ #{rest\ 399}#
+ #{kw\ 400}#
+ #{body\ 401}#
+ (reverse #{vars\ 402}#)
+ #{r*\ 404}#
+ #{w*\ 405}#
'()
'()))))))
- ((lambda (#{tmp\ 421}#)
- ((lambda (#{tmp\ 422}#)
- (if #{tmp\ 422}#
- (apply (lambda () (values #f #f)) #{tmp\ 422}#)
- ((lambda (#{tmp\ 423}#)
- (if #{tmp\ 423}#
- (apply (lambda (#{args\ 424}#
- #{e1\ 425}#
- #{e2\ 426}#
- #{args*\ 427}#
- #{e1*\ 428}#
- #{e2*\ 429}#)
+ ((lambda (#{tmp\ 406}#)
+ ((lambda (#{tmp\ 407}#)
+ (if #{tmp\ 407}#
+ (apply (lambda () (values #f #f)) #{tmp\ 407}#)
+ ((lambda (#{tmp\ 408}#)
+ (if #{tmp\ 408}#
+ (apply (lambda (#{args\ 409}#
+ #{e1\ 410}#
+ #{e2\ 411}#
+ #{args*\ 412}#
+ #{e1*\ 413}#
+ #{e2*\ 414}#)
(call-with-values
(lambda ()
(#{get-formals\ 326}#
- #{args\ 424}#))
- (lambda (#{req\ 430}#
- #{opt\ 431}#
- #{rest\ 432}#
- #{kw\ 433}#
- #{pred\ 434}#)
+ #{args\ 409}#))
+ (lambda (#{req\ 415}#
+ #{opt\ 416}#
+ #{rest\ 417}#
+ #{kw\ 418}#)
(call-with-values
(lambda ()
(#{expand-req\ 328}#
- #{req\ 430}#
- #{opt\ 431}#
- #{rest\ 432}#
- #{kw\ 433}#
- #{pred\ 434}#
- (cons #{e1\ 425}#
- #{e2\ 426}#)))
- (lambda (#{docstring\ 436}#
- #{req\ 437}#
- #{opt\ 438}#
- #{rest\ 439}#
- #{kw\ 440}#
- #{inits\ 441}#
- #{vars\ 442}#
- #{pred\ 443}#
- #{body\ 444}#)
+ #{req\ 415}#
+ #{opt\ 416}#
+ #{rest\ 417}#
+ #{kw\ 418}#
+ (cons #{e1\ 410}#
+ #{e2\ 411}#)))
+ (lambda (#{docstring\ 420}#
+ #{req\ 421}#
+ #{opt\ 422}#
+ #{rest\ 423}#
+ #{kw\ 424}#
+ #{inits\ 425}#
+ #{vars\ 426}#
+ #{body\ 427}#)
(call-with-values
(lambda ()
(#{chi-lambda-case\ 179}#
@@ -509,205 +466,131 @@
#{s\ 324}#
#{mod\ 325}#
#{get-formals\ 326}#
- (map (lambda (#{tmp\ 447}#
- #{tmp\ 446}#
- #{tmp\
445}#)
- (cons #{tmp\ 445}#
- (cons #{tmp\
446}#
- #{tmp\
447}#)))
- #{e2*\ 429}#
- #{e1*\ 428}#
- #{args*\ 427}#)))
- (lambda (#{docstring*\ 449}#
- #{else*\ 450}#)
+ (map (lambda (#{tmp\ 430}#
+ #{tmp\ 429}#
+ #{tmp\
428}#)
+ (cons #{tmp\ 428}#
+ (cons #{tmp\
429}#
+ #{tmp\
430}#)))
+ #{e2*\ 414}#
+ #{e1*\ 413}#
+ #{args*\ 412}#)))
+ (lambda (#{docstring*\ 432}#
+ #{else*\ 433}#)
(values
- (let ((#{t\ 451}#
#{docstring\ 436}#))
- (if #{t\ 451}#
- #{t\ 451}#
- #{docstring*\ 449}#))
+ (let ((#{t\ 434}#
#{docstring\ 420}#))
+ (if #{t\ 434}#
+ #{t\ 434}#
+ #{docstring*\ 432}#))
(#{build-lambda-case\
107}#
#{s\ 324}#
- #{req\ 437}#
- #{opt\ 438}#
- #{rest\ 439}#
- #{kw\ 440}#
- #{inits\ 441}#
- #{vars\ 442}#
- #{pred\ 443}#
- #{body\ 444}#
- #{else*\ 450}#)))))))))
- #{tmp\ 423}#)
+ #{req\ 421}#
+ #{opt\ 422}#
+ #{rest\ 423}#
+ #{kw\ 424}#
+ #{inits\ 425}#
+ #{vars\ 426}#
+ #{body\ 427}#
+ #{else*\ 433}#)))))))))
+ #{tmp\ 408}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 421}#)))
+ #{tmp\ 406}#)))
($sc-dispatch
- #{tmp\ 421}#
+ #{tmp\ 406}#
'((any any . each-any)
.
#(each (any any . each-any)))))))
- ($sc-dispatch #{tmp\ 421}# (quote ()))))
+ ($sc-dispatch #{tmp\ 406}# (quote ()))))
#{clauses\ 327}#))))
(#{lambda*-formals\ 178}#
- (lambda (#{orig-args\ 452}#)
- (letrec ((#{check\ 458}#
- (lambda (#{req\ 459}#
- #{opt\ 460}#
- #{rest\ 461}#
- #{kw\ 462}#
- #{pred\ 463}#)
+ (lambda (#{orig-args\ 435}#)
+ (letrec ((#{check\ 440}#
+ (lambda (#{req\ 441}#
+ #{opt\ 442}#
+ #{rest\ 443}#
+ #{kw\ 444}#)
(if (#{distinct-bound-ids?\ 157}#
(append
- #{req\ 459}#
- (map car #{opt\ 460}#)
- (if #{rest\ 461}#
- (list #{rest\ 461}#)
+ #{req\ 441}#
+ (map car #{opt\ 442}#)
+ (if #{rest\ 443}#
+ (list #{rest\ 443}#)
'())
- (if (pair? #{kw\ 462}#)
- (map cadr (cdr #{kw\ 462}#))
+ (if (pair? #{kw\ 444}#)
+ (map cadr (cdr #{kw\ 444}#))
'())))
(values
- #{req\ 459}#
- #{opt\ 460}#
- #{rest\ 461}#
- #{kw\ 462}#
- #{pred\ 463}#)
+ #{req\ 441}#
+ #{opt\ 442}#
+ #{rest\ 443}#
+ #{kw\ 444}#)
(syntax-violation
'lambda*
"duplicate identifier in argument list"
- #{orig-args\ 452}#))))
- (#{rest\ 457}#
- (lambda (#{args\ 464}#
- #{req\ 465}#
- #{opt\ 466}#
- #{kw\ 467}#
- #{pred\ 468}#)
- ((lambda (#{tmp\ 469}#)
- ((lambda (#{tmp\ 470}#)
- (if (if #{tmp\ 470}#
- (apply (lambda (#{r\ 471}#)
- (#{id?\ 131}# #{r\ 471}#))
- #{tmp\ 470}#)
+ #{orig-args\ 435}#))))
+ (#{rest\ 439}#
+ (lambda (#{args\ 445}#
+ #{req\ 446}#
+ #{opt\ 447}#
+ #{kw\ 448}#)
+ ((lambda (#{tmp\ 449}#)
+ ((lambda (#{tmp\ 450}#)
+ (if (if #{tmp\ 450}#
+ (apply (lambda (#{r\ 451}#)
+ (#{id?\ 131}# #{r\ 451}#))
+ #{tmp\ 450}#)
#f)
- (apply (lambda (#{r\ 472}#)
- (#{check\ 458}#
- #{req\ 465}#
- #{opt\ 466}#
- #{r\ 472}#
- #{kw\ 467}#
- #{pred\ 468}#))
- #{tmp\ 470}#)
- ((lambda (#{else\ 473}#)
+ (apply (lambda (#{r\ 452}#)
+ (#{check\ 440}#
+ #{req\ 446}#
+ #{opt\ 447}#
+ #{r\ 452}#
+ #{kw\ 448}#))
+ #{tmp\ 450}#)
+ ((lambda (#{else\ 453}#)
(syntax-violation
'lambda*
"invalid rest argument"
- #{orig-args\ 452}#
- #{args\ 464}#))
- #{tmp\ 469}#)))
- (list #{tmp\ 469}#)))
- #{args\ 464}#)))
- (#{pred\ 456}#
- (lambda (#{args\ 474}#
- #{req\ 475}#
- #{opt\ 476}#
- #{kw\ 477}#)
- ((lambda (#{tmp\ 478}#)
- ((lambda (#{tmp\ 479}#)
- (if #{tmp\ 479}#
- (apply (lambda (#{x\ 480}#)
- (#{check\ 458}#
- #{req\ 475}#
- #{opt\ 476}#
- #f
- #{kw\ 477}#
- #{x\ 480}#))
- #{tmp\ 479}#)
- ((lambda (#{tmp\ 481}#)
- (if (if #{tmp\ 481}#
- (apply (lambda (#{x\ 482}#
- #{a\ 483}#
- #{b\ 484}#)
- (eq? (syntax->datum
- #{a\ 483}#)
- #:rest))
- #{tmp\ 481}#)
- #f)
- (apply (lambda (#{x\ 485}#
- #{a\ 486}#
- #{b\ 487}#)
- (#{rest\ 457}#
- #{b\ 487}#
- #{req\ 475}#
- #{opt\ 476}#
- #{kw\ 477}#
- #f))
- #{tmp\ 481}#)
- ((lambda (#{tmp\ 488}#)
- (if (if #{tmp\ 488}#
- (apply (lambda (#{x\ 489}#
- #{b\ 490}#)
- (#{id?\ 131}#
- #{b\ 490}#))
- #{tmp\ 488}#)
- #f)
- (apply (lambda (#{x\ 491}#
- #{b\ 492}#)
- (#{rest\ 457}#
- #{b\ 492}#
- #{req\ 475}#
- #{opt\ 476}#
- #{kw\ 477}#
- #f))
- #{tmp\ 488}#)
- ((lambda (#{else\ 493}#)
- (syntax-violation
- 'lambda*
- "invalid argument list
following #:predicate"
- #{orig-args\ 452}#
- #{args\ 474}#))
- #{tmp\ 478}#)))
- ($sc-dispatch
- #{tmp\ 478}#
- '(any . any)))))
- ($sc-dispatch
- #{tmp\ 478}#
- '(any any any)))))
- ($sc-dispatch #{tmp\ 478}# (quote (any)))))
- #{args\ 474}#)))
- (#{key\ 455}#
- (lambda (#{args\ 494}#
- #{req\ 495}#
- #{opt\ 496}#
- #{rkey\ 497}#)
- ((lambda (#{tmp\ 498}#)
- ((lambda (#{tmp\ 499}#)
- (if #{tmp\ 499}#
+ #{orig-args\ 435}#
+ #{args\ 445}#))
+ #{tmp\ 449}#)))
+ (list #{tmp\ 449}#)))
+ #{args\ 445}#)))
+ (#{key\ 438}#
+ (lambda (#{args\ 454}#
+ #{req\ 455}#
+ #{opt\ 456}#
+ #{rkey\ 457}#)
+ ((lambda (#{tmp\ 458}#)
+ ((lambda (#{tmp\ 459}#)
+ (if #{tmp\ 459}#
(apply (lambda ()
- (#{check\ 458}#
- #{req\ 495}#
- #{opt\ 496}#
+ (#{check\ 440}#
+ #{req\ 455}#
+ #{opt\ 456}#
#f
(cons #f
- (reverse #{rkey\ 497}#))
- #f))
- #{tmp\ 499}#)
- ((lambda (#{tmp\ 500}#)
- (if (if #{tmp\ 500}#
- (apply (lambda (#{a\ 501}#
- #{b\ 502}#)
+ (reverse #{rkey\ 457}#))))
+ #{tmp\ 459}#)
+ ((lambda (#{tmp\ 460}#)
+ (if (if #{tmp\ 460}#
+ (apply (lambda (#{a\ 461}#
+ #{b\ 462}#)
(#{id?\ 131}#
- #{a\ 501}#))
- #{tmp\ 500}#)
+ #{a\ 461}#))
+ #{tmp\ 460}#)
#f)
- (apply (lambda (#{a\ 503}# #{b\ 504}#)
- ((lambda (#{tmp\ 505}#)
- ((lambda (#{k\ 506}#)
- (#{key\ 455}#
- #{b\ 504}#
- #{req\ 495}#
- #{opt\ 496}#
- (cons (cons #{k\
506}#
- (cons
#{a\ 503}#
+ (apply (lambda (#{a\ 463}# #{b\ 464}#)
+ ((lambda (#{tmp\ 465}#)
+ ((lambda (#{k\ 466}#)
+ (#{key\ 438}#
+ #{b\ 464}#
+ #{req\ 455}#
+ #{opt\ 456}#
+ (cons (cons #{k\
466}#
+ (cons
#{a\ 463}#
'(#(syntax-object
#f
((top)
@@ -741,7 +624,6 @@
"i"))
#(ribcage
(check rest
-
pred
key
opt
req)
@@ -749,13 +631,11 @@
(top)
(top)
(top)
-
(top)
(top))
("i"
"i"
"i"
"i"
-
"i"
"i"))
#(ribcage
#(orig-args)
@@ -1122,280 +1002,222 @@
"i")))
(hygiene
guile)))))
- #{rkey\
497}#)))
- #{tmp\ 505}#))
+ #{rkey\
457}#)))
+ #{tmp\ 465}#))
(symbol->keyword
(syntax->datum
- #{a\ 503}#))))
- #{tmp\ 500}#)
- ((lambda (#{tmp\ 507}#)
- (if (if #{tmp\ 507}#
- (apply (lambda (#{a\ 508}#
- #{init\ 509}#
- #{b\ 510}#)
+ #{a\ 463}#))))
+ #{tmp\ 460}#)
+ ((lambda (#{tmp\ 467}#)
+ (if (if #{tmp\ 467}#
+ (apply (lambda (#{a\ 468}#
+ #{init\ 469}#
+ #{b\ 470}#)
(#{id?\ 131}#
- #{a\ 508}#))
- #{tmp\ 507}#)
+ #{a\ 468}#))
+ #{tmp\ 467}#)
#f)
- (apply (lambda (#{a\ 511}#
- #{init\ 512}#
- #{b\ 513}#)
- ((lambda (#{tmp\ 514}#)
- ((lambda (#{k\ 515}#)
- (#{key\ 455}#
- #{b\ 513}#
- #{req\ 495}#
- #{opt\ 496}#
- (cons (list
#{k\ 515}#
-
#{a\ 511}#
-
#{init\ 512}#)
- #{rkey\
497}#)))
- #{tmp\ 514}#))
+ (apply (lambda (#{a\ 471}#
+ #{init\ 472}#
+ #{b\ 473}#)
+ ((lambda (#{tmp\ 474}#)
+ ((lambda (#{k\ 475}#)
+ (#{key\ 438}#
+ #{b\ 473}#
+ #{req\ 455}#
+ #{opt\ 456}#
+ (cons (list
#{k\ 475}#
+
#{a\ 471}#
+
#{init\ 472}#)
+ #{rkey\
457}#)))
+ #{tmp\ 474}#))
(symbol->keyword
(syntax->datum
- #{a\ 511}#))))
- #{tmp\ 507}#)
- ((lambda (#{tmp\ 516}#)
- (if (if #{tmp\ 516}#
- (apply (lambda (#{a\
517}#
- #{init\
518}#
- #{k\
519}#
- #{b\
520}#)
+ #{a\ 471}#))))
+ #{tmp\ 467}#)
+ ((lambda (#{tmp\ 476}#)
+ (if (if #{tmp\ 476}#
+ (apply (lambda (#{a\
477}#
+ #{init\
478}#
+ #{k\
479}#
+ #{b\
480}#)
(if (#{id?\
131}#
- #{a\
517}#)
+ #{a\
477}#)
(keyword?
(syntax->datum
- #{k\
519}#))
+ #{k\
479}#))
#f))
- #{tmp\ 516}#)
+ #{tmp\ 476}#)
#f)
- (apply (lambda (#{a\ 521}#
- #{init\
522}#
- #{k\ 523}#
- #{b\ 524}#)
- (#{key\ 455}#
- #{b\ 524}#
- #{req\ 495}#
- #{opt\ 496}#
- (cons (list #{k\
523}#
- #{a\
521}#
-
#{init\ 522}#)
- #{rkey\
497}#)))
- #{tmp\ 516}#)
- ((lambda (#{tmp\ 525}#)
- (if (if #{tmp\ 525}#
- (apply (lambda
(#{aok\ 526}#)
+ (apply (lambda (#{a\ 481}#
+ #{init\
482}#
+ #{k\ 483}#
+ #{b\ 484}#)
+ (#{key\ 438}#
+ #{b\ 484}#
+ #{req\ 455}#
+ #{opt\ 456}#
+ (cons (list #{k\
483}#
+ #{a\
481}#
+
#{init\ 482}#)
+ #{rkey\
457}#)))
+ #{tmp\ 476}#)
+ ((lambda (#{tmp\ 485}#)
+ (if (if #{tmp\ 485}#
+ (apply (lambda
(#{aok\ 486}#)
(eq?
(syntax->datum
-
#{aok\ 526}#)
+
#{aok\ 486}#)
#:allow-other-keys))
- #{tmp\
525}#)
+ #{tmp\
485}#)
#f)
- (apply (lambda (#{aok\
527}#)
- (#{check\
458}#
- #{req\ 495}#
- #{opt\ 496}#
+ (apply (lambda (#{aok\
487}#)
+ (#{check\
440}#
+ #{req\ 455}#
+ #{opt\ 456}#
#f
(cons #t
(reverse
-
#{rkey\ 497}#))
- #f))
- #{tmp\ 525}#)
- ((lambda (#{tmp\ 528}#)
- (if (if #{tmp\ 528}#
- (apply
(lambda (#{aok\ 529}#
-
#{a\ 530}#
-
#{b\ 531}#)
+
#{rkey\ 457}#))))
+ #{tmp\ 485}#)
+ ((lambda (#{tmp\ 488}#)
+ (if (if #{tmp\ 488}#
+ (apply
(lambda (#{aok\ 489}#
+
#{a\ 490}#
+
#{b\ 491}#)
(if
(eq? (syntax->datum
-
#{aok\ 529}#)
+
#{aok\ 489}#)
#:allow-other-keys)
(eq? (syntax->datum
-
#{a\ 530}#)
-
#:predicate)
+
#{a\ 490}#)
+
#:rest)
#f))
- #{tmp\
528}#)
+ #{tmp\
488}#)
#f)
- (apply (lambda
(#{aok\ 532}#
-
#{a\ 533}#
-
#{b\ 534}#)
- (#{pred\
456}#
- #{b\
534}#
- #{req\
495}#
- #{opt\
496}#
+ (apply (lambda
(#{aok\ 492}#
+
#{a\ 493}#
+
#{b\ 494}#)
+ (#{rest\
439}#
+ #{b\
494}#
+ #{req\
455}#
+ #{opt\
456}#
(cons
#t
(reverse
-
#{rkey\ 497}#))))
- #{tmp\
528}#)
- ((lambda (#{tmp\
535}#)
- (if (if #{tmp\
535}#
- (apply
(lambda (#{aok\ 536}#
-
#{a\ 537}#
-
#{b\ 538}#)
+
#{rkey\ 457}#))))
+ #{tmp\
488}#)
+ ((lambda (#{tmp\
495}#)
+ (if (if #{tmp\
495}#
+ (apply
(lambda (#{aok\ 496}#
+
#{r\ 497}#)
(if (eq? (syntax->datum
-
#{aok\ 536}#)
+
#{aok\ 496}#)
#:allow-other-keys)
-
(eq? (syntax->datum
-
#{a\ 537}#)
-
#:rest)
+
(#{id?\ 131}#
+
#{r\ 497}#)
#f))
-
#{tmp\ 535}#)
+
#{tmp\ 495}#)
#f)
- (apply
(lambda (#{aok\ 539}#
-
#{a\ 540}#
-
#{b\ 541}#)
-
(#{rest\ 457}#
-
#{b\ 541}#
-
#{req\ 495}#
-
#{opt\ 496}#
+ (apply
(lambda (#{aok\ 498}#
+
#{r\ 499}#)
+
(#{rest\ 439}#
+
#{r\ 499}#
+
#{req\ 455}#
+
#{opt\ 456}#
(cons #t
(reverse
-
#{rkey\ 497}#))
-
#f))
-
#{tmp\ 535}#)
- ((lambda
(#{tmp\ 542}#)
- (if (if
#{tmp\ 542}#
-
(apply (lambda (#{aok\ 543}#
-
#{r\ 544}#)
-
(if (eq? (syntax->datum
-
#{aok\ 543}#)
-
#:allow-other-keys)
-
(#{id?\ 131}#
-
#{r\ 544}#)
-
#f))
-
#{tmp\ 542}#)
+
#{rkey\ 457}#))))
+
#{tmp\ 495}#)
+ ((lambda
(#{tmp\ 500}#)
+ (if (if
#{tmp\ 500}#
+
(apply (lambda (#{a\ 501}#
+
#{b\ 502}#)
+
(eq? (syntax->datum
+
#{a\ 501}#)
+
#:rest))
+
#{tmp\ 500}#)
#f)
- (apply
(lambda (#{aok\ 545}#
-
#{r\ 546}#)
-
(#{rest\ 457}#
-
#{r\ 546}#
-
#{req\ 495}#
-
#{opt\ 496}#
-
(cons #t
+ (apply
(lambda (#{a\ 503}#
+
#{b\ 504}#)
+
(#{rest\ 439}#
+
#{b\ 504}#
+
#{req\ 455}#
+
#{opt\ 456}#
+
(cons #f
(reverse
-
#{rkey\ 497}#))
-
#f))
-
#{tmp\ 542}#)
-
((lambda (#{tmp\ 547}#)
- (if
(if #{tmp\ 547}#
-
(apply (lambda (#{a\ 548}#
-
#{b\ 549}#)
-
(eq? (syntax->datum
-
#{a\ 548}#)
-
#:predicate))
-
#{tmp\ 547}#)
+
#{rkey\ 457}#))))
+
#{tmp\ 500}#)
+
((lambda (#{tmp\ 505}#)
+ (if
(if #{tmp\ 505}#
+
(apply (lambda (#{r\ 506}#)
+
(#{id?\ 131}#
+
#{r\ 506}#))
+
#{tmp\ 505}#)
#f)
-
(apply (lambda (#{a\ 550}#
-
#{b\ 551}#)
-
(#{pred\ 456}#
-
#{b\ 551}#
-
#{req\ 495}#
-
#{opt\ 496}#
+
(apply (lambda (#{r\ 507}#)
+
(#{rest\ 439}#
+
#{r\ 507}#
+
#{req\ 455}#
+
#{opt\ 456}#
(cons #f
(reverse
-
#{rkey\ 497}#))))
-
#{tmp\ 547}#)
-
((lambda (#{tmp\ 552}#)
-
(if (if #{tmp\ 552}#
-
(apply (lambda (#{a\ 553}#
-
#{b\ 554}#)
-
(eq? (syntax->datum
-
#{a\ 553}#)
-
#:rest))
-
#{tmp\ 552}#)
-
#f)
-
(apply (lambda (#{a\ 555}#
-
#{b\ 556}#)
-
(#{rest\ 457}#
-
#{b\ 556}#
-
#{req\ 495}#
-
#{opt\ 496}#
-
(cons #f
-
(reverse
-
#{rkey\ 497}#))
-
#f))
-
#{tmp\ 552}#)
-
((lambda (#{tmp\ 557}#)
-
(if (if #{tmp\ 557}#
-
(apply (lambda (#{r\ 558}#)
-
(#{id?\ 131}#
-
#{r\ 558}#))
-
#{tmp\ 557}#)
-
#f)
-
(apply (lambda (#{r\ 559}#)
-
(#{rest\ 457}#
-
#{r\ 559}#
-
#{req\ 495}#
-
#{opt\ 496}#
-
(cons #f
-
(reverse
-
#{rkey\ 497}#))
-
#f))
-
#{tmp\ 557}#)
-
((lambda (#{else\ 560}#)
-
(syntax-violation
-
'lambda*
-
"invalid keyword argument list"
-
#{orig-args\ 452}#
-
#{args\ 494}#))
-
#{tmp\ 498}#)))
-
(list #{tmp\ 498}#))))
-
($sc-dispatch
-
#{tmp\ 498}#
-
'(any any)))))
-
($sc-dispatch
-
#{tmp\ 498}#
-
'(any .
-
any)))))
+
#{rkey\ 457}#))))
+
#{tmp\ 505}#)
+
((lambda (#{else\ 508}#)
+
(syntax-violation
+
'lambda*
+
"invalid keyword argument list"
+
#{orig-args\ 435}#
+
#{args\ 454}#))
+
#{tmp\ 458}#)))
+ (list
#{tmp\ 458}#))))
($sc-dispatch
- #{tmp\
498}#
- '(any .
-
any)))))
+ #{tmp\
458}#
+ '(any
any)))))
($sc-dispatch
- #{tmp\ 498}#
- '(any any
+ #{tmp\ 458}#
+ '(any .
any)))))
($sc-dispatch
- #{tmp\ 498}#
- '(any any . any)))))
+ #{tmp\ 458}#
+ '(any any any)))))
($sc-dispatch
- #{tmp\ 498}#
+ #{tmp\ 458}#
'(any)))))
($sc-dispatch
- #{tmp\ 498}#
+ #{tmp\ 458}#
'((any any any) . any)))))
($sc-dispatch
- #{tmp\ 498}#
+ #{tmp\ 458}#
'((any any) . any)))))
($sc-dispatch
- #{tmp\ 498}#
+ #{tmp\ 458}#
'(any . any)))))
- ($sc-dispatch #{tmp\ 498}# (quote ()))))
- #{args\ 494}#)))
- (#{opt\ 454}#
- (lambda (#{args\ 561}# #{req\ 562}# #{ropt\ 563}#)
- ((lambda (#{tmp\ 564}#)
- ((lambda (#{tmp\ 565}#)
- (if #{tmp\ 565}#
+ ($sc-dispatch #{tmp\ 458}# (quote ()))))
+ #{args\ 454}#)))
+ (#{opt\ 437}#
+ (lambda (#{args\ 509}# #{req\ 510}# #{ropt\ 511}#)
+ ((lambda (#{tmp\ 512}#)
+ ((lambda (#{tmp\ 513}#)
+ (if #{tmp\ 513}#
(apply (lambda ()
- (#{check\ 458}#
- #{req\ 562}#
- (reverse #{ropt\ 563}#)
+ (#{check\ 440}#
+ #{req\ 510}#
+ (reverse #{ropt\ 511}#)
#f
- '()
- #f))
- #{tmp\ 565}#)
- ((lambda (#{tmp\ 566}#)
- (if (if #{tmp\ 566}#
- (apply (lambda (#{a\ 567}#
- #{b\ 568}#)
+ '()))
+ #{tmp\ 513}#)
+ ((lambda (#{tmp\ 514}#)
+ (if (if #{tmp\ 514}#
+ (apply (lambda (#{a\ 515}#
+ #{b\ 516}#)
(#{id?\ 131}#
- #{a\ 567}#))
- #{tmp\ 566}#)
+ #{a\ 515}#))
+ #{tmp\ 514}#)
#f)
- (apply (lambda (#{a\ 569}# #{b\ 570}#)
- (#{opt\ 454}#
- #{b\ 570}#
- #{req\ 562}#
- (cons (cons #{a\ 569}#
+ (apply (lambda (#{a\ 517}# #{b\ 518}#)
+ (#{opt\ 437}#
+ #{b\ 518}#
+ #{req\ 510}#
+ (cons (cons #{a\ 517}#
'(#(syntax-object
#f
((top)
@@ -1421,7 +1243,6 @@
"i"))
#(ribcage
(check
rest
-
pred
key
opt
req)
@@ -1429,13 +1250,11 @@
(top)
(top)
(top)
- (top)
(top))
("i"
"i"
"i"
"i"
- "i"
"i"))
#(ribcage
#(orig-args)
@@ -1802,375 +1621,328 @@
"i")))
(hygiene
guile))))
- #{ropt\ 563}#)))
- #{tmp\ 566}#)
- ((lambda (#{tmp\ 571}#)
- (if (if #{tmp\ 571}#
- (apply (lambda (#{a\ 572}#
- #{init\ 573}#
- #{b\ 574}#)
+ #{ropt\ 511}#)))
+ #{tmp\ 514}#)
+ ((lambda (#{tmp\ 519}#)
+ (if (if #{tmp\ 519}#
+ (apply (lambda (#{a\ 520}#
+ #{init\ 521}#
+ #{b\ 522}#)
(#{id?\ 131}#
- #{a\ 572}#))
- #{tmp\ 571}#)
+ #{a\ 520}#))
+ #{tmp\ 519}#)
#f)
- (apply (lambda (#{a\ 575}#
- #{init\ 576}#
- #{b\ 577}#)
- (#{opt\ 454}#
- #{b\ 577}#
- #{req\ 562}#
- (cons (list #{a\ 575}#
- #{init\
576}#)
- #{ropt\ 563}#)))
- #{tmp\ 571}#)
- ((lambda (#{tmp\ 578}#)
- (if (if #{tmp\ 578}#
- (apply (lambda (#{a\
579}#
- #{b\
580}#)
+ (apply (lambda (#{a\ 523}#
+ #{init\ 524}#
+ #{b\ 525}#)
+ (#{opt\ 437}#
+ #{b\ 525}#
+ #{req\ 510}#
+ (cons (list #{a\ 523}#
+ #{init\
524}#)
+ #{ropt\ 511}#)))
+ #{tmp\ 519}#)
+ ((lambda (#{tmp\ 526}#)
+ (if (if #{tmp\ 526}#
+ (apply (lambda (#{a\
527}#
+ #{b\
528}#)
(eq?
(syntax->datum
- #{a\
579}#)
+ #{a\
527}#)
#:key))
- #{tmp\ 578}#)
+ #{tmp\ 526}#)
#f)
- (apply (lambda (#{a\ 581}#
- #{b\ 582}#)
- (#{key\ 455}#
- #{b\ 582}#
- #{req\ 562}#
+ (apply (lambda (#{a\ 529}#
+ #{b\ 530}#)
+ (#{key\ 438}#
+ #{b\ 530}#
+ #{req\ 510}#
(reverse
- #{ropt\ 563}#)
+ #{ropt\ 511}#)
'()))
- #{tmp\ 578}#)
- ((lambda (#{tmp\ 583}#)
- (if (if #{tmp\ 583}#
- (apply (lambda
(#{a\ 584}#
-
#{b\ 585}#)
+ #{tmp\ 526}#)
+ ((lambda (#{tmp\ 531}#)
+ (if (if #{tmp\ 531}#
+ (apply (lambda
(#{a\ 532}#
+
#{b\ 533}#)
(eq?
(syntax->datum
-
#{a\ 584}#)
-
#:predicate))
- #{tmp\
583}#)
+
#{a\ 532}#)
+
#:rest))
+ #{tmp\
531}#)
#f)
- (apply (lambda (#{a\
586}#
- #{b\
587}#)
- (#{pred\ 456}#
- #{b\ 587}#
- #{req\ 562}#
+ (apply (lambda (#{a\
534}#
+ #{b\
535}#)
+ (#{rest\ 439}#
+ #{b\ 535}#
+ #{req\ 510}#
(reverse
- #{ropt\
563}#)
+ #{ropt\
511}#)
'()))
- #{tmp\ 583}#)
- ((lambda (#{tmp\ 588}#)
- (if (if #{tmp\ 588}#
- (apply
(lambda (#{a\ 589}#
-
#{b\ 590}#)
- (eq?
(syntax->datum
-
#{a\ 589}#)
-
#:rest))
- #{tmp\
588}#)
+ #{tmp\ 531}#)
+ ((lambda (#{tmp\ 536}#)
+ (if (if #{tmp\ 536}#
+ (apply
(lambda (#{r\ 537}#)
+
(#{id?\ 131}#
+
#{r\ 537}#))
+ #{tmp\
536}#)
#f)
- (apply (lambda
(#{a\ 591}#
-
#{b\ 592}#)
- (#{rest\
457}#
- #{b\
592}#
- #{req\
562}#
+ (apply (lambda
(#{r\ 538}#)
+ (#{rest\
439}#
+ #{r\
538}#
+ #{req\
510}#
(reverse
-
#{ropt\ 563}#)
- '()
- #f))
- #{tmp\
588}#)
- ((lambda (#{tmp\
593}#)
- (if (if #{tmp\
593}#
- (apply
(lambda (#{r\ 594}#)
-
(#{id?\ 131}#
-
#{r\ 594}#))
-
#{tmp\ 593}#)
- #f)
- (apply
(lambda (#{r\ 595}#)
-
(#{rest\ 457}#
-
#{r\ 595}#
-
#{req\ 562}#
-
(reverse
-
#{ropt\ 563}#)
-
'()
-
#f))
-
#{tmp\ 593}#)
- ((lambda
(#{else\ 596}#)
-
(syntax-violation
- 'lambda*
-
"invalid optional argument list"
-
#{orig-args\ 452}#
- #{args\
561}#))
- #{tmp\
564}#)))
- (list #{tmp\
564}#))))
- ($sc-dispatch
- #{tmp\ 564}#
- '(any any)))))
+
#{ropt\ 511}#)
+ '()))
+ #{tmp\
536}#)
+ ((lambda (#{else\
539}#)
+
(syntax-violation
+ 'lambda*
+ "invalid
optional argument list"
+ #{orig-args\
435}#
+ #{args\
509}#))
+ #{tmp\ 512}#)))
+ (list #{tmp\ 512}#))))
($sc-dispatch
- #{tmp\ 564}#
- '(any . any)))))
+ #{tmp\ 512}#
+ '(any any)))))
($sc-dispatch
- #{tmp\ 564}#
+ #{tmp\ 512}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 564}#
+ #{tmp\ 512}#
'((any any) . any)))))
($sc-dispatch
- #{tmp\ 564}#
+ #{tmp\ 512}#
'(any . any)))))
- ($sc-dispatch #{tmp\ 564}# (quote ()))))
- #{args\ 561}#)))
- (#{req\ 453}#
- (lambda (#{args\ 597}# #{rreq\ 598}#)
- ((lambda (#{tmp\ 599}#)
- ((lambda (#{tmp\ 600}#)
- (if #{tmp\ 600}#
+ ($sc-dispatch #{tmp\ 512}# (quote ()))))
+ #{args\ 509}#)))
+ (#{req\ 436}#
+ (lambda (#{args\ 540}# #{rreq\ 541}#)
+ ((lambda (#{tmp\ 542}#)
+ ((lambda (#{tmp\ 543}#)
+ (if #{tmp\ 543}#
(apply (lambda ()
- (#{check\ 458}#
- (reverse #{rreq\ 598}#)
+ (#{check\ 440}#
+ (reverse #{rreq\ 541}#)
'()
#f
- '()
- #f))
- #{tmp\ 600}#)
- ((lambda (#{tmp\ 601}#)
- (if (if #{tmp\ 601}#
- (apply (lambda (#{a\ 602}#
- #{b\ 603}#)
+ '()))
+ #{tmp\ 543}#)
+ ((lambda (#{tmp\ 544}#)
+ (if (if #{tmp\ 544}#
+ (apply (lambda (#{a\ 545}#
+ #{b\ 546}#)
(#{id?\ 131}#
- #{a\ 602}#))
- #{tmp\ 601}#)
+ #{a\ 545}#))
+ #{tmp\ 544}#)
#f)
- (apply (lambda (#{a\ 604}# #{b\ 605}#)
- (#{req\ 453}#
- #{b\ 605}#
- (cons #{a\ 604}#
- #{rreq\ 598}#)))
- #{tmp\ 601}#)
- ((lambda (#{tmp\ 606}#)
- (if (if #{tmp\ 606}#
- (apply (lambda (#{a\ 607}#
- #{b\ 608}#)
+ (apply (lambda (#{a\ 547}# #{b\ 548}#)
+ (#{req\ 436}#
+ #{b\ 548}#
+ (cons #{a\ 547}#
+ #{rreq\ 541}#)))
+ #{tmp\ 544}#)
+ ((lambda (#{tmp\ 549}#)
+ (if (if #{tmp\ 549}#
+ (apply (lambda (#{a\ 550}#
+ #{b\ 551}#)
(eq? (syntax->datum
- #{a\ 607}#)
+ #{a\ 550}#)
#:optional))
- #{tmp\ 606}#)
+ #{tmp\ 549}#)
#f)
- (apply (lambda (#{a\ 609}#
- #{b\ 610}#)
- (#{opt\ 454}#
- #{b\ 610}#
+ (apply (lambda (#{a\ 552}#
+ #{b\ 553}#)
+ (#{opt\ 437}#
+ #{b\ 553}#
(reverse
- #{rreq\ 598}#)
+ #{rreq\ 541}#)
'()))
- #{tmp\ 606}#)
- ((lambda (#{tmp\ 611}#)
- (if (if #{tmp\ 611}#
- (apply (lambda (#{a\
612}#
- #{b\
613}#)
+ #{tmp\ 549}#)
+ ((lambda (#{tmp\ 554}#)
+ (if (if #{tmp\ 554}#
+ (apply (lambda (#{a\
555}#
+ #{b\
556}#)
(eq?
(syntax->datum
- #{a\
612}#)
+ #{a\
555}#)
#:key))
- #{tmp\ 611}#)
+ #{tmp\ 554}#)
#f)
- (apply (lambda (#{a\ 614}#
- #{b\ 615}#)
- (#{key\ 455}#
- #{b\ 615}#
+ (apply (lambda (#{a\ 557}#
+ #{b\ 558}#)
+ (#{key\ 438}#
+ #{b\ 558}#
(reverse
- #{rreq\ 598}#)
+ #{rreq\ 541}#)
'()
'()))
- #{tmp\ 611}#)
- ((lambda (#{tmp\ 616}#)
- (if (if #{tmp\ 616}#
- (apply (lambda
(#{a\ 617}#
-
#{b\ 618}#)
+ #{tmp\ 554}#)
+ ((lambda (#{tmp\ 559}#)
+ (if (if #{tmp\ 559}#
+ (apply (lambda
(#{a\ 560}#
+
#{b\ 561}#)
(eq?
(syntax->datum
-
#{a\ 617}#)
-
#:predicate))
- #{tmp\
616}#)
+
#{a\ 560}#)
+
#:rest))
+ #{tmp\
559}#)
#f)
- (apply (lambda (#{a\
619}#
- #{b\
620}#)
- (#{pred\ 456}#
- #{b\ 620}#
+ (apply (lambda (#{a\
562}#
+ #{b\
563}#)
+ (#{rest\ 439}#
+ #{b\ 563}#
(reverse
- #{rreq\
598}#)
+ #{rreq\
541}#)
'()
'()))
- #{tmp\ 616}#)
- ((lambda (#{tmp\ 621}#)
- (if (if #{tmp\ 621}#
- (apply
(lambda (#{a\ 622}#
-
#{b\ 623}#)
- (eq?
(syntax->datum
-
#{a\ 622}#)
-
#:rest))
- #{tmp\
621}#)
+ #{tmp\ 559}#)
+ ((lambda (#{tmp\ 564}#)
+ (if (if #{tmp\ 564}#
+ (apply
(lambda (#{r\ 565}#)
+
(#{id?\ 131}#
+
#{r\ 565}#))
+ #{tmp\
564}#)
#f)
- (apply (lambda
(#{a\ 624}#
-
#{b\ 625}#)
- (#{rest\
457}#
- #{b\
625}#
+ (apply (lambda
(#{r\ 566}#)
+ (#{rest\
439}#
+ #{r\
566}#
(reverse
-
#{rreq\ 598}#)
- '()
+
#{rreq\ 541}#)
'()
- #f))
- #{tmp\
621}#)
- ((lambda (#{tmp\
626}#)
- (if (if #{tmp\
626}#
- (apply
(lambda (#{r\ 627}#)
-
(#{id?\ 131}#
-
#{r\ 627}#))
-
#{tmp\ 626}#)
- #f)
- (apply
(lambda (#{r\ 628}#)
-
(#{rest\ 457}#
-
#{r\ 628}#
-
(reverse
-
#{rreq\ 598}#)
-
'()
-
'()
-
#f))
-
#{tmp\ 626}#)
- ((lambda
(#{else\ 629}#)
-
(syntax-violation
- 'lambda*
-
"invalid argument list"
-
#{orig-args\ 452}#
- #{args\
597}#))
- #{tmp\
599}#)))
- (list #{tmp\
599}#))))
- ($sc-dispatch
- #{tmp\ 599}#
- '(any any)))))
+ '()))
+ #{tmp\
564}#)
+ ((lambda (#{else\
567}#)
+
(syntax-violation
+ 'lambda*
+ "invalid
argument list"
+ #{orig-args\
435}#
+ #{args\
540}#))
+ #{tmp\ 542}#)))
+ (list #{tmp\ 542}#))))
($sc-dispatch
- #{tmp\ 599}#
- '(any . any)))))
+ #{tmp\ 542}#
+ '(any any)))))
($sc-dispatch
- #{tmp\ 599}#
+ #{tmp\ 542}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 599}#
+ #{tmp\ 542}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 599}#
+ #{tmp\ 542}#
'(any . any)))))
- ($sc-dispatch #{tmp\ 599}# (quote ()))))
- #{args\ 597}#))))
- (#{req\ 453}# #{orig-args\ 452}# (quote ())))))
+ ($sc-dispatch #{tmp\ 542}# (quote ()))))
+ #{args\ 540}#))))
+ (#{req\ 436}# #{orig-args\ 435}# (quote ())))))
(#{chi-simple-lambda\ 177}#
- (lambda (#{e\ 630}#
- #{r\ 631}#
- #{w\ 632}#
- #{s\ 633}#
- #{mod\ 634}#
- #{req\ 635}#
- #{rest\ 636}#
- #{docstring\ 637}#
- #{body\ 638}#)
- (let ((#{ids\ 639}#
- (if #{rest\ 636}#
- (append #{req\ 635}# (list #{rest\ 636}#))
- #{req\ 635}#)))
- (let ((#{vars\ 640}#
- (map #{gen-var\ 181}# #{ids\ 639}#)))
- (let ((#{labels\ 641}#
- (#{gen-labels\ 137}# #{ids\ 639}#)))
+ (lambda (#{e\ 568}#
+ #{r\ 569}#
+ #{w\ 570}#
+ #{s\ 571}#
+ #{mod\ 572}#
+ #{req\ 573}#
+ #{rest\ 574}#
+ #{docstring\ 575}#
+ #{body\ 576}#)
+ (let ((#{ids\ 577}#
+ (if #{rest\ 574}#
+ (append #{req\ 573}# (list #{rest\ 574}#))
+ #{req\ 573}#)))
+ (let ((#{vars\ 578}#
+ (map #{gen-var\ 181}# #{ids\ 577}#)))
+ (let ((#{labels\ 579}#
+ (#{gen-labels\ 137}# #{ids\ 577}#)))
(#{build-simple-lambda\ 105}#
- #{s\ 633}#
- (map syntax->datum #{req\ 635}#)
- (if #{rest\ 636}#
- (syntax->datum #{rest\ 636}#)
+ #{s\ 571}#
+ (map syntax->datum #{req\ 573}#)
+ (if #{rest\ 574}#
+ (syntax->datum #{rest\ 574}#)
#f)
- #{vars\ 640}#
- #{docstring\ 637}#
+ #{vars\ 578}#
+ #{docstring\ 575}#
(#{chi-body\ 171}#
- #{body\ 638}#
+ #{body\ 576}#
(#{source-wrap\ 160}#
- #{e\ 630}#
- #{w\ 632}#
- #{s\ 633}#
- #{mod\ 634}#)
+ #{e\ 568}#
+ #{w\ 570}#
+ #{s\ 571}#
+ #{mod\ 572}#)
(#{extend-var-env\ 126}#
- #{labels\ 641}#
- #{vars\ 640}#
- #{r\ 631}#)
+ #{labels\ 579}#
+ #{vars\ 578}#
+ #{r\ 569}#)
(#{make-binding-wrap\ 148}#
- #{ids\ 639}#
- #{labels\ 641}#
- #{w\ 632}#)
- #{mod\ 634}#)))))))
+ #{ids\ 577}#
+ #{labels\ 579}#
+ #{w\ 570}#)
+ #{mod\ 572}#)))))))
(#{lambda-formals\ 176}#
- (lambda (#{orig-args\ 642}#)
- (letrec ((#{check\ 644}#
- (lambda (#{req\ 645}# #{rest\ 646}#)
+ (lambda (#{orig-args\ 580}#)
+ (letrec ((#{check\ 582}#
+ (lambda (#{req\ 583}# #{rest\ 584}#)
(if (#{distinct-bound-ids?\ 157}#
- (if #{rest\ 646}#
- (cons #{rest\ 646}# #{req\ 645}#)
- #{req\ 645}#))
- (values #{req\ 645}# #f #{rest\ 646}# #f #f)
+ (if #{rest\ 584}#
+ (cons #{rest\ 584}# #{req\ 583}#)
+ #{req\ 583}#))
+ (values #{req\ 583}# #f #{rest\ 584}# #f)
(syntax-violation
'lambda
"duplicate identifier in argument list"
- #{orig-args\ 642}#))))
- (#{req\ 643}#
- (lambda (#{args\ 647}# #{rreq\ 648}#)
- ((lambda (#{tmp\ 649}#)
- ((lambda (#{tmp\ 650}#)
- (if #{tmp\ 650}#
+ #{orig-args\ 580}#))))
+ (#{req\ 581}#
+ (lambda (#{args\ 585}# #{rreq\ 586}#)
+ ((lambda (#{tmp\ 587}#)
+ ((lambda (#{tmp\ 588}#)
+ (if #{tmp\ 588}#
(apply (lambda ()
- (#{check\ 644}#
- (reverse #{rreq\ 648}#)
+ (#{check\ 582}#
+ (reverse #{rreq\ 586}#)
#f))
- #{tmp\ 650}#)
- ((lambda (#{tmp\ 651}#)
- (if (if #{tmp\ 651}#
- (apply (lambda (#{a\ 652}#
- #{b\ 653}#)
+ #{tmp\ 588}#)
+ ((lambda (#{tmp\ 589}#)
+ (if (if #{tmp\ 589}#
+ (apply (lambda (#{a\ 590}#
+ #{b\ 591}#)
(#{id?\ 131}#
- #{a\ 652}#))
- #{tmp\ 651}#)
+ #{a\ 590}#))
+ #{tmp\ 589}#)
#f)
- (apply (lambda (#{a\ 654}# #{b\ 655}#)
- (#{req\ 643}#
- #{b\ 655}#
- (cons #{a\ 654}#
- #{rreq\ 648}#)))
- #{tmp\ 651}#)
- ((lambda (#{tmp\ 656}#)
- (if (if #{tmp\ 656}#
- (apply (lambda (#{r\ 657}#)
+ (apply (lambda (#{a\ 592}# #{b\ 593}#)
+ (#{req\ 581}#
+ #{b\ 593}#
+ (cons #{a\ 592}#
+ #{rreq\ 586}#)))
+ #{tmp\ 589}#)
+ ((lambda (#{tmp\ 594}#)
+ (if (if #{tmp\ 594}#
+ (apply (lambda (#{r\ 595}#)
(#{id?\ 131}#
- #{r\ 657}#))
- #{tmp\ 656}#)
+ #{r\ 595}#))
+ #{tmp\ 594}#)
#f)
- (apply (lambda (#{r\ 658}#)
- (#{check\ 644}#
+ (apply (lambda (#{r\ 596}#)
+ (#{check\ 582}#
(reverse
- #{rreq\ 648}#)
- #{r\ 658}#))
- #{tmp\ 656}#)
- ((lambda (#{else\ 659}#)
+ #{rreq\ 586}#)
+ #{r\ 596}#))
+ #{tmp\ 594}#)
+ ((lambda (#{else\ 597}#)
(syntax-violation
'lambda
"invalid argument list"
- #{orig-args\ 642}#
- #{args\ 647}#))
- #{tmp\ 649}#)))
- (list #{tmp\ 649}#))))
+ #{orig-args\ 580}#
+ #{args\ 585}#))
+ #{tmp\ 587}#)))
+ (list #{tmp\ 587}#))))
($sc-dispatch
- #{tmp\ 649}#
+ #{tmp\ 587}#
'(any . any)))))
- ($sc-dispatch #{tmp\ 649}# (quote ()))))
- #{args\ 647}#))))
- (#{req\ 643}# #{orig-args\ 642}# (quote ())))))
+ ($sc-dispatch #{tmp\ 587}# (quote ()))))
+ #{args\ 585}#))))
+ (#{req\ 581}# #{orig-args\ 580}# (quote ())))))
(#{ellipsis?\ 175}#
- (lambda (#{x\ 660}#)
- (if (#{nonsymbol-id?\ 130}# #{x\ 660}#)
+ (lambda (#{x\ 598}#)
+ (if (#{nonsymbol-id?\ 130}# #{x\ 598}#)
(#{free-id=?\ 154}#
- #{x\ 660}#
+ #{x\ 598}#
'#(syntax-object
...
((top)
@@ -2538,368 +2310,368 @@
(#{chi-void\ 174}#
(lambda () (#{build-void\ 95}# #f)))
(#{eval-local-transformer\ 173}#
- (lambda (#{expanded\ 661}# #{mod\ 662}#)
- (let ((#{p\ 663}# (#{local-eval-hook\ 91}#
- #{expanded\ 661}#
- #{mod\ 662}#)))
- (if (procedure? #{p\ 663}#)
- #{p\ 663}#
+ (lambda (#{expanded\ 599}# #{mod\ 600}#)
+ (let ((#{p\ 601}# (#{local-eval-hook\ 91}#
+ #{expanded\ 599}#
+ #{mod\ 600}#)))
+ (if (procedure? #{p\ 601}#)
+ #{p\ 601}#
(syntax-violation
#f
"nonprocedure transformer"
- #{p\ 663}#)))))
+ #{p\ 601}#)))))
(#{chi-local-syntax\ 172}#
- (lambda (#{rec?\ 664}#
- #{e\ 665}#
- #{r\ 666}#
- #{w\ 667}#
- #{s\ 668}#
- #{mod\ 669}#
- #{k\ 670}#)
- ((lambda (#{tmp\ 671}#)
- ((lambda (#{tmp\ 672}#)
- (if #{tmp\ 672}#
- (apply (lambda (#{_\ 673}#
- #{id\ 674}#
- #{val\ 675}#
- #{e1\ 676}#
- #{e2\ 677}#)
- (let ((#{ids\ 678}# #{id\ 674}#))
+ (lambda (#{rec?\ 602}#
+ #{e\ 603}#
+ #{r\ 604}#
+ #{w\ 605}#
+ #{s\ 606}#
+ #{mod\ 607}#
+ #{k\ 608}#)
+ ((lambda (#{tmp\ 609}#)
+ ((lambda (#{tmp\ 610}#)
+ (if #{tmp\ 610}#
+ (apply (lambda (#{_\ 611}#
+ #{id\ 612}#
+ #{val\ 613}#
+ #{e1\ 614}#
+ #{e2\ 615}#)
+ (let ((#{ids\ 616}# #{id\ 612}#))
(if (not (#{valid-bound-ids?\ 156}#
- #{ids\ 678}#))
+ #{ids\ 616}#))
(syntax-violation
#f
"duplicate bound keyword"
- #{e\ 665}#)
- (let ((#{labels\ 680}#
+ #{e\ 603}#)
+ (let ((#{labels\ 618}#
(#{gen-labels\ 137}#
- #{ids\ 678}#)))
- (let ((#{new-w\ 681}#
+ #{ids\ 616}#)))
+ (let ((#{new-w\ 619}#
(#{make-binding-wrap\ 148}#
- #{ids\ 678}#
- #{labels\ 680}#
- #{w\ 667}#)))
- (#{k\ 670}# (cons #{e1\ 676}#
- #{e2\ 677}#)
+ #{ids\ 616}#
+ #{labels\ 618}#
+ #{w\ 605}#)))
+ (#{k\ 608}# (cons #{e1\ 614}#
+ #{e2\ 615}#)
(#{extend-env\ 125}#
- #{labels\ 680}#
- (let ((#{w\ 683}# (if
#{rec?\ 664}#
-
#{new-w\ 681}#
- #{w\
667}#))
- (#{trans-r\ 684}#
+ #{labels\ 618}#
+ (let ((#{w\ 621}# (if
#{rec?\ 602}#
+
#{new-w\ 619}#
+ #{w\
605}#))
+ (#{trans-r\ 622}#
(#{macros-only-env\ 127}#
- #{r\ 666}#)))
- (map (lambda (#{x\
685}#)
+ #{r\ 604}#)))
+ (map (lambda (#{x\
623}#)
(cons 'macro
(#{eval-local-transformer\ 173}#
(#{chi\
167}#
- #{x\
685}#
-
#{trans-r\ 684}#
- #{w\
683}#
-
#{mod\ 669}#)
- #{mod\
669}#)))
- #{val\ 675}#))
- #{r\ 666}#)
- #{new-w\ 681}#
- #{s\ 668}#
- #{mod\ 669}#))))))
- #{tmp\ 672}#)
- ((lambda (#{_\ 687}#)
+ #{x\
623}#
+
#{trans-r\ 622}#
+ #{w\
621}#
+
#{mod\ 607}#)
+ #{mod\
607}#)))
+ #{val\ 613}#))
+ #{r\ 604}#)
+ #{new-w\ 619}#
+ #{s\ 606}#
+ #{mod\ 607}#))))))
+ #{tmp\ 610}#)
+ ((lambda (#{_\ 625}#)
(syntax-violation
#f
"bad local syntax definition"
(#{source-wrap\ 160}#
- #{e\ 665}#
- #{w\ 667}#
- #{s\ 668}#
- #{mod\ 669}#)))
- #{tmp\ 671}#)))
+ #{e\ 603}#
+ #{w\ 605}#
+ #{s\ 606}#
+ #{mod\ 607}#)))
+ #{tmp\ 609}#)))
($sc-dispatch
- #{tmp\ 671}#
+ #{tmp\ 609}#
'(any #(each (any any)) any . each-any))))
- #{e\ 665}#)))
+ #{e\ 603}#)))
(#{chi-body\ 171}#
- (lambda (#{body\ 688}#
- #{outer-form\ 689}#
- #{r\ 690}#
- #{w\ 691}#
- #{mod\ 692}#)
- (let ((#{r\ 693}# (cons '("placeholder" placeholder)
- #{r\ 690}#)))
- (let ((#{ribcage\ 694}#
+ (lambda (#{body\ 626}#
+ #{outer-form\ 627}#
+ #{r\ 628}#
+ #{w\ 629}#
+ #{mod\ 630}#)
+ (let ((#{r\ 631}# (cons '("placeholder" placeholder)
+ #{r\ 628}#)))
+ (let ((#{ribcage\ 632}#
(#{make-ribcage\ 138}#
'()
'()
'())))
- (let ((#{w\ 695}# (#{make-wrap\ 133}#
- (#{wrap-marks\ 134}# #{w\ 691}#)
- (cons #{ribcage\ 694}#
+ (let ((#{w\ 633}# (#{make-wrap\ 133}#
+ (#{wrap-marks\ 134}# #{w\ 629}#)
+ (cons #{ribcage\ 632}#
(#{wrap-subst\ 135}#
- #{w\ 691}#)))))
- (letrec ((#{parse\ 696}#
- (lambda (#{body\ 697}#
- #{ids\ 698}#
- #{labels\ 699}#
- #{var-ids\ 700}#
- #{vars\ 701}#
- #{vals\ 702}#
- #{bindings\ 703}#)
- (if (null? #{body\ 697}#)
+ #{w\ 629}#)))))
+ (letrec ((#{parse\ 634}#
+ (lambda (#{body\ 635}#
+ #{ids\ 636}#
+ #{labels\ 637}#
+ #{var-ids\ 638}#
+ #{vars\ 639}#
+ #{vals\ 640}#
+ #{bindings\ 641}#)
+ (if (null? #{body\ 635}#)
(syntax-violation
#f
"no expressions in body"
- #{outer-form\ 689}#)
- (let ((#{e\ 705}# (cdar #{body\ 697}#))
- (#{er\ 706}# (caar #{body\ 697}#)))
+ #{outer-form\ 627}#)
+ (let ((#{e\ 643}# (cdar #{body\ 635}#))
+ (#{er\ 644}# (caar #{body\ 635}#)))
(call-with-values
(lambda ()
(#{syntax-type\ 165}#
- #{e\ 705}#
- #{er\ 706}#
+ #{e\ 643}#
+ #{er\ 644}#
'(())
(#{source-annotation\ 122}#
- #{er\ 706}#)
- #{ribcage\ 694}#
- #{mod\ 692}#
+ #{er\ 644}#)
+ #{ribcage\ 632}#
+ #{mod\ 630}#
#f))
- (lambda (#{type\ 707}#
- #{value\ 708}#
- #{e\ 709}#
- #{w\ 710}#
- #{s\ 711}#
- #{mod\ 712}#)
- (if (memv #{type\ 707}#
+ (lambda (#{type\ 645}#
+ #{value\ 646}#
+ #{e\ 647}#
+ #{w\ 648}#
+ #{s\ 649}#
+ #{mod\ 650}#)
+ (if (memv #{type\ 645}#
'(define-form))
- (let ((#{id\ 713}#
+ (let ((#{id\ 651}#
(#{wrap\ 159}#
- #{value\ 708}#
- #{w\ 710}#
- #{mod\ 712}#))
- (#{label\ 714}#
+ #{value\ 646}#
+ #{w\ 648}#
+ #{mod\ 650}#))
+ (#{label\ 652}#
(#{gen-label\ 136}#)))
- (let ((#{var\ 715}#
+ (let ((#{var\ 653}#
(#{gen-var\ 181}#
- #{id\ 713}#)))
+ #{id\ 651}#)))
(begin
(#{extend-ribcage!\ 147}#
- #{ribcage\ 694}#
- #{id\ 713}#
- #{label\ 714}#)
- (#{parse\ 696}#
- (cdr #{body\ 697}#)
- (cons #{id\ 713}#
- #{ids\ 698}#)
- (cons #{label\ 714}#
- #{labels\ 699}#)
- (cons #{id\ 713}#
- #{var-ids\ 700}#)
- (cons #{var\ 715}#
- #{vars\ 701}#)
- (cons (cons #{er\ 706}#
+ #{ribcage\ 632}#
+ #{id\ 651}#
+ #{label\ 652}#)
+ (#{parse\ 634}#
+ (cdr #{body\ 635}#)
+ (cons #{id\ 651}#
+ #{ids\ 636}#)
+ (cons #{label\ 652}#
+ #{labels\ 637}#)
+ (cons #{id\ 651}#
+ #{var-ids\ 638}#)
+ (cons #{var\ 653}#
+ #{vars\ 639}#)
+ (cons (cons #{er\ 644}#
(#{wrap\ 159}#
- #{e\ 709}#
- #{w\ 710}#
- #{mod\
712}#))
- #{vals\ 702}#)
+ #{e\ 647}#
+ #{w\ 648}#
+ #{mod\
650}#))
+ #{vals\ 640}#)
(cons (cons 'lexical
- #{var\ 715}#)
- #{bindings\
703}#)))))
- (if (memv #{type\ 707}#
+ #{var\ 653}#)
+ #{bindings\
641}#)))))
+ (if (memv #{type\ 645}#
'(define-syntax-form))
- (let ((#{id\ 716}#
+ (let ((#{id\ 654}#
(#{wrap\ 159}#
- #{value\ 708}#
- #{w\ 710}#
- #{mod\ 712}#))
- (#{label\ 717}#
+ #{value\ 646}#
+ #{w\ 648}#
+ #{mod\ 650}#))
+ (#{label\ 655}#
(#{gen-label\ 136}#)))
(begin
(#{extend-ribcage!\ 147}#
- #{ribcage\ 694}#
- #{id\ 716}#
- #{label\ 717}#)
- (#{parse\ 696}#
- (cdr #{body\ 697}#)
- (cons #{id\ 716}#
- #{ids\ 698}#)
- (cons #{label\ 717}#
- #{labels\ 699}#)
- #{var-ids\ 700}#
- #{vars\ 701}#
- #{vals\ 702}#
+ #{ribcage\ 632}#
+ #{id\ 654}#
+ #{label\ 655}#)
+ (#{parse\ 634}#
+ (cdr #{body\ 635}#)
+ (cons #{id\ 654}#
+ #{ids\ 636}#)
+ (cons #{label\ 655}#
+ #{labels\ 637}#)
+ #{var-ids\ 638}#
+ #{vars\ 639}#
+ #{vals\ 640}#
(cons (cons 'macro
- (cons #{er\
706}#
+ (cons #{er\
644}#
(#{wrap\
159}#
- #{e\
709}#
- #{w\
710}#
- #{mod\
712}#)))
- #{bindings\ 703}#))))
- (if (memv #{type\ 707}#
+ #{e\
647}#
+ #{w\
648}#
+ #{mod\
650}#)))
+ #{bindings\ 641}#))))
+ (if (memv #{type\ 645}#
'(begin-form))
- ((lambda (#{tmp\ 718}#)
- ((lambda (#{tmp\ 719}#)
- (if #{tmp\ 719}#
- (apply (lambda (#{_\
720}#
- #{e1\
721}#)
- (#{parse\
696}#
- (letrec
((#{f\ 722}# (lambda (#{forms\ 723}#)
-
(if (null? #{forms\ 723}#)
-
(cdr #{body\ 697}#)
-
(cons (cons #{er\ 706}#
+ ((lambda (#{tmp\ 656}#)
+ ((lambda (#{tmp\ 657}#)
+ (if #{tmp\ 657}#
+ (apply (lambda (#{_\
658}#
+ #{e1\
659}#)
+ (#{parse\
634}#
+ (letrec
((#{f\ 660}# (lambda (#{forms\ 661}#)
+
(if (null? #{forms\ 661}#)
+
(cdr #{body\ 635}#)
+
(cons (cons #{er\ 644}#
(#{wrap\ 159}#
-
(car #{forms\ 723}#)
-
#{w\ 710}#
-
#{mod\ 712}#))
-
(#{f\ 722}# (cdr #{forms\ 723}#)))))))
- (#{f\
722}# #{e1\ 721}#))
- #{ids\ 698}#
- #{labels\
699}#
- #{var-ids\
700}#
- #{vars\
701}#
- #{vals\
702}#
- #{bindings\
703}#))
- #{tmp\ 719}#)
+
(car #{forms\ 661}#)
+
#{w\ 648}#
+
#{mod\ 650}#))
+
(#{f\ 660}# (cdr #{forms\ 661}#)))))))
+ (#{f\
660}# #{e1\ 659}#))
+ #{ids\ 636}#
+ #{labels\
637}#
+ #{var-ids\
638}#
+ #{vars\
639}#
+ #{vals\
640}#
+ #{bindings\
641}#))
+ #{tmp\ 657}#)
(syntax-violation
#f
"source expression
failed to match any pattern"
- #{tmp\ 718}#)))
+ #{tmp\ 656}#)))
($sc-dispatch
- #{tmp\ 718}#
+ #{tmp\ 656}#
'(any . each-any))))
- #{e\ 709}#)
- (if (memv #{type\ 707}#
+ #{e\ 647}#)
+ (if (memv #{type\ 645}#
'(local-syntax-form))
(#{chi-local-syntax\ 172}#
- #{value\ 708}#
- #{e\ 709}#
- #{er\ 706}#
- #{w\ 710}#
- #{s\ 711}#
- #{mod\ 712}#
- (lambda (#{forms\ 725}#
- #{er\ 726}#
- #{w\ 727}#
- #{s\ 728}#
- #{mod\ 729}#)
- (#{parse\ 696}#
- (letrec ((#{f\ 730}#
(lambda (#{forms\ 731}#)
-
(if (null? #{forms\ 731}#)
-
(cdr #{body\ 697}#)
-
(cons (cons #{er\ 726}#
+ #{value\ 646}#
+ #{e\ 647}#
+ #{er\ 644}#
+ #{w\ 648}#
+ #{s\ 649}#
+ #{mod\ 650}#
+ (lambda (#{forms\ 663}#
+ #{er\ 664}#
+ #{w\ 665}#
+ #{s\ 666}#
+ #{mod\ 667}#)
+ (#{parse\ 634}#
+ (letrec ((#{f\ 668}#
(lambda (#{forms\ 669}#)
+
(if (null? #{forms\ 669}#)
+
(cdr #{body\ 635}#)
+
(cons (cons #{er\ 664}#
(#{wrap\ 159}#
-
(car #{forms\ 731}#)
-
#{w\ 727}#
-
#{mod\ 729}#))
-
(#{f\ 730}# (cdr #{forms\ 731}#)))))))
- (#{f\ 730}# #{forms\
725}#))
- #{ids\ 698}#
- #{labels\ 699}#
- #{var-ids\ 700}#
- #{vars\ 701}#
- #{vals\ 702}#
- #{bindings\ 703}#)))
- (if (null? #{ids\ 698}#)
+
(car #{forms\ 669}#)
+
#{w\ 665}#
+
#{mod\ 667}#))
+
(#{f\ 668}# (cdr #{forms\ 669}#)))))))
+ (#{f\ 668}# #{forms\
663}#))
+ #{ids\ 636}#
+ #{labels\ 637}#
+ #{var-ids\ 638}#
+ #{vars\ 639}#
+ #{vals\ 640}#
+ #{bindings\ 641}#)))
+ (if (null? #{ids\ 636}#)
(#{build-sequence\ 110}#
#f
- (map (lambda (#{x\ 732}#)
+ (map (lambda (#{x\ 670}#)
(#{chi\ 167}#
- (cdr #{x\ 732}#)
- (car #{x\ 732}#)
+ (cdr #{x\ 670}#)
+ (car #{x\ 670}#)
'(())
- #{mod\ 712}#))
- (cons (cons #{er\
706}#
+ #{mod\ 650}#))
+ (cons (cons #{er\
644}#
(#{source-wrap\ 160}#
- #{e\
709}#
- #{w\
710}#
- #{s\
711}#
-
#{mod\ 712}#))
- (cdr #{body\
697}#))))
+ #{e\
647}#
+ #{w\
648}#
+ #{s\
649}#
+
#{mod\ 650}#))
+ (cdr #{body\
635}#))))
(begin
(if (not
(#{valid-bound-ids?\ 156}#
- #{ids\ 698}#))
+ #{ids\ 636}#))
(syntax-violation
#f
"invalid or
duplicate identifier in definition"
- #{outer-form\ 689}#))
- (letrec ((#{loop\ 733}#
- (lambda
(#{bs\ 734}#
-
#{er-cache\ 735}#
-
#{r-cache\ 736}#)
- (if (not
(null? #{bs\ 734}#))
- (let
((#{b\ 737}# (car #{bs\ 734}#)))
- (if
(eq? (car #{b\ 737}#)
+ #{outer-form\ 627}#))
+ (letrec ((#{loop\ 671}#
+ (lambda
(#{bs\ 672}#
+
#{er-cache\ 673}#
+
#{r-cache\ 674}#)
+ (if (not
(null? #{bs\ 672}#))
+ (let
((#{b\ 675}# (car #{bs\ 672}#)))
+ (if
(eq? (car #{b\ 675}#)
'macro)
- (let
((#{er\ 738}#
-
(cadr #{b\ 737}#)))
-
(let ((#{r-cache\ 739}#
-
(if (eq? #{er\ 738}#
-
#{er-cache\ 735}#)
-
#{r-cache\ 736}#
+ (let
((#{er\ 676}#
+
(cadr #{b\ 675}#)))
+
(let ((#{r-cache\ 677}#
+
(if (eq? #{er\ 676}#
+
#{er-cache\ 673}#)
+
#{r-cache\ 674}#
(#{macros-only-env\ 127}#
-
#{er\ 738}#))))
+
#{er\ 676}#))))
(begin
(set-cdr!
-
#{b\ 737}#
+
#{b\ 675}#
(#{eval-local-transformer\ 173}#
(#{chi\ 167}#
-
(cddr #{b\ 737}#)
-
#{r-cache\ 739}#
+
(cddr #{b\ 675}#)
+
#{r-cache\ 677}#
'(())
-
#{mod\ 712}#)
-
#{mod\ 712}#))
-
(#{loop\ 733}#
-
(cdr #{bs\ 734}#)
-
#{er\ 738}#
-
#{r-cache\ 739}#))))
-
(#{loop\ 733}#
-
(cdr #{bs\ 734}#)
-
#{er-cache\ 735}#
-
#{r-cache\ 736}#)))))))
- (#{loop\ 733}#
- #{bindings\ 703}#
+
#{mod\ 650}#)
+
#{mod\ 650}#))
+
(#{loop\ 671}#
+
(cdr #{bs\ 672}#)
+
#{er\ 676}#
+
#{r-cache\ 677}#))))
+
(#{loop\ 671}#
+
(cdr #{bs\ 672}#)
+
#{er-cache\ 673}#
+
#{r-cache\ 674}#)))))))
+ (#{loop\ 671}#
+ #{bindings\ 641}#
#f
#f))
(set-cdr!
- #{r\ 693}#
+ #{r\ 631}#
(#{extend-env\ 125}#
- #{labels\ 699}#
- #{bindings\ 703}#
- (cdr #{r\ 693}#)))
+ #{labels\ 637}#
+ #{bindings\ 641}#
+ (cdr #{r\ 631}#)))
(#{build-letrec\ 113}#
#f
(map syntax->datum
- #{var-ids\ 700}#)
- #{vars\ 701}#
- (map (lambda (#{x\
740}#)
+ #{var-ids\ 638}#)
+ #{vars\ 639}#
+ (map (lambda (#{x\
678}#)
(#{chi\ 167}#
- (cdr #{x\
740}#)
- (car #{x\
740}#)
+ (cdr #{x\
678}#)
+ (car #{x\
678}#)
'(())
- #{mod\ 712}#))
- #{vals\ 702}#)
+ #{mod\ 650}#))
+ #{vals\ 640}#)
(#{build-sequence\
110}#
#f
- (map (lambda (#{x\
741}#)
+ (map (lambda (#{x\
679}#)
(#{chi\ 167}#
- (cdr #{x\
741}#)
- (car #{x\
741}#)
+ (cdr #{x\
679}#)
+ (car #{x\
679}#)
'(())
- #{mod\
712}#))
- (cons (cons
#{er\ 706}#
+ #{mod\
650}#))
+ (cons (cons
#{er\ 644}#
(#{source-wrap\ 160}#
-
#{e\ 709}#
-
#{w\ 710}#
-
#{s\ 711}#
-
#{mod\ 712}#))
- (cdr
#{body\ 697}#))))))))))))))))))
- (#{parse\ 696}#
- (map (lambda (#{x\ 704}#)
- (cons #{r\ 693}#
+
#{e\ 647}#
+
#{w\ 648}#
+
#{s\ 649}#
+
#{mod\ 650}#))
+ (cdr
#{body\ 635}#))))))))))))))))))
+ (#{parse\ 634}#
+ (map (lambda (#{x\ 642}#)
+ (cons #{r\ 631}#
(#{wrap\ 159}#
- #{x\ 704}#
- #{w\ 695}#
- #{mod\ 692}#)))
- #{body\ 688}#)
+ #{x\ 642}#
+ #{w\ 633}#
+ #{mod\ 630}#)))
+ #{body\ 626}#)
'()
'()
'()
@@ -2907,850 +2679,850 @@
'()
'())))))))
(#{chi-macro\ 170}#
- (lambda (#{p\ 742}#
- #{e\ 743}#
- #{r\ 744}#
- #{w\ 745}#
- #{rib\ 746}#
- #{mod\ 747}#)
- (letrec ((#{rebuild-macro-output\ 748}#
- (lambda (#{x\ 749}# #{m\ 750}#)
- (if (pair? #{x\ 749}#)
- (cons (#{rebuild-macro-output\ 748}#
- (car #{x\ 749}#)
- #{m\ 750}#)
- (#{rebuild-macro-output\ 748}#
- (cdr #{x\ 749}#)
- #{m\ 750}#))
- (if (#{syntax-object?\ 115}# #{x\ 749}#)
- (let ((#{w\ 751}# (#{syntax-object-wrap\ 117}#
- #{x\ 749}#)))
- (let ((#{ms\ 752}#
- (#{wrap-marks\ 134}# #{w\ 751}#))
- (#{s\ 753}# (#{wrap-subst\ 135}#
- #{w\ 751}#)))
- (if (if (pair? #{ms\ 752}#)
- (eq? (car #{ms\ 752}#) #f)
+ (lambda (#{p\ 680}#
+ #{e\ 681}#
+ #{r\ 682}#
+ #{w\ 683}#
+ #{rib\ 684}#
+ #{mod\ 685}#)
+ (letrec ((#{rebuild-macro-output\ 686}#
+ (lambda (#{x\ 687}# #{m\ 688}#)
+ (if (pair? #{x\ 687}#)
+ (cons (#{rebuild-macro-output\ 686}#
+ (car #{x\ 687}#)
+ #{m\ 688}#)
+ (#{rebuild-macro-output\ 686}#
+ (cdr #{x\ 687}#)
+ #{m\ 688}#))
+ (if (#{syntax-object?\ 115}# #{x\ 687}#)
+ (let ((#{w\ 689}# (#{syntax-object-wrap\ 117}#
+ #{x\ 687}#)))
+ (let ((#{ms\ 690}#
+ (#{wrap-marks\ 134}# #{w\ 689}#))
+ (#{s\ 691}# (#{wrap-subst\ 135}#
+ #{w\ 689}#)))
+ (if (if (pair? #{ms\ 690}#)
+ (eq? (car #{ms\ 690}#) #f)
#f)
(#{make-syntax-object\ 114}#
(#{syntax-object-expression\ 116}#
- #{x\ 749}#)
+ #{x\ 687}#)
(#{make-wrap\ 133}#
- (cdr #{ms\ 752}#)
- (if #{rib\ 746}#
- (cons #{rib\ 746}#
- (cdr #{s\ 753}#))
- (cdr #{s\ 753}#)))
+ (cdr #{ms\ 690}#)
+ (if #{rib\ 684}#
+ (cons #{rib\ 684}#
+ (cdr #{s\ 691}#))
+ (cdr #{s\ 691}#)))
(#{syntax-object-module\ 118}#
- #{x\ 749}#))
+ #{x\ 687}#))
(#{make-syntax-object\ 114}#
(#{syntax-object-expression\ 116}#
- #{x\ 749}#)
+ #{x\ 687}#)
(#{make-wrap\ 133}#
- (cons #{m\ 750}# #{ms\ 752}#)
- (if #{rib\ 746}#
- (cons #{rib\ 746}#
+ (cons #{m\ 688}# #{ms\ 690}#)
+ (if #{rib\ 684}#
+ (cons #{rib\ 684}#
(cons 'shift
- #{s\ 753}#))
- (cons (quote shift) #{s\ 753}#)))
- (let ((#{pmod\ 754}#
- (procedure-module #{p\ 742}#)))
- (if #{pmod\ 754}#
+ #{s\ 691}#))
+ (cons (quote shift) #{s\ 691}#)))
+ (let ((#{pmod\ 692}#
+ (procedure-module #{p\ 680}#)))
+ (if #{pmod\ 692}#
(cons 'hygiene
- (module-name #{pmod\ 754}#))
+ (module-name #{pmod\ 692}#))
'(hygiene guile)))))))
- (if (vector? #{x\ 749}#)
- (let ((#{n\ 755}# (vector-length
- #{x\ 749}#)))
- (let ((#{v\ 756}# (make-vector
- #{n\ 755}#)))
- (letrec ((#{loop\ 757}#
- (lambda (#{i\ 758}#)
+ (if (vector? #{x\ 687}#)
+ (let ((#{n\ 693}# (vector-length
+ #{x\ 687}#)))
+ (let ((#{v\ 694}# (make-vector
+ #{n\ 693}#)))
+ (letrec ((#{loop\ 695}#
+ (lambda (#{i\ 696}#)
(if (#{fx=\ 88}#
- #{i\ 758}#
- #{n\ 755}#)
+ #{i\ 696}#
+ #{n\ 693}#)
(begin
(if #f #f)
- #{v\ 756}#)
+ #{v\ 694}#)
(begin
(vector-set!
- #{v\ 756}#
- #{i\ 758}#
-
(#{rebuild-macro-output\ 748}#
+ #{v\ 694}#
+ #{i\ 696}#
+
(#{rebuild-macro-output\ 686}#
(vector-ref
- #{x\ 749}#
- #{i\ 758}#)
- #{m\ 750}#))
- (#{loop\ 757}#
+ #{x\ 687}#
+ #{i\ 696}#)
+ #{m\ 688}#))
+ (#{loop\ 695}#
(#{fx+\ 86}#
- #{i\ 758}#
+ #{i\ 696}#
1)))))))
- (#{loop\ 757}# 0))))
- (if (symbol? #{x\ 749}#)
+ (#{loop\ 695}# 0))))
+ (if (symbol? #{x\ 687}#)
(syntax-violation
#f
"encountered raw symbol in macro output"
(#{source-wrap\ 160}#
- #{e\ 743}#
- #{w\ 745}#
- (#{wrap-subst\ 135}# #{w\ 745}#)
- #{mod\ 747}#)
- #{x\ 749}#)
- #{x\ 749}#)))))))
- (#{rebuild-macro-output\ 748}#
- (#{p\ 742}# (#{wrap\ 159}#
- #{e\ 743}#
- (#{anti-mark\ 146}# #{w\ 745}#)
- #{mod\ 747}#))
+ #{e\ 681}#
+ #{w\ 683}#
+ (#{wrap-subst\ 135}# #{w\ 683}#)
+ #{mod\ 685}#)
+ #{x\ 687}#)
+ #{x\ 687}#)))))))
+ (#{rebuild-macro-output\ 686}#
+ (#{p\ 680}# (#{wrap\ 159}#
+ #{e\ 681}#
+ (#{anti-mark\ 146}# #{w\ 683}#)
+ #{mod\ 685}#))
(string #\m)))))
(#{chi-application\ 169}#
- (lambda (#{x\ 759}#
- #{e\ 760}#
- #{r\ 761}#
- #{w\ 762}#
- #{s\ 763}#
- #{mod\ 764}#)
- ((lambda (#{tmp\ 765}#)
- ((lambda (#{tmp\ 766}#)
- (if #{tmp\ 766}#
- (apply (lambda (#{e0\ 767}# #{e1\ 768}#)
+ (lambda (#{x\ 697}#
+ #{e\ 698}#
+ #{r\ 699}#
+ #{w\ 700}#
+ #{s\ 701}#
+ #{mod\ 702}#)
+ ((lambda (#{tmp\ 703}#)
+ ((lambda (#{tmp\ 704}#)
+ (if #{tmp\ 704}#
+ (apply (lambda (#{e0\ 705}# #{e1\ 706}#)
(#{build-application\ 96}#
- #{s\ 763}#
- #{x\ 759}#
- (map (lambda (#{e\ 769}#)
+ #{s\ 701}#
+ #{x\ 697}#
+ (map (lambda (#{e\ 707}#)
(#{chi\ 167}#
- #{e\ 769}#
- #{r\ 761}#
- #{w\ 762}#
- #{mod\ 764}#))
- #{e1\ 768}#)))
- #{tmp\ 766}#)
+ #{e\ 707}#
+ #{r\ 699}#
+ #{w\ 700}#
+ #{mod\ 702}#))
+ #{e1\ 706}#)))
+ #{tmp\ 704}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 765}#)))
+ #{tmp\ 703}#)))
($sc-dispatch
- #{tmp\ 765}#
+ #{tmp\ 703}#
'(any . each-any))))
- #{e\ 760}#)))
+ #{e\ 698}#)))
(#{chi-expr\ 168}#
- (lambda (#{type\ 771}#
- #{value\ 772}#
- #{e\ 773}#
- #{r\ 774}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#)
- (if (memv #{type\ 771}# (quote (lexical)))
+ (lambda (#{type\ 709}#
+ #{value\ 710}#
+ #{e\ 711}#
+ #{r\ 712}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#)
+ (if (memv #{type\ 709}# (quote (lexical)))
(#{build-lexical-reference\ 98}#
'value
- #{s\ 776}#
- #{e\ 773}#
- #{value\ 772}#)
- (if (memv #{type\ 771}# (quote (core core-form)))
- (#{value\ 772}#
- #{e\ 773}#
- #{r\ 774}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#)
- (if (memv #{type\ 771}# (quote (module-ref)))
+ #{s\ 714}#
+ #{e\ 711}#
+ #{value\ 710}#)
+ (if (memv #{type\ 709}# (quote (core core-form)))
+ (#{value\ 710}#
+ #{e\ 711}#
+ #{r\ 712}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#)
+ (if (memv #{type\ 709}# (quote (module-ref)))
(call-with-values
- (lambda () (#{value\ 772}# #{e\ 773}#))
- (lambda (#{id\ 778}# #{mod\ 779}#)
+ (lambda () (#{value\ 710}# #{e\ 711}#))
+ (lambda (#{id\ 716}# #{mod\ 717}#)
(#{build-global-reference\ 101}#
- #{s\ 776}#
- #{id\ 778}#
- #{mod\ 779}#)))
- (if (memv #{type\ 771}# (quote (lexical-call)))
+ #{s\ 714}#
+ #{id\ 716}#
+ #{mod\ 717}#)))
+ (if (memv #{type\ 709}# (quote (lexical-call)))
(#{chi-application\ 169}#
(#{build-lexical-reference\ 98}#
'fun
- (#{source-annotation\ 122}# (car #{e\ 773}#))
- (car #{e\ 773}#)
- #{value\ 772}#)
- #{e\ 773}#
- #{r\ 774}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#)
- (if (memv #{type\ 771}# (quote (global-call)))
+ (#{source-annotation\ 122}# (car #{e\ 711}#))
+ (car #{e\ 711}#)
+ #{value\ 710}#)
+ #{e\ 711}#
+ #{r\ 712}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#)
+ (if (memv #{type\ 709}# (quote (global-call)))
(#{chi-application\ 169}#
(#{build-global-reference\ 101}#
- (#{source-annotation\ 122}# (car #{e\ 773}#))
- (if (#{syntax-object?\ 115}# #{value\ 772}#)
+ (#{source-annotation\ 122}# (car #{e\ 711}#))
+ (if (#{syntax-object?\ 115}# #{value\ 710}#)
(#{syntax-object-expression\ 116}#
- #{value\ 772}#)
- #{value\ 772}#)
- (if (#{syntax-object?\ 115}# #{value\ 772}#)
- (#{syntax-object-module\ 118}# #{value\ 772}#)
- #{mod\ 777}#))
- #{e\ 773}#
- #{r\ 774}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#)
- (if (memv #{type\ 771}# (quote (constant)))
+ #{value\ 710}#)
+ #{value\ 710}#)
+ (if (#{syntax-object?\ 115}# #{value\ 710}#)
+ (#{syntax-object-module\ 118}# #{value\ 710}#)
+ #{mod\ 715}#))
+ #{e\ 711}#
+ #{r\ 712}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#)
+ (if (memv #{type\ 709}# (quote (constant)))
(#{build-data\ 109}#
- #{s\ 776}#
+ #{s\ 714}#
(#{strip\ 180}#
(#{source-wrap\ 160}#
- #{e\ 773}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#)
+ #{e\ 711}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#)
'(())))
- (if (memv #{type\ 771}# (quote (global)))
+ (if (memv #{type\ 709}# (quote (global)))
(#{build-global-reference\ 101}#
- #{s\ 776}#
- #{value\ 772}#
- #{mod\ 777}#)
- (if (memv #{type\ 771}# (quote (call)))
+ #{s\ 714}#
+ #{value\ 710}#
+ #{mod\ 715}#)
+ (if (memv #{type\ 709}# (quote (call)))
(#{chi-application\ 169}#
(#{chi\ 167}#
- (car #{e\ 773}#)
- #{r\ 774}#
- #{w\ 775}#
- #{mod\ 777}#)
- #{e\ 773}#
- #{r\ 774}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#)
- (if (memv #{type\ 771}# (quote (begin-form)))
- ((lambda (#{tmp\ 780}#)
- ((lambda (#{tmp\ 781}#)
- (if #{tmp\ 781}#
- (apply (lambda (#{_\ 782}#
- #{e1\ 783}#
- #{e2\ 784}#)
+ (car #{e\ 711}#)
+ #{r\ 712}#
+ #{w\ 713}#
+ #{mod\ 715}#)
+ #{e\ 711}#
+ #{r\ 712}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#)
+ (if (memv #{type\ 709}# (quote (begin-form)))
+ ((lambda (#{tmp\ 718}#)
+ ((lambda (#{tmp\ 719}#)
+ (if #{tmp\ 719}#
+ (apply (lambda (#{_\ 720}#
+ #{e1\ 721}#
+ #{e2\ 722}#)
(#{chi-sequence\ 161}#
- (cons #{e1\ 783}#
- #{e2\ 784}#)
- #{r\ 774}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#))
- #{tmp\ 781}#)
+ (cons #{e1\ 721}#
+ #{e2\ 722}#)
+ #{r\ 712}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#))
+ #{tmp\ 719}#)
(syntax-violation
#f
"source expression failed to match
any pattern"
- #{tmp\ 780}#)))
+ #{tmp\ 718}#)))
($sc-dispatch
- #{tmp\ 780}#
+ #{tmp\ 718}#
'(any any . each-any))))
- #{e\ 773}#)
- (if (memv #{type\ 771}#
+ #{e\ 711}#)
+ (if (memv #{type\ 709}#
'(local-syntax-form))
(#{chi-local-syntax\ 172}#
- #{value\ 772}#
- #{e\ 773}#
- #{r\ 774}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#
+ #{value\ 710}#
+ #{e\ 711}#
+ #{r\ 712}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#
#{chi-sequence\ 161}#)
- (if (memv #{type\ 771}#
+ (if (memv #{type\ 709}#
'(eval-when-form))
- ((lambda (#{tmp\ 786}#)
- ((lambda (#{tmp\ 787}#)
- (if #{tmp\ 787}#
- (apply (lambda (#{_\ 788}#
- #{x\ 789}#
- #{e1\ 790}#
- #{e2\ 791}#)
- (let ((#{when-list\ 792}#
+ ((lambda (#{tmp\ 724}#)
+ ((lambda (#{tmp\ 725}#)
+ (if #{tmp\ 725}#
+ (apply (lambda (#{_\ 726}#
+ #{x\ 727}#
+ #{e1\ 728}#
+ #{e2\ 729}#)
+ (let ((#{when-list\ 730}#
(#{chi-when-list\ 164}#
- #{e\ 773}#
- #{x\ 789}#
- #{w\ 775}#)))
+ #{e\ 711}#
+ #{x\ 727}#
+ #{w\ 713}#)))
(if (memq 'eval
- #{when-list\
792}#)
+ #{when-list\
730}#)
(#{chi-sequence\
161}#
- (cons #{e1\ 790}#
- #{e2\ 791}#)
- #{r\ 774}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#)
+ (cons #{e1\ 728}#
+ #{e2\ 729}#)
+ #{r\ 712}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#)
(#{chi-void\
174}#))))
- #{tmp\ 787}#)
+ #{tmp\ 725}#)
(syntax-violation
#f
"source expression failed to
match any pattern"
- #{tmp\ 786}#)))
+ #{tmp\ 724}#)))
($sc-dispatch
- #{tmp\ 786}#
+ #{tmp\ 724}#
'(any each-any any . each-any))))
- #{e\ 773}#)
- (if (memv #{type\ 771}#
+ #{e\ 711}#)
+ (if (memv #{type\ 709}#
'(define-form
define-syntax-form))
(syntax-violation
#f
"definition in expression context"
- #{e\ 773}#
+ #{e\ 711}#
(#{wrap\ 159}#
- #{value\ 772}#
- #{w\ 775}#
- #{mod\ 777}#))
- (if (memv #{type\ 771}#
+ #{value\ 710}#
+ #{w\ 713}#
+ #{mod\ 715}#))
+ (if (memv #{type\ 709}#
'(syntax))
(syntax-violation
#f
"reference to pattern variable
outside syntax form"
(#{source-wrap\ 160}#
- #{e\ 773}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#))
- (if (memv #{type\ 771}#
+ #{e\ 711}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#))
+ (if (memv #{type\ 709}#
'(displaced-lexical))
(syntax-violation
#f
"reference to identifier outside
its scope"
(#{source-wrap\ 160}#
- #{e\ 773}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#))
+ #{e\ 711}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#))
(syntax-violation
#f
"unexpected syntax"
(#{source-wrap\ 160}#
- #{e\ 773}#
- #{w\ 775}#
- #{s\ 776}#
- #{mod\ 777}#))))))))))))))))))
+ #{e\ 711}#
+ #{w\ 713}#
+ #{s\ 714}#
+ #{mod\ 715}#))))))))))))))))))
(#{chi\ 167}#
- (lambda (#{e\ 795}# #{r\ 796}# #{w\ 797}# #{mod\ 798}#)
+ (lambda (#{e\ 733}# #{r\ 734}# #{w\ 735}# #{mod\ 736}#)
(call-with-values
(lambda ()
(#{syntax-type\ 165}#
- #{e\ 795}#
- #{r\ 796}#
- #{w\ 797}#
- (#{source-annotation\ 122}# #{e\ 795}#)
+ #{e\ 733}#
+ #{r\ 734}#
+ #{w\ 735}#
+ (#{source-annotation\ 122}# #{e\ 733}#)
#f
- #{mod\ 798}#
+ #{mod\ 736}#
#f))
- (lambda (#{type\ 799}#
- #{value\ 800}#
- #{e\ 801}#
- #{w\ 802}#
- #{s\ 803}#
- #{mod\ 804}#)
+ (lambda (#{type\ 737}#
+ #{value\ 738}#
+ #{e\ 739}#
+ #{w\ 740}#
+ #{s\ 741}#
+ #{mod\ 742}#)
(#{chi-expr\ 168}#
- #{type\ 799}#
- #{value\ 800}#
- #{e\ 801}#
- #{r\ 796}#
- #{w\ 802}#
- #{s\ 803}#
- #{mod\ 804}#)))))
+ #{type\ 737}#
+ #{value\ 738}#
+ #{e\ 739}#
+ #{r\ 734}#
+ #{w\ 740}#
+ #{s\ 741}#
+ #{mod\ 742}#)))))
(#{chi-top\ 166}#
- (lambda (#{e\ 805}#
- #{r\ 806}#
- #{w\ 807}#
- #{m\ 808}#
- #{esew\ 809}#
- #{mod\ 810}#)
+ (lambda (#{e\ 743}#
+ #{r\ 744}#
+ #{w\ 745}#
+ #{m\ 746}#
+ #{esew\ 747}#
+ #{mod\ 748}#)
(call-with-values
(lambda ()
(#{syntax-type\ 165}#
- #{e\ 805}#
- #{r\ 806}#
- #{w\ 807}#
- (#{source-annotation\ 122}# #{e\ 805}#)
+ #{e\ 743}#
+ #{r\ 744}#
+ #{w\ 745}#
+ (#{source-annotation\ 122}# #{e\ 743}#)
#f
- #{mod\ 810}#
+ #{mod\ 748}#
#f))
- (lambda (#{type\ 818}#
- #{value\ 819}#
- #{e\ 820}#
- #{w\ 821}#
- #{s\ 822}#
- #{mod\ 823}#)
- (if (memv #{type\ 818}# (quote (begin-form)))
- ((lambda (#{tmp\ 824}#)
- ((lambda (#{tmp\ 825}#)
- (if #{tmp\ 825}#
- (apply (lambda (#{_\ 826}#) (#{chi-void\ 174}#))
- #{tmp\ 825}#)
- ((lambda (#{tmp\ 827}#)
- (if #{tmp\ 827}#
- (apply (lambda (#{_\ 828}#
- #{e1\ 829}#
- #{e2\ 830}#)
+ (lambda (#{type\ 756}#
+ #{value\ 757}#
+ #{e\ 758}#
+ #{w\ 759}#
+ #{s\ 760}#
+ #{mod\ 761}#)
+ (if (memv #{type\ 756}# (quote (begin-form)))
+ ((lambda (#{tmp\ 762}#)
+ ((lambda (#{tmp\ 763}#)
+ (if #{tmp\ 763}#
+ (apply (lambda (#{_\ 764}#) (#{chi-void\ 174}#))
+ #{tmp\ 763}#)
+ ((lambda (#{tmp\ 765}#)
+ (if #{tmp\ 765}#
+ (apply (lambda (#{_\ 766}#
+ #{e1\ 767}#
+ #{e2\ 768}#)
(#{chi-top-sequence\ 162}#
- (cons #{e1\ 829}# #{e2\ 830}#)
- #{r\ 806}#
- #{w\ 821}#
- #{s\ 822}#
- #{m\ 808}#
- #{esew\ 809}#
- #{mod\ 823}#))
- #{tmp\ 827}#)
+ (cons #{e1\ 767}# #{e2\ 768}#)
+ #{r\ 744}#
+ #{w\ 759}#
+ #{s\ 760}#
+ #{m\ 746}#
+ #{esew\ 747}#
+ #{mod\ 761}#))
+ #{tmp\ 765}#)
(syntax-violation
#f
"source expression failed to match any
pattern"
- #{tmp\ 824}#)))
+ #{tmp\ 762}#)))
($sc-dispatch
- #{tmp\ 824}#
+ #{tmp\ 762}#
'(any any . each-any)))))
- ($sc-dispatch #{tmp\ 824}# (quote (any)))))
- #{e\ 820}#)
- (if (memv #{type\ 818}# (quote (local-syntax-form)))
+ ($sc-dispatch #{tmp\ 762}# (quote (any)))))
+ #{e\ 758}#)
+ (if (memv #{type\ 756}# (quote (local-syntax-form)))
(#{chi-local-syntax\ 172}#
- #{value\ 819}#
- #{e\ 820}#
- #{r\ 806}#
- #{w\ 821}#
- #{s\ 822}#
- #{mod\ 823}#
- (lambda (#{body\ 832}#
- #{r\ 833}#
- #{w\ 834}#
- #{s\ 835}#
- #{mod\ 836}#)
+ #{value\ 757}#
+ #{e\ 758}#
+ #{r\ 744}#
+ #{w\ 759}#
+ #{s\ 760}#
+ #{mod\ 761}#
+ (lambda (#{body\ 770}#
+ #{r\ 771}#
+ #{w\ 772}#
+ #{s\ 773}#
+ #{mod\ 774}#)
(#{chi-top-sequence\ 162}#
- #{body\ 832}#
- #{r\ 833}#
- #{w\ 834}#
- #{s\ 835}#
- #{m\ 808}#
- #{esew\ 809}#
- #{mod\ 836}#)))
- (if (memv #{type\ 818}# (quote (eval-when-form)))
- ((lambda (#{tmp\ 837}#)
- ((lambda (#{tmp\ 838}#)
- (if #{tmp\ 838}#
- (apply (lambda (#{_\ 839}#
- #{x\ 840}#
- #{e1\ 841}#
- #{e2\ 842}#)
- (let ((#{when-list\ 843}#
+ #{body\ 770}#
+ #{r\ 771}#
+ #{w\ 772}#
+ #{s\ 773}#
+ #{m\ 746}#
+ #{esew\ 747}#
+ #{mod\ 774}#)))
+ (if (memv #{type\ 756}# (quote (eval-when-form)))
+ ((lambda (#{tmp\ 775}#)
+ ((lambda (#{tmp\ 776}#)
+ (if #{tmp\ 776}#
+ (apply (lambda (#{_\ 777}#
+ #{x\ 778}#
+ #{e1\ 779}#
+ #{e2\ 780}#)
+ (let ((#{when-list\ 781}#
(#{chi-when-list\ 164}#
- #{e\ 820}#
- #{x\ 840}#
- #{w\ 821}#))
- (#{body\ 844}#
- (cons #{e1\ 841}#
- #{e2\ 842}#)))
- (if (eq? #{m\ 808}# (quote e))
+ #{e\ 758}#
+ #{x\ 778}#
+ #{w\ 759}#))
+ (#{body\ 782}#
+ (cons #{e1\ 779}#
+ #{e2\ 780}#)))
+ (if (eq? #{m\ 746}# (quote e))
(if (memq 'eval
- #{when-list\ 843}#)
+ #{when-list\ 781}#)
(#{chi-top-sequence\ 162}#
- #{body\ 844}#
- #{r\ 806}#
- #{w\ 821}#
- #{s\ 822}#
+ #{body\ 782}#
+ #{r\ 744}#
+ #{w\ 759}#
+ #{s\ 760}#
'e
'(eval)
- #{mod\ 823}#)
+ #{mod\ 761}#)
(#{chi-void\ 174}#))
(if (memq 'load
- #{when-list\ 843}#)
- (if (let ((#{t\ 847}# (memq
'compile
-
#{when-list\ 843}#)))
- (if #{t\ 847}#
- #{t\ 847}#
- (if (eq? #{m\ 808}#
+ #{when-list\ 781}#)
+ (if (let ((#{t\ 785}# (memq
'compile
+
#{when-list\ 781}#)))
+ (if #{t\ 785}#
+ #{t\ 785}#
+ (if (eq? #{m\ 746}#
'c&e)
(memq 'eval
- #{when-list\
843}#)
+ #{when-list\
781}#)
#f)))
(#{chi-top-sequence\ 162}#
- #{body\ 844}#
- #{r\ 806}#
- #{w\ 821}#
- #{s\ 822}#
+ #{body\ 782}#
+ #{r\ 744}#
+ #{w\ 759}#
+ #{s\ 760}#
'c&e
'(compile load)
- #{mod\ 823}#)
- (if (memq #{m\ 808}#
+ #{mod\ 761}#)
+ (if (memq #{m\ 746}#
'(c c&e))
(#{chi-top-sequence\ 162}#
- #{body\ 844}#
- #{r\ 806}#
- #{w\ 821}#
- #{s\ 822}#
+ #{body\ 782}#
+ #{r\ 744}#
+ #{w\ 759}#
+ #{s\ 760}#
'c
'(load)
- #{mod\ 823}#)
+ #{mod\ 761}#)
(#{chi-void\ 174}#)))
- (if (let ((#{t\ 848}# (memq
'compile
-
#{when-list\ 843}#)))
- (if #{t\ 848}#
- #{t\ 848}#
- (if (eq? #{m\ 808}#
+ (if (let ((#{t\ 786}# (memq
'compile
+
#{when-list\ 781}#)))
+ (if #{t\ 786}#
+ #{t\ 786}#
+ (if (eq? #{m\ 746}#
'c&e)
(memq 'eval
- #{when-list\
843}#)
+ #{when-list\
781}#)
#f)))
(begin
(#{top-level-eval-hook\
90}#
(#{chi-top-sequence\
162}#
- #{body\ 844}#
- #{r\ 806}#
- #{w\ 821}#
- #{s\ 822}#
+ #{body\ 782}#
+ #{r\ 744}#
+ #{w\ 759}#
+ #{s\ 760}#
'e
'(eval)
- #{mod\ 823}#)
- #{mod\ 823}#)
+ #{mod\ 761}#)
+ #{mod\ 761}#)
(#{chi-void\ 174}#))
(#{chi-void\ 174}#))))))
- #{tmp\ 838}#)
+ #{tmp\ 776}#)
(syntax-violation
#f
"source expression failed to match any
pattern"
- #{tmp\ 837}#)))
+ #{tmp\ 775}#)))
($sc-dispatch
- #{tmp\ 837}#
+ #{tmp\ 775}#
'(any each-any any . each-any))))
- #{e\ 820}#)
- (if (memv #{type\ 818}# (quote (define-syntax-form)))
- (let ((#{n\ 849}# (#{id-var-name\ 153}#
- #{value\ 819}#
- #{w\ 821}#))
- (#{r\ 850}# (#{macros-only-env\ 127}#
- #{r\ 806}#)))
- (if (memv #{m\ 808}# (quote (c)))
- (if (memq (quote compile) #{esew\ 809}#)
- (let ((#{e\ 851}# (#{chi-install-global\ 163}#
- #{n\ 849}#
+ #{e\ 758}#)
+ (if (memv #{type\ 756}# (quote (define-syntax-form)))
+ (let ((#{n\ 787}# (#{id-var-name\ 153}#
+ #{value\ 757}#
+ #{w\ 759}#))
+ (#{r\ 788}# (#{macros-only-env\ 127}#
+ #{r\ 744}#)))
+ (if (memv #{m\ 746}# (quote (c)))
+ (if (memq (quote compile) #{esew\ 747}#)
+ (let ((#{e\ 789}# (#{chi-install-global\ 163}#
+ #{n\ 787}#
(#{chi\ 167}#
- #{e\ 820}#
- #{r\ 850}#
- #{w\ 821}#
- #{mod\ 823}#))))
+ #{e\ 758}#
+ #{r\ 788}#
+ #{w\ 759}#
+ #{mod\ 761}#))))
(begin
(#{top-level-eval-hook\ 90}#
- #{e\ 851}#
- #{mod\ 823}#)
- (if (memq (quote load) #{esew\ 809}#)
- #{e\ 851}#
+ #{e\ 789}#
+ #{mod\ 761}#)
+ (if (memq (quote load) #{esew\ 747}#)
+ #{e\ 789}#
(#{chi-void\ 174}#))))
- (if (memq (quote load) #{esew\ 809}#)
+ (if (memq (quote load) #{esew\ 747}#)
(#{chi-install-global\ 163}#
- #{n\ 849}#
+ #{n\ 787}#
(#{chi\ 167}#
- #{e\ 820}#
- #{r\ 850}#
- #{w\ 821}#
- #{mod\ 823}#))
+ #{e\ 758}#
+ #{r\ 788}#
+ #{w\ 759}#
+ #{mod\ 761}#))
(#{chi-void\ 174}#)))
- (if (memv #{m\ 808}# (quote (c&e)))
- (let ((#{e\ 852}# (#{chi-install-global\ 163}#
- #{n\ 849}#
+ (if (memv #{m\ 746}# (quote (c&e)))
+ (let ((#{e\ 790}# (#{chi-install-global\ 163}#
+ #{n\ 787}#
(#{chi\ 167}#
- #{e\ 820}#
- #{r\ 850}#
- #{w\ 821}#
- #{mod\ 823}#))))
+ #{e\ 758}#
+ #{r\ 788}#
+ #{w\ 759}#
+ #{mod\ 761}#))))
(begin
(#{top-level-eval-hook\ 90}#
- #{e\ 852}#
- #{mod\ 823}#)
- #{e\ 852}#))
+ #{e\ 790}#
+ #{mod\ 761}#)
+ #{e\ 790}#))
(begin
- (if (memq (quote eval) #{esew\ 809}#)
+ (if (memq (quote eval) #{esew\ 747}#)
(#{top-level-eval-hook\ 90}#
(#{chi-install-global\ 163}#
- #{n\ 849}#
+ #{n\ 787}#
(#{chi\ 167}#
- #{e\ 820}#
- #{r\ 850}#
- #{w\ 821}#
- #{mod\ 823}#))
- #{mod\ 823}#))
+ #{e\ 758}#
+ #{r\ 788}#
+ #{w\ 759}#
+ #{mod\ 761}#))
+ #{mod\ 761}#))
(#{chi-void\ 174}#)))))
- (if (memv #{type\ 818}# (quote (define-form)))
- (let ((#{n\ 853}# (#{id-var-name\ 153}#
- #{value\ 819}#
- #{w\ 821}#)))
- (let ((#{type\ 854}#
+ (if (memv #{type\ 756}# (quote (define-form)))
+ (let ((#{n\ 791}# (#{id-var-name\ 153}#
+ #{value\ 757}#
+ #{w\ 759}#)))
+ (let ((#{type\ 792}#
(#{binding-type\ 123}#
(#{lookup\ 128}#
- #{n\ 853}#
- #{r\ 806}#
- #{mod\ 823}#))))
- (if (memv #{type\ 854}#
+ #{n\ 791}#
+ #{r\ 744}#
+ #{mod\ 761}#))))
+ (if (memv #{type\ 792}#
'(global core macro module-ref))
(begin
(if (if (not (module-local-variable
(current-module)
- #{n\ 853}#))
+ #{n\ 791}#))
(current-module)
#f)
- (let ((#{old\ 855}#
+ (let ((#{old\ 793}#
(module-variable
(current-module)
- #{n\ 853}#)))
+ #{n\ 791}#)))
(module-define!
(current-module)
- #{n\ 853}#
- (if (variable? #{old\ 855}#)
- (variable-ref #{old\ 855}#)
+ #{n\ 791}#
+ (if (variable? #{old\ 793}#)
+ (variable-ref #{old\ 793}#)
#f))))
- (let ((#{x\ 856}#
(#{build-global-definition\ 104}#
- #{s\ 822}#
- #{n\ 853}#
+ (let ((#{x\ 794}#
(#{build-global-definition\ 104}#
+ #{s\ 760}#
+ #{n\ 791}#
(#{chi\ 167}#
- #{e\ 820}#
- #{r\ 806}#
- #{w\ 821}#
- #{mod\ 823}#))))
+ #{e\ 758}#
+ #{r\ 744}#
+ #{w\ 759}#
+ #{mod\ 761}#))))
(begin
- (if (eq? #{m\ 808}# (quote c&e))
+ (if (eq? #{m\ 746}# (quote c&e))
(#{top-level-eval-hook\ 90}#
- #{x\ 856}#
- #{mod\ 823}#))
- #{x\ 856}#)))
- (if (memv #{type\ 854}#
+ #{x\ 794}#
+ #{mod\ 761}#))
+ #{x\ 794}#)))
+ (if (memv #{type\ 792}#
'(displaced-lexical))
(syntax-violation
#f
"identifier out of context"
- #{e\ 820}#
+ #{e\ 758}#
(#{wrap\ 159}#
- #{value\ 819}#
- #{w\ 821}#
- #{mod\ 823}#))
+ #{value\ 757}#
+ #{w\ 759}#
+ #{mod\ 761}#))
(syntax-violation
#f
"cannot define keyword at top level"
- #{e\ 820}#
+ #{e\ 758}#
(#{wrap\ 159}#
- #{value\ 819}#
- #{w\ 821}#
- #{mod\ 823}#))))))
- (let ((#{x\ 857}# (#{chi-expr\ 168}#
- #{type\ 818}#
- #{value\ 819}#
- #{e\ 820}#
- #{r\ 806}#
- #{w\ 821}#
- #{s\ 822}#
- #{mod\ 823}#)))
+ #{value\ 757}#
+ #{w\ 759}#
+ #{mod\ 761}#))))))
+ (let ((#{x\ 795}# (#{chi-expr\ 168}#
+ #{type\ 756}#
+ #{value\ 757}#
+ #{e\ 758}#
+ #{r\ 744}#
+ #{w\ 759}#
+ #{s\ 760}#
+ #{mod\ 761}#)))
(begin
- (if (eq? #{m\ 808}# (quote c&e))
+ (if (eq? #{m\ 746}# (quote c&e))
(#{top-level-eval-hook\ 90}#
- #{x\ 857}#
- #{mod\ 823}#))
- #{x\ 857}#)))))))))))
+ #{x\ 795}#
+ #{mod\ 761}#))
+ #{x\ 795}#)))))))))))
(#{syntax-type\ 165}#
- (lambda (#{e\ 858}#
- #{r\ 859}#
- #{w\ 860}#
- #{s\ 861}#
- #{rib\ 862}#
- #{mod\ 863}#
- #{for-car?\ 864}#)
- (if (symbol? #{e\ 858}#)
- (let ((#{n\ 865}# (#{id-var-name\ 153}#
- #{e\ 858}#
- #{w\ 860}#)))
- (let ((#{b\ 866}# (#{lookup\ 128}#
- #{n\ 865}#
- #{r\ 859}#
- #{mod\ 863}#)))
- (let ((#{type\ 867}#
- (#{binding-type\ 123}# #{b\ 866}#)))
- (if (memv #{type\ 867}# (quote (lexical)))
+ (lambda (#{e\ 796}#
+ #{r\ 797}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{rib\ 800}#
+ #{mod\ 801}#
+ #{for-car?\ 802}#)
+ (if (symbol? #{e\ 796}#)
+ (let ((#{n\ 803}# (#{id-var-name\ 153}#
+ #{e\ 796}#
+ #{w\ 798}#)))
+ (let ((#{b\ 804}# (#{lookup\ 128}#
+ #{n\ 803}#
+ #{r\ 797}#
+ #{mod\ 801}#)))
+ (let ((#{type\ 805}#
+ (#{binding-type\ 123}# #{b\ 804}#)))
+ (if (memv #{type\ 805}# (quote (lexical)))
(values
- #{type\ 867}#
- (#{binding-value\ 124}# #{b\ 866}#)
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
- (if (memv #{type\ 867}# (quote (global)))
+ #{type\ 805}#
+ (#{binding-value\ 124}# #{b\ 804}#)
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
+ (if (memv #{type\ 805}# (quote (global)))
(values
- #{type\ 867}#
- #{n\ 865}#
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
- (if (memv #{type\ 867}# (quote (macro)))
- (if #{for-car?\ 864}#
+ #{type\ 805}#
+ #{n\ 803}#
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
+ (if (memv #{type\ 805}# (quote (macro)))
+ (if #{for-car?\ 802}#
(values
- #{type\ 867}#
- (#{binding-value\ 124}# #{b\ 866}#)
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
+ #{type\ 805}#
+ (#{binding-value\ 124}# #{b\ 804}#)
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
(#{syntax-type\ 165}#
(#{chi-macro\ 170}#
- (#{binding-value\ 124}# #{b\ 866}#)
- #{e\ 858}#
- #{r\ 859}#
- #{w\ 860}#
- #{rib\ 862}#
- #{mod\ 863}#)
- #{r\ 859}#
+ (#{binding-value\ 124}# #{b\ 804}#)
+ #{e\ 796}#
+ #{r\ 797}#
+ #{w\ 798}#
+ #{rib\ 800}#
+ #{mod\ 801}#)
+ #{r\ 797}#
'(())
- #{s\ 861}#
- #{rib\ 862}#
- #{mod\ 863}#
+ #{s\ 799}#
+ #{rib\ 800}#
+ #{mod\ 801}#
#f))
(values
- #{type\ 867}#
- (#{binding-value\ 124}# #{b\ 866}#)
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)))))))
- (if (pair? #{e\ 858}#)
- (let ((#{first\ 868}# (car #{e\ 858}#)))
+ #{type\ 805}#
+ (#{binding-value\ 124}# #{b\ 804}#)
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)))))))
+ (if (pair? #{e\ 796}#)
+ (let ((#{first\ 806}# (car #{e\ 796}#)))
(call-with-values
(lambda ()
(#{syntax-type\ 165}#
- #{first\ 868}#
- #{r\ 859}#
- #{w\ 860}#
- #{s\ 861}#
- #{rib\ 862}#
- #{mod\ 863}#
+ #{first\ 806}#
+ #{r\ 797}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{rib\ 800}#
+ #{mod\ 801}#
#t))
- (lambda (#{ftype\ 869}#
- #{fval\ 870}#
- #{fe\ 871}#
- #{fw\ 872}#
- #{fs\ 873}#
- #{fmod\ 874}#)
- (if (memv #{ftype\ 869}# (quote (lexical)))
+ (lambda (#{ftype\ 807}#
+ #{fval\ 808}#
+ #{fe\ 809}#
+ #{fw\ 810}#
+ #{fs\ 811}#
+ #{fmod\ 812}#)
+ (if (memv #{ftype\ 807}# (quote (lexical)))
(values
'lexical-call
- #{fval\ 870}#
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
- (if (memv #{ftype\ 869}# (quote (global)))
+ #{fval\ 808}#
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
+ (if (memv #{ftype\ 807}# (quote (global)))
(values
'global-call
(#{make-syntax-object\ 114}#
- #{fval\ 870}#
- #{w\ 860}#
- #{fmod\ 874}#)
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
- (if (memv #{ftype\ 869}# (quote (macro)))
+ #{fval\ 808}#
+ #{w\ 798}#
+ #{fmod\ 812}#)
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
+ (if (memv #{ftype\ 807}# (quote (macro)))
(#{syntax-type\ 165}#
(#{chi-macro\ 170}#
- #{fval\ 870}#
- #{e\ 858}#
- #{r\ 859}#
- #{w\ 860}#
- #{rib\ 862}#
- #{mod\ 863}#)
- #{r\ 859}#
+ #{fval\ 808}#
+ #{e\ 796}#
+ #{r\ 797}#
+ #{w\ 798}#
+ #{rib\ 800}#
+ #{mod\ 801}#)
+ #{r\ 797}#
'(())
- #{s\ 861}#
- #{rib\ 862}#
- #{mod\ 863}#
- #{for-car?\ 864}#)
- (if (memv #{ftype\ 869}# (quote (module-ref)))
+ #{s\ 799}#
+ #{rib\ 800}#
+ #{mod\ 801}#
+ #{for-car?\ 802}#)
+ (if (memv #{ftype\ 807}# (quote (module-ref)))
(call-with-values
- (lambda () (#{fval\ 870}# #{e\ 858}#))
- (lambda (#{sym\ 875}# #{mod\ 876}#)
+ (lambda () (#{fval\ 808}# #{e\ 796}#))
+ (lambda (#{sym\ 813}# #{mod\ 814}#)
(#{syntax-type\ 165}#
- #{sym\ 875}#
- #{r\ 859}#
- #{w\ 860}#
- #{s\ 861}#
- #{rib\ 862}#
- #{mod\ 876}#
- #{for-car?\ 864}#)))
- (if (memv #{ftype\ 869}# (quote (core)))
+ #{sym\ 813}#
+ #{r\ 797}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{rib\ 800}#
+ #{mod\ 814}#
+ #{for-car?\ 802}#)))
+ (if (memv #{ftype\ 807}# (quote (core)))
(values
'core-form
- #{fval\ 870}#
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
- (if (memv #{ftype\ 869}#
+ #{fval\ 808}#
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
+ (if (memv #{ftype\ 807}#
'(local-syntax))
(values
'local-syntax-form
- #{fval\ 870}#
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
- (if (memv #{ftype\ 869}# (quote (begin)))
+ #{fval\ 808}#
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
+ (if (memv #{ftype\ 807}# (quote (begin)))
(values
'begin-form
#f
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
- (if (memv #{ftype\ 869}#
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
+ (if (memv #{ftype\ 807}#
'(eval-when))
(values
'eval-when-form
#f
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
- (if (memv #{ftype\ 869}#
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
+ (if (memv #{ftype\ 807}#
'(define))
- ((lambda (#{tmp\ 877}#)
- ((lambda (#{tmp\ 878}#)
- (if (if #{tmp\ 878}#
- (apply (lambda (#{_\
879}#
- #{name\
880}#
- #{val\
881}#)
+ ((lambda (#{tmp\ 815}#)
+ ((lambda (#{tmp\ 816}#)
+ (if (if #{tmp\ 816}#
+ (apply (lambda (#{_\
817}#
+ #{name\
818}#
+ #{val\
819}#)
(#{id?\ 131}#
- #{name\
880}#))
- #{tmp\ 878}#)
+ #{name\
818}#))
+ #{tmp\ 816}#)
#f)
- (apply (lambda (#{_\ 882}#
- #{name\
883}#
- #{val\
884}#)
+ (apply (lambda (#{_\ 820}#
+ #{name\
821}#
+ #{val\
822}#)
(values
'define-form
- #{name\ 883}#
- #{val\ 884}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#))
- #{tmp\ 878}#)
- ((lambda (#{tmp\ 885}#)
- (if (if #{tmp\ 885}#
- (apply (lambda
(#{_\ 886}#
-
#{name\ 887}#
-
#{args\ 888}#
-
#{e1\ 889}#
-
#{e2\ 890}#)
+ #{name\ 821}#
+ #{val\ 822}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#))
+ #{tmp\ 816}#)
+ ((lambda (#{tmp\ 823}#)
+ (if (if #{tmp\ 823}#
+ (apply (lambda
(#{_\ 824}#
+
#{name\ 825}#
+
#{args\ 826}#
+
#{e1\ 827}#
+
#{e2\ 828}#)
(if
(#{id?\ 131}#
-
#{name\ 887}#)
+
#{name\ 825}#)
(#{valid-bound-ids?\ 156}#
(#{lambda-var-list\ 182}#
-
#{args\ 888}#))
+
#{args\ 826}#))
#f))
- #{tmp\
885}#)
+ #{tmp\
823}#)
#f)
- (apply (lambda (#{_\
891}#
-
#{name\ 892}#
-
#{args\ 893}#
- #{e1\
894}#
- #{e2\
895}#)
+ (apply (lambda (#{_\
829}#
+
#{name\ 830}#
+
#{args\ 831}#
+ #{e1\
832}#
+ #{e2\
833}#)
(values
'define-form
(#{wrap\
159}#
- #{name\
892}#
- #{w\ 860}#
- #{mod\
863}#)
+ #{name\
830}#
+ #{w\ 798}#
+ #{mod\
801}#)
(#{decorate-source\ 94}#
(cons
'#(syntax-object
lambda
@@ -4202,32 +3974,32 @@
(hygiene
guile))
(#{wrap\ 159}#
-
(cons #{args\ 893}#
-
(cons #{e1\ 894}#
-
#{e2\ 895}#))
-
#{w\ 860}#
-
#{mod\ 863}#))
- #{s\
861}#)
+
(cons #{args\ 831}#
+
(cons #{e1\ 832}#
+
#{e2\ 833}#))
+
#{w\ 798}#
+
#{mod\ 801}#))
+ #{s\
799}#)
'(())
- #{s\ 861}#
- #{mod\
863}#))
- #{tmp\ 885}#)
- ((lambda (#{tmp\ 897}#)
- (if (if #{tmp\ 897}#
- (apply
(lambda (#{_\ 898}#
-
#{name\ 899}#)
+ #{s\ 799}#
+ #{mod\
801}#))
+ #{tmp\ 823}#)
+ ((lambda (#{tmp\ 835}#)
+ (if (if #{tmp\ 835}#
+ (apply
(lambda (#{_\ 836}#
+
#{name\ 837}#)
(#{id?\ 131}#
-
#{name\ 899}#))
- #{tmp\
897}#)
+
#{name\ 837}#))
+ #{tmp\
835}#)
#f)
- (apply (lambda
(#{_\ 900}#
-
#{name\ 901}#)
+ (apply (lambda
(#{_\ 838}#
+
#{name\ 839}#)
(values
'define-form
(#{wrap\ 159}#
-
#{name\ 901}#
- #{w\
860}#
-
#{mod\ 863}#)
+
#{name\ 839}#
+ #{w\
798}#
+
#{mod\ 801}#)
'(#(syntax-object
if
((top)
@@ -5549,102 +5321,102 @@
(hygiene
guile)))
'(())
- #{s\
861}#
- #{mod\
863}#))
- #{tmp\
897}#)
+ #{s\
799}#
+ #{mod\
801}#))
+ #{tmp\
835}#)
(syntax-violation
#f
"source
expression failed to match any pattern"
- #{tmp\ 877}#)))
+ #{tmp\ 815}#)))
($sc-dispatch
- #{tmp\ 877}#
+ #{tmp\ 815}#
'(any any)))))
($sc-dispatch
- #{tmp\ 877}#
+ #{tmp\ 815}#
'(any (any . any)
any
.
each-any)))))
($sc-dispatch
- #{tmp\ 877}#
+ #{tmp\ 815}#
'(any any any))))
- #{e\ 858}#)
- (if (memv #{ftype\ 869}#
+ #{e\ 796}#)
+ (if (memv #{ftype\ 807}#
'(define-syntax))
- ((lambda (#{tmp\ 902}#)
- ((lambda (#{tmp\ 903}#)
- (if (if #{tmp\ 903}#
- (apply (lambda (#{_\
904}#
-
#{name\ 905}#
-
#{val\ 906}#)
+ ((lambda (#{tmp\ 840}#)
+ ((lambda (#{tmp\ 841}#)
+ (if (if #{tmp\ 841}#
+ (apply (lambda (#{_\
842}#
+
#{name\ 843}#
+
#{val\ 844}#)
(#{id?\ 131}#
- #{name\
905}#))
- #{tmp\ 903}#)
+ #{name\
843}#))
+ #{tmp\ 841}#)
#f)
- (apply (lambda (#{_\ 907}#
- #{name\
908}#
- #{val\
909}#)
+ (apply (lambda (#{_\ 845}#
+ #{name\
846}#
+ #{val\
847}#)
(values
'define-syntax-form
- #{name\ 908}#
- #{val\ 909}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#))
- #{tmp\ 903}#)
+ #{name\ 846}#
+ #{val\ 847}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#))
+ #{tmp\ 841}#)
(syntax-violation
#f
"source expression
failed to match any pattern"
- #{tmp\ 902}#)))
+ #{tmp\ 840}#)))
($sc-dispatch
- #{tmp\ 902}#
+ #{tmp\ 840}#
'(any any any))))
- #{e\ 858}#)
+ #{e\ 796}#)
(values
'call
#f
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#))))))))))))))
- (if (#{syntax-object?\ 115}# #{e\ 858}#)
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#))))))))))))))
+ (if (#{syntax-object?\ 115}# #{e\ 796}#)
(#{syntax-type\ 165}#
- (#{syntax-object-expression\ 116}# #{e\ 858}#)
- #{r\ 859}#
+ (#{syntax-object-expression\ 116}# #{e\ 796}#)
+ #{r\ 797}#
(#{join-wraps\ 150}#
- #{w\ 860}#
- (#{syntax-object-wrap\ 117}# #{e\ 858}#))
- #{s\ 861}#
- #{rib\ 862}#
- (let ((#{t\ 910}# (#{syntax-object-module\ 118}#
- #{e\ 858}#)))
- (if #{t\ 910}# #{t\ 910}# #{mod\ 863}#))
- #{for-car?\ 864}#)
- (if (self-evaluating? #{e\ 858}#)
+ #{w\ 798}#
+ (#{syntax-object-wrap\ 117}# #{e\ 796}#))
+ #{s\ 799}#
+ #{rib\ 800}#
+ (let ((#{t\ 848}# (#{syntax-object-module\ 118}#
+ #{e\ 796}#)))
+ (if #{t\ 848}# #{t\ 848}# #{mod\ 801}#))
+ #{for-car?\ 802}#)
+ (if (self-evaluating? #{e\ 796}#)
(values
'constant
#f
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)
(values
'other
#f
- #{e\ 858}#
- #{w\ 860}#
- #{s\ 861}#
- #{mod\ 863}#)))))))
+ #{e\ 796}#
+ #{w\ 798}#
+ #{s\ 799}#
+ #{mod\ 801}#)))))))
(#{chi-when-list\ 164}#
- (lambda (#{e\ 911}# #{when-list\ 912}# #{w\ 913}#)
- (letrec ((#{f\ 914}# (lambda (#{when-list\ 915}#
- #{situations\ 916}#)
- (if (null? #{when-list\ 915}#)
- #{situations\ 916}#
- (#{f\ 914}# (cdr #{when-list\ 915}#)
- (cons (let ((#{x\ 917}#
(car #{when-list\ 915}#)))
+ (lambda (#{e\ 849}# #{when-list\ 850}# #{w\ 851}#)
+ (letrec ((#{f\ 852}# (lambda (#{when-list\ 853}#
+ #{situations\ 854}#)
+ (if (null? #{when-list\ 853}#)
+ #{situations\ 854}#
+ (#{f\ 852}# (cdr #{when-list\ 853}#)
+ (cons (let ((#{x\ 855}#
(car #{when-list\ 853}#)))
(if (#{free-id=?\
154}#
- #{x\ 917}#
+ #{x\ 855}#
'#(syntax-object
compile
((top)
@@ -6055,7 +5827,7 @@
guile)))
'compile
(if
(#{free-id=?\ 154}#
- #{x\ 917}#
+ #{x\ 855}#
'#(syntax-object
load
((top)
@@ -6466,7 +6238,7 @@
guile)))
'load
(if
(#{free-id=?\ 154}#
- #{x\
917}#
+ #{x\
855}#
'#(syntax-object
eval
((top)
@@ -6879,25 +6651,25 @@
(syntax-violation
'eval-when
"invalid
situation"
- #{e\ 911}#
+ #{e\ 849}#
(#{wrap\
159}#
- #{x\
917}#
- #{w\
913}#
+ #{x\
855}#
+ #{w\
851}#
#f))))))
- #{situations\
916}#))))))
- (#{f\ 914}# #{when-list\ 912}# (quote ())))))
+ #{situations\
854}#))))))
+ (#{f\ 852}# #{when-list\ 850}# (quote ())))))
(#{chi-install-global\ 163}#
- (lambda (#{name\ 918}# #{e\ 919}#)
+ (lambda (#{name\ 856}# #{e\ 857}#)
(#{build-global-definition\ 104}#
#f
- #{name\ 918}#
- (if (let ((#{v\ 920}# (module-variable
+ #{name\ 856}#
+ (if (let ((#{v\ 858}# (module-variable
(current-module)
- #{name\ 918}#)))
- (if #{v\ 920}#
- (if (variable-bound? #{v\ 920}#)
- (if (macro? (variable-ref #{v\ 920}#))
- (not (eq? (macro-type (variable-ref #{v\ 920}#))
+ #{name\ 856}#)))
+ (if #{v\ 858}#
+ (if (variable-bound? #{v\ 858}#)
+ (if (macro? (variable-ref #{v\ 858}#))
+ (not (eq? (macro-type (variable-ref #{v\ 858}#))
'syncase-macro))
#f)
#f)
@@ -6916,1187 +6688,1176 @@
#f
'current-module)
'())
- (#{build-data\ 109}# #f #{name\ 918}#)))
+ (#{build-data\ 109}# #f #{name\ 856}#)))
(#{build-data\ 109}# #f (quote macro))
- #{e\ 919}#))
+ #{e\ 857}#))
(#{build-application\ 96}#
#f
(#{build-primref\ 108}#
#f
'make-syncase-macro)
(list (#{build-data\ 109}# #f (quote macro))
- #{e\ 919}#))))))
+ #{e\ 857}#))))))
(#{chi-top-sequence\ 162}#
- (lambda (#{body\ 921}#
- #{r\ 922}#
- #{w\ 923}#
- #{s\ 924}#
- #{m\ 925}#
- #{esew\ 926}#
- #{mod\ 927}#)
+ (lambda (#{body\ 859}#
+ #{r\ 860}#
+ #{w\ 861}#
+ #{s\ 862}#
+ #{m\ 863}#
+ #{esew\ 864}#
+ #{mod\ 865}#)
(#{build-sequence\ 110}#
- #{s\ 924}#
- (letrec ((#{dobody\ 928}#
- (lambda (#{body\ 929}#
- #{r\ 930}#
- #{w\ 931}#
- #{m\ 932}#
- #{esew\ 933}#
- #{mod\ 934}#)
- (if (null? #{body\ 929}#)
+ #{s\ 862}#
+ (letrec ((#{dobody\ 866}#
+ (lambda (#{body\ 867}#
+ #{r\ 868}#
+ #{w\ 869}#
+ #{m\ 870}#
+ #{esew\ 871}#
+ #{mod\ 872}#)
+ (if (null? #{body\ 867}#)
'()
- (let ((#{first\ 935}#
+ (let ((#{first\ 873}#
(#{chi-top\ 166}#
- (car #{body\ 929}#)
- #{r\ 930}#
- #{w\ 931}#
- #{m\ 932}#
- #{esew\ 933}#
- #{mod\ 934}#)))
- (cons #{first\ 935}#
- (#{dobody\ 928}#
- (cdr #{body\ 929}#)
- #{r\ 930}#
- #{w\ 931}#
- #{m\ 932}#
- #{esew\ 933}#
- #{mod\ 934}#)))))))
- (#{dobody\ 928}#
- #{body\ 921}#
- #{r\ 922}#
- #{w\ 923}#
- #{m\ 925}#
- #{esew\ 926}#
- #{mod\ 927}#)))))
+ (car #{body\ 867}#)
+ #{r\ 868}#
+ #{w\ 869}#
+ #{m\ 870}#
+ #{esew\ 871}#
+ #{mod\ 872}#)))
+ (cons #{first\ 873}#
+ (#{dobody\ 866}#
+ (cdr #{body\ 867}#)
+ #{r\ 868}#
+ #{w\ 869}#
+ #{m\ 870}#
+ #{esew\ 871}#
+ #{mod\ 872}#)))))))
+ (#{dobody\ 866}#
+ #{body\ 859}#
+ #{r\ 860}#
+ #{w\ 861}#
+ #{m\ 863}#
+ #{esew\ 864}#
+ #{mod\ 865}#)))))
(#{chi-sequence\ 161}#
- (lambda (#{body\ 936}#
- #{r\ 937}#
- #{w\ 938}#
- #{s\ 939}#
- #{mod\ 940}#)
+ (lambda (#{body\ 874}#
+ #{r\ 875}#
+ #{w\ 876}#
+ #{s\ 877}#
+ #{mod\ 878}#)
(#{build-sequence\ 110}#
- #{s\ 939}#
- (letrec ((#{dobody\ 941}#
- (lambda (#{body\ 942}#
- #{r\ 943}#
- #{w\ 944}#
- #{mod\ 945}#)
- (if (null? #{body\ 942}#)
+ #{s\ 877}#
+ (letrec ((#{dobody\ 879}#
+ (lambda (#{body\ 880}#
+ #{r\ 881}#
+ #{w\ 882}#
+ #{mod\ 883}#)
+ (if (null? #{body\ 880}#)
'()
- (let ((#{first\ 946}#
+ (let ((#{first\ 884}#
(#{chi\ 167}#
- (car #{body\ 942}#)
- #{r\ 943}#
- #{w\ 944}#
- #{mod\ 945}#)))
- (cons #{first\ 946}#
- (#{dobody\ 941}#
- (cdr #{body\ 942}#)
- #{r\ 943}#
- #{w\ 944}#
- #{mod\ 945}#)))))))
- (#{dobody\ 941}#
- #{body\ 936}#
- #{r\ 937}#
- #{w\ 938}#
- #{mod\ 940}#)))))
+ (car #{body\ 880}#)
+ #{r\ 881}#
+ #{w\ 882}#
+ #{mod\ 883}#)))
+ (cons #{first\ 884}#
+ (#{dobody\ 879}#
+ (cdr #{body\ 880}#)
+ #{r\ 881}#
+ #{w\ 882}#
+ #{mod\ 883}#)))))))
+ (#{dobody\ 879}#
+ #{body\ 874}#
+ #{r\ 875}#
+ #{w\ 876}#
+ #{mod\ 878}#)))))
(#{source-wrap\ 160}#
- (lambda (#{x\ 947}#
- #{w\ 948}#
- #{s\ 949}#
- #{defmod\ 950}#)
+ (lambda (#{x\ 885}#
+ #{w\ 886}#
+ #{s\ 887}#
+ #{defmod\ 888}#)
(#{wrap\ 159}#
- (#{decorate-source\ 94}# #{x\ 947}# #{s\ 949}#)
- #{w\ 948}#
- #{defmod\ 950}#)))
+ (#{decorate-source\ 94}# #{x\ 885}# #{s\ 887}#)
+ #{w\ 886}#
+ #{defmod\ 888}#)))
(#{wrap\ 159}#
- (lambda (#{x\ 951}# #{w\ 952}# #{defmod\ 953}#)
- (if (if (null? (#{wrap-marks\ 134}# #{w\ 952}#))
- (null? (#{wrap-subst\ 135}# #{w\ 952}#))
+ (lambda (#{x\ 889}# #{w\ 890}# #{defmod\ 891}#)
+ (if (if (null? (#{wrap-marks\ 134}# #{w\ 890}#))
+ (null? (#{wrap-subst\ 135}# #{w\ 890}#))
#f)
- #{x\ 951}#
- (if (#{syntax-object?\ 115}# #{x\ 951}#)
+ #{x\ 889}#
+ (if (#{syntax-object?\ 115}# #{x\ 889}#)
(#{make-syntax-object\ 114}#
- (#{syntax-object-expression\ 116}# #{x\ 951}#)
+ (#{syntax-object-expression\ 116}# #{x\ 889}#)
(#{join-wraps\ 150}#
- #{w\ 952}#
- (#{syntax-object-wrap\ 117}# #{x\ 951}#))
- (#{syntax-object-module\ 118}# #{x\ 951}#))
- (if (null? #{x\ 951}#)
- #{x\ 951}#
+ #{w\ 890}#
+ (#{syntax-object-wrap\ 117}# #{x\ 889}#))
+ (#{syntax-object-module\ 118}# #{x\ 889}#))
+ (if (null? #{x\ 889}#)
+ #{x\ 889}#
(#{make-syntax-object\ 114}#
- #{x\ 951}#
- #{w\ 952}#
- #{defmod\ 953}#))))))
+ #{x\ 889}#
+ #{w\ 890}#
+ #{defmod\ 891}#))))))
(#{bound-id-member?\ 158}#
- (lambda (#{x\ 954}# #{list\ 955}#)
- (if (not (null? #{list\ 955}#))
- (let ((#{t\ 956}# (#{bound-id=?\ 155}#
- #{x\ 954}#
- (car #{list\ 955}#))))
- (if #{t\ 956}#
- #{t\ 956}#
+ (lambda (#{x\ 892}# #{list\ 893}#)
+ (if (not (null? #{list\ 893}#))
+ (let ((#{t\ 894}# (#{bound-id=?\ 155}#
+ #{x\ 892}#
+ (car #{list\ 893}#))))
+ (if #{t\ 894}#
+ #{t\ 894}#
(#{bound-id-member?\ 158}#
- #{x\ 954}#
- (cdr #{list\ 955}#))))
+ #{x\ 892}#
+ (cdr #{list\ 893}#))))
#f)))
(#{distinct-bound-ids?\ 157}#
- (lambda (#{ids\ 957}#)
- (letrec ((#{distinct?\ 958}#
- (lambda (#{ids\ 959}#)
- (let ((#{t\ 960}# (null? #{ids\ 959}#)))
- (if #{t\ 960}#
- #{t\ 960}#
+ (lambda (#{ids\ 895}#)
+ (letrec ((#{distinct?\ 896}#
+ (lambda (#{ids\ 897}#)
+ (let ((#{t\ 898}# (null? #{ids\ 897}#)))
+ (if #{t\ 898}#
+ #{t\ 898}#
(if (not (#{bound-id-member?\ 158}#
- (car #{ids\ 959}#)
- (cdr #{ids\ 959}#)))
- (#{distinct?\ 958}# (cdr #{ids\ 959}#))
+ (car #{ids\ 897}#)
+ (cdr #{ids\ 897}#)))
+ (#{distinct?\ 896}# (cdr #{ids\ 897}#))
#f))))))
- (#{distinct?\ 958}# #{ids\ 957}#))))
+ (#{distinct?\ 896}# #{ids\ 895}#))))
(#{valid-bound-ids?\ 156}#
- (lambda (#{ids\ 961}#)
- (if (letrec ((#{all-ids?\ 962}#
- (lambda (#{ids\ 963}#)
- (let ((#{t\ 964}# (null? #{ids\ 963}#)))
- (if #{t\ 964}#
- #{t\ 964}#
- (if (#{id?\ 131}# (car #{ids\ 963}#))
- (#{all-ids?\ 962}# (cdr #{ids\ 963}#))
+ (lambda (#{ids\ 899}#)
+ (if (letrec ((#{all-ids?\ 900}#
+ (lambda (#{ids\ 901}#)
+ (let ((#{t\ 902}# (null? #{ids\ 901}#)))
+ (if #{t\ 902}#
+ #{t\ 902}#
+ (if (#{id?\ 131}# (car #{ids\ 901}#))
+ (#{all-ids?\ 900}# (cdr #{ids\ 901}#))
#f))))))
- (#{all-ids?\ 962}# #{ids\ 961}#))
- (#{distinct-bound-ids?\ 157}# #{ids\ 961}#)
+ (#{all-ids?\ 900}# #{ids\ 899}#))
+ (#{distinct-bound-ids?\ 157}# #{ids\ 899}#)
#f)))
(#{bound-id=?\ 155}#
- (lambda (#{i\ 965}# #{j\ 966}#)
- (if (if (#{syntax-object?\ 115}# #{i\ 965}#)
- (#{syntax-object?\ 115}# #{j\ 966}#)
+ (lambda (#{i\ 903}# #{j\ 904}#)
+ (if (if (#{syntax-object?\ 115}# #{i\ 903}#)
+ (#{syntax-object?\ 115}# #{j\ 904}#)
#f)
- (if (eq? (#{syntax-object-expression\ 116}# #{i\ 965}#)
- (#{syntax-object-expression\ 116}# #{j\ 966}#))
+ (if (eq? (#{syntax-object-expression\ 116}# #{i\ 903}#)
+ (#{syntax-object-expression\ 116}# #{j\ 904}#))
(#{same-marks?\ 152}#
(#{wrap-marks\ 134}#
- (#{syntax-object-wrap\ 117}# #{i\ 965}#))
+ (#{syntax-object-wrap\ 117}# #{i\ 903}#))
(#{wrap-marks\ 134}#
- (#{syntax-object-wrap\ 117}# #{j\ 966}#)))
+ (#{syntax-object-wrap\ 117}# #{j\ 904}#)))
#f)
- (eq? #{i\ 965}# #{j\ 966}#))))
+ (eq? #{i\ 903}# #{j\ 904}#))))
(#{free-id=?\ 154}#
- (lambda (#{i\ 967}# #{j\ 968}#)
- (if (eq? (let ((#{x\ 969}# #{i\ 967}#))
- (if (#{syntax-object?\ 115}# #{x\ 969}#)
- (#{syntax-object-expression\ 116}# #{x\ 969}#)
- #{x\ 969}#))
- (let ((#{x\ 970}# #{j\ 968}#))
- (if (#{syntax-object?\ 115}# #{x\ 970}#)
- (#{syntax-object-expression\ 116}# #{x\ 970}#)
- #{x\ 970}#)))
- (eq? (#{id-var-name\ 153}# #{i\ 967}# (quote (())))
- (#{id-var-name\ 153}# #{j\ 968}# (quote (()))))
+ (lambda (#{i\ 905}# #{j\ 906}#)
+ (if (eq? (let ((#{x\ 907}# #{i\ 905}#))
+ (if (#{syntax-object?\ 115}# #{x\ 907}#)
+ (#{syntax-object-expression\ 116}# #{x\ 907}#)
+ #{x\ 907}#))
+ (let ((#{x\ 908}# #{j\ 906}#))
+ (if (#{syntax-object?\ 115}# #{x\ 908}#)
+ (#{syntax-object-expression\ 116}# #{x\ 908}#)
+ #{x\ 908}#)))
+ (eq? (#{id-var-name\ 153}# #{i\ 905}# (quote (())))
+ (#{id-var-name\ 153}# #{j\ 906}# (quote (()))))
#f)))
(#{id-var-name\ 153}#
- (lambda (#{id\ 971}# #{w\ 972}#)
- (letrec ((#{search-vector-rib\ 975}#
- (lambda (#{sym\ 981}#
- #{subst\ 982}#
- #{marks\ 983}#
- #{symnames\ 984}#
- #{ribcage\ 985}#)
- (let ((#{n\ 986}# (vector-length
- #{symnames\ 984}#)))
- (letrec ((#{f\ 987}# (lambda (#{i\ 988}#)
+ (lambda (#{id\ 909}# #{w\ 910}#)
+ (letrec ((#{search-vector-rib\ 913}#
+ (lambda (#{sym\ 919}#
+ #{subst\ 920}#
+ #{marks\ 921}#
+ #{symnames\ 922}#
+ #{ribcage\ 923}#)
+ (let ((#{n\ 924}# (vector-length
+ #{symnames\ 922}#)))
+ (letrec ((#{f\ 925}# (lambda (#{i\ 926}#)
(if (#{fx=\ 88}#
- #{i\ 988}#
- #{n\ 986}#)
- (#{search\ 973}#
- #{sym\ 981}#
- (cdr #{subst\ 982}#)
- #{marks\ 983}#)
+ #{i\ 926}#
+ #{n\ 924}#)
+ (#{search\ 911}#
+ #{sym\ 919}#
+ (cdr #{subst\ 920}#)
+ #{marks\ 921}#)
(if (if (eq? (vector-ref
-
#{symnames\ 984}#
- #{i\
988}#)
- #{sym\
981}#)
+
#{symnames\ 922}#
+ #{i\
926}#)
+ #{sym\
919}#)
(#{same-marks?\
152}#
- #{marks\ 983}#
+ #{marks\ 921}#
(vector-ref
(#{ribcage-marks\ 141}#
- #{ribcage\
985}#)
- #{i\ 988}#))
+ #{ribcage\
923}#)
+ #{i\ 926}#))
#f)
(values
(vector-ref
(#{ribcage-labels\ 142}#
- #{ribcage\
985}#)
- #{i\ 988}#)
- #{marks\ 983}#)
- (#{f\ 987}# (#{fx+\
86}#
- #{i\
988}#
+ #{ribcage\
923}#)
+ #{i\ 926}#)
+ #{marks\ 921}#)
+ (#{f\ 925}# (#{fx+\
86}#
+ #{i\
926}#
1)))))))
- (#{f\ 987}# 0)))))
- (#{search-list-rib\ 974}#
- (lambda (#{sym\ 989}#
- #{subst\ 990}#
- #{marks\ 991}#
- #{symnames\ 992}#
- #{ribcage\ 993}#)
- (letrec ((#{f\ 994}# (lambda (#{symnames\ 995}#
- #{i\ 996}#)
- (if (null? #{symnames\
995}#)
- (#{search\ 973}#
- #{sym\ 989}#
- (cdr #{subst\ 990}#)
- #{marks\ 991}#)
- (if (if (eq? (car
#{symnames\ 995}#)
- #{sym\ 989}#)
+ (#{f\ 925}# 0)))))
+ (#{search-list-rib\ 912}#
+ (lambda (#{sym\ 927}#
+ #{subst\ 928}#
+ #{marks\ 929}#
+ #{symnames\ 930}#
+ #{ribcage\ 931}#)
+ (letrec ((#{f\ 932}# (lambda (#{symnames\ 933}#
+ #{i\ 934}#)
+ (if (null? #{symnames\
933}#)
+ (#{search\ 911}#
+ #{sym\ 927}#
+ (cdr #{subst\ 928}#)
+ #{marks\ 929}#)
+ (if (if (eq? (car
#{symnames\ 933}#)
+ #{sym\ 927}#)
(#{same-marks?\
152}#
- #{marks\ 991}#
+ #{marks\ 929}#
(list-ref
(#{ribcage-marks\ 141}#
- #{ribcage\
993}#)
- #{i\ 996}#))
+ #{ribcage\
931}#)
+ #{i\ 934}#))
#f)
(values
(list-ref
(#{ribcage-labels\
142}#
- #{ribcage\ 993}#)
- #{i\ 996}#)
- #{marks\ 991}#)
- (#{f\ 994}# (cdr
#{symnames\ 995}#)
+ #{ribcage\ 931}#)
+ #{i\ 934}#)
+ #{marks\ 929}#)
+ (#{f\ 932}# (cdr
#{symnames\ 933}#)
(#{fx+\ 86}#
- #{i\ 996}#
+ #{i\ 934}#
1)))))))
- (#{f\ 994}# #{symnames\ 992}# 0))))
- (#{search\ 973}#
- (lambda (#{sym\ 997}# #{subst\ 998}# #{marks\ 999}#)
- (if (null? #{subst\ 998}#)
- (values #f #{marks\ 999}#)
- (let ((#{fst\ 1000}# (car #{subst\ 998}#)))
- (if (eq? #{fst\ 1000}# (quote shift))
- (#{search\ 973}#
- #{sym\ 997}#
- (cdr #{subst\ 998}#)
- (cdr #{marks\ 999}#))
- (let ((#{symnames\ 1001}#
+ (#{f\ 932}# #{symnames\ 930}# 0))))
+ (#{search\ 911}#
+ (lambda (#{sym\ 935}# #{subst\ 936}# #{marks\ 937}#)
+ (if (null? #{subst\ 936}#)
+ (values #f #{marks\ 937}#)
+ (let ((#{fst\ 938}# (car #{subst\ 936}#)))
+ (if (eq? #{fst\ 938}# (quote shift))
+ (#{search\ 911}#
+ #{sym\ 935}#
+ (cdr #{subst\ 936}#)
+ (cdr #{marks\ 937}#))
+ (let ((#{symnames\ 939}#
(#{ribcage-symnames\ 140}#
- #{fst\ 1000}#)))
- (if (vector? #{symnames\ 1001}#)
- (#{search-vector-rib\ 975}#
- #{sym\ 997}#
- #{subst\ 998}#
- #{marks\ 999}#
- #{symnames\ 1001}#
- #{fst\ 1000}#)
- (#{search-list-rib\ 974}#
- #{sym\ 997}#
- #{subst\ 998}#
- #{marks\ 999}#
- #{symnames\ 1001}#
- #{fst\ 1000}#)))))))))
- (if (symbol? #{id\ 971}#)
- (let ((#{t\ 1002}#
- (call-with-values
- (lambda ()
- (#{search\ 973}#
- #{id\ 971}#
- (#{wrap-subst\ 135}# #{w\ 972}#)
- (#{wrap-marks\ 134}# #{w\ 972}#)))
- (lambda (#{x\ 1003}# . #{ignore\ 1004}#)
- #{x\ 1003}#))))
- (if #{t\ 1002}# #{t\ 1002}# #{id\ 971}#))
- (if (#{syntax-object?\ 115}# #{id\ 971}#)
- (let ((#{id\ 1005}#
- (#{syntax-object-expression\ 116}# #{id\ 971}#))
- (#{w1\ 1006}#
- (#{syntax-object-wrap\ 117}# #{id\ 971}#)))
- (let ((#{marks\ 1007}#
+ #{fst\ 938}#)))
+ (if (vector? #{symnames\ 939}#)
+ (#{search-vector-rib\ 913}#
+ #{sym\ 935}#
+ #{subst\ 936}#
+ #{marks\ 937}#
+ #{symnames\ 939}#
+ #{fst\ 938}#)
+ (#{search-list-rib\ 912}#
+ #{sym\ 935}#
+ #{subst\ 936}#
+ #{marks\ 937}#
+ #{symnames\ 939}#
+ #{fst\ 938}#)))))))))
+ (if (symbol? #{id\ 909}#)
+ (let ((#{t\ 940}# (call-with-values
+ (lambda ()
+ (#{search\ 911}#
+ #{id\ 909}#
+ (#{wrap-subst\ 135}# #{w\ 910}#)
+ (#{wrap-marks\ 134}# #{w\ 910}#)))
+ (lambda (#{x\ 941}# . #{ignore\ 942}#)
+ #{x\ 941}#))))
+ (if #{t\ 940}# #{t\ 940}# #{id\ 909}#))
+ (if (#{syntax-object?\ 115}# #{id\ 909}#)
+ (let ((#{id\ 943}#
+ (#{syntax-object-expression\ 116}# #{id\ 909}#))
+ (#{w1\ 944}#
+ (#{syntax-object-wrap\ 117}# #{id\ 909}#)))
+ (let ((#{marks\ 945}#
(#{join-marks\ 151}#
- (#{wrap-marks\ 134}# #{w\ 972}#)
- (#{wrap-marks\ 134}# #{w1\ 1006}#))))
+ (#{wrap-marks\ 134}# #{w\ 910}#)
+ (#{wrap-marks\ 134}# #{w1\ 944}#))))
(call-with-values
(lambda ()
- (#{search\ 973}#
- #{id\ 1005}#
- (#{wrap-subst\ 135}# #{w\ 972}#)
- #{marks\ 1007}#))
- (lambda (#{new-id\ 1008}# #{marks\ 1009}#)
- (let ((#{t\ 1010}# #{new-id\ 1008}#))
- (if #{t\ 1010}#
- #{t\ 1010}#
- (let ((#{t\ 1011}#
- (call-with-values
- (lambda ()
- (#{search\ 973}#
- #{id\ 1005}#
- (#{wrap-subst\ 135}#
- #{w1\ 1006}#)
- #{marks\ 1009}#))
- (lambda (#{x\ 1012}#
- .
- #{ignore\ 1013}#)
- #{x\ 1012}#))))
- (if #{t\ 1011}#
- #{t\ 1011}#
- #{id\ 1005}#))))))))
+ (#{search\ 911}#
+ #{id\ 943}#
+ (#{wrap-subst\ 135}# #{w\ 910}#)
+ #{marks\ 945}#))
+ (lambda (#{new-id\ 946}# #{marks\ 947}#)
+ (let ((#{t\ 948}# #{new-id\ 946}#))
+ (if #{t\ 948}#
+ #{t\ 948}#
+ (let ((#{t\ 949}# (call-with-values
+ (lambda ()
+ (#{search\ 911}#
+ #{id\ 943}#
+ (#{wrap-subst\ 135}#
+ #{w1\ 944}#)
+ #{marks\ 947}#))
+ (lambda (#{x\ 950}#
+ .
+ #{ignore\ 951}#)
+ #{x\ 950}#))))
+ (if #{t\ 949}#
+ #{t\ 949}#
+ #{id\ 943}#))))))))
(syntax-violation
'id-var-name
"invalid id"
- #{id\ 971}#))))))
+ #{id\ 909}#))))))
(#{same-marks?\ 152}#
- (lambda (#{x\ 1014}# #{y\ 1015}#)
- (let ((#{t\ 1016}# (eq? #{x\ 1014}# #{y\ 1015}#)))
- (if #{t\ 1016}#
- #{t\ 1016}#
- (if (not (null? #{x\ 1014}#))
- (if (not (null? #{y\ 1015}#))
- (if (eq? (car #{x\ 1014}#) (car #{y\ 1015}#))
+ (lambda (#{x\ 952}# #{y\ 953}#)
+ (let ((#{t\ 954}# (eq? #{x\ 952}# #{y\ 953}#)))
+ (if #{t\ 954}#
+ #{t\ 954}#
+ (if (not (null? #{x\ 952}#))
+ (if (not (null? #{y\ 953}#))
+ (if (eq? (car #{x\ 952}#) (car #{y\ 953}#))
(#{same-marks?\ 152}#
- (cdr #{x\ 1014}#)
- (cdr #{y\ 1015}#))
+ (cdr #{x\ 952}#)
+ (cdr #{y\ 953}#))
#f)
#f)
#f)))))
(#{join-marks\ 151}#
- (lambda (#{m1\ 1017}# #{m2\ 1018}#)
- (#{smart-append\ 149}# #{m1\ 1017}# #{m2\ 1018}#)))
+ (lambda (#{m1\ 955}# #{m2\ 956}#)
+ (#{smart-append\ 149}# #{m1\ 955}# #{m2\ 956}#)))
(#{join-wraps\ 150}#
- (lambda (#{w1\ 1019}# #{w2\ 1020}#)
- (let ((#{m1\ 1021}# (#{wrap-marks\ 134}# #{w1\ 1019}#))
- (#{s1\ 1022}# (#{wrap-subst\ 135}# #{w1\ 1019}#)))
- (if (null? #{m1\ 1021}#)
- (if (null? #{s1\ 1022}#)
- #{w2\ 1020}#
+ (lambda (#{w1\ 957}# #{w2\ 958}#)
+ (let ((#{m1\ 959}# (#{wrap-marks\ 134}# #{w1\ 957}#))
+ (#{s1\ 960}# (#{wrap-subst\ 135}# #{w1\ 957}#)))
+ (if (null? #{m1\ 959}#)
+ (if (null? #{s1\ 960}#)
+ #{w2\ 958}#
(#{make-wrap\ 133}#
- (#{wrap-marks\ 134}# #{w2\ 1020}#)
+ (#{wrap-marks\ 134}# #{w2\ 958}#)
(#{smart-append\ 149}#
- #{s1\ 1022}#
- (#{wrap-subst\ 135}# #{w2\ 1020}#))))
+ #{s1\ 960}#
+ (#{wrap-subst\ 135}# #{w2\ 958}#))))
(#{make-wrap\ 133}#
(#{smart-append\ 149}#
- #{m1\ 1021}#
- (#{wrap-marks\ 134}# #{w2\ 1020}#))
+ #{m1\ 959}#
+ (#{wrap-marks\ 134}# #{w2\ 958}#))
(#{smart-append\ 149}#
- #{s1\ 1022}#
- (#{wrap-subst\ 135}# #{w2\ 1020}#)))))))
+ #{s1\ 960}#
+ (#{wrap-subst\ 135}# #{w2\ 958}#)))))))
(#{smart-append\ 149}#
- (lambda (#{m1\ 1023}# #{m2\ 1024}#)
- (if (null? #{m2\ 1024}#)
- #{m1\ 1023}#
- (append #{m1\ 1023}# #{m2\ 1024}#))))
+ (lambda (#{m1\ 961}# #{m2\ 962}#)
+ (if (null? #{m2\ 962}#)
+ #{m1\ 961}#
+ (append #{m1\ 961}# #{m2\ 962}#))))
(#{make-binding-wrap\ 148}#
- (lambda (#{ids\ 1025}# #{labels\ 1026}# #{w\ 1027}#)
- (if (null? #{ids\ 1025}#)
- #{w\ 1027}#
+ (lambda (#{ids\ 963}# #{labels\ 964}# #{w\ 965}#)
+ (if (null? #{ids\ 963}#)
+ #{w\ 965}#
(#{make-wrap\ 133}#
- (#{wrap-marks\ 134}# #{w\ 1027}#)
- (cons (let ((#{labelvec\ 1028}#
- (list->vector #{labels\ 1026}#)))
- (let ((#{n\ 1029}#
- (vector-length #{labelvec\ 1028}#)))
- (let ((#{symnamevec\ 1030}#
- (make-vector #{n\ 1029}#))
- (#{marksvec\ 1031}#
- (make-vector #{n\ 1029}#)))
+ (#{wrap-marks\ 134}# #{w\ 965}#)
+ (cons (let ((#{labelvec\ 966}#
+ (list->vector #{labels\ 964}#)))
+ (let ((#{n\ 967}# (vector-length
+ #{labelvec\ 966}#)))
+ (let ((#{symnamevec\ 968}#
+ (make-vector #{n\ 967}#))
+ (#{marksvec\ 969}#
+ (make-vector #{n\ 967}#)))
(begin
- (letrec ((#{f\ 1032}#
- (lambda (#{ids\ 1033}# #{i\ 1034}#)
- (if (not (null? #{ids\ 1033}#))
- (call-with-values
- (lambda ()
- (#{id-sym-name&marks\ 132}#
- (car #{ids\ 1033}#)
- #{w\ 1027}#))
- (lambda (#{symname\ 1035}#
- #{marks\ 1036}#)
- (begin
- (vector-set!
- #{symnamevec\ 1030}#
- #{i\ 1034}#
- #{symname\ 1035}#)
- (vector-set!
- #{marksvec\ 1031}#
- #{i\ 1034}#
- #{marks\ 1036}#)
- (#{f\ 1032}#
- (cdr #{ids\ 1033}#)
- (#{fx+\ 86}#
- #{i\ 1034}#
- 1)))))))))
- (#{f\ 1032}# #{ids\ 1025}# 0))
+ (letrec ((#{f\ 970}# (lambda (#{ids\ 971}#
+ #{i\ 972}#)
+ (if (not (null? #{ids\
971}#))
+ (call-with-values
+ (lambda ()
+
(#{id-sym-name&marks\ 132}#
+ (car #{ids\
971}#)
+ #{w\ 965}#))
+ (lambda
(#{symname\ 973}#
+ #{marks\
974}#)
+ (begin
+ (vector-set!
+
#{symnamevec\ 968}#
+ #{i\ 972}#
+ #{symname\
973}#)
+ (vector-set!
+ #{marksvec\
969}#
+ #{i\ 972}#
+ #{marks\
974}#)
+ (#{f\ 970}#
(cdr #{ids\ 971}#)
+
(#{fx+\ 86}#
+
#{i\ 972}#
+
1)))))))))
+ (#{f\ 970}# #{ids\ 963}# 0))
(#{make-ribcage\ 138}#
- #{symnamevec\ 1030}#
- #{marksvec\ 1031}#
- #{labelvec\ 1028}#)))))
- (#{wrap-subst\ 135}# #{w\ 1027}#))))))
+ #{symnamevec\ 968}#
+ #{marksvec\ 969}#
+ #{labelvec\ 966}#)))))
+ (#{wrap-subst\ 135}# #{w\ 965}#))))))
(#{extend-ribcage!\ 147}#
- (lambda (#{ribcage\ 1037}# #{id\ 1038}# #{label\ 1039}#)
+ (lambda (#{ribcage\ 975}# #{id\ 976}# #{label\ 977}#)
(begin
(#{set-ribcage-symnames!\ 143}#
- #{ribcage\ 1037}#
- (cons (#{syntax-object-expression\ 116}# #{id\ 1038}#)
- (#{ribcage-symnames\ 140}# #{ribcage\ 1037}#)))
+ #{ribcage\ 975}#
+ (cons (#{syntax-object-expression\ 116}# #{id\ 976}#)
+ (#{ribcage-symnames\ 140}# #{ribcage\ 975}#)))
(#{set-ribcage-marks!\ 144}#
- #{ribcage\ 1037}#
+ #{ribcage\ 975}#
(cons (#{wrap-marks\ 134}#
- (#{syntax-object-wrap\ 117}# #{id\ 1038}#))
- (#{ribcage-marks\ 141}# #{ribcage\ 1037}#)))
+ (#{syntax-object-wrap\ 117}# #{id\ 976}#))
+ (#{ribcage-marks\ 141}# #{ribcage\ 975}#)))
(#{set-ribcage-labels!\ 145}#
- #{ribcage\ 1037}#
- (cons #{label\ 1039}#
- (#{ribcage-labels\ 142}# #{ribcage\ 1037}#))))))
+ #{ribcage\ 975}#
+ (cons #{label\ 977}#
+ (#{ribcage-labels\ 142}# #{ribcage\ 975}#))))))
(#{anti-mark\ 146}#
- (lambda (#{w\ 1040}#)
+ (lambda (#{w\ 978}#)
(#{make-wrap\ 133}#
- (cons #f (#{wrap-marks\ 134}# #{w\ 1040}#))
+ (cons #f (#{wrap-marks\ 134}# #{w\ 978}#))
(cons 'shift
- (#{wrap-subst\ 135}# #{w\ 1040}#)))))
+ (#{wrap-subst\ 135}# #{w\ 978}#)))))
(#{set-ribcage-labels!\ 145}#
- (lambda (#{x\ 1041}# #{update\ 1042}#)
- (vector-set! #{x\ 1041}# 3 #{update\ 1042}#)))
+ (lambda (#{x\ 979}# #{update\ 980}#)
+ (vector-set! #{x\ 979}# 3 #{update\ 980}#)))
(#{set-ribcage-marks!\ 144}#
- (lambda (#{x\ 1043}# #{update\ 1044}#)
- (vector-set! #{x\ 1043}# 2 #{update\ 1044}#)))
+ (lambda (#{x\ 981}# #{update\ 982}#)
+ (vector-set! #{x\ 981}# 2 #{update\ 982}#)))
(#{set-ribcage-symnames!\ 143}#
- (lambda (#{x\ 1045}# #{update\ 1046}#)
- (vector-set! #{x\ 1045}# 1 #{update\ 1046}#)))
+ (lambda (#{x\ 983}# #{update\ 984}#)
+ (vector-set! #{x\ 983}# 1 #{update\ 984}#)))
(#{ribcage-labels\ 142}#
- (lambda (#{x\ 1047}#) (vector-ref #{x\ 1047}# 3)))
+ (lambda (#{x\ 985}#) (vector-ref #{x\ 985}# 3)))
(#{ribcage-marks\ 141}#
- (lambda (#{x\ 1048}#) (vector-ref #{x\ 1048}# 2)))
+ (lambda (#{x\ 986}#) (vector-ref #{x\ 986}# 2)))
(#{ribcage-symnames\ 140}#
- (lambda (#{x\ 1049}#) (vector-ref #{x\ 1049}# 1)))
+ (lambda (#{x\ 987}#) (vector-ref #{x\ 987}# 1)))
(#{ribcage?\ 139}#
- (lambda (#{x\ 1050}#)
- (if (vector? #{x\ 1050}#)
- (if (= (vector-length #{x\ 1050}#) 4)
- (eq? (vector-ref #{x\ 1050}# 0) (quote ribcage))
+ (lambda (#{x\ 988}#)
+ (if (vector? #{x\ 988}#)
+ (if (= (vector-length #{x\ 988}#) 4)
+ (eq? (vector-ref #{x\ 988}# 0) (quote ribcage))
#f)
#f)))
(#{make-ribcage\ 138}#
- (lambda (#{symnames\ 1051}#
- #{marks\ 1052}#
- #{labels\ 1053}#)
+ (lambda (#{symnames\ 989}#
+ #{marks\ 990}#
+ #{labels\ 991}#)
(vector
'ribcage
- #{symnames\ 1051}#
- #{marks\ 1052}#
- #{labels\ 1053}#)))
+ #{symnames\ 989}#
+ #{marks\ 990}#
+ #{labels\ 991}#)))
(#{gen-labels\ 137}#
- (lambda (#{ls\ 1054}#)
- (if (null? #{ls\ 1054}#)
+ (lambda (#{ls\ 992}#)
+ (if (null? #{ls\ 992}#)
'()
(cons (#{gen-label\ 136}#)
- (#{gen-labels\ 137}# (cdr #{ls\ 1054}#))))))
+ (#{gen-labels\ 137}# (cdr #{ls\ 992}#))))))
(#{gen-label\ 136}# (lambda () (string #\i)))
(#{wrap-subst\ 135}# cdr)
(#{wrap-marks\ 134}# car)
(#{make-wrap\ 133}# cons)
(#{id-sym-name&marks\ 132}#
- (lambda (#{x\ 1055}# #{w\ 1056}#)
- (if (#{syntax-object?\ 115}# #{x\ 1055}#)
+ (lambda (#{x\ 993}# #{w\ 994}#)
+ (if (#{syntax-object?\ 115}# #{x\ 993}#)
(values
- (#{syntax-object-expression\ 116}# #{x\ 1055}#)
+ (#{syntax-object-expression\ 116}# #{x\ 993}#)
(#{join-marks\ 151}#
- (#{wrap-marks\ 134}# #{w\ 1056}#)
+ (#{wrap-marks\ 134}# #{w\ 994}#)
(#{wrap-marks\ 134}#
- (#{syntax-object-wrap\ 117}# #{x\ 1055}#))))
+ (#{syntax-object-wrap\ 117}# #{x\ 993}#))))
(values
- #{x\ 1055}#
- (#{wrap-marks\ 134}# #{w\ 1056}#)))))
+ #{x\ 993}#
+ (#{wrap-marks\ 134}# #{w\ 994}#)))))
(#{id?\ 131}#
- (lambda (#{x\ 1057}#)
- (if (symbol? #{x\ 1057}#)
+ (lambda (#{x\ 995}#)
+ (if (symbol? #{x\ 995}#)
#t
- (if (#{syntax-object?\ 115}# #{x\ 1057}#)
+ (if (#{syntax-object?\ 115}# #{x\ 995}#)
(symbol?
- (#{syntax-object-expression\ 116}# #{x\ 1057}#))
+ (#{syntax-object-expression\ 116}# #{x\ 995}#))
#f))))
(#{nonsymbol-id?\ 130}#
- (lambda (#{x\ 1058}#)
- (if (#{syntax-object?\ 115}# #{x\ 1058}#)
+ (lambda (#{x\ 996}#)
+ (if (#{syntax-object?\ 115}# #{x\ 996}#)
(symbol?
- (#{syntax-object-expression\ 116}# #{x\ 1058}#))
+ (#{syntax-object-expression\ 116}# #{x\ 996}#))
#f)))
(#{global-extend\ 129}#
- (lambda (#{type\ 1059}# #{sym\ 1060}# #{val\ 1061}#)
+ (lambda (#{type\ 997}# #{sym\ 998}# #{val\ 999}#)
(#{put-global-definition-hook\ 92}#
- #{sym\ 1060}#
- #{type\ 1059}#
- #{val\ 1061}#)))
+ #{sym\ 998}#
+ #{type\ 997}#
+ #{val\ 999}#)))
(#{lookup\ 128}#
- (lambda (#{x\ 1062}# #{r\ 1063}# #{mod\ 1064}#)
- (let ((#{t\ 1065}# (assq #{x\ 1062}# #{r\ 1063}#)))
- (if #{t\ 1065}#
- (cdr #{t\ 1065}#)
- (if (symbol? #{x\ 1062}#)
- (let ((#{t\ 1066}#
+ (lambda (#{x\ 1000}# #{r\ 1001}# #{mod\ 1002}#)
+ (let ((#{t\ 1003}# (assq #{x\ 1000}# #{r\ 1001}#)))
+ (if #{t\ 1003}#
+ (cdr #{t\ 1003}#)
+ (if (symbol? #{x\ 1000}#)
+ (let ((#{t\ 1004}#
(#{get-global-definition-hook\ 93}#
- #{x\ 1062}#
- #{mod\ 1064}#)))
- (if #{t\ 1066}# #{t\ 1066}# (quote (global))))
+ #{x\ 1000}#
+ #{mod\ 1002}#)))
+ (if #{t\ 1004}# #{t\ 1004}# (quote (global))))
'(displaced-lexical))))))
(#{macros-only-env\ 127}#
- (lambda (#{r\ 1067}#)
- (if (null? #{r\ 1067}#)
+ (lambda (#{r\ 1005}#)
+ (if (null? #{r\ 1005}#)
'()
- (let ((#{a\ 1068}# (car #{r\ 1067}#)))
- (if (eq? (cadr #{a\ 1068}#) (quote macro))
- (cons #{a\ 1068}#
- (#{macros-only-env\ 127}# (cdr #{r\ 1067}#)))
- (#{macros-only-env\ 127}# (cdr #{r\ 1067}#)))))))
+ (let ((#{a\ 1006}# (car #{r\ 1005}#)))
+ (if (eq? (cadr #{a\ 1006}#) (quote macro))
+ (cons #{a\ 1006}#
+ (#{macros-only-env\ 127}# (cdr #{r\ 1005}#)))
+ (#{macros-only-env\ 127}# (cdr #{r\ 1005}#)))))))
(#{extend-var-env\ 126}#
- (lambda (#{labels\ 1069}# #{vars\ 1070}# #{r\ 1071}#)
- (if (null? #{labels\ 1069}#)
- #{r\ 1071}#
+ (lambda (#{labels\ 1007}# #{vars\ 1008}# #{r\ 1009}#)
+ (if (null? #{labels\ 1007}#)
+ #{r\ 1009}#
(#{extend-var-env\ 126}#
- (cdr #{labels\ 1069}#)
- (cdr #{vars\ 1070}#)
- (cons (cons (car #{labels\ 1069}#)
- (cons (quote lexical) (car #{vars\ 1070}#)))
- #{r\ 1071}#)))))
+ (cdr #{labels\ 1007}#)
+ (cdr #{vars\ 1008}#)
+ (cons (cons (car #{labels\ 1007}#)
+ (cons (quote lexical) (car #{vars\ 1008}#)))
+ #{r\ 1009}#)))))
(#{extend-env\ 125}#
- (lambda (#{labels\ 1072}# #{bindings\ 1073}# #{r\ 1074}#)
- (if (null? #{labels\ 1072}#)
- #{r\ 1074}#
+ (lambda (#{labels\ 1010}# #{bindings\ 1011}# #{r\ 1012}#)
+ (if (null? #{labels\ 1010}#)
+ #{r\ 1012}#
(#{extend-env\ 125}#
- (cdr #{labels\ 1072}#)
- (cdr #{bindings\ 1073}#)
- (cons (cons (car #{labels\ 1072}#)
- (car #{bindings\ 1073}#))
- #{r\ 1074}#)))))
+ (cdr #{labels\ 1010}#)
+ (cdr #{bindings\ 1011}#)
+ (cons (cons (car #{labels\ 1010}#)
+ (car #{bindings\ 1011}#))
+ #{r\ 1012}#)))))
(#{binding-value\ 124}# cdr)
(#{binding-type\ 123}# car)
(#{source-annotation\ 122}#
- (lambda (#{x\ 1075}#)
- (if (#{syntax-object?\ 115}# #{x\ 1075}#)
+ (lambda (#{x\ 1013}#)
+ (if (#{syntax-object?\ 115}# #{x\ 1013}#)
(#{source-annotation\ 122}#
- (#{syntax-object-expression\ 116}# #{x\ 1075}#))
- (if (pair? #{x\ 1075}#)
- (let ((#{props\ 1076}# (source-properties #{x\ 1075}#)))
- (if (pair? #{props\ 1076}#) #{props\ 1076}# #f))
+ (#{syntax-object-expression\ 116}# #{x\ 1013}#))
+ (if (pair? #{x\ 1013}#)
+ (let ((#{props\ 1014}# (source-properties #{x\ 1013}#)))
+ (if (pair? #{props\ 1014}#) #{props\ 1014}# #f))
#f))))
(#{set-syntax-object-module!\ 121}#
- (lambda (#{x\ 1077}# #{update\ 1078}#)
- (vector-set! #{x\ 1077}# 3 #{update\ 1078}#)))
+ (lambda (#{x\ 1015}# #{update\ 1016}#)
+ (vector-set! #{x\ 1015}# 3 #{update\ 1016}#)))
(#{set-syntax-object-wrap!\ 120}#
- (lambda (#{x\ 1079}# #{update\ 1080}#)
- (vector-set! #{x\ 1079}# 2 #{update\ 1080}#)))
+ (lambda (#{x\ 1017}# #{update\ 1018}#)
+ (vector-set! #{x\ 1017}# 2 #{update\ 1018}#)))
(#{set-syntax-object-expression!\ 119}#
- (lambda (#{x\ 1081}# #{update\ 1082}#)
- (vector-set! #{x\ 1081}# 1 #{update\ 1082}#)))
+ (lambda (#{x\ 1019}# #{update\ 1020}#)
+ (vector-set! #{x\ 1019}# 1 #{update\ 1020}#)))
(#{syntax-object-module\ 118}#
- (lambda (#{x\ 1083}#) (vector-ref #{x\ 1083}# 3)))
+ (lambda (#{x\ 1021}#) (vector-ref #{x\ 1021}# 3)))
(#{syntax-object-wrap\ 117}#
- (lambda (#{x\ 1084}#) (vector-ref #{x\ 1084}# 2)))
+ (lambda (#{x\ 1022}#) (vector-ref #{x\ 1022}# 2)))
(#{syntax-object-expression\ 116}#
- (lambda (#{x\ 1085}#) (vector-ref #{x\ 1085}# 1)))
+ (lambda (#{x\ 1023}#) (vector-ref #{x\ 1023}# 1)))
(#{syntax-object?\ 115}#
- (lambda (#{x\ 1086}#)
- (if (vector? #{x\ 1086}#)
- (if (= (vector-length #{x\ 1086}#) 4)
- (eq? (vector-ref #{x\ 1086}# 0)
+ (lambda (#{x\ 1024}#)
+ (if (vector? #{x\ 1024}#)
+ (if (= (vector-length #{x\ 1024}#) 4)
+ (eq? (vector-ref #{x\ 1024}# 0)
'syntax-object)
#f)
#f)))
(#{make-syntax-object\ 114}#
- (lambda (#{expression\ 1087}#
- #{wrap\ 1088}#
- #{module\ 1089}#)
+ (lambda (#{expression\ 1025}#
+ #{wrap\ 1026}#
+ #{module\ 1027}#)
(vector
'syntax-object
- #{expression\ 1087}#
- #{wrap\ 1088}#
- #{module\ 1089}#)))
+ #{expression\ 1025}#
+ #{wrap\ 1026}#
+ #{module\ 1027}#)))
(#{build-letrec\ 113}#
- (lambda (#{src\ 1090}#
- #{ids\ 1091}#
- #{vars\ 1092}#
- #{val-exps\ 1093}#
- #{body-exp\ 1094}#)
- (if (null? #{vars\ 1092}#)
- #{body-exp\ 1094}#
- (let ((#{atom-key\ 1095}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1095}# (quote (c)))
+ (lambda (#{src\ 1028}#
+ #{ids\ 1029}#
+ #{vars\ 1030}#
+ #{val-exps\ 1031}#
+ #{body-exp\ 1032}#)
+ (if (null? #{vars\ 1030}#)
+ #{body-exp\ 1032}#
+ (let ((#{atom-key\ 1033}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1033}# (quote (c)))
(begin
(for-each
#{maybe-name-value!\ 103}#
- #{ids\ 1091}#
- #{val-exps\ 1093}#)
+ #{ids\ 1029}#
+ #{val-exps\ 1031}#)
((@ (language tree-il) make-letrec)
- #{src\ 1090}#
- #{ids\ 1091}#
- #{vars\ 1092}#
- #{val-exps\ 1093}#
- #{body-exp\ 1094}#))
+ #{src\ 1028}#
+ #{ids\ 1029}#
+ #{vars\ 1030}#
+ #{val-exps\ 1031}#
+ #{body-exp\ 1032}#))
(#{decorate-source\ 94}#
(list 'letrec
- (map list #{vars\ 1092}# #{val-exps\ 1093}#)
- #{body-exp\ 1094}#)
- #{src\ 1090}#))))))
+ (map list #{vars\ 1030}# #{val-exps\ 1031}#)
+ #{body-exp\ 1032}#)
+ #{src\ 1028}#))))))
(#{build-named-let\ 112}#
- (lambda (#{src\ 1096}#
- #{ids\ 1097}#
- #{vars\ 1098}#
- #{val-exps\ 1099}#
- #{body-exp\ 1100}#)
- (let ((#{f\ 1101}# (car #{vars\ 1098}#))
- (#{f-name\ 1102}# (car #{ids\ 1097}#))
- (#{vars\ 1103}# (cdr #{vars\ 1098}#))
- (#{ids\ 1104}# (cdr #{ids\ 1097}#)))
- (let ((#{atom-key\ 1105}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1105}# (quote (c)))
- (let ((#{proc\ 1106}#
+ (lambda (#{src\ 1034}#
+ #{ids\ 1035}#
+ #{vars\ 1036}#
+ #{val-exps\ 1037}#
+ #{body-exp\ 1038}#)
+ (let ((#{f\ 1039}# (car #{vars\ 1036}#))
+ (#{f-name\ 1040}# (car #{ids\ 1035}#))
+ (#{vars\ 1041}# (cdr #{vars\ 1036}#))
+ (#{ids\ 1042}# (cdr #{ids\ 1035}#)))
+ (let ((#{atom-key\ 1043}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1043}# (quote (c)))
+ (let ((#{proc\ 1044}#
(#{build-simple-lambda\ 105}#
- #{src\ 1096}#
- #{ids\ 1104}#
+ #{src\ 1034}#
+ #{ids\ 1042}#
#f
- #{vars\ 1103}#
+ #{vars\ 1041}#
#f
- #{body-exp\ 1100}#)))
+ #{body-exp\ 1038}#)))
(begin
(#{maybe-name-value!\ 103}#
- #{f-name\ 1102}#
- #{proc\ 1106}#)
+ #{f-name\ 1040}#
+ #{proc\ 1044}#)
(for-each
#{maybe-name-value!\ 103}#
- #{ids\ 1104}#
- #{val-exps\ 1099}#)
+ #{ids\ 1042}#
+ #{val-exps\ 1037}#)
((@ (language tree-il) make-letrec)
- #{src\ 1096}#
- (list #{f-name\ 1102}#)
- (list #{f\ 1101}#)
- (list #{proc\ 1106}#)
+ #{src\ 1034}#
+ (list #{f-name\ 1040}#)
+ (list #{f\ 1039}#)
+ (list #{proc\ 1044}#)
(#{build-application\ 96}#
- #{src\ 1096}#
+ #{src\ 1034}#
(#{build-lexical-reference\ 98}#
'fun
- #{src\ 1096}#
- #{f-name\ 1102}#
- #{f\ 1101}#)
- #{val-exps\ 1099}#))))
+ #{src\ 1034}#
+ #{f-name\ 1040}#
+ #{f\ 1039}#)
+ #{val-exps\ 1037}#))))
(#{decorate-source\ 94}#
(list 'let
- #{f\ 1101}#
- (map list #{vars\ 1103}# #{val-exps\ 1099}#)
- #{body-exp\ 1100}#)
- #{src\ 1096}#))))))
+ #{f\ 1039}#
+ (map list #{vars\ 1041}# #{val-exps\ 1037}#)
+ #{body-exp\ 1038}#)
+ #{src\ 1034}#))))))
(#{build-let\ 111}#
- (lambda (#{src\ 1107}#
- #{ids\ 1108}#
- #{vars\ 1109}#
- #{val-exps\ 1110}#
- #{body-exp\ 1111}#)
- (if (null? #{vars\ 1109}#)
- #{body-exp\ 1111}#
- (let ((#{atom-key\ 1112}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1112}# (quote (c)))
+ (lambda (#{src\ 1045}#
+ #{ids\ 1046}#
+ #{vars\ 1047}#
+ #{val-exps\ 1048}#
+ #{body-exp\ 1049}#)
+ (if (null? #{vars\ 1047}#)
+ #{body-exp\ 1049}#
+ (let ((#{atom-key\ 1050}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1050}# (quote (c)))
(begin
(for-each
#{maybe-name-value!\ 103}#
- #{ids\ 1108}#
- #{val-exps\ 1110}#)
+ #{ids\ 1046}#
+ #{val-exps\ 1048}#)
((@ (language tree-il) make-let)
- #{src\ 1107}#
- #{ids\ 1108}#
- #{vars\ 1109}#
- #{val-exps\ 1110}#
- #{body-exp\ 1111}#))
+ #{src\ 1045}#
+ #{ids\ 1046}#
+ #{vars\ 1047}#
+ #{val-exps\ 1048}#
+ #{body-exp\ 1049}#))
(#{decorate-source\ 94}#
(list 'let
- (map list #{vars\ 1109}# #{val-exps\ 1110}#)
- #{body-exp\ 1111}#)
- #{src\ 1107}#))))))
+ (map list #{vars\ 1047}# #{val-exps\ 1048}#)
+ #{body-exp\ 1049}#)
+ #{src\ 1045}#))))))
(#{build-sequence\ 110}#
- (lambda (#{src\ 1113}# #{exps\ 1114}#)
- (if (null? (cdr #{exps\ 1114}#))
- (car #{exps\ 1114}#)
- (let ((#{atom-key\ 1115}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1115}# (quote (c)))
+ (lambda (#{src\ 1051}# #{exps\ 1052}#)
+ (if (null? (cdr #{exps\ 1052}#))
+ (car #{exps\ 1052}#)
+ (let ((#{atom-key\ 1053}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1053}# (quote (c)))
((@ (language tree-il) make-sequence)
- #{src\ 1113}#
- #{exps\ 1114}#)
+ #{src\ 1051}#
+ #{exps\ 1052}#)
(#{decorate-source\ 94}#
- (cons (quote begin) #{exps\ 1114}#)
- #{src\ 1113}#))))))
+ (cons (quote begin) #{exps\ 1052}#)
+ #{src\ 1051}#))))))
(#{build-data\ 109}#
- (lambda (#{src\ 1116}# #{exp\ 1117}#)
- (let ((#{atom-key\ 1118}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1118}# (quote (c)))
+ (lambda (#{src\ 1054}# #{exp\ 1055}#)
+ (let ((#{atom-key\ 1056}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1056}# (quote (c)))
((@ (language tree-il) make-const)
- #{src\ 1116}#
- #{exp\ 1117}#)
+ #{src\ 1054}#
+ #{exp\ 1055}#)
(#{decorate-source\ 94}#
- (if (if (self-evaluating? #{exp\ 1117}#)
- (not (vector? #{exp\ 1117}#))
+ (if (if (self-evaluating? #{exp\ 1055}#)
+ (not (vector? #{exp\ 1055}#))
#f)
- #{exp\ 1117}#
- (list (quote quote) #{exp\ 1117}#))
- #{src\ 1116}#)))))
+ #{exp\ 1055}#
+ (list (quote quote) #{exp\ 1055}#))
+ #{src\ 1054}#)))))
(#{build-primref\ 108}#
- (lambda (#{src\ 1119}# #{name\ 1120}#)
+ (lambda (#{src\ 1057}# #{name\ 1058}#)
(if (equal?
(module-name (current-module))
'(guile))
- (let ((#{atom-key\ 1121}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1121}# (quote (c)))
+ (let ((#{atom-key\ 1059}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1059}# (quote (c)))
((@ (language tree-il) make-toplevel-ref)
- #{src\ 1119}#
- #{name\ 1120}#)
+ #{src\ 1057}#
+ #{name\ 1058}#)
(#{decorate-source\ 94}#
- #{name\ 1120}#
- #{src\ 1119}#)))
- (let ((#{atom-key\ 1122}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1122}# (quote (c)))
+ #{name\ 1058}#
+ #{src\ 1057}#)))
+ (let ((#{atom-key\ 1060}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1060}# (quote (c)))
((@ (language tree-il) make-module-ref)
- #{src\ 1119}#
+ #{src\ 1057}#
'(guile)
- #{name\ 1120}#
+ #{name\ 1058}#
#f)
(#{decorate-source\ 94}#
- (list (quote @@) (quote (guile)) #{name\ 1120}#)
- #{src\ 1119}#))))))
+ (list (quote @@) (quote (guile)) #{name\ 1058}#)
+ #{src\ 1057}#))))))
(#{build-lambda-case\ 107}#
- (lambda (#{src\ 1123}#
- #{req\ 1124}#
- #{opt\ 1125}#
- #{rest\ 1126}#
- #{kw\ 1127}#
- #{inits\ 1128}#
- #{vars\ 1129}#
- #{predicate\ 1130}#
- #{body\ 1131}#
- #{else-case\ 1132}#)
- (let ((#{atom-key\ 1133}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1133}# (quote (c)))
+ (lambda (#{src\ 1061}#
+ #{req\ 1062}#
+ #{opt\ 1063}#
+ #{rest\ 1064}#
+ #{kw\ 1065}#
+ #{inits\ 1066}#
+ #{vars\ 1067}#
+ #{body\ 1068}#
+ #{else-case\ 1069}#)
+ (let ((#{atom-key\ 1070}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1070}# (quote (c)))
((@ (language tree-il) make-lambda-case)
- #{src\ 1123}#
- #{req\ 1124}#
- #{opt\ 1125}#
- #{rest\ 1126}#
- #{kw\ 1127}#
- #{inits\ 1128}#
- #{vars\ 1129}#
- #{predicate\ 1130}#
- #{body\ 1131}#
- #{else-case\ 1132}#)
- (let ((#{nreq\ 1134}# (length #{req\ 1124}#)))
- (let ((#{nopt\ 1135}#
- (if #{opt\ 1125}# (length #{opt\ 1125}#) 0)))
- (let ((#{rest-idx\ 1136}#
- (if #{rest\ 1126}#
- (+ #{nreq\ 1134}# #{nopt\ 1135}#)
+ #{src\ 1061}#
+ #{req\ 1062}#
+ #{opt\ 1063}#
+ #{rest\ 1064}#
+ #{kw\ 1065}#
+ #{inits\ 1066}#
+ #{vars\ 1067}#
+ #{body\ 1068}#
+ #{else-case\ 1069}#)
+ (let ((#{nreq\ 1071}# (length #{req\ 1062}#)))
+ (let ((#{nopt\ 1072}#
+ (if #{opt\ 1063}# (length #{opt\ 1063}#) 0)))
+ (let ((#{rest-idx\ 1073}#
+ (if #{rest\ 1064}#
+ (+ #{nreq\ 1071}# #{nopt\ 1072}#)
#f)))
- (let ((#{allow-other-keys?\ 1137}#
- (if #{kw\ 1127}# (car #{kw\ 1127}#) #f)))
- (let ((#{kw-indices\ 1138}#
- (map (lambda (#{x\ 1139}#)
- (cons (car #{x\ 1139}#)
+ (let ((#{allow-other-keys?\ 1074}#
+ (if #{kw\ 1065}# (car #{kw\ 1065}#) #f)))
+ (let ((#{kw-indices\ 1075}#
+ (map (lambda (#{x\ 1076}#)
+ (cons (car #{x\ 1076}#)
(list-index
- #{vars\ 1129}#
- (caddr #{x\ 1139}#))))
- (if #{kw\ 1127}#
- (cdr #{kw\ 1127}#)
+ #{vars\ 1067}#
+ (caddr #{x\ 1076}#))))
+ (if #{kw\ 1065}#
+ (cdr #{kw\ 1065}#)
'()))))
- (let ((#{nargs\ 1140}#
+ (let ((#{nargs\ 1077}#
(apply max
- (+ #{nreq\ 1134}#
- #{nopt\ 1135}#
- (if #{rest\ 1126}# 1 0))
+ (+ #{nreq\ 1071}#
+ #{nopt\ 1072}#
+ (if #{rest\ 1064}# 1 0))
(map 1+
(map cdr
- #{kw-indices\ 1138}#)))))
+ #{kw-indices\ 1075}#)))))
(begin
- (let ((#{t\ 1141}#
- (= #{nargs\ 1140}#
- (length #{vars\ 1129}#)
- (+ #{nreq\ 1134}#
- (length #{inits\ 1128}#)
- (if #{rest\ 1126}# 1 0)))))
- (if #{t\ 1141}#
- #{t\ 1141}#
+ (let ((#{t\ 1078}#
+ (= #{nargs\ 1077}#
+ (length #{vars\ 1067}#)
+ (+ #{nreq\ 1071}#
+ (length #{inits\ 1066}#)
+ (if #{rest\ 1064}# 1 0)))))
+ (if #{t\ 1078}#
+ #{t\ 1078}#
(error "something went wrong"
- #{req\ 1124}#
- #{opt\ 1125}#
- #{rest\ 1126}#
- #{kw\ 1127}#
- #{inits\ 1128}#
- #{vars\ 1129}#
- #{nreq\ 1134}#
- #{nopt\ 1135}#
- #{kw-indices\ 1138}#
- #{nargs\ 1140}#)))
+ #{req\ 1062}#
+ #{opt\ 1063}#
+ #{rest\ 1064}#
+ #{kw\ 1065}#
+ #{inits\ 1066}#
+ #{vars\ 1067}#
+ #{nreq\ 1071}#
+ #{nopt\ 1072}#
+ #{kw-indices\ 1075}#
+ #{nargs\ 1077}#)))
(#{decorate-source\ 94}#
(cons (list (cons '(@@ (ice-9 optargs)
parse-lambda-case)
(cons (list 'quote
- (list #{nreq\
1134}#
- #{nopt\
1135}#
-
#{rest-idx\ 1136}#
-
#{nargs\ 1140}#
-
#{allow-other-keys?\ 1137}#
-
#{kw-indices\ 1138}#))
+ (list #{nreq\
1071}#
+ #{nopt\
1072}#
+
#{rest-idx\ 1073}#
+
#{nargs\ 1077}#
+
#{allow-other-keys?\ 1074}#
+
#{kw-indices\ 1075}#))
(cons (cons 'list
- (map
(lambda (#{i\ 1142}#)
+ (map
(lambda (#{i\ 1079}#)
(list 'lambda
-
#{vars\ 1129}#
-
#{i\ 1142}#))
-
#{inits\ 1128}#))
- (cons (if
#{predicate\ 1130}#
- (list
'lambda
-
#{vars\ 1129}#
-
#{predicate\ 1130}#)
- #f)
-
'(%%args)))))
+
#{vars\ 1067}#
+
#{i\ 1079}#))
+
#{inits\ 1066}#))
+ '(%%args))))
'=>
(list 'lambda
'(%%%args . _)
(cons 'apply
(cons (list 'lambda
- #{vars\
1129}#
- #{body\
1131}#)
+ #{vars\
1067}#
+ #{body\
1068}#)
'(%%%args)))))
- (let ((#{t\ 1143}#
- #{else-case\ 1132}#))
- (if #{t\ 1143}#
- #{t\ 1143}#
+ (let ((#{t\ 1080}#
+ #{else-case\ 1069}#))
+ (if #{t\ 1080}#
+ #{t\ 1080}#
'((%%args
(error "wrong number of
arguments"
%%args))))))
- #{src\ 1123}#))))))))))))
+ #{src\ 1061}#))))))))))))
(#{build-case-lambda\ 106}#
- (lambda (#{src\ 1144}#
- #{docstring\ 1145}#
- #{body\ 1146}#)
- (let ((#{atom-key\ 1147}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1147}# (quote (c)))
+ (lambda (#{src\ 1081}#
+ #{docstring\ 1082}#
+ #{body\ 1083}#)
+ (let ((#{atom-key\ 1084}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1084}# (quote (c)))
((@ (language tree-il) make-lambda)
- #{src\ 1144}#
- (if #{docstring\ 1145}#
- (list (cons (quote documentation) #{docstring\ 1145}#))
+ #{src\ 1081}#
+ (if #{docstring\ 1082}#
+ (list (cons (quote documentation) #{docstring\ 1082}#))
'())
- #{body\ 1146}#)
+ #{body\ 1083}#)
(#{decorate-source\ 94}#
(cons 'lambda
(cons '%%args
(append
- (if #{docstring\ 1145}#
- (list #{docstring\ 1145}#)
+ (if #{docstring\ 1082}#
+ (list #{docstring\ 1082}#)
'())
- (list (cons (quote cond) #{body\ 1146}#)))))
- #{src\ 1144}#)))))
+ (list (cons (quote cond) #{body\ 1083}#)))))
+ #{src\ 1081}#)))))
(#{build-simple-lambda\ 105}#
- (lambda (#{src\ 1148}#
- #{req\ 1149}#
- #{rest\ 1150}#
- #{vars\ 1151}#
- #{docstring\ 1152}#
- #{exp\ 1153}#)
- (let ((#{atom-key\ 1154}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1154}# (quote (c)))
+ (lambda (#{src\ 1085}#
+ #{req\ 1086}#
+ #{rest\ 1087}#
+ #{vars\ 1088}#
+ #{docstring\ 1089}#
+ #{exp\ 1090}#)
+ (let ((#{atom-key\ 1091}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1091}# (quote (c)))
((@ (language tree-il) make-lambda)
- #{src\ 1148}#
- (if #{docstring\ 1152}#
- (list (cons (quote documentation) #{docstring\ 1152}#))
+ #{src\ 1085}#
+ (if #{docstring\ 1089}#
+ (list (cons (quote documentation) #{docstring\ 1089}#))
'())
((@ (language tree-il) make-lambda-case)
- #{src\ 1148}#
- #{req\ 1149}#
+ #{src\ 1085}#
+ #{req\ 1086}#
#f
- #{rest\ 1150}#
+ #{rest\ 1087}#
#f
'()
- #{vars\ 1151}#
- #f
- #{exp\ 1153}#
+ #{vars\ 1088}#
+ #{exp\ 1090}#
#f))
(#{decorate-source\ 94}#
(cons 'lambda
- (cons (if #{rest\ 1150}#
- (apply cons* #{vars\ 1151}#)
- #{vars\ 1151}#)
+ (cons (if #{rest\ 1087}#
+ (apply cons* #{vars\ 1088}#)
+ #{vars\ 1088}#)
(append
- (if #{docstring\ 1152}#
- (list #{docstring\ 1152}#)
+ (if #{docstring\ 1089}#
+ (list #{docstring\ 1089}#)
'())
- (list #{exp\ 1153}#))))
- #{src\ 1148}#)))))
+ (list #{exp\ 1090}#))))
+ #{src\ 1085}#)))))
(#{build-global-definition\ 104}#
- (lambda (#{source\ 1155}# #{var\ 1156}# #{exp\ 1157}#)
- (let ((#{atom-key\ 1158}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1158}# (quote (c)))
+ (lambda (#{source\ 1092}# #{var\ 1093}# #{exp\ 1094}#)
+ (let ((#{atom-key\ 1095}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1095}# (quote (c)))
(begin
(#{maybe-name-value!\ 103}#
- #{var\ 1156}#
- #{exp\ 1157}#)
+ #{var\ 1093}#
+ #{exp\ 1094}#)
((@ (language tree-il) make-toplevel-define)
- #{source\ 1155}#
- #{var\ 1156}#
- #{exp\ 1157}#))
+ #{source\ 1092}#
+ #{var\ 1093}#
+ #{exp\ 1094}#))
(#{decorate-source\ 94}#
- (list (quote define) #{var\ 1156}# #{exp\ 1157}#)
- #{source\ 1155}#)))))
+ (list (quote define) #{var\ 1093}# #{exp\ 1094}#)
+ #{source\ 1092}#)))))
(#{maybe-name-value!\ 103}#
- (lambda (#{name\ 1159}# #{val\ 1160}#)
- (if ((@ (language tree-il) lambda?) #{val\ 1160}#)
- (let ((#{meta\ 1161}#
+ (lambda (#{name\ 1096}# #{val\ 1097}#)
+ (if ((@ (language tree-il) lambda?) #{val\ 1097}#)
+ (let ((#{meta\ 1098}#
((@ (language tree-il) lambda-meta)
- #{val\ 1160}#)))
- (if (not (assq (quote name) #{meta\ 1161}#))
+ #{val\ 1097}#)))
+ (if (not (assq (quote name) #{meta\ 1098}#))
((setter (@ (language tree-il) lambda-meta))
- #{val\ 1160}#
+ #{val\ 1097}#
(acons 'name
- #{name\ 1159}#
- #{meta\ 1161}#)))))))
+ #{name\ 1096}#
+ #{meta\ 1098}#)))))))
(#{build-global-assignment\ 102}#
- (lambda (#{source\ 1162}#
- #{var\ 1163}#
- #{exp\ 1164}#
- #{mod\ 1165}#)
+ (lambda (#{source\ 1099}#
+ #{var\ 1100}#
+ #{exp\ 1101}#
+ #{mod\ 1102}#)
(#{analyze-variable\ 100}#
- #{mod\ 1165}#
- #{var\ 1163}#
- (lambda (#{mod\ 1166}# #{var\ 1167}# #{public?\ 1168}#)
- (let ((#{atom-key\ 1169}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1169}# (quote (c)))
+ #{mod\ 1102}#
+ #{var\ 1100}#
+ (lambda (#{mod\ 1103}# #{var\ 1104}# #{public?\ 1105}#)
+ (let ((#{atom-key\ 1106}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1106}# (quote (c)))
((@ (language tree-il) make-module-set)
- #{source\ 1162}#
- #{mod\ 1166}#
- #{var\ 1167}#
- #{public?\ 1168}#
- #{exp\ 1164}#)
+ #{source\ 1099}#
+ #{mod\ 1103}#
+ #{var\ 1104}#
+ #{public?\ 1105}#
+ #{exp\ 1101}#)
(#{decorate-source\ 94}#
(list 'set!
- (list (if #{public?\ 1168}#
+ (list (if #{public?\ 1105}#
'@
'@@)
- #{mod\ 1166}#
- #{var\ 1167}#)
- #{exp\ 1164}#)
- #{source\ 1162}#))))
- (lambda (#{var\ 1170}#)
- (let ((#{atom-key\ 1171}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1171}# (quote (c)))
+ #{mod\ 1103}#
+ #{var\ 1104}#)
+ #{exp\ 1101}#)
+ #{source\ 1099}#))))
+ (lambda (#{var\ 1107}#)
+ (let ((#{atom-key\ 1108}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1108}# (quote (c)))
((@ (language tree-il) make-toplevel-set)
- #{source\ 1162}#
- #{var\ 1170}#
- #{exp\ 1164}#)
+ #{source\ 1099}#
+ #{var\ 1107}#
+ #{exp\ 1101}#)
(#{decorate-source\ 94}#
- (list (quote set!) #{var\ 1170}# #{exp\ 1164}#)
- #{source\ 1162}#)))))))
+ (list (quote set!) #{var\ 1107}# #{exp\ 1101}#)
+ #{source\ 1099}#)))))))
(#{build-global-reference\ 101}#
- (lambda (#{source\ 1172}# #{var\ 1173}# #{mod\ 1174}#)
+ (lambda (#{source\ 1109}# #{var\ 1110}# #{mod\ 1111}#)
(#{analyze-variable\ 100}#
- #{mod\ 1174}#
- #{var\ 1173}#
- (lambda (#{mod\ 1175}# #{var\ 1176}# #{public?\ 1177}#)
- (let ((#{atom-key\ 1178}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1178}# (quote (c)))
+ #{mod\ 1111}#
+ #{var\ 1110}#
+ (lambda (#{mod\ 1112}# #{var\ 1113}# #{public?\ 1114}#)
+ (let ((#{atom-key\ 1115}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1115}# (quote (c)))
((@ (language tree-il) make-module-ref)
- #{source\ 1172}#
- #{mod\ 1175}#
- #{var\ 1176}#
- #{public?\ 1177}#)
+ #{source\ 1109}#
+ #{mod\ 1112}#
+ #{var\ 1113}#
+ #{public?\ 1114}#)
(#{decorate-source\ 94}#
- (list (if #{public?\ 1177}# (quote @) (quote @@))
- #{mod\ 1175}#
- #{var\ 1176}#)
- #{source\ 1172}#))))
- (lambda (#{var\ 1179}#)
- (let ((#{atom-key\ 1180}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1180}# (quote (c)))
+ (list (if #{public?\ 1114}# (quote @) (quote @@))
+ #{mod\ 1112}#
+ #{var\ 1113}#)
+ #{source\ 1109}#))))
+ (lambda (#{var\ 1116}#)
+ (let ((#{atom-key\ 1117}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1117}# (quote (c)))
((@ (language tree-il) make-toplevel-ref)
- #{source\ 1172}#
- #{var\ 1179}#)
+ #{source\ 1109}#
+ #{var\ 1116}#)
(#{decorate-source\ 94}#
- #{var\ 1179}#
- #{source\ 1172}#)))))))
+ #{var\ 1116}#
+ #{source\ 1109}#)))))))
(#{analyze-variable\ 100}#
- (lambda (#{mod\ 1181}#
- #{var\ 1182}#
- #{modref-cont\ 1183}#
- #{bare-cont\ 1184}#)
- (if (not #{mod\ 1181}#)
- (#{bare-cont\ 1184}# #{var\ 1182}#)
- (let ((#{kind\ 1185}# (car #{mod\ 1181}#))
- (#{mod\ 1186}# (cdr #{mod\ 1181}#)))
- (if (memv #{kind\ 1185}# (quote (public)))
- (#{modref-cont\ 1183}#
- #{mod\ 1186}#
- #{var\ 1182}#
+ (lambda (#{mod\ 1118}#
+ #{var\ 1119}#
+ #{modref-cont\ 1120}#
+ #{bare-cont\ 1121}#)
+ (if (not #{mod\ 1118}#)
+ (#{bare-cont\ 1121}# #{var\ 1119}#)
+ (let ((#{kind\ 1122}# (car #{mod\ 1118}#))
+ (#{mod\ 1123}# (cdr #{mod\ 1118}#)))
+ (if (memv #{kind\ 1122}# (quote (public)))
+ (#{modref-cont\ 1120}#
+ #{mod\ 1123}#
+ #{var\ 1119}#
#t)
- (if (memv #{kind\ 1185}# (quote (private)))
+ (if (memv #{kind\ 1122}# (quote (private)))
(if (not (equal?
- #{mod\ 1186}#
+ #{mod\ 1123}#
(module-name (current-module))))
- (#{modref-cont\ 1183}#
- #{mod\ 1186}#
- #{var\ 1182}#
+ (#{modref-cont\ 1120}#
+ #{mod\ 1123}#
+ #{var\ 1119}#
#f)
- (#{bare-cont\ 1184}# #{var\ 1182}#))
- (if (memv #{kind\ 1185}# (quote (bare)))
- (#{bare-cont\ 1184}# #{var\ 1182}#)
- (if (memv #{kind\ 1185}# (quote (hygiene)))
+ (#{bare-cont\ 1121}# #{var\ 1119}#))
+ (if (memv #{kind\ 1122}# (quote (bare)))
+ (#{bare-cont\ 1121}# #{var\ 1119}#)
+ (if (memv #{kind\ 1122}# (quote (hygiene)))
(if (if (not (equal?
- #{mod\ 1186}#
+ #{mod\ 1123}#
(module-name (current-module))))
(module-variable
- (resolve-module #{mod\ 1186}#)
- #{var\ 1182}#)
+ (resolve-module #{mod\ 1123}#)
+ #{var\ 1119}#)
#f)
- (#{modref-cont\ 1183}#
- #{mod\ 1186}#
- #{var\ 1182}#
+ (#{modref-cont\ 1120}#
+ #{mod\ 1123}#
+ #{var\ 1119}#
#f)
- (#{bare-cont\ 1184}# #{var\ 1182}#))
+ (#{bare-cont\ 1121}# #{var\ 1119}#))
(syntax-violation
#f
"bad module kind"
- #{var\ 1182}#
- #{mod\ 1186}#)))))))))
+ #{var\ 1119}#
+ #{mod\ 1123}#)))))))))
(#{build-lexical-assignment\ 99}#
- (lambda (#{source\ 1187}#
- #{name\ 1188}#
- #{var\ 1189}#
- #{exp\ 1190}#)
- (let ((#{atom-key\ 1191}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1191}# (quote (c)))
+ (lambda (#{source\ 1124}#
+ #{name\ 1125}#
+ #{var\ 1126}#
+ #{exp\ 1127}#)
+ (let ((#{atom-key\ 1128}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1128}# (quote (c)))
((@ (language tree-il) make-lexical-set)
- #{source\ 1187}#
- #{name\ 1188}#
- #{var\ 1189}#
- #{exp\ 1190}#)
+ #{source\ 1124}#
+ #{name\ 1125}#
+ #{var\ 1126}#
+ #{exp\ 1127}#)
(#{decorate-source\ 94}#
- (list (quote set!) #{var\ 1189}# #{exp\ 1190}#)
- #{source\ 1187}#)))))
+ (list (quote set!) #{var\ 1126}# #{exp\ 1127}#)
+ #{source\ 1124}#)))))
(#{build-lexical-reference\ 98}#
- (lambda (#{type\ 1192}#
- #{source\ 1193}#
- #{name\ 1194}#
- #{var\ 1195}#)
- (let ((#{atom-key\ 1196}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1196}# (quote (c)))
+ (lambda (#{type\ 1129}#
+ #{source\ 1130}#
+ #{name\ 1131}#
+ #{var\ 1132}#)
+ (let ((#{atom-key\ 1133}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1133}# (quote (c)))
((@ (language tree-il) make-lexical-ref)
- #{source\ 1193}#
- #{name\ 1194}#
- #{var\ 1195}#)
+ #{source\ 1130}#
+ #{name\ 1131}#
+ #{var\ 1132}#)
(#{decorate-source\ 94}#
- #{var\ 1195}#
- #{source\ 1193}#)))))
+ #{var\ 1132}#
+ #{source\ 1130}#)))))
(#{build-conditional\ 97}#
- (lambda (#{source\ 1197}#
- #{test-exp\ 1198}#
- #{then-exp\ 1199}#
- #{else-exp\ 1200}#)
- (let ((#{atom-key\ 1201}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1201}# (quote (c)))
+ (lambda (#{source\ 1134}#
+ #{test-exp\ 1135}#
+ #{then-exp\ 1136}#
+ #{else-exp\ 1137}#)
+ (let ((#{atom-key\ 1138}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1138}# (quote (c)))
((@ (language tree-il) make-conditional)
- #{source\ 1197}#
- #{test-exp\ 1198}#
- #{then-exp\ 1199}#
- #{else-exp\ 1200}#)
+ #{source\ 1134}#
+ #{test-exp\ 1135}#
+ #{then-exp\ 1136}#
+ #{else-exp\ 1137}#)
(#{decorate-source\ 94}#
- (if (equal? #{else-exp\ 1200}# (quote (if #f #f)))
+ (if (equal? #{else-exp\ 1137}# (quote (if #f #f)))
(list 'if
- #{test-exp\ 1198}#
- #{then-exp\ 1199}#)
+ #{test-exp\ 1135}#
+ #{then-exp\ 1136}#)
(list 'if
- #{test-exp\ 1198}#
- #{then-exp\ 1199}#
- #{else-exp\ 1200}#))
- #{source\ 1197}#)))))
+ #{test-exp\ 1135}#
+ #{then-exp\ 1136}#
+ #{else-exp\ 1137}#))
+ #{source\ 1134}#)))))
(#{build-application\ 96}#
- (lambda (#{source\ 1202}#
- #{fun-exp\ 1203}#
- #{arg-exps\ 1204}#)
- (let ((#{atom-key\ 1205}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1205}# (quote (c)))
+ (lambda (#{source\ 1139}#
+ #{fun-exp\ 1140}#
+ #{arg-exps\ 1141}#)
+ (let ((#{atom-key\ 1142}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1142}# (quote (c)))
((@ (language tree-il) make-application)
- #{source\ 1202}#
- #{fun-exp\ 1203}#
- #{arg-exps\ 1204}#)
+ #{source\ 1139}#
+ #{fun-exp\ 1140}#
+ #{arg-exps\ 1141}#)
(#{decorate-source\ 94}#
- (cons #{fun-exp\ 1203}# #{arg-exps\ 1204}#)
- #{source\ 1202}#)))))
+ (cons #{fun-exp\ 1140}# #{arg-exps\ 1141}#)
+ #{source\ 1139}#)))))
(#{build-void\ 95}#
- (lambda (#{source\ 1206}#)
- (let ((#{atom-key\ 1207}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1207}# (quote (c)))
+ (lambda (#{source\ 1143}#)
+ (let ((#{atom-key\ 1144}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1144}# (quote (c)))
((@ (language tree-il) make-void)
- #{source\ 1206}#)
+ #{source\ 1143}#)
(#{decorate-source\ 94}#
'(if #f #f)
- #{source\ 1206}#)))))
+ #{source\ 1143}#)))))
(#{decorate-source\ 94}#
- (lambda (#{e\ 1208}# #{s\ 1209}#)
+ (lambda (#{e\ 1145}# #{s\ 1146}#)
(begin
- (if (if (pair? #{e\ 1208}#) #{s\ 1209}# #f)
- (set-source-properties! #{e\ 1208}# #{s\ 1209}#))
- #{e\ 1208}#)))
+ (if (if (pair? #{e\ 1145}#) #{s\ 1146}# #f)
+ (set-source-properties! #{e\ 1145}# #{s\ 1146}#))
+ #{e\ 1145}#)))
(#{get-global-definition-hook\ 93}#
- (lambda (#{symbol\ 1210}# #{module\ 1211}#)
+ (lambda (#{symbol\ 1147}# #{module\ 1148}#)
(begin
- (if (if (not #{module\ 1211}#) (current-module) #f)
+ (if (if (not #{module\ 1148}#) (current-module) #f)
(warn "module system is booted, we should have a module"
- #{symbol\ 1210}#))
- (let ((#{v\ 1212}#
+ #{symbol\ 1147}#))
+ (let ((#{v\ 1149}#
(module-variable
- (if #{module\ 1211}#
- (resolve-module (cdr #{module\ 1211}#))
+ (if #{module\ 1148}#
+ (resolve-module (cdr #{module\ 1148}#))
(current-module))
- #{symbol\ 1210}#)))
- (if #{v\ 1212}#
- (if (variable-bound? #{v\ 1212}#)
- (let ((#{val\ 1213}# (variable-ref #{v\ 1212}#)))
- (if (macro? #{val\ 1213}#)
- (if (syncase-macro-type #{val\ 1213}#)
- (cons (syncase-macro-type #{val\ 1213}#)
- (syncase-macro-binding #{val\ 1213}#))
+ #{symbol\ 1147}#)))
+ (if #{v\ 1149}#
+ (if (variable-bound? #{v\ 1149}#)
+ (let ((#{val\ 1150}# (variable-ref #{v\ 1149}#)))
+ (if (macro? #{val\ 1150}#)
+ (if (syncase-macro-type #{val\ 1150}#)
+ (cons (syncase-macro-type #{val\ 1150}#)
+ (syncase-macro-binding #{val\ 1150}#))
#f)
#f))
#f)
#f)))))
(#{put-global-definition-hook\ 92}#
- (lambda (#{symbol\ 1214}# #{type\ 1215}# #{val\ 1216}#)
- (let ((#{existing\ 1217}#
- (let ((#{v\ 1218}#
+ (lambda (#{symbol\ 1151}# #{type\ 1152}# #{val\ 1153}#)
+ (let ((#{existing\ 1154}#
+ (let ((#{v\ 1155}#
(module-variable
(current-module)
- #{symbol\ 1214}#)))
- (if #{v\ 1218}#
- (if (variable-bound? #{v\ 1218}#)
- (let ((#{val\ 1219}# (variable-ref #{v\ 1218}#)))
- (if (macro? #{val\ 1219}#)
- (if (not (syncase-macro-type #{val\ 1219}#))
- #{val\ 1219}#
+ #{symbol\ 1151}#)))
+ (if #{v\ 1155}#
+ (if (variable-bound? #{v\ 1155}#)
+ (let ((#{val\ 1156}# (variable-ref #{v\ 1155}#)))
+ (if (macro? #{val\ 1156}#)
+ (if (not (syncase-macro-type #{val\ 1156}#))
+ #{val\ 1156}#
#f)
#f))
#f)
#f))))
(module-define!
(current-module)
- #{symbol\ 1214}#
- (if #{existing\ 1217}#
+ #{symbol\ 1151}#
+ (if #{existing\ 1154}#
(make-extended-syncase-macro
- #{existing\ 1217}#
- #{type\ 1215}#
- #{val\ 1216}#)
- (make-syncase-macro #{type\ 1215}# #{val\ 1216}#))))))
+ #{existing\ 1154}#
+ #{type\ 1152}#
+ #{val\ 1153}#)
+ (make-syncase-macro #{type\ 1152}# #{val\ 1153}#))))))
(#{local-eval-hook\ 91}#
- (lambda (#{x\ 1220}# #{mod\ 1221}#)
+ (lambda (#{x\ 1157}# #{mod\ 1158}#)
(primitive-eval
(list #{noexpand\ 84}#
- (let ((#{atom-key\ 1222}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1222}# (quote (c)))
+ (let ((#{atom-key\ 1159}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1159}# (quote (c)))
((@ (language tree-il) tree-il->scheme)
- #{x\ 1220}#)
- #{x\ 1220}#))))))
+ #{x\ 1157}#)
+ #{x\ 1157}#))))))
(#{top-level-eval-hook\ 90}#
- (lambda (#{x\ 1223}# #{mod\ 1224}#)
+ (lambda (#{x\ 1160}# #{mod\ 1161}#)
(primitive-eval
(list #{noexpand\ 84}#
- (let ((#{atom-key\ 1225}# (fluid-ref #{*mode*\ 85}#)))
- (if (memv #{atom-key\ 1225}# (quote (c)))
+ (let ((#{atom-key\ 1162}# (fluid-ref #{*mode*\ 85}#)))
+ (if (memv #{atom-key\ 1162}# (quote (c)))
((@ (language tree-il) tree-il->scheme)
- #{x\ 1223}#)
- #{x\ 1223}#))))))
+ #{x\ 1160}#)
+ #{x\ 1160}#))))))
(#{fx<\ 89}# <)
(#{fx=\ 88}# =)
(#{fx-\ 87}# -)
@@ -8115,1070 +7876,1068 @@
(#{global-extend\ 129}#
'core
'fluid-let-syntax
- (lambda (#{e\ 1226}#
- #{r\ 1227}#
- #{w\ 1228}#
- #{s\ 1229}#
- #{mod\ 1230}#)
- ((lambda (#{tmp\ 1231}#)
- ((lambda (#{tmp\ 1232}#)
- (if (if #{tmp\ 1232}#
- (apply (lambda (#{_\ 1233}#
- #{var\ 1234}#
- #{val\ 1235}#
- #{e1\ 1236}#
- #{e2\ 1237}#)
- (#{valid-bound-ids?\ 156}# #{var\ 1234}#))
- #{tmp\ 1232}#)
+ (lambda (#{e\ 1163}#
+ #{r\ 1164}#
+ #{w\ 1165}#
+ #{s\ 1166}#
+ #{mod\ 1167}#)
+ ((lambda (#{tmp\ 1168}#)
+ ((lambda (#{tmp\ 1169}#)
+ (if (if #{tmp\ 1169}#
+ (apply (lambda (#{_\ 1170}#
+ #{var\ 1171}#
+ #{val\ 1172}#
+ #{e1\ 1173}#
+ #{e2\ 1174}#)
+ (#{valid-bound-ids?\ 156}# #{var\ 1171}#))
+ #{tmp\ 1169}#)
#f)
- (apply (lambda (#{_\ 1239}#
- #{var\ 1240}#
- #{val\ 1241}#
- #{e1\ 1242}#
- #{e2\ 1243}#)
- (let ((#{names\ 1244}#
- (map (lambda (#{x\ 1245}#)
+ (apply (lambda (#{_\ 1176}#
+ #{var\ 1177}#
+ #{val\ 1178}#
+ #{e1\ 1179}#
+ #{e2\ 1180}#)
+ (let ((#{names\ 1181}#
+ (map (lambda (#{x\ 1182}#)
(#{id-var-name\ 153}#
- #{x\ 1245}#
- #{w\ 1228}#))
- #{var\ 1240}#)))
+ #{x\ 1182}#
+ #{w\ 1165}#))
+ #{var\ 1177}#)))
(begin
(for-each
- (lambda (#{id\ 1247}# #{n\ 1248}#)
- (let ((#{atom-key\ 1249}#
+ (lambda (#{id\ 1184}# #{n\ 1185}#)
+ (let ((#{atom-key\ 1186}#
(#{binding-type\ 123}#
(#{lookup\ 128}#
- #{n\ 1248}#
- #{r\ 1227}#
- #{mod\ 1230}#))))
- (if (memv #{atom-key\ 1249}#
+ #{n\ 1185}#
+ #{r\ 1164}#
+ #{mod\ 1167}#))))
+ (if (memv #{atom-key\ 1186}#
'(displaced-lexical))
(syntax-violation
'fluid-let-syntax
"identifier out of context"
- #{e\ 1226}#
+ #{e\ 1163}#
(#{source-wrap\ 160}#
- #{id\ 1247}#
- #{w\ 1228}#
- #{s\ 1229}#
- #{mod\ 1230}#)))))
- #{var\ 1240}#
- #{names\ 1244}#)
+ #{id\ 1184}#
+ #{w\ 1165}#
+ #{s\ 1166}#
+ #{mod\ 1167}#)))))
+ #{var\ 1177}#
+ #{names\ 1181}#)
(#{chi-body\ 171}#
- (cons #{e1\ 1242}# #{e2\ 1243}#)
+ (cons #{e1\ 1179}# #{e2\ 1180}#)
(#{source-wrap\ 160}#
- #{e\ 1226}#
- #{w\ 1228}#
- #{s\ 1229}#
- #{mod\ 1230}#)
+ #{e\ 1163}#
+ #{w\ 1165}#
+ #{s\ 1166}#
+ #{mod\ 1167}#)
(#{extend-env\ 125}#
- #{names\ 1244}#
- (let ((#{trans-r\ 1252}#
+ #{names\ 1181}#
+ (let ((#{trans-r\ 1189}#
(#{macros-only-env\ 127}#
- #{r\ 1227}#)))
- (map (lambda (#{x\ 1253}#)
+ #{r\ 1164}#)))
+ (map (lambda (#{x\ 1190}#)
(cons 'macro
(#{eval-local-transformer\
173}#
(#{chi\ 167}#
- #{x\ 1253}#
- #{trans-r\ 1252}#
- #{w\ 1228}#
- #{mod\ 1230}#)
- #{mod\ 1230}#)))
- #{val\ 1241}#))
- #{r\ 1227}#)
- #{w\ 1228}#
- #{mod\ 1230}#))))
- #{tmp\ 1232}#)
- ((lambda (#{_\ 1255}#)
+ #{x\ 1190}#
+ #{trans-r\ 1189}#
+ #{w\ 1165}#
+ #{mod\ 1167}#)
+ #{mod\ 1167}#)))
+ #{val\ 1178}#))
+ #{r\ 1164}#)
+ #{w\ 1165}#
+ #{mod\ 1167}#))))
+ #{tmp\ 1169}#)
+ ((lambda (#{_\ 1192}#)
(syntax-violation
'fluid-let-syntax
"bad syntax"
(#{source-wrap\ 160}#
- #{e\ 1226}#
- #{w\ 1228}#
- #{s\ 1229}#
- #{mod\ 1230}#)))
- #{tmp\ 1231}#)))
+ #{e\ 1163}#
+ #{w\ 1165}#
+ #{s\ 1166}#
+ #{mod\ 1167}#)))
+ #{tmp\ 1168}#)))
($sc-dispatch
- #{tmp\ 1231}#
+ #{tmp\ 1168}#
'(any #(each (any any)) any . each-any))))
- #{e\ 1226}#)))
+ #{e\ 1163}#)))
(#{global-extend\ 129}#
'core
'quote
- (lambda (#{e\ 1256}#
- #{r\ 1257}#
- #{w\ 1258}#
- #{s\ 1259}#
- #{mod\ 1260}#)
- ((lambda (#{tmp\ 1261}#)
- ((lambda (#{tmp\ 1262}#)
- (if #{tmp\ 1262}#
- (apply (lambda (#{_\ 1263}# #{e\ 1264}#)
+ (lambda (#{e\ 1193}#
+ #{r\ 1194}#
+ #{w\ 1195}#
+ #{s\ 1196}#
+ #{mod\ 1197}#)
+ ((lambda (#{tmp\ 1198}#)
+ ((lambda (#{tmp\ 1199}#)
+ (if #{tmp\ 1199}#
+ (apply (lambda (#{_\ 1200}# #{e\ 1201}#)
(#{build-data\ 109}#
- #{s\ 1259}#
- (#{strip\ 180}# #{e\ 1264}# #{w\ 1258}#)))
- #{tmp\ 1262}#)
- ((lambda (#{_\ 1265}#)
+ #{s\ 1196}#
+ (#{strip\ 180}# #{e\ 1201}# #{w\ 1195}#)))
+ #{tmp\ 1199}#)
+ ((lambda (#{_\ 1202}#)
(syntax-violation
'quote
"bad syntax"
(#{source-wrap\ 160}#
- #{e\ 1256}#
- #{w\ 1258}#
- #{s\ 1259}#
- #{mod\ 1260}#)))
- #{tmp\ 1261}#)))
- ($sc-dispatch #{tmp\ 1261}# (quote (any any)))))
- #{e\ 1256}#)))
+ #{e\ 1193}#
+ #{w\ 1195}#
+ #{s\ 1196}#
+ #{mod\ 1197}#)))
+ #{tmp\ 1198}#)))
+ ($sc-dispatch #{tmp\ 1198}# (quote (any any)))))
+ #{e\ 1193}#)))
(#{global-extend\ 129}#
'core
'syntax
- (letrec ((#{regen\ 1273}#
- (lambda (#{x\ 1274}#)
- (let ((#{atom-key\ 1275}# (car #{x\ 1274}#)))
- (if (memv #{atom-key\ 1275}# (quote (ref)))
+ (letrec ((#{regen\ 1210}#
+ (lambda (#{x\ 1211}#)
+ (let ((#{atom-key\ 1212}# (car #{x\ 1211}#)))
+ (if (memv #{atom-key\ 1212}# (quote (ref)))
(#{build-lexical-reference\ 98}#
'value
#f
- (cadr #{x\ 1274}#)
- (cadr #{x\ 1274}#))
- (if (memv #{atom-key\ 1275}# (quote (primitive)))
- (#{build-primref\ 108}# #f (cadr #{x\ 1274}#))
- (if (memv #{atom-key\ 1275}# (quote (quote)))
- (#{build-data\ 109}# #f (cadr #{x\ 1274}#))
- (if (memv #{atom-key\ 1275}# (quote (lambda)))
- (if (list? (cadr #{x\ 1274}#))
+ (cadr #{x\ 1211}#)
+ (cadr #{x\ 1211}#))
+ (if (memv #{atom-key\ 1212}# (quote (primitive)))
+ (#{build-primref\ 108}# #f (cadr #{x\ 1211}#))
+ (if (memv #{atom-key\ 1212}# (quote (quote)))
+ (#{build-data\ 109}# #f (cadr #{x\ 1211}#))
+ (if (memv #{atom-key\ 1212}# (quote (lambda)))
+ (if (list? (cadr #{x\ 1211}#))
(#{build-simple-lambda\ 105}#
#f
- (cadr #{x\ 1274}#)
+ (cadr #{x\ 1211}#)
#f
- (cadr #{x\ 1274}#)
+ (cadr #{x\ 1211}#)
#f
- (#{regen\ 1273}# (caddr #{x\ 1274}#)))
- (error "how did we get here" #{x\ 1274}#))
+ (#{regen\ 1210}# (caddr #{x\ 1211}#)))
+ (error "how did we get here" #{x\ 1211}#))
(#{build-application\ 96}#
#f
- (#{build-primref\ 108}# #f (car #{x\ 1274}#))
- (map #{regen\ 1273}#
- (cdr #{x\ 1274}#))))))))))
- (#{gen-vector\ 1272}#
- (lambda (#{x\ 1276}#)
- (if (eq? (car #{x\ 1276}#) (quote list))
- (cons (quote vector) (cdr #{x\ 1276}#))
- (if (eq? (car #{x\ 1276}#) (quote quote))
+ (#{build-primref\ 108}# #f (car #{x\ 1211}#))
+ (map #{regen\ 1210}#
+ (cdr #{x\ 1211}#))))))))))
+ (#{gen-vector\ 1209}#
+ (lambda (#{x\ 1213}#)
+ (if (eq? (car #{x\ 1213}#) (quote list))
+ (cons (quote vector) (cdr #{x\ 1213}#))
+ (if (eq? (car #{x\ 1213}#) (quote quote))
(list 'quote
- (list->vector (cadr #{x\ 1276}#)))
- (list (quote list->vector) #{x\ 1276}#)))))
- (#{gen-append\ 1271}#
- (lambda (#{x\ 1277}# #{y\ 1278}#)
- (if (equal? #{y\ 1278}# (quote (quote ())))
- #{x\ 1277}#
- (list (quote append) #{x\ 1277}# #{y\ 1278}#))))
- (#{gen-cons\ 1270}#
- (lambda (#{x\ 1279}# #{y\ 1280}#)
- (let ((#{atom-key\ 1281}# (car #{y\ 1280}#)))
- (if (memv #{atom-key\ 1281}# (quote (quote)))
- (if (eq? (car #{x\ 1279}#) (quote quote))
+ (list->vector (cadr #{x\ 1213}#)))
+ (list (quote list->vector) #{x\ 1213}#)))))
+ (#{gen-append\ 1208}#
+ (lambda (#{x\ 1214}# #{y\ 1215}#)
+ (if (equal? #{y\ 1215}# (quote (quote ())))
+ #{x\ 1214}#
+ (list (quote append) #{x\ 1214}# #{y\ 1215}#))))
+ (#{gen-cons\ 1207}#
+ (lambda (#{x\ 1216}# #{y\ 1217}#)
+ (let ((#{atom-key\ 1218}# (car #{y\ 1217}#)))
+ (if (memv #{atom-key\ 1218}# (quote (quote)))
+ (if (eq? (car #{x\ 1216}#) (quote quote))
(list 'quote
- (cons (cadr #{x\ 1279}#) (cadr #{y\ 1280}#)))
- (if (eq? (cadr #{y\ 1280}#) (quote ()))
- (list (quote list) #{x\ 1279}#)
- (list (quote cons) #{x\ 1279}# #{y\ 1280}#)))
- (if (memv #{atom-key\ 1281}# (quote (list)))
+ (cons (cadr #{x\ 1216}#) (cadr #{y\ 1217}#)))
+ (if (eq? (cadr #{y\ 1217}#) (quote ()))
+ (list (quote list) #{x\ 1216}#)
+ (list (quote cons) #{x\ 1216}# #{y\ 1217}#)))
+ (if (memv #{atom-key\ 1218}# (quote (list)))
(cons 'list
- (cons #{x\ 1279}# (cdr #{y\ 1280}#)))
- (list (quote cons) #{x\ 1279}# #{y\ 1280}#))))))
- (#{gen-map\ 1269}#
- (lambda (#{e\ 1282}# #{map-env\ 1283}#)
- (let ((#{formals\ 1284}# (map cdr #{map-env\ 1283}#))
- (#{actuals\ 1285}#
- (map (lambda (#{x\ 1286}#)
- (list (quote ref) (car #{x\ 1286}#)))
- #{map-env\ 1283}#)))
- (if (eq? (car #{e\ 1282}#) (quote ref))
- (car #{actuals\ 1285}#)
+ (cons #{x\ 1216}# (cdr #{y\ 1217}#)))
+ (list (quote cons) #{x\ 1216}# #{y\ 1217}#))))))
+ (#{gen-map\ 1206}#
+ (lambda (#{e\ 1219}# #{map-env\ 1220}#)
+ (let ((#{formals\ 1221}# (map cdr #{map-env\ 1220}#))
+ (#{actuals\ 1222}#
+ (map (lambda (#{x\ 1223}#)
+ (list (quote ref) (car #{x\ 1223}#)))
+ #{map-env\ 1220}#)))
+ (if (eq? (car #{e\ 1219}#) (quote ref))
+ (car #{actuals\ 1222}#)
(if (and-map
- (lambda (#{x\ 1287}#)
- (if (eq? (car #{x\ 1287}#) (quote ref))
- (memq (cadr #{x\ 1287}#) #{formals\ 1284}#)
+ (lambda (#{x\ 1224}#)
+ (if (eq? (car #{x\ 1224}#) (quote ref))
+ (memq (cadr #{x\ 1224}#) #{formals\ 1221}#)
#f))
- (cdr #{e\ 1282}#))
+ (cdr #{e\ 1219}#))
(cons 'map
(cons (list 'primitive
- (car #{e\ 1282}#))
- (map (let ((#{r\ 1288}#
+ (car #{e\ 1219}#))
+ (map (let ((#{r\ 1225}#
(map cons
- #{formals\ 1284}#
- #{actuals\ 1285}#)))
- (lambda (#{x\ 1289}#)
- (cdr (assq (cadr #{x\ 1289}#)
- #{r\ 1288}#))))
- (cdr #{e\ 1282}#))))
+ #{formals\ 1221}#
+ #{actuals\ 1222}#)))
+ (lambda (#{x\ 1226}#)
+ (cdr (assq (cadr #{x\ 1226}#)
+ #{r\ 1225}#))))
+ (cdr #{e\ 1219}#))))
(cons 'map
(cons (list 'lambda
- #{formals\ 1284}#
- #{e\ 1282}#)
- #{actuals\ 1285}#)))))))
- (#{gen-mappend\ 1268}#
- (lambda (#{e\ 1290}# #{map-env\ 1291}#)
+ #{formals\ 1221}#
+ #{e\ 1219}#)
+ #{actuals\ 1222}#)))))))
+ (#{gen-mappend\ 1205}#
+ (lambda (#{e\ 1227}# #{map-env\ 1228}#)
(list 'apply
'(primitive append)
- (#{gen-map\ 1269}# #{e\ 1290}# #{map-env\ 1291}#))))
- (#{gen-ref\ 1267}#
- (lambda (#{src\ 1292}#
- #{var\ 1293}#
- #{level\ 1294}#
- #{maps\ 1295}#)
- (if (#{fx=\ 88}# #{level\ 1294}# 0)
- (values #{var\ 1293}# #{maps\ 1295}#)
- (if (null? #{maps\ 1295}#)
+ (#{gen-map\ 1206}# #{e\ 1227}# #{map-env\ 1228}#))))
+ (#{gen-ref\ 1204}#
+ (lambda (#{src\ 1229}#
+ #{var\ 1230}#
+ #{level\ 1231}#
+ #{maps\ 1232}#)
+ (if (#{fx=\ 88}# #{level\ 1231}# 0)
+ (values #{var\ 1230}# #{maps\ 1232}#)
+ (if (null? #{maps\ 1232}#)
(syntax-violation
'syntax
"missing ellipsis"
- #{src\ 1292}#)
+ #{src\ 1229}#)
(call-with-values
(lambda ()
- (#{gen-ref\ 1267}#
- #{src\ 1292}#
- #{var\ 1293}#
- (#{fx-\ 87}# #{level\ 1294}# 1)
- (cdr #{maps\ 1295}#)))
- (lambda (#{outer-var\ 1296}# #{outer-maps\ 1297}#)
- (let ((#{b\ 1298}#
- (assq #{outer-var\ 1296}#
- (car #{maps\ 1295}#))))
- (if #{b\ 1298}#
- (values (cdr #{b\ 1298}#) #{maps\ 1295}#)
- (let ((#{inner-var\ 1299}#
+ (#{gen-ref\ 1204}#
+ #{src\ 1229}#
+ #{var\ 1230}#
+ (#{fx-\ 87}# #{level\ 1231}# 1)
+ (cdr #{maps\ 1232}#)))
+ (lambda (#{outer-var\ 1233}# #{outer-maps\ 1234}#)
+ (let ((#{b\ 1235}#
+ (assq #{outer-var\ 1233}#
+ (car #{maps\ 1232}#))))
+ (if #{b\ 1235}#
+ (values (cdr #{b\ 1235}#) #{maps\ 1232}#)
+ (let ((#{inner-var\ 1236}#
(#{gen-var\ 181}# (quote tmp))))
(values
- #{inner-var\ 1299}#
- (cons (cons (cons #{outer-var\ 1296}#
- #{inner-var\ 1299}#)
- (car #{maps\ 1295}#))
- #{outer-maps\ 1297}#)))))))))))
- (#{gen-syntax\ 1266}#
- (lambda (#{src\ 1300}#
- #{e\ 1301}#
- #{r\ 1302}#
- #{maps\ 1303}#
- #{ellipsis?\ 1304}#
- #{mod\ 1305}#)
- (if (#{id?\ 131}# #{e\ 1301}#)
- (let ((#{label\ 1306}#
+ #{inner-var\ 1236}#
+ (cons (cons (cons #{outer-var\ 1233}#
+ #{inner-var\ 1236}#)
+ (car #{maps\ 1232}#))
+ #{outer-maps\ 1234}#)))))))))))
+ (#{gen-syntax\ 1203}#
+ (lambda (#{src\ 1237}#
+ #{e\ 1238}#
+ #{r\ 1239}#
+ #{maps\ 1240}#
+ #{ellipsis?\ 1241}#
+ #{mod\ 1242}#)
+ (if (#{id?\ 131}# #{e\ 1238}#)
+ (let ((#{label\ 1243}#
(#{id-var-name\ 153}#
- #{e\ 1301}#
+ #{e\ 1238}#
'(()))))
- (let ((#{b\ 1307}#
+ (let ((#{b\ 1244}#
(#{lookup\ 128}#
- #{label\ 1306}#
- #{r\ 1302}#
- #{mod\ 1305}#)))
- (if (eq? (#{binding-type\ 123}# #{b\ 1307}#)
+ #{label\ 1243}#
+ #{r\ 1239}#
+ #{mod\ 1242}#)))
+ (if (eq? (#{binding-type\ 123}# #{b\ 1244}#)
'syntax)
(call-with-values
(lambda ()
- (let ((#{var.lev\ 1308}#
- (#{binding-value\ 124}# #{b\ 1307}#)))
- (#{gen-ref\ 1267}#
- #{src\ 1300}#
- (car #{var.lev\ 1308}#)
- (cdr #{var.lev\ 1308}#)
- #{maps\ 1303}#)))
- (lambda (#{var\ 1309}# #{maps\ 1310}#)
+ (let ((#{var.lev\ 1245}#
+ (#{binding-value\ 124}# #{b\ 1244}#)))
+ (#{gen-ref\ 1204}#
+ #{src\ 1237}#
+ (car #{var.lev\ 1245}#)
+ (cdr #{var.lev\ 1245}#)
+ #{maps\ 1240}#)))
+ (lambda (#{var\ 1246}# #{maps\ 1247}#)
(values
- (list (quote ref) #{var\ 1309}#)
- #{maps\ 1310}#)))
- (if (#{ellipsis?\ 1304}# #{e\ 1301}#)
+ (list (quote ref) #{var\ 1246}#)
+ #{maps\ 1247}#)))
+ (if (#{ellipsis?\ 1241}# #{e\ 1238}#)
(syntax-violation
'syntax
"misplaced ellipsis"
- #{src\ 1300}#)
+ #{src\ 1237}#)
(values
- (list (quote quote) #{e\ 1301}#)
- #{maps\ 1303}#)))))
- ((lambda (#{tmp\ 1311}#)
- ((lambda (#{tmp\ 1312}#)
- (if (if #{tmp\ 1312}#
- (apply (lambda (#{dots\ 1313}# #{e\ 1314}#)
- (#{ellipsis?\ 1304}#
- #{dots\ 1313}#))
- #{tmp\ 1312}#)
+ (list (quote quote) #{e\ 1238}#)
+ #{maps\ 1240}#)))))
+ ((lambda (#{tmp\ 1248}#)
+ ((lambda (#{tmp\ 1249}#)
+ (if (if #{tmp\ 1249}#
+ (apply (lambda (#{dots\ 1250}# #{e\ 1251}#)
+ (#{ellipsis?\ 1241}#
+ #{dots\ 1250}#))
+ #{tmp\ 1249}#)
#f)
- (apply (lambda (#{dots\ 1315}# #{e\ 1316}#)
- (#{gen-syntax\ 1266}#
- #{src\ 1300}#
- #{e\ 1316}#
- #{r\ 1302}#
- #{maps\ 1303}#
- (lambda (#{x\ 1317}#) #f)
- #{mod\ 1305}#))
- #{tmp\ 1312}#)
- ((lambda (#{tmp\ 1318}#)
- (if (if #{tmp\ 1318}#
- (apply (lambda (#{x\ 1319}#
- #{dots\ 1320}#
- #{y\ 1321}#)
- (#{ellipsis?\ 1304}#
- #{dots\ 1320}#))
- #{tmp\ 1318}#)
+ (apply (lambda (#{dots\ 1252}# #{e\ 1253}#)
+ (#{gen-syntax\ 1203}#
+ #{src\ 1237}#
+ #{e\ 1253}#
+ #{r\ 1239}#
+ #{maps\ 1240}#
+ (lambda (#{x\ 1254}#) #f)
+ #{mod\ 1242}#))
+ #{tmp\ 1249}#)
+ ((lambda (#{tmp\ 1255}#)
+ (if (if #{tmp\ 1255}#
+ (apply (lambda (#{x\ 1256}#
+ #{dots\ 1257}#
+ #{y\ 1258}#)
+ (#{ellipsis?\ 1241}#
+ #{dots\ 1257}#))
+ #{tmp\ 1255}#)
#f)
- (apply (lambda (#{x\ 1322}#
- #{dots\ 1323}#
- #{y\ 1324}#)
- (letrec ((#{f\ 1325}#
- (lambda (#{y\ 1326}#
- #{k\ 1327}#)
- ((lambda (#{tmp\
1331}#)
- ((lambda (#{tmp\
1332}#)
- (if (if #{tmp\
1332}#
- (apply
(lambda (#{dots\ 1333}#
-
#{y\ 1334}#)
-
(#{ellipsis?\ 1304}#
-
#{dots\ 1333}#))
-
#{tmp\ 1332}#)
+ (apply (lambda (#{x\ 1259}#
+ #{dots\ 1260}#
+ #{y\ 1261}#)
+ (letrec ((#{f\ 1262}#
+ (lambda (#{y\ 1263}#
+ #{k\ 1264}#)
+ ((lambda (#{tmp\
1268}#)
+ ((lambda (#{tmp\
1269}#)
+ (if (if #{tmp\
1269}#
+ (apply
(lambda (#{dots\ 1270}#
+
#{y\ 1271}#)
+
(#{ellipsis?\ 1241}#
+
#{dots\ 1270}#))
+
#{tmp\ 1269}#)
#f)
- (apply
(lambda (#{dots\ 1335}#
-
#{y\ 1336}#)
-
(#{f\ 1325}#
-
#{y\ 1336}#
-
(lambda (#{maps\ 1337}#)
+ (apply
(lambda (#{dots\ 1272}#
+
#{y\ 1273}#)
+
(#{f\ 1262}#
+
#{y\ 1273}#
+
(lambda (#{maps\ 1274}#)
(call-with-values
(lambda ()
-
(#{k\ 1327}#
+
(#{k\ 1264}#
(cons '()
-
#{maps\ 1337}#)))
-
(lambda (#{x\ 1338}#
-
#{maps\ 1339}#)
-
(if (null? (car #{maps\ 1339}#))
+
#{maps\ 1274}#)))
+
(lambda (#{x\ 1275}#
+
#{maps\ 1276}#)
+
(if (null? (car #{maps\ 1276}#))
(syntax-violation
'syntax
"extra ellipsis"
-
#{src\ 1300}#)
+
#{src\ 1237}#)
(values
-
(#{gen-mappend\ 1268}#
-
#{x\ 1338}#
-
(car #{maps\ 1339}#))
-
(cdr #{maps\ 1339}#))))))))
-
#{tmp\ 1332}#)
- ((lambda
(#{_\ 1340}#)
+
(#{gen-mappend\ 1205}#
+
#{x\ 1275}#
+
(car #{maps\ 1276}#))
+
(cdr #{maps\ 1276}#))))))))
+
#{tmp\ 1269}#)
+ ((lambda
(#{_\ 1277}#)
(call-with-values
(lambda
()
-
(#{gen-syntax\ 1266}#
-
#{src\ 1300}#
-
#{y\ 1326}#
-
#{r\ 1302}#
-
#{maps\ 1303}#
-
#{ellipsis?\ 1304}#
-
#{mod\ 1305}#))
- (lambda
(#{y\ 1341}#
-
#{maps\ 1342}#)
+
(#{gen-syntax\ 1203}#
+
#{src\ 1237}#
+
#{y\ 1263}#
+
#{r\ 1239}#
+
#{maps\ 1240}#
+
#{ellipsis?\ 1241}#
+
#{mod\ 1242}#))
+ (lambda
(#{y\ 1278}#
+
#{maps\ 1279}#)
(call-with-values
(lambda ()
-
(#{k\ 1327}#
-
#{maps\ 1342}#))
-
(lambda (#{x\ 1343}#
-
#{maps\ 1344}#)
+
(#{k\ 1264}#
+
#{maps\ 1279}#))
+
(lambda (#{x\ 1280}#
+
#{maps\ 1281}#)
(values
-
(#{gen-append\ 1271}#
-
#{x\ 1343}#
-
#{y\ 1341}#)
-
#{maps\ 1344}#))))))
- #{tmp\
1331}#)))
+
(#{gen-append\ 1208}#
+
#{x\ 1280}#
+
#{y\ 1278}#)
+
#{maps\ 1281}#))))))
+ #{tmp\
1268}#)))
($sc-dispatch
- #{tmp\ 1331}#
+ #{tmp\ 1268}#
'(any . any))))
- #{y\ 1326}#))))
- (#{f\ 1325}#
- #{y\ 1324}#
- (lambda (#{maps\ 1328}#)
+ #{y\ 1263}#))))
+ (#{f\ 1262}#
+ #{y\ 1261}#
+ (lambda (#{maps\ 1265}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 1266}#
- #{src\ 1300}#
- #{x\ 1322}#
- #{r\ 1302}#
+ (#{gen-syntax\ 1203}#
+ #{src\ 1237}#
+ #{x\ 1259}#
+ #{r\ 1239}#
(cons '()
- #{maps\ 1328}#)
- #{ellipsis?\ 1304}#
- #{mod\ 1305}#))
- (lambda (#{x\ 1329}#
- #{maps\ 1330}#)
- (if (null? (car #{maps\
1330}#))
+ #{maps\ 1265}#)
+ #{ellipsis?\ 1241}#
+ #{mod\ 1242}#))
+ (lambda (#{x\ 1266}#
+ #{maps\ 1267}#)
+ (if (null? (car #{maps\
1267}#))
(syntax-violation
'syntax
"extra ellipsis"
- #{src\ 1300}#)
+ #{src\ 1237}#)
(values
- (#{gen-map\ 1269}#
- #{x\ 1329}#
- (car #{maps\
1330}#))
- (cdr #{maps\
1330}#)))))))))
- #{tmp\ 1318}#)
- ((lambda (#{tmp\ 1345}#)
- (if #{tmp\ 1345}#
- (apply (lambda (#{x\ 1346}#
- #{y\ 1347}#)
+ (#{gen-map\ 1206}#
+ #{x\ 1266}#
+ (car #{maps\
1267}#))
+ (cdr #{maps\
1267}#)))))))))
+ #{tmp\ 1255}#)
+ ((lambda (#{tmp\ 1282}#)
+ (if #{tmp\ 1282}#
+ (apply (lambda (#{x\ 1283}#
+ #{y\ 1284}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 1266}#
- #{src\ 1300}#
- #{x\ 1346}#
- #{r\ 1302}#
- #{maps\ 1303}#
- #{ellipsis?\ 1304}#
- #{mod\ 1305}#))
- (lambda (#{x\ 1348}#
- #{maps\ 1349}#)
+ (#{gen-syntax\ 1203}#
+ #{src\ 1237}#
+ #{x\ 1283}#
+ #{r\ 1239}#
+ #{maps\ 1240}#
+ #{ellipsis?\ 1241}#
+ #{mod\ 1242}#))
+ (lambda (#{x\ 1285}#
+ #{maps\ 1286}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 1266}#
- #{src\ 1300}#
- #{y\ 1347}#
- #{r\ 1302}#
- #{maps\ 1349}#
- #{ellipsis?\ 1304}#
- #{mod\ 1305}#))
- (lambda (#{y\ 1350}#
- #{maps\
1351}#)
+ (#{gen-syntax\ 1203}#
+ #{src\ 1237}#
+ #{y\ 1284}#
+ #{r\ 1239}#
+ #{maps\ 1286}#
+ #{ellipsis?\ 1241}#
+ #{mod\ 1242}#))
+ (lambda (#{y\ 1287}#
+ #{maps\
1288}#)
(values
- (#{gen-cons\ 1270}#
- #{x\ 1348}#
- #{y\ 1350}#)
- #{maps\
1351}#))))))
- #{tmp\ 1345}#)
- ((lambda (#{tmp\ 1352}#)
- (if #{tmp\ 1352}#
- (apply (lambda (#{e1\ 1353}#
- #{e2\ 1354}#)
+ (#{gen-cons\ 1207}#
+ #{x\ 1285}#
+ #{y\ 1287}#)
+ #{maps\
1288}#))))))
+ #{tmp\ 1282}#)
+ ((lambda (#{tmp\ 1289}#)
+ (if #{tmp\ 1289}#
+ (apply (lambda (#{e1\ 1290}#
+ #{e2\ 1291}#)
(call-with-values
(lambda ()
- (#{gen-syntax\
1266}#
- #{src\ 1300}#
- (cons #{e1\ 1353}#
- #{e2\
1354}#)
- #{r\ 1302}#
- #{maps\ 1303}#
- #{ellipsis?\
1304}#
- #{mod\ 1305}#))
- (lambda (#{e\ 1356}#
- #{maps\
1357}#)
+ (#{gen-syntax\
1203}#
+ #{src\ 1237}#
+ (cons #{e1\ 1290}#
+ #{e2\
1291}#)
+ #{r\ 1239}#
+ #{maps\ 1240}#
+ #{ellipsis?\
1241}#
+ #{mod\ 1242}#))
+ (lambda (#{e\ 1293}#
+ #{maps\
1294}#)
(values
- (#{gen-vector\
1272}#
- #{e\ 1356}#)
- #{maps\ 1357}#))))
- #{tmp\ 1352}#)
- ((lambda (#{_\ 1358}#)
+ (#{gen-vector\
1209}#
+ #{e\ 1293}#)
+ #{maps\ 1294}#))))
+ #{tmp\ 1289}#)
+ ((lambda (#{_\ 1295}#)
(values
(list 'quote
- #{e\ 1301}#)
- #{maps\ 1303}#))
- #{tmp\ 1311}#)))
+ #{e\ 1238}#)
+ #{maps\ 1240}#))
+ #{tmp\ 1248}#)))
($sc-dispatch
- #{tmp\ 1311}#
+ #{tmp\ 1248}#
'#(vector (any . each-any))))))
($sc-dispatch
- #{tmp\ 1311}#
+ #{tmp\ 1248}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 1311}#
+ #{tmp\ 1248}#
'(any any . any)))))
- ($sc-dispatch #{tmp\ 1311}# (quote (any any)))))
- #{e\ 1301}#)))))
- (lambda (#{e\ 1359}#
- #{r\ 1360}#
- #{w\ 1361}#
- #{s\ 1362}#
- #{mod\ 1363}#)
- (let ((#{e\ 1364}#
+ ($sc-dispatch #{tmp\ 1248}# (quote (any any)))))
+ #{e\ 1238}#)))))
+ (lambda (#{e\ 1296}#
+ #{r\ 1297}#
+ #{w\ 1298}#
+ #{s\ 1299}#
+ #{mod\ 1300}#)
+ (let ((#{e\ 1301}#
(#{source-wrap\ 160}#
- #{e\ 1359}#
- #{w\ 1361}#
- #{s\ 1362}#
- #{mod\ 1363}#)))
- ((lambda (#{tmp\ 1365}#)
- ((lambda (#{tmp\ 1366}#)
- (if #{tmp\ 1366}#
- (apply (lambda (#{_\ 1367}# #{x\ 1368}#)
+ #{e\ 1296}#
+ #{w\ 1298}#
+ #{s\ 1299}#
+ #{mod\ 1300}#)))
+ ((lambda (#{tmp\ 1302}#)
+ ((lambda (#{tmp\ 1303}#)
+ (if #{tmp\ 1303}#
+ (apply (lambda (#{_\ 1304}# #{x\ 1305}#)
(call-with-values
(lambda ()
- (#{gen-syntax\ 1266}#
- #{e\ 1364}#
- #{x\ 1368}#
- #{r\ 1360}#
+ (#{gen-syntax\ 1203}#
+ #{e\ 1301}#
+ #{x\ 1305}#
+ #{r\ 1297}#
'()
#{ellipsis?\ 175}#
- #{mod\ 1363}#))
- (lambda (#{e\ 1369}# #{maps\ 1370}#)
- (#{regen\ 1273}# #{e\ 1369}#))))
- #{tmp\ 1366}#)
- ((lambda (#{_\ 1371}#)
+ #{mod\ 1300}#))
+ (lambda (#{e\ 1306}# #{maps\ 1307}#)
+ (#{regen\ 1210}# #{e\ 1306}#))))
+ #{tmp\ 1303}#)
+ ((lambda (#{_\ 1308}#)
(syntax-violation
'syntax
"bad `syntax' form"
- #{e\ 1364}#))
- #{tmp\ 1365}#)))
- ($sc-dispatch #{tmp\ 1365}# (quote (any any)))))
- #{e\ 1364}#)))))
+ #{e\ 1301}#))
+ #{tmp\ 1302}#)))
+ ($sc-dispatch #{tmp\ 1302}# (quote (any any)))))
+ #{e\ 1301}#)))))
(#{global-extend\ 129}#
'core
'lambda
- (lambda (#{e\ 1372}#
- #{r\ 1373}#
- #{w\ 1374}#
- #{s\ 1375}#
- #{mod\ 1376}#)
- ((lambda (#{tmp\ 1377}#)
- ((lambda (#{tmp\ 1378}#)
- (if (if #{tmp\ 1378}#
- (apply (lambda (#{_\ 1379}#
- #{args\ 1380}#
- #{docstring\ 1381}#
- #{e1\ 1382}#
- #{e2\ 1383}#)
- (string? (syntax->datum #{docstring\ 1381}#)))
- #{tmp\ 1378}#)
+ (lambda (#{e\ 1309}#
+ #{r\ 1310}#
+ #{w\ 1311}#
+ #{s\ 1312}#
+ #{mod\ 1313}#)
+ ((lambda (#{tmp\ 1314}#)
+ ((lambda (#{tmp\ 1315}#)
+ (if (if #{tmp\ 1315}#
+ (apply (lambda (#{_\ 1316}#
+ #{args\ 1317}#
+ #{docstring\ 1318}#
+ #{e1\ 1319}#
+ #{e2\ 1320}#)
+ (string? (syntax->datum #{docstring\ 1318}#)))
+ #{tmp\ 1315}#)
#f)
- (apply (lambda (#{_\ 1384}#
- #{args\ 1385}#
- #{docstring\ 1386}#
- #{e1\ 1387}#
- #{e2\ 1388}#)
+ (apply (lambda (#{_\ 1321}#
+ #{args\ 1322}#
+ #{docstring\ 1323}#
+ #{e1\ 1324}#
+ #{e2\ 1325}#)
(call-with-values
(lambda ()
- (#{lambda-formals\ 176}# #{args\ 1385}#))
- (lambda (#{req\ 1389}#
- #{opt\ 1390}#
- #{rest\ 1391}#
- #{kw\ 1392}#
- #{pred\ 1393}#)
+ (#{lambda-formals\ 176}# #{args\ 1322}#))
+ (lambda (#{req\ 1326}#
+ #{opt\ 1327}#
+ #{rest\ 1328}#
+ #{kw\ 1329}#)
(#{chi-simple-lambda\ 177}#
- #{e\ 1372}#
- #{r\ 1373}#
- #{w\ 1374}#
- #{s\ 1375}#
- #{mod\ 1376}#
- #{req\ 1389}#
- #{rest\ 1391}#
- (syntax->datum #{docstring\ 1386}#)
- (cons #{e1\ 1387}# #{e2\ 1388}#)))))
- #{tmp\ 1378}#)
- ((lambda (#{tmp\ 1395}#)
- (if #{tmp\ 1395}#
- (apply (lambda (#{_\ 1396}#
- #{args\ 1397}#
- #{e1\ 1398}#
- #{e2\ 1399}#)
+ #{e\ 1309}#
+ #{r\ 1310}#
+ #{w\ 1311}#
+ #{s\ 1312}#
+ #{mod\ 1313}#
+ #{req\ 1326}#
+ #{rest\ 1328}#
+ (syntax->datum #{docstring\ 1323}#)
+ (cons #{e1\ 1324}# #{e2\ 1325}#)))))
+ #{tmp\ 1315}#)
+ ((lambda (#{tmp\ 1331}#)
+ (if #{tmp\ 1331}#
+ (apply (lambda (#{_\ 1332}#
+ #{args\ 1333}#
+ #{e1\ 1334}#
+ #{e2\ 1335}#)
(call-with-values
(lambda ()
- (#{lambda-formals\ 176}# #{args\ 1397}#))
- (lambda (#{req\ 1400}#
- #{opt\ 1401}#
- #{rest\ 1402}#
- #{kw\ 1403}#
- #{pred\ 1404}#)
+ (#{lambda-formals\ 176}# #{args\ 1333}#))
+ (lambda (#{req\ 1336}#
+ #{opt\ 1337}#
+ #{rest\ 1338}#
+ #{kw\ 1339}#)
(#{chi-simple-lambda\ 177}#
- #{e\ 1372}#
- #{r\ 1373}#
- #{w\ 1374}#
- #{s\ 1375}#
- #{mod\ 1376}#
- #{req\ 1400}#
- #{rest\ 1402}#
+ #{e\ 1309}#
+ #{r\ 1310}#
+ #{w\ 1311}#
+ #{s\ 1312}#
+ #{mod\ 1313}#
+ #{req\ 1336}#
+ #{rest\ 1338}#
#f
- (cons #{e1\ 1398}# #{e2\ 1399}#)))))
- #{tmp\ 1395}#)
- ((lambda (#{_\ 1406}#)
+ (cons #{e1\ 1334}# #{e2\ 1335}#)))))
+ #{tmp\ 1331}#)
+ ((lambda (#{_\ 1341}#)
(syntax-violation
'lambda
"bad lambda"
- #{e\ 1372}#))
- #{tmp\ 1377}#)))
+ #{e\ 1309}#))
+ #{tmp\ 1314}#)))
($sc-dispatch
- #{tmp\ 1377}#
+ #{tmp\ 1314}#
'(any any any . each-any)))))
($sc-dispatch
- #{tmp\ 1377}#
+ #{tmp\ 1314}#
'(any any any any . each-any))))
- #{e\ 1372}#)))
+ #{e\ 1309}#)))
(#{global-extend\ 129}#
'core
'lambda*
- (lambda (#{e\ 1407}#
- #{r\ 1408}#
- #{w\ 1409}#
- #{s\ 1410}#
- #{mod\ 1411}#)
- ((lambda (#{tmp\ 1412}#)
- ((lambda (#{tmp\ 1413}#)
- (if #{tmp\ 1413}#
- (apply (lambda (#{_\ 1414}#
- #{args\ 1415}#
- #{e1\ 1416}#
- #{e2\ 1417}#)
+ (lambda (#{e\ 1342}#
+ #{r\ 1343}#
+ #{w\ 1344}#
+ #{s\ 1345}#
+ #{mod\ 1346}#)
+ ((lambda (#{tmp\ 1347}#)
+ ((lambda (#{tmp\ 1348}#)
+ (if #{tmp\ 1348}#
+ (apply (lambda (#{_\ 1349}#
+ #{args\ 1350}#
+ #{e1\ 1351}#
+ #{e2\ 1352}#)
(call-with-values
(lambda ()
(#{chi-lambda-case\ 179}#
- #{e\ 1407}#
- #{r\ 1408}#
- #{w\ 1409}#
- #{s\ 1410}#
- #{mod\ 1411}#
+ #{e\ 1342}#
+ #{r\ 1343}#
+ #{w\ 1344}#
+ #{s\ 1345}#
+ #{mod\ 1346}#
#{lambda*-formals\ 178}#
- (list (cons #{args\ 1415}#
- (cons #{e1\ 1416}#
- #{e2\ 1417}#)))))
- (lambda (#{docstring\ 1419}# #{lcase\ 1420}#)
+ (list (cons #{args\ 1350}#
+ (cons #{e1\ 1351}#
+ #{e2\ 1352}#)))))
+ (lambda (#{docstring\ 1354}# #{lcase\ 1355}#)
(#{build-case-lambda\ 106}#
- #{s\ 1410}#
- #{docstring\ 1419}#
- #{lcase\ 1420}#))))
- #{tmp\ 1413}#)
- ((lambda (#{_\ 1421}#)
+ #{s\ 1345}#
+ #{docstring\ 1354}#
+ #{lcase\ 1355}#))))
+ #{tmp\ 1348}#)
+ ((lambda (#{_\ 1356}#)
(syntax-violation
'lambda
"bad lambda*"
- #{e\ 1407}#))
- #{tmp\ 1412}#)))
+ #{e\ 1342}#))
+ #{tmp\ 1347}#)))
($sc-dispatch
- #{tmp\ 1412}#
+ #{tmp\ 1347}#
'(any any any . each-any))))
- #{e\ 1407}#)))
+ #{e\ 1342}#)))
(#{global-extend\ 129}#
'core
'case-lambda
- (lambda (#{e\ 1422}#
- #{r\ 1423}#
- #{w\ 1424}#
- #{s\ 1425}#
- #{mod\ 1426}#)
- ((lambda (#{tmp\ 1427}#)
- ((lambda (#{tmp\ 1428}#)
- (if #{tmp\ 1428}#
- (apply (lambda (#{_\ 1429}#
- #{args\ 1430}#
- #{e1\ 1431}#
- #{e2\ 1432}#
- #{args*\ 1433}#
- #{e1*\ 1434}#
- #{e2*\ 1435}#)
+ (lambda (#{e\ 1357}#
+ #{r\ 1358}#
+ #{w\ 1359}#
+ #{s\ 1360}#
+ #{mod\ 1361}#)
+ ((lambda (#{tmp\ 1362}#)
+ ((lambda (#{tmp\ 1363}#)
+ (if #{tmp\ 1363}#
+ (apply (lambda (#{_\ 1364}#
+ #{args\ 1365}#
+ #{e1\ 1366}#
+ #{e2\ 1367}#
+ #{args*\ 1368}#
+ #{e1*\ 1369}#
+ #{e2*\ 1370}#)
(call-with-values
(lambda ()
(#{chi-lambda-case\ 179}#
- #{e\ 1422}#
- #{r\ 1423}#
- #{w\ 1424}#
- #{s\ 1425}#
- #{mod\ 1426}#
+ #{e\ 1357}#
+ #{r\ 1358}#
+ #{w\ 1359}#
+ #{s\ 1360}#
+ #{mod\ 1361}#
#{lambda-formals\ 176}#
- (cons (cons #{args\ 1430}#
- (cons #{e1\ 1431}# #{e2\ 1432}#))
- (map (lambda (#{tmp\ 1439}#
- #{tmp\ 1438}#
- #{tmp\ 1437}#)
- (cons #{tmp\ 1437}#
- (cons #{tmp\ 1438}#
- #{tmp\ 1439}#)))
- #{e2*\ 1435}#
- #{e1*\ 1434}#
- #{args*\ 1433}#))))
- (lambda (#{docstring\ 1441}# #{lcase\ 1442}#)
+ (cons (cons #{args\ 1365}#
+ (cons #{e1\ 1366}# #{e2\ 1367}#))
+ (map (lambda (#{tmp\ 1374}#
+ #{tmp\ 1373}#
+ #{tmp\ 1372}#)
+ (cons #{tmp\ 1372}#
+ (cons #{tmp\ 1373}#
+ #{tmp\ 1374}#)))
+ #{e2*\ 1370}#
+ #{e1*\ 1369}#
+ #{args*\ 1368}#))))
+ (lambda (#{docstring\ 1376}# #{lcase\ 1377}#)
(#{build-case-lambda\ 106}#
- #{s\ 1425}#
- #{docstring\ 1441}#
- #{lcase\ 1442}#))))
- #{tmp\ 1428}#)
- ((lambda (#{_\ 1443}#)
+ #{s\ 1360}#
+ #{docstring\ 1376}#
+ #{lcase\ 1377}#))))
+ #{tmp\ 1363}#)
+ ((lambda (#{_\ 1378}#)
(syntax-violation
'case-lambda
"bad case-lambda"
- #{e\ 1422}#))
- #{tmp\ 1427}#)))
+ #{e\ 1357}#))
+ #{tmp\ 1362}#)))
($sc-dispatch
- #{tmp\ 1427}#
+ #{tmp\ 1362}#
'(any (any any . each-any)
.
#(each (any any . each-any))))))
- #{e\ 1422}#)))
+ #{e\ 1357}#)))
(#{global-extend\ 129}#
'core
'case-lambda*
- (lambda (#{e\ 1444}#
- #{r\ 1445}#
- #{w\ 1446}#
- #{s\ 1447}#
- #{mod\ 1448}#)
- ((lambda (#{tmp\ 1449}#)
- ((lambda (#{tmp\ 1450}#)
- (if #{tmp\ 1450}#
- (apply (lambda (#{_\ 1451}#
- #{args\ 1452}#
- #{e1\ 1453}#
- #{e2\ 1454}#
- #{args*\ 1455}#
- #{e1*\ 1456}#
- #{e2*\ 1457}#)
+ (lambda (#{e\ 1379}#
+ #{r\ 1380}#
+ #{w\ 1381}#
+ #{s\ 1382}#
+ #{mod\ 1383}#)
+ ((lambda (#{tmp\ 1384}#)
+ ((lambda (#{tmp\ 1385}#)
+ (if #{tmp\ 1385}#
+ (apply (lambda (#{_\ 1386}#
+ #{args\ 1387}#
+ #{e1\ 1388}#
+ #{e2\ 1389}#
+ #{args*\ 1390}#
+ #{e1*\ 1391}#
+ #{e2*\ 1392}#)
(call-with-values
(lambda ()
(#{chi-lambda-case\ 179}#
- #{e\ 1444}#
- #{r\ 1445}#
- #{w\ 1446}#
- #{s\ 1447}#
- #{mod\ 1448}#
+ #{e\ 1379}#
+ #{r\ 1380}#
+ #{w\ 1381}#
+ #{s\ 1382}#
+ #{mod\ 1383}#
#{lambda*-formals\ 178}#
- (cons (cons #{args\ 1452}#
- (cons #{e1\ 1453}# #{e2\ 1454}#))
- (map (lambda (#{tmp\ 1461}#
- #{tmp\ 1460}#
- #{tmp\ 1459}#)
- (cons #{tmp\ 1459}#
- (cons #{tmp\ 1460}#
- #{tmp\ 1461}#)))
- #{e2*\ 1457}#
- #{e1*\ 1456}#
- #{args*\ 1455}#))))
- (lambda (#{docstring\ 1463}# #{lcase\ 1464}#)
+ (cons (cons #{args\ 1387}#
+ (cons #{e1\ 1388}# #{e2\ 1389}#))
+ (map (lambda (#{tmp\ 1396}#
+ #{tmp\ 1395}#
+ #{tmp\ 1394}#)
+ (cons #{tmp\ 1394}#
+ (cons #{tmp\ 1395}#
+ #{tmp\ 1396}#)))
+ #{e2*\ 1392}#
+ #{e1*\ 1391}#
+ #{args*\ 1390}#))))
+ (lambda (#{docstring\ 1398}# #{lcase\ 1399}#)
(#{build-case-lambda\ 106}#
- #{s\ 1447}#
- #{docstring\ 1463}#
- #{lcase\ 1464}#))))
- #{tmp\ 1450}#)
- ((lambda (#{_\ 1465}#)
+ #{s\ 1382}#
+ #{docstring\ 1398}#
+ #{lcase\ 1399}#))))
+ #{tmp\ 1385}#)
+ ((lambda (#{_\ 1400}#)
(syntax-violation
'case-lambda
"bad case-lambda*"
- #{e\ 1444}#))
- #{tmp\ 1449}#)))
+ #{e\ 1379}#))
+ #{tmp\ 1384}#)))
($sc-dispatch
- #{tmp\ 1449}#
+ #{tmp\ 1384}#
'(any (any any . each-any)
.
#(each (any any . each-any))))))
- #{e\ 1444}#)))
+ #{e\ 1379}#)))
(#{global-extend\ 129}#
'core
'let
- (letrec ((#{chi-let\ 1466}#
- (lambda (#{e\ 1467}#
- #{r\ 1468}#
- #{w\ 1469}#
- #{s\ 1470}#
- #{mod\ 1471}#
- #{constructor\ 1472}#
- #{ids\ 1473}#
- #{vals\ 1474}#
- #{exps\ 1475}#)
- (if (not (#{valid-bound-ids?\ 156}# #{ids\ 1473}#))
+ (letrec ((#{chi-let\ 1401}#
+ (lambda (#{e\ 1402}#
+ #{r\ 1403}#
+ #{w\ 1404}#
+ #{s\ 1405}#
+ #{mod\ 1406}#
+ #{constructor\ 1407}#
+ #{ids\ 1408}#
+ #{vals\ 1409}#
+ #{exps\ 1410}#)
+ (if (not (#{valid-bound-ids?\ 156}# #{ids\ 1408}#))
(syntax-violation
'let
"duplicate bound variable"
- #{e\ 1467}#)
- (let ((#{labels\ 1476}#
- (#{gen-labels\ 137}# #{ids\ 1473}#))
- (#{new-vars\ 1477}#
- (map #{gen-var\ 181}# #{ids\ 1473}#)))
- (let ((#{nw\ 1478}#
+ #{e\ 1402}#)
+ (let ((#{labels\ 1411}#
+ (#{gen-labels\ 137}# #{ids\ 1408}#))
+ (#{new-vars\ 1412}#
+ (map #{gen-var\ 181}# #{ids\ 1408}#)))
+ (let ((#{nw\ 1413}#
(#{make-binding-wrap\ 148}#
- #{ids\ 1473}#
- #{labels\ 1476}#
- #{w\ 1469}#))
- (#{nr\ 1479}#
+ #{ids\ 1408}#
+ #{labels\ 1411}#
+ #{w\ 1404}#))
+ (#{nr\ 1414}#
(#{extend-var-env\ 126}#
- #{labels\ 1476}#
- #{new-vars\ 1477}#
- #{r\ 1468}#)))
- (#{constructor\ 1472}#
- #{s\ 1470}#
- (map syntax->datum #{ids\ 1473}#)
- #{new-vars\ 1477}#
- (map (lambda (#{x\ 1480}#)
+ #{labels\ 1411}#
+ #{new-vars\ 1412}#
+ #{r\ 1403}#)))
+ (#{constructor\ 1407}#
+ #{s\ 1405}#
+ (map syntax->datum #{ids\ 1408}#)
+ #{new-vars\ 1412}#
+ (map (lambda (#{x\ 1415}#)
(#{chi\ 167}#
- #{x\ 1480}#
- #{r\ 1468}#
- #{w\ 1469}#
- #{mod\ 1471}#))
- #{vals\ 1474}#)
+ #{x\ 1415}#
+ #{r\ 1403}#
+ #{w\ 1404}#
+ #{mod\ 1406}#))
+ #{vals\ 1409}#)
(#{chi-body\ 171}#
- #{exps\ 1475}#
+ #{exps\ 1410}#
(#{source-wrap\ 160}#
- #{e\ 1467}#
- #{nw\ 1478}#
- #{s\ 1470}#
- #{mod\ 1471}#)
- #{nr\ 1479}#
- #{nw\ 1478}#
- #{mod\ 1471}#))))))))
- (lambda (#{e\ 1481}#
- #{r\ 1482}#
- #{w\ 1483}#
- #{s\ 1484}#
- #{mod\ 1485}#)
- ((lambda (#{tmp\ 1486}#)
- ((lambda (#{tmp\ 1487}#)
- (if (if #{tmp\ 1487}#
- (apply (lambda (#{_\ 1488}#
- #{id\ 1489}#
- #{val\ 1490}#
- #{e1\ 1491}#
- #{e2\ 1492}#)
- (and-map #{id?\ 131}# #{id\ 1489}#))
- #{tmp\ 1487}#)
+ #{e\ 1402}#
+ #{nw\ 1413}#
+ #{s\ 1405}#
+ #{mod\ 1406}#)
+ #{nr\ 1414}#
+ #{nw\ 1413}#
+ #{mod\ 1406}#))))))))
+ (lambda (#{e\ 1416}#
+ #{r\ 1417}#
+ #{w\ 1418}#
+ #{s\ 1419}#
+ #{mod\ 1420}#)
+ ((lambda (#{tmp\ 1421}#)
+ ((lambda (#{tmp\ 1422}#)
+ (if (if #{tmp\ 1422}#
+ (apply (lambda (#{_\ 1423}#
+ #{id\ 1424}#
+ #{val\ 1425}#
+ #{e1\ 1426}#
+ #{e2\ 1427}#)
+ (and-map #{id?\ 131}# #{id\ 1424}#))
+ #{tmp\ 1422}#)
#f)
- (apply (lambda (#{_\ 1494}#
- #{id\ 1495}#
- #{val\ 1496}#
- #{e1\ 1497}#
- #{e2\ 1498}#)
- (#{chi-let\ 1466}#
- #{e\ 1481}#
- #{r\ 1482}#
- #{w\ 1483}#
- #{s\ 1484}#
- #{mod\ 1485}#
+ (apply (lambda (#{_\ 1429}#
+ #{id\ 1430}#
+ #{val\ 1431}#
+ #{e1\ 1432}#
+ #{e2\ 1433}#)
+ (#{chi-let\ 1401}#
+ #{e\ 1416}#
+ #{r\ 1417}#
+ #{w\ 1418}#
+ #{s\ 1419}#
+ #{mod\ 1420}#
#{build-let\ 111}#
- #{id\ 1495}#
- #{val\ 1496}#
- (cons #{e1\ 1497}# #{e2\ 1498}#)))
- #{tmp\ 1487}#)
- ((lambda (#{tmp\ 1502}#)
- (if (if #{tmp\ 1502}#
- (apply (lambda (#{_\ 1503}#
- #{f\ 1504}#
- #{id\ 1505}#
- #{val\ 1506}#
- #{e1\ 1507}#
- #{e2\ 1508}#)
- (if (#{id?\ 131}# #{f\ 1504}#)
- (and-map #{id?\ 131}# #{id\ 1505}#)
+ #{id\ 1430}#
+ #{val\ 1431}#
+ (cons #{e1\ 1432}# #{e2\ 1433}#)))
+ #{tmp\ 1422}#)
+ ((lambda (#{tmp\ 1437}#)
+ (if (if #{tmp\ 1437}#
+ (apply (lambda (#{_\ 1438}#
+ #{f\ 1439}#
+ #{id\ 1440}#
+ #{val\ 1441}#
+ #{e1\ 1442}#
+ #{e2\ 1443}#)
+ (if (#{id?\ 131}# #{f\ 1439}#)
+ (and-map #{id?\ 131}# #{id\ 1440}#)
#f))
- #{tmp\ 1502}#)
+ #{tmp\ 1437}#)
#f)
- (apply (lambda (#{_\ 1510}#
- #{f\ 1511}#
- #{id\ 1512}#
- #{val\ 1513}#
- #{e1\ 1514}#
- #{e2\ 1515}#)
- (#{chi-let\ 1466}#
- #{e\ 1481}#
- #{r\ 1482}#
- #{w\ 1483}#
- #{s\ 1484}#
- #{mod\ 1485}#
+ (apply (lambda (#{_\ 1445}#
+ #{f\ 1446}#
+ #{id\ 1447}#
+ #{val\ 1448}#
+ #{e1\ 1449}#
+ #{e2\ 1450}#)
+ (#{chi-let\ 1401}#
+ #{e\ 1416}#
+ #{r\ 1417}#
+ #{w\ 1418}#
+ #{s\ 1419}#
+ #{mod\ 1420}#
#{build-named-let\ 112}#
- (cons #{f\ 1511}# #{id\ 1512}#)
- #{val\ 1513}#
- (cons #{e1\ 1514}# #{e2\ 1515}#)))
- #{tmp\ 1502}#)
- ((lambda (#{_\ 1519}#)
+ (cons #{f\ 1446}# #{id\ 1447}#)
+ #{val\ 1448}#
+ (cons #{e1\ 1449}# #{e2\ 1450}#)))
+ #{tmp\ 1437}#)
+ ((lambda (#{_\ 1454}#)
(syntax-violation
'let
"bad let"
(#{source-wrap\ 160}#
- #{e\ 1481}#
- #{w\ 1483}#
- #{s\ 1484}#
- #{mod\ 1485}#)))
- #{tmp\ 1486}#)))
+ #{e\ 1416}#
+ #{w\ 1418}#
+ #{s\ 1419}#
+ #{mod\ 1420}#)))
+ #{tmp\ 1421}#)))
($sc-dispatch
- #{tmp\ 1486}#
+ #{tmp\ 1421}#
'(any any #(each (any any)) any . each-any)))))
($sc-dispatch
- #{tmp\ 1486}#
+ #{tmp\ 1421}#
'(any #(each (any any)) any . each-any))))
- #{e\ 1481}#))))
+ #{e\ 1416}#))))
(#{global-extend\ 129}#
'core
'letrec
- (lambda (#{e\ 1520}#
- #{r\ 1521}#
- #{w\ 1522}#
- #{s\ 1523}#
- #{mod\ 1524}#)
- ((lambda (#{tmp\ 1525}#)
- ((lambda (#{tmp\ 1526}#)
- (if (if #{tmp\ 1526}#
- (apply (lambda (#{_\ 1527}#
- #{id\ 1528}#
- #{val\ 1529}#
- #{e1\ 1530}#
- #{e2\ 1531}#)
- (and-map #{id?\ 131}# #{id\ 1528}#))
- #{tmp\ 1526}#)
+ (lambda (#{e\ 1455}#
+ #{r\ 1456}#
+ #{w\ 1457}#
+ #{s\ 1458}#
+ #{mod\ 1459}#)
+ ((lambda (#{tmp\ 1460}#)
+ ((lambda (#{tmp\ 1461}#)
+ (if (if #{tmp\ 1461}#
+ (apply (lambda (#{_\ 1462}#
+ #{id\ 1463}#
+ #{val\ 1464}#
+ #{e1\ 1465}#
+ #{e2\ 1466}#)
+ (and-map #{id?\ 131}# #{id\ 1463}#))
+ #{tmp\ 1461}#)
#f)
- (apply (lambda (#{_\ 1533}#
- #{id\ 1534}#
- #{val\ 1535}#
- #{e1\ 1536}#
- #{e2\ 1537}#)
- (let ((#{ids\ 1538}# #{id\ 1534}#))
+ (apply (lambda (#{_\ 1468}#
+ #{id\ 1469}#
+ #{val\ 1470}#
+ #{e1\ 1471}#
+ #{e2\ 1472}#)
+ (let ((#{ids\ 1473}# #{id\ 1469}#))
(if (not (#{valid-bound-ids?\ 156}#
- #{ids\ 1538}#))
+ #{ids\ 1473}#))
(syntax-violation
'letrec
"duplicate bound variable"
- #{e\ 1520}#)
- (let ((#{labels\ 1540}#
- (#{gen-labels\ 137}# #{ids\ 1538}#))
- (#{new-vars\ 1541}#
- (map #{gen-var\ 181}# #{ids\ 1538}#)))
- (let ((#{w\ 1542}#
+ #{e\ 1455}#)
+ (let ((#{labels\ 1475}#
+ (#{gen-labels\ 137}# #{ids\ 1473}#))
+ (#{new-vars\ 1476}#
+ (map #{gen-var\ 181}# #{ids\ 1473}#)))
+ (let ((#{w\ 1477}#
(#{make-binding-wrap\ 148}#
- #{ids\ 1538}#
- #{labels\ 1540}#
- #{w\ 1522}#))
- (#{r\ 1543}#
+ #{ids\ 1473}#
+ #{labels\ 1475}#
+ #{w\ 1457}#))
+ (#{r\ 1478}#
(#{extend-var-env\ 126}#
- #{labels\ 1540}#
- #{new-vars\ 1541}#
- #{r\ 1521}#)))
+ #{labels\ 1475}#
+ #{new-vars\ 1476}#
+ #{r\ 1456}#)))
(#{build-letrec\ 113}#
- #{s\ 1523}#
- (map syntax->datum #{ids\ 1538}#)
- #{new-vars\ 1541}#
- (map (lambda (#{x\ 1544}#)
+ #{s\ 1458}#
+ (map syntax->datum #{ids\ 1473}#)
+ #{new-vars\ 1476}#
+ (map (lambda (#{x\ 1479}#)
(#{chi\ 167}#
- #{x\ 1544}#
- #{r\ 1543}#
- #{w\ 1542}#
- #{mod\ 1524}#))
- #{val\ 1535}#)
+ #{x\ 1479}#
+ #{r\ 1478}#
+ #{w\ 1477}#
+ #{mod\ 1459}#))
+ #{val\ 1470}#)
(#{chi-body\ 171}#
- (cons #{e1\ 1536}# #{e2\ 1537}#)
+ (cons #{e1\ 1471}# #{e2\ 1472}#)
(#{source-wrap\ 160}#
- #{e\ 1520}#
- #{w\ 1542}#
- #{s\ 1523}#
- #{mod\ 1524}#)
- #{r\ 1543}#
- #{w\ 1542}#
- #{mod\ 1524}#)))))))
- #{tmp\ 1526}#)
- ((lambda (#{_\ 1547}#)
+ #{e\ 1455}#
+ #{w\ 1477}#
+ #{s\ 1458}#
+ #{mod\ 1459}#)
+ #{r\ 1478}#
+ #{w\ 1477}#
+ #{mod\ 1459}#)))))))
+ #{tmp\ 1461}#)
+ ((lambda (#{_\ 1482}#)
(syntax-violation
'letrec
"bad letrec"
(#{source-wrap\ 160}#
- #{e\ 1520}#
- #{w\ 1522}#
- #{s\ 1523}#
- #{mod\ 1524}#)))
- #{tmp\ 1525}#)))
+ #{e\ 1455}#
+ #{w\ 1457}#
+ #{s\ 1458}#
+ #{mod\ 1459}#)))
+ #{tmp\ 1460}#)))
($sc-dispatch
- #{tmp\ 1525}#
+ #{tmp\ 1460}#
'(any #(each (any any)) any . each-any))))
- #{e\ 1520}#)))
+ #{e\ 1455}#)))
(#{global-extend\ 129}#
'core
'set!
- (lambda (#{e\ 1548}#
- #{r\ 1549}#
- #{w\ 1550}#
- #{s\ 1551}#
- #{mod\ 1552}#)
- ((lambda (#{tmp\ 1553}#)
- ((lambda (#{tmp\ 1554}#)
- (if (if #{tmp\ 1554}#
- (apply (lambda (#{_\ 1555}# #{id\ 1556}# #{val\ 1557}#)
- (#{id?\ 131}# #{id\ 1556}#))
- #{tmp\ 1554}#)
+ (lambda (#{e\ 1483}#
+ #{r\ 1484}#
+ #{w\ 1485}#
+ #{s\ 1486}#
+ #{mod\ 1487}#)
+ ((lambda (#{tmp\ 1488}#)
+ ((lambda (#{tmp\ 1489}#)
+ (if (if #{tmp\ 1489}#
+ (apply (lambda (#{_\ 1490}# #{id\ 1491}# #{val\ 1492}#)
+ (#{id?\ 131}# #{id\ 1491}#))
+ #{tmp\ 1489}#)
#f)
- (apply (lambda (#{_\ 1558}# #{id\ 1559}# #{val\ 1560}#)
- (let ((#{val\ 1561}#
+ (apply (lambda (#{_\ 1493}# #{id\ 1494}# #{val\ 1495}#)
+ (let ((#{val\ 1496}#
(#{chi\ 167}#
- #{val\ 1560}#
- #{r\ 1549}#
- #{w\ 1550}#
- #{mod\ 1552}#))
- (#{n\ 1562}#
+ #{val\ 1495}#
+ #{r\ 1484}#
+ #{w\ 1485}#
+ #{mod\ 1487}#))
+ (#{n\ 1497}#
(#{id-var-name\ 153}#
- #{id\ 1559}#
- #{w\ 1550}#)))
- (let ((#{b\ 1563}#
+ #{id\ 1494}#
+ #{w\ 1485}#)))
+ (let ((#{b\ 1498}#
(#{lookup\ 128}#
- #{n\ 1562}#
- #{r\ 1549}#
- #{mod\ 1552}#)))
- (let ((#{atom-key\ 1564}#
- (#{binding-type\ 123}# #{b\ 1563}#)))
- (if (memv #{atom-key\ 1564}#
+ #{n\ 1497}#
+ #{r\ 1484}#
+ #{mod\ 1487}#)))
+ (let ((#{atom-key\ 1499}#
+ (#{binding-type\ 123}# #{b\ 1498}#)))
+ (if (memv #{atom-key\ 1499}#
'(lexical))
(#{build-lexical-assignment\ 99}#
- #{s\ 1551}#
- (syntax->datum #{id\ 1559}#)
- (#{binding-value\ 124}# #{b\ 1563}#)
- #{val\ 1561}#)
- (if (memv #{atom-key\ 1564}#
+ #{s\ 1486}#
+ (syntax->datum #{id\ 1494}#)
+ (#{binding-value\ 124}# #{b\ 1498}#)
+ #{val\ 1496}#)
+ (if (memv #{atom-key\ 1499}#
'(global))
(#{build-global-assignment\ 102}#
- #{s\ 1551}#
- #{n\ 1562}#
- #{val\ 1561}#
- #{mod\ 1552}#)
- (if (memv #{atom-key\ 1564}#
+ #{s\ 1486}#
+ #{n\ 1497}#
+ #{val\ 1496}#
+ #{mod\ 1487}#)
+ (if (memv #{atom-key\ 1499}#
'(displaced-lexical))
(syntax-violation
'set!
"identifier out of context"
(#{wrap\ 159}#
- #{id\ 1559}#
- #{w\ 1550}#
- #{mod\ 1552}#))
+ #{id\ 1494}#
+ #{w\ 1485}#
+ #{mod\ 1487}#))
(syntax-violation
'set!
"bad set!"
(#{source-wrap\ 160}#
- #{e\ 1548}#
- #{w\ 1550}#
- #{s\ 1551}#
- #{mod\ 1552}#)))))))))
- #{tmp\ 1554}#)
- ((lambda (#{tmp\ 1565}#)
- (if #{tmp\ 1565}#
- (apply (lambda (#{_\ 1566}#
- #{head\ 1567}#
- #{tail\ 1568}#
- #{val\ 1569}#)
+ #{e\ 1483}#
+ #{w\ 1485}#
+ #{s\ 1486}#
+ #{mod\ 1487}#)))))))))
+ #{tmp\ 1489}#)
+ ((lambda (#{tmp\ 1500}#)
+ (if #{tmp\ 1500}#
+ (apply (lambda (#{_\ 1501}#
+ #{head\ 1502}#
+ #{tail\ 1503}#
+ #{val\ 1504}#)
(call-with-values
(lambda ()
(#{syntax-type\ 165}#
- #{head\ 1567}#
- #{r\ 1549}#
+ #{head\ 1502}#
+ #{r\ 1484}#
'(())
#f
#f
- #{mod\ 1552}#
+ #{mod\ 1487}#
#t))
- (lambda (#{type\ 1570}#
- #{value\ 1571}#
- #{ee\ 1572}#
- #{ww\ 1573}#
- #{ss\ 1574}#
- #{modmod\ 1575}#)
- (if (memv #{type\ 1570}#
+ (lambda (#{type\ 1505}#
+ #{value\ 1506}#
+ #{ee\ 1507}#
+ #{ww\ 1508}#
+ #{ss\ 1509}#
+ #{modmod\ 1510}#)
+ (if (memv #{type\ 1505}#
'(module-ref))
- (let ((#{val\ 1576}#
+ (let ((#{val\ 1511}#
(#{chi\ 167}#
- #{val\ 1569}#
- #{r\ 1549}#
- #{w\ 1550}#
- #{mod\ 1552}#)))
+ #{val\ 1504}#
+ #{r\ 1484}#
+ #{w\ 1485}#
+ #{mod\ 1487}#)))
(call-with-values
(lambda ()
- (#{value\ 1571}#
- (cons #{head\ 1567}#
- #{tail\ 1568}#)))
- (lambda (#{id\ 1578}# #{mod\ 1579}#)
+ (#{value\ 1506}#
+ (cons #{head\ 1502}#
+ #{tail\ 1503}#)))
+ (lambda (#{id\ 1513}# #{mod\ 1514}#)
(#{build-global-assignment\ 102}#
- #{s\ 1551}#
- #{id\ 1578}#
- #{val\ 1576}#
- #{mod\ 1579}#))))
+ #{s\ 1486}#
+ #{id\ 1513}#
+ #{val\ 1511}#
+ #{mod\ 1514}#))))
(#{build-application\ 96}#
- #{s\ 1551}#
+ #{s\ 1486}#
(#{chi\ 167}#
(list '#(syntax-object
setter
@@ -9578,53 +9337,53 @@
((top) (top))
("i" "i")))
(hygiene guile))
- #{head\ 1567}#)
- #{r\ 1549}#
- #{w\ 1550}#
- #{mod\ 1552}#)
- (map (lambda (#{e\ 1580}#)
+ #{head\ 1502}#)
+ #{r\ 1484}#
+ #{w\ 1485}#
+ #{mod\ 1487}#)
+ (map (lambda (#{e\ 1515}#)
(#{chi\ 167}#
- #{e\ 1580}#
- #{r\ 1549}#
- #{w\ 1550}#
- #{mod\ 1552}#))
+ #{e\ 1515}#
+ #{r\ 1484}#
+ #{w\ 1485}#
+ #{mod\ 1487}#))
(append
- #{tail\ 1568}#
- (list #{val\ 1569}#))))))))
- #{tmp\ 1565}#)
- ((lambda (#{_\ 1582}#)
+ #{tail\ 1503}#
+ (list #{val\ 1504}#))))))))
+ #{tmp\ 1500}#)
+ ((lambda (#{_\ 1517}#)
(syntax-violation
'set!
"bad set!"
(#{source-wrap\ 160}#
- #{e\ 1548}#
- #{w\ 1550}#
- #{s\ 1551}#
- #{mod\ 1552}#)))
- #{tmp\ 1553}#)))
+ #{e\ 1483}#
+ #{w\ 1485}#
+ #{s\ 1486}#
+ #{mod\ 1487}#)))
+ #{tmp\ 1488}#)))
($sc-dispatch
- #{tmp\ 1553}#
+ #{tmp\ 1488}#
'(any (any . each-any) any)))))
($sc-dispatch
- #{tmp\ 1553}#
+ #{tmp\ 1488}#
'(any any any))))
- #{e\ 1548}#)))
+ #{e\ 1483}#)))
(#{global-extend\ 129}#
'module-ref
'@
- (lambda (#{e\ 1583}#)
- ((lambda (#{tmp\ 1584}#)
- ((lambda (#{tmp\ 1585}#)
- (if (if #{tmp\ 1585}#
- (apply (lambda (#{_\ 1586}# #{mod\ 1587}# #{id\ 1588}#)
- (if (and-map #{id?\ 131}# #{mod\ 1587}#)
- (#{id?\ 131}# #{id\ 1588}#)
+ (lambda (#{e\ 1518}#)
+ ((lambda (#{tmp\ 1519}#)
+ ((lambda (#{tmp\ 1520}#)
+ (if (if #{tmp\ 1520}#
+ (apply (lambda (#{_\ 1521}# #{mod\ 1522}# #{id\ 1523}#)
+ (if (and-map #{id?\ 131}# #{mod\ 1522}#)
+ (#{id?\ 131}# #{id\ 1523}#)
#f))
- #{tmp\ 1585}#)
+ #{tmp\ 1520}#)
#f)
- (apply (lambda (#{_\ 1590}# #{mod\ 1591}# #{id\ 1592}#)
+ (apply (lambda (#{_\ 1525}# #{mod\ 1526}# #{id\ 1527}#)
(values
- (syntax->datum #{id\ 1592}#)
+ (syntax->datum #{id\ 1527}#)
(syntax->datum
(cons '#(syntax-object
public
@@ -9992,32 +9751,32 @@
((top) (top))
("i" "i")))
(hygiene guile))
- #{mod\ 1591}#))))
- #{tmp\ 1585}#)
+ #{mod\ 1526}#))))
+ #{tmp\ 1520}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1584}#)))
+ #{tmp\ 1519}#)))
($sc-dispatch
- #{tmp\ 1584}#
+ #{tmp\ 1519}#
'(any each-any any))))
- #{e\ 1583}#)))
+ #{e\ 1518}#)))
(#{global-extend\ 129}#
'module-ref
'@@
- (lambda (#{e\ 1594}#)
- ((lambda (#{tmp\ 1595}#)
- ((lambda (#{tmp\ 1596}#)
- (if (if #{tmp\ 1596}#
- (apply (lambda (#{_\ 1597}# #{mod\ 1598}# #{id\ 1599}#)
- (if (and-map #{id?\ 131}# #{mod\ 1598}#)
- (#{id?\ 131}# #{id\ 1599}#)
+ (lambda (#{e\ 1529}#)
+ ((lambda (#{tmp\ 1530}#)
+ ((lambda (#{tmp\ 1531}#)
+ (if (if #{tmp\ 1531}#
+ (apply (lambda (#{_\ 1532}# #{mod\ 1533}# #{id\ 1534}#)
+ (if (and-map #{id?\ 131}# #{mod\ 1533}#)
+ (#{id?\ 131}# #{id\ 1534}#)
#f))
- #{tmp\ 1596}#)
+ #{tmp\ 1531}#)
#f)
- (apply (lambda (#{_\ 1601}# #{mod\ 1602}# #{id\ 1603}#)
+ (apply (lambda (#{_\ 1536}# #{mod\ 1537}# #{id\ 1538}#)
(values
- (syntax->datum #{id\ 1603}#)
+ (syntax->datum #{id\ 1538}#)
(syntax->datum
(cons '#(syntax-object
private
@@ -10385,77 +10144,77 @@
((top) (top))
("i" "i")))
(hygiene guile))
- #{mod\ 1602}#))))
- #{tmp\ 1596}#)
+ #{mod\ 1537}#))))
+ #{tmp\ 1531}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1595}#)))
+ #{tmp\ 1530}#)))
($sc-dispatch
- #{tmp\ 1595}#
+ #{tmp\ 1530}#
'(any each-any any))))
- #{e\ 1594}#)))
+ #{e\ 1529}#)))
(#{global-extend\ 129}#
'core
'if
- (lambda (#{e\ 1605}#
- #{r\ 1606}#
- #{w\ 1607}#
- #{s\ 1608}#
- #{mod\ 1609}#)
- ((lambda (#{tmp\ 1610}#)
- ((lambda (#{tmp\ 1611}#)
- (if #{tmp\ 1611}#
- (apply (lambda (#{_\ 1612}# #{test\ 1613}# #{then\ 1614}#)
+ (lambda (#{e\ 1540}#
+ #{r\ 1541}#
+ #{w\ 1542}#
+ #{s\ 1543}#
+ #{mod\ 1544}#)
+ ((lambda (#{tmp\ 1545}#)
+ ((lambda (#{tmp\ 1546}#)
+ (if #{tmp\ 1546}#
+ (apply (lambda (#{_\ 1547}# #{test\ 1548}# #{then\ 1549}#)
(#{build-conditional\ 97}#
- #{s\ 1608}#
+ #{s\ 1543}#
(#{chi\ 167}#
- #{test\ 1613}#
- #{r\ 1606}#
- #{w\ 1607}#
- #{mod\ 1609}#)
+ #{test\ 1548}#
+ #{r\ 1541}#
+ #{w\ 1542}#
+ #{mod\ 1544}#)
(#{chi\ 167}#
- #{then\ 1614}#
- #{r\ 1606}#
- #{w\ 1607}#
- #{mod\ 1609}#)
+ #{then\ 1549}#
+ #{r\ 1541}#
+ #{w\ 1542}#
+ #{mod\ 1544}#)
(#{build-void\ 95}# #f)))
- #{tmp\ 1611}#)
- ((lambda (#{tmp\ 1615}#)
- (if #{tmp\ 1615}#
- (apply (lambda (#{_\ 1616}#
- #{test\ 1617}#
- #{then\ 1618}#
- #{else\ 1619}#)
+ #{tmp\ 1546}#)
+ ((lambda (#{tmp\ 1550}#)
+ (if #{tmp\ 1550}#
+ (apply (lambda (#{_\ 1551}#
+ #{test\ 1552}#
+ #{then\ 1553}#
+ #{else\ 1554}#)
(#{build-conditional\ 97}#
- #{s\ 1608}#
+ #{s\ 1543}#
(#{chi\ 167}#
- #{test\ 1617}#
- #{r\ 1606}#
- #{w\ 1607}#
- #{mod\ 1609}#)
+ #{test\ 1552}#
+ #{r\ 1541}#
+ #{w\ 1542}#
+ #{mod\ 1544}#)
(#{chi\ 167}#
- #{then\ 1618}#
- #{r\ 1606}#
- #{w\ 1607}#
- #{mod\ 1609}#)
+ #{then\ 1553}#
+ #{r\ 1541}#
+ #{w\ 1542}#
+ #{mod\ 1544}#)
(#{chi\ 167}#
- #{else\ 1619}#
- #{r\ 1606}#
- #{w\ 1607}#
- #{mod\ 1609}#)))
- #{tmp\ 1615}#)
+ #{else\ 1554}#
+ #{r\ 1541}#
+ #{w\ 1542}#
+ #{mod\ 1544}#)))
+ #{tmp\ 1550}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1610}#)))
+ #{tmp\ 1545}#)))
($sc-dispatch
- #{tmp\ 1610}#
+ #{tmp\ 1545}#
'(any any any any)))))
($sc-dispatch
- #{tmp\ 1610}#
+ #{tmp\ 1545}#
'(any any any))))
- #{e\ 1605}#)))
+ #{e\ 1540}#)))
(#{global-extend\ 129}#
'begin
'begin
@@ -10475,13 +10234,13 @@
(#{global-extend\ 129}#
'core
'syntax-case
- (letrec ((#{gen-syntax-case\ 1623}#
- (lambda (#{x\ 1624}#
- #{keys\ 1625}#
- #{clauses\ 1626}#
- #{r\ 1627}#
- #{mod\ 1628}#)
- (if (null? #{clauses\ 1626}#)
+ (letrec ((#{gen-syntax-case\ 1558}#
+ (lambda (#{x\ 1559}#
+ #{keys\ 1560}#
+ #{clauses\ 1561}#
+ #{r\ 1562}#
+ #{mod\ 1563}#)
+ (if (null? #{clauses\ 1561}#)
(#{build-application\ 96}#
#f
(#{build-primref\ 108}#
@@ -10491,17 +10250,17 @@
(#{build-data\ 109}#
#f
"source expression failed to match any
pattern")
- #{x\ 1624}#))
- ((lambda (#{tmp\ 1629}#)
- ((lambda (#{tmp\ 1630}#)
- (if #{tmp\ 1630}#
- (apply (lambda (#{pat\ 1631}# #{exp\ 1632}#)
- (if (if (#{id?\ 131}# #{pat\ 1631}#)
+ #{x\ 1559}#))
+ ((lambda (#{tmp\ 1564}#)
+ ((lambda (#{tmp\ 1565}#)
+ (if #{tmp\ 1565}#
+ (apply (lambda (#{pat\ 1566}# #{exp\ 1567}#)
+ (if (if (#{id?\ 131}# #{pat\ 1566}#)
(and-map
- (lambda (#{x\ 1633}#)
+ (lambda (#{x\ 1568}#)
(not (#{free-id=?\ 154}#
- #{pat\ 1631}#
- #{x\ 1633}#)))
+ #{pat\ 1566}#
+ #{x\ 1568}#)))
(cons '#(syntax-object
...
((top)
@@ -10894,103 +10653,103 @@
((top) (top))
("i" "i")))
(hygiene guile))
- #{keys\ 1625}#))
+ #{keys\ 1560}#))
#f)
- (let ((#{labels\ 1634}#
+ (let ((#{labels\ 1569}#
(list (#{gen-label\ 136}#)))
- (#{var\ 1635}#
+ (#{var\ 1570}#
(#{gen-var\ 181}#
- #{pat\ 1631}#)))
+ #{pat\ 1566}#)))
(#{build-application\ 96}#
#f
(#{build-simple-lambda\ 105}#
#f
(list (syntax->datum
- #{pat\ 1631}#))
+ #{pat\ 1566}#))
#f
- (list #{var\ 1635}#)
+ (list #{var\ 1570}#)
#f
(#{chi\ 167}#
- #{exp\ 1632}#
+ #{exp\ 1567}#
(#{extend-env\ 125}#
- #{labels\ 1634}#
+ #{labels\ 1569}#
(list (cons 'syntax
- (cons #{var\
1635}#
+ (cons #{var\
1570}#
0)))
- #{r\ 1627}#)
+ #{r\ 1562}#)
(#{make-binding-wrap\ 148}#
- (list #{pat\ 1631}#)
- #{labels\ 1634}#
+ (list #{pat\ 1566}#)
+ #{labels\ 1569}#
'(()))
- #{mod\ 1628}#))
- (list #{x\ 1624}#)))
- (#{gen-clause\ 1622}#
- #{x\ 1624}#
- #{keys\ 1625}#
- (cdr #{clauses\ 1626}#)
- #{r\ 1627}#
- #{pat\ 1631}#
+ #{mod\ 1563}#))
+ (list #{x\ 1559}#)))
+ (#{gen-clause\ 1557}#
+ #{x\ 1559}#
+ #{keys\ 1560}#
+ (cdr #{clauses\ 1561}#)
+ #{r\ 1562}#
+ #{pat\ 1566}#
#t
- #{exp\ 1632}#
- #{mod\ 1628}#)))
- #{tmp\ 1630}#)
- ((lambda (#{tmp\ 1636}#)
- (if #{tmp\ 1636}#
- (apply (lambda (#{pat\ 1637}#
- #{fender\ 1638}#
- #{exp\ 1639}#)
- (#{gen-clause\ 1622}#
- #{x\ 1624}#
- #{keys\ 1625}#
- (cdr #{clauses\ 1626}#)
- #{r\ 1627}#
- #{pat\ 1637}#
- #{fender\ 1638}#
- #{exp\ 1639}#
- #{mod\ 1628}#))
- #{tmp\ 1636}#)
- ((lambda (#{_\ 1640}#)
+ #{exp\ 1567}#
+ #{mod\ 1563}#)))
+ #{tmp\ 1565}#)
+ ((lambda (#{tmp\ 1571}#)
+ (if #{tmp\ 1571}#
+ (apply (lambda (#{pat\ 1572}#
+ #{fender\ 1573}#
+ #{exp\ 1574}#)
+ (#{gen-clause\ 1557}#
+ #{x\ 1559}#
+ #{keys\ 1560}#
+ (cdr #{clauses\ 1561}#)
+ #{r\ 1562}#
+ #{pat\ 1572}#
+ #{fender\ 1573}#
+ #{exp\ 1574}#
+ #{mod\ 1563}#))
+ #{tmp\ 1571}#)
+ ((lambda (#{_\ 1575}#)
(syntax-violation
'syntax-case
"invalid clause"
- (car #{clauses\ 1626}#)))
- #{tmp\ 1629}#)))
+ (car #{clauses\ 1561}#)))
+ #{tmp\ 1564}#)))
($sc-dispatch
- #{tmp\ 1629}#
+ #{tmp\ 1564}#
'(any any any)))))
- ($sc-dispatch #{tmp\ 1629}# (quote (any any)))))
- (car #{clauses\ 1626}#)))))
- (#{gen-clause\ 1622}#
- (lambda (#{x\ 1641}#
- #{keys\ 1642}#
- #{clauses\ 1643}#
- #{r\ 1644}#
- #{pat\ 1645}#
- #{fender\ 1646}#
- #{exp\ 1647}#
- #{mod\ 1648}#)
+ ($sc-dispatch #{tmp\ 1564}# (quote (any any)))))
+ (car #{clauses\ 1561}#)))))
+ (#{gen-clause\ 1557}#
+ (lambda (#{x\ 1576}#
+ #{keys\ 1577}#
+ #{clauses\ 1578}#
+ #{r\ 1579}#
+ #{pat\ 1580}#
+ #{fender\ 1581}#
+ #{exp\ 1582}#
+ #{mod\ 1583}#)
(call-with-values
(lambda ()
- (#{convert-pattern\ 1620}#
- #{pat\ 1645}#
- #{keys\ 1642}#))
- (lambda (#{p\ 1649}# #{pvars\ 1650}#)
+ (#{convert-pattern\ 1555}#
+ #{pat\ 1580}#
+ #{keys\ 1577}#))
+ (lambda (#{p\ 1584}# #{pvars\ 1585}#)
(if (not (#{distinct-bound-ids?\ 157}#
- (map car #{pvars\ 1650}#)))
+ (map car #{pvars\ 1585}#)))
(syntax-violation
'syntax-case
"duplicate pattern variable"
- #{pat\ 1645}#)
+ #{pat\ 1580}#)
(if (not (and-map
- (lambda (#{x\ 1651}#)
+ (lambda (#{x\ 1586}#)
(not (#{ellipsis?\ 175}#
- (car #{x\ 1651}#))))
- #{pvars\ 1650}#))
+ (car #{x\ 1586}#))))
+ #{pvars\ 1585}#))
(syntax-violation
'syntax-case
"misplaced ellipsis"
- #{pat\ 1645}#)
- (let ((#{y\ 1652}#
+ #{pat\ 1580}#)
+ (let ((#{y\ 1587}#
(#{gen-var\ 181}# (quote tmp))))
(#{build-application\ 96}#
#f
@@ -10998,630 +10757,630 @@
#f
(list (quote tmp))
#f
- (list #{y\ 1652}#)
+ (list #{y\ 1587}#)
#f
- (let ((#{y\ 1653}#
+ (let ((#{y\ 1588}#
(#{build-lexical-reference\ 98}#
'value
#f
'tmp
- #{y\ 1652}#)))
+ #{y\ 1587}#)))
(#{build-conditional\ 97}#
#f
- ((lambda (#{tmp\ 1654}#)
- ((lambda (#{tmp\ 1655}#)
- (if #{tmp\ 1655}#
- (apply (lambda () #{y\ 1653}#)
- #{tmp\ 1655}#)
- ((lambda (#{_\ 1656}#)
+ ((lambda (#{tmp\ 1589}#)
+ ((lambda (#{tmp\ 1590}#)
+ (if #{tmp\ 1590}#
+ (apply (lambda () #{y\ 1588}#)
+ #{tmp\ 1590}#)
+ ((lambda (#{_\ 1591}#)
(#{build-conditional\ 97}#
#f
- #{y\ 1653}#
- (#{build-dispatch-call\
1621}#
- #{pvars\ 1650}#
- #{fender\ 1646}#
- #{y\ 1653}#
- #{r\ 1644}#
- #{mod\ 1648}#)
+ #{y\ 1588}#
+ (#{build-dispatch-call\
1556}#
+ #{pvars\ 1585}#
+ #{fender\ 1581}#
+ #{y\ 1588}#
+ #{r\ 1579}#
+ #{mod\ 1583}#)
(#{build-data\ 109}#
#f
#f)))
- #{tmp\ 1654}#)))
+ #{tmp\ 1589}#)))
($sc-dispatch
- #{tmp\ 1654}#
+ #{tmp\ 1589}#
'#(atom #t))))
- #{fender\ 1646}#)
- (#{build-dispatch-call\ 1621}#
- #{pvars\ 1650}#
- #{exp\ 1647}#
- #{y\ 1653}#
- #{r\ 1644}#
- #{mod\ 1648}#)
- (#{gen-syntax-case\ 1623}#
- #{x\ 1641}#
- #{keys\ 1642}#
- #{clauses\ 1643}#
- #{r\ 1644}#
- #{mod\ 1648}#))))
- (list (if (eq? #{p\ 1649}# (quote any))
+ #{fender\ 1581}#)
+ (#{build-dispatch-call\ 1556}#
+ #{pvars\ 1585}#
+ #{exp\ 1582}#
+ #{y\ 1588}#
+ #{r\ 1579}#
+ #{mod\ 1583}#)
+ (#{gen-syntax-case\ 1558}#
+ #{x\ 1576}#
+ #{keys\ 1577}#
+ #{clauses\ 1578}#
+ #{r\ 1579}#
+ #{mod\ 1583}#))))
+ (list (if (eq? #{p\ 1584}# (quote any))
(#{build-application\ 96}#
#f
(#{build-primref\ 108}#
#f
'list)
- (list #{x\ 1641}#))
+ (list #{x\ 1576}#))
(#{build-application\ 96}#
#f
(#{build-primref\ 108}#
#f
'$sc-dispatch)
- (list #{x\ 1641}#
+ (list #{x\ 1576}#
(#{build-data\ 109}#
#f
- #{p\ 1649}#)))))))))))))
- (#{build-dispatch-call\ 1621}#
- (lambda (#{pvars\ 1657}#
- #{exp\ 1658}#
- #{y\ 1659}#
- #{r\ 1660}#
- #{mod\ 1661}#)
- (let ((#{ids\ 1662}# (map car #{pvars\ 1657}#))
- (#{levels\ 1663}# (map cdr #{pvars\ 1657}#)))
- (let ((#{labels\ 1664}#
- (#{gen-labels\ 137}# #{ids\ 1662}#))
- (#{new-vars\ 1665}#
- (map #{gen-var\ 181}# #{ids\ 1662}#)))
+ #{p\ 1584}#)))))))))))))
+ (#{build-dispatch-call\ 1556}#
+ (lambda (#{pvars\ 1592}#
+ #{exp\ 1593}#
+ #{y\ 1594}#
+ #{r\ 1595}#
+ #{mod\ 1596}#)
+ (let ((#{ids\ 1597}# (map car #{pvars\ 1592}#))
+ (#{levels\ 1598}# (map cdr #{pvars\ 1592}#)))
+ (let ((#{labels\ 1599}#
+ (#{gen-labels\ 137}# #{ids\ 1597}#))
+ (#{new-vars\ 1600}#
+ (map #{gen-var\ 181}# #{ids\ 1597}#)))
(#{build-application\ 96}#
#f
(#{build-primref\ 108}# #f (quote apply))
(list (#{build-simple-lambda\ 105}#
#f
- (map syntax->datum #{ids\ 1662}#)
+ (map syntax->datum #{ids\ 1597}#)
#f
- #{new-vars\ 1665}#
+ #{new-vars\ 1600}#
#f
(#{chi\ 167}#
- #{exp\ 1658}#
+ #{exp\ 1593}#
(#{extend-env\ 125}#
- #{labels\ 1664}#
- (map (lambda (#{var\ 1666}#
- #{level\ 1667}#)
+ #{labels\ 1599}#
+ (map (lambda (#{var\ 1601}#
+ #{level\ 1602}#)
(cons 'syntax
- (cons #{var\ 1666}#
- #{level\ 1667}#)))
- #{new-vars\ 1665}#
- (map cdr #{pvars\ 1657}#))
- #{r\ 1660}#)
+ (cons #{var\ 1601}#
+ #{level\ 1602}#)))
+ #{new-vars\ 1600}#
+ (map cdr #{pvars\ 1592}#))
+ #{r\ 1595}#)
(#{make-binding-wrap\ 148}#
- #{ids\ 1662}#
- #{labels\ 1664}#
+ #{ids\ 1597}#
+ #{labels\ 1599}#
'(()))
- #{mod\ 1661}#))
- #{y\ 1659}#))))))
- (#{convert-pattern\ 1620}#
- (lambda (#{pattern\ 1668}# #{keys\ 1669}#)
- (letrec ((#{cvt\ 1670}#
- (lambda (#{p\ 1671}# #{n\ 1672}# #{ids\ 1673}#)
- (if (#{id?\ 131}# #{p\ 1671}#)
+ #{mod\ 1596}#))
+ #{y\ 1594}#))))))
+ (#{convert-pattern\ 1555}#
+ (lambda (#{pattern\ 1603}# #{keys\ 1604}#)
+ (letrec ((#{cvt\ 1605}#
+ (lambda (#{p\ 1606}# #{n\ 1607}# #{ids\ 1608}#)
+ (if (#{id?\ 131}# #{p\ 1606}#)
(if (#{bound-id-member?\ 158}#
- #{p\ 1671}#
- #{keys\ 1669}#)
+ #{p\ 1606}#
+ #{keys\ 1604}#)
(values
- (vector (quote free-id) #{p\ 1671}#)
- #{ids\ 1673}#)
+ (vector (quote free-id) #{p\ 1606}#)
+ #{ids\ 1608}#)
(values
'any
- (cons (cons #{p\ 1671}# #{n\ 1672}#)
- #{ids\ 1673}#)))
- ((lambda (#{tmp\ 1674}#)
- ((lambda (#{tmp\ 1675}#)
- (if (if #{tmp\ 1675}#
- (apply (lambda (#{x\ 1676}#
- #{dots\ 1677}#)
+ (cons (cons #{p\ 1606}# #{n\ 1607}#)
+ #{ids\ 1608}#)))
+ ((lambda (#{tmp\ 1609}#)
+ ((lambda (#{tmp\ 1610}#)
+ (if (if #{tmp\ 1610}#
+ (apply (lambda (#{x\ 1611}#
+ #{dots\ 1612}#)
(#{ellipsis?\ 175}#
- #{dots\ 1677}#))
- #{tmp\ 1675}#)
+ #{dots\ 1612}#))
+ #{tmp\ 1610}#)
#f)
- (apply (lambda (#{x\ 1678}#
- #{dots\ 1679}#)
+ (apply (lambda (#{x\ 1613}#
+ #{dots\ 1614}#)
(call-with-values
(lambda ()
- (#{cvt\ 1670}#
- #{x\ 1678}#
+ (#{cvt\ 1605}#
+ #{x\ 1613}#
(#{fx+\ 86}#
- #{n\ 1672}#
+ #{n\ 1607}#
1)
- #{ids\ 1673}#))
- (lambda (#{p\ 1680}#
- #{ids\ 1681}#)
+ #{ids\ 1608}#))
+ (lambda (#{p\ 1615}#
+ #{ids\ 1616}#)
(values
- (if (eq? #{p\ 1680}#
+ (if (eq? #{p\ 1615}#
'any)
'each-any
(vector
'each
- #{p\ 1680}#))
- #{ids\ 1681}#))))
- #{tmp\ 1675}#)
- ((lambda (#{tmp\ 1682}#)
- (if #{tmp\ 1682}#
- (apply (lambda (#{x\ 1683}#
- #{y\ 1684}#)
+ #{p\ 1615}#))
+ #{ids\ 1616}#))))
+ #{tmp\ 1610}#)
+ ((lambda (#{tmp\ 1617}#)
+ (if #{tmp\ 1617}#
+ (apply (lambda (#{x\ 1618}#
+ #{y\ 1619}#)
(call-with-values
(lambda ()
- (#{cvt\ 1670}#
- #{y\ 1684}#
- #{n\ 1672}#
- #{ids\ 1673}#))
- (lambda (#{y\
1685}#
- #{ids\
1686}#)
+ (#{cvt\ 1605}#
+ #{y\ 1619}#
+ #{n\ 1607}#
+ #{ids\ 1608}#))
+ (lambda (#{y\
1620}#
+ #{ids\
1621}#)
(call-with-values
(lambda ()
- (#{cvt\
1670}#
- #{x\ 1683}#
- #{n\ 1672}#
- #{ids\
1686}#))
- (lambda (#{x\
1687}#
-
#{ids\ 1688}#)
+ (#{cvt\
1605}#
+ #{x\ 1618}#
+ #{n\ 1607}#
+ #{ids\
1621}#))
+ (lambda (#{x\
1622}#
+
#{ids\ 1623}#)
(values
- (cons #{x\
1687}#
- #{y\
1685}#)
- #{ids\
1688}#))))))
- #{tmp\ 1682}#)
- ((lambda (#{tmp\ 1689}#)
- (if #{tmp\ 1689}#
+ (cons #{x\
1622}#
+ #{y\
1620}#)
+ #{ids\
1623}#))))))
+ #{tmp\ 1617}#)
+ ((lambda (#{tmp\ 1624}#)
+ (if #{tmp\ 1624}#
(apply (lambda ()
(values
'()
- #{ids\
1673}#))
- #{tmp\ 1689}#)
- ((lambda (#{tmp\ 1690}#)
- (if #{tmp\ 1690}#
- (apply (lambda
(#{x\ 1691}#)
+ #{ids\
1608}#))
+ #{tmp\ 1624}#)
+ ((lambda (#{tmp\ 1625}#)
+ (if #{tmp\ 1625}#
+ (apply (lambda
(#{x\ 1626}#)
(call-with-values
(lambda
()
-
(#{cvt\ 1670}#
- #{x\
1691}#
- #{n\
1672}#
-
#{ids\ 1673}#))
- (lambda
(#{p\ 1693}#
-
#{ids\ 1694}#)
+
(#{cvt\ 1605}#
+ #{x\
1626}#
+ #{n\
1607}#
+
#{ids\ 1608}#))
+ (lambda
(#{p\ 1628}#
+
#{ids\ 1629}#)
(values
(vector
'vector
-
#{p\ 1693}#)
-
#{ids\ 1694}#))))
- #{tmp\
1690}#)
- ((lambda (#{x\
1695}#)
+
#{p\ 1628}#)
+
#{ids\ 1629}#))))
+ #{tmp\
1625}#)
+ ((lambda (#{x\
1630}#)
(values
(vector
'atom
(#{strip\
180}#
- #{p\ 1671}#
+ #{p\ 1606}#
'(())))
- #{ids\ 1673}#))
- #{tmp\ 1674}#)))
+ #{ids\ 1608}#))
+ #{tmp\ 1609}#)))
($sc-dispatch
- #{tmp\ 1674}#
+ #{tmp\ 1609}#
'#(vector
each-any)))))
($sc-dispatch
- #{tmp\ 1674}#
+ #{tmp\ 1609}#
'()))))
($sc-dispatch
- #{tmp\ 1674}#
+ #{tmp\ 1609}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 1674}#
+ #{tmp\ 1609}#
'(any any))))
- #{p\ 1671}#)))))
- (#{cvt\ 1670}# #{pattern\ 1668}# 0 (quote ()))))))
- (lambda (#{e\ 1696}#
- #{r\ 1697}#
- #{w\ 1698}#
- #{s\ 1699}#
- #{mod\ 1700}#)
- (let ((#{e\ 1701}#
+ #{p\ 1606}#)))))
+ (#{cvt\ 1605}# #{pattern\ 1603}# 0 (quote ()))))))
+ (lambda (#{e\ 1631}#
+ #{r\ 1632}#
+ #{w\ 1633}#
+ #{s\ 1634}#
+ #{mod\ 1635}#)
+ (let ((#{e\ 1636}#
(#{source-wrap\ 160}#
- #{e\ 1696}#
- #{w\ 1698}#
- #{s\ 1699}#
- #{mod\ 1700}#)))
- ((lambda (#{tmp\ 1702}#)
- ((lambda (#{tmp\ 1703}#)
- (if #{tmp\ 1703}#
- (apply (lambda (#{_\ 1704}#
- #{val\ 1705}#
- #{key\ 1706}#
- #{m\ 1707}#)
+ #{e\ 1631}#
+ #{w\ 1633}#
+ #{s\ 1634}#
+ #{mod\ 1635}#)))
+ ((lambda (#{tmp\ 1637}#)
+ ((lambda (#{tmp\ 1638}#)
+ (if #{tmp\ 1638}#
+ (apply (lambda (#{_\ 1639}#
+ #{val\ 1640}#
+ #{key\ 1641}#
+ #{m\ 1642}#)
(if (and-map
- (lambda (#{x\ 1708}#)
- (if (#{id?\ 131}# #{x\ 1708}#)
- (not (#{ellipsis?\ 175}# #{x\ 1708}#))
+ (lambda (#{x\ 1643}#)
+ (if (#{id?\ 131}# #{x\ 1643}#)
+ (not (#{ellipsis?\ 175}# #{x\ 1643}#))
#f))
- #{key\ 1706}#)
- (let ((#{x\ 1710}#
+ #{key\ 1641}#)
+ (let ((#{x\ 1645}#
(#{gen-var\ 181}# (quote tmp))))
(#{build-application\ 96}#
- #{s\ 1699}#
+ #{s\ 1634}#
(#{build-simple-lambda\ 105}#
#f
(list (quote tmp))
#f
- (list #{x\ 1710}#)
+ (list #{x\ 1645}#)
#f
- (#{gen-syntax-case\ 1623}#
+ (#{gen-syntax-case\ 1558}#
(#{build-lexical-reference\ 98}#
'value
#f
'tmp
- #{x\ 1710}#)
- #{key\ 1706}#
- #{m\ 1707}#
- #{r\ 1697}#
- #{mod\ 1700}#))
+ #{x\ 1645}#)
+ #{key\ 1641}#
+ #{m\ 1642}#
+ #{r\ 1632}#
+ #{mod\ 1635}#))
(list (#{chi\ 167}#
- #{val\ 1705}#
- #{r\ 1697}#
+ #{val\ 1640}#
+ #{r\ 1632}#
'(())
- #{mod\ 1700}#))))
+ #{mod\ 1635}#))))
(syntax-violation
'syntax-case
"invalid literals list"
- #{e\ 1701}#)))
- #{tmp\ 1703}#)
+ #{e\ 1636}#)))
+ #{tmp\ 1638}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1702}#)))
+ #{tmp\ 1637}#)))
($sc-dispatch
- #{tmp\ 1702}#
+ #{tmp\ 1637}#
'(any any each-any . each-any))))
- #{e\ 1701}#)))))
+ #{e\ 1636}#)))))
(set! sc-expand
- (lambda (#{x\ 1713}# . #{rest\ 1714}#)
- (if (if (pair? #{x\ 1713}#)
- (equal? (car #{x\ 1713}#) #{noexpand\ 84}#)
+ (lambda (#{x\ 1648}# . #{rest\ 1649}#)
+ (if (if (pair? #{x\ 1648}#)
+ (equal? (car #{x\ 1648}#) #{noexpand\ 84}#)
#f)
- (cadr #{x\ 1713}#)
- (let ((#{m\ 1715}#
- (if (null? #{rest\ 1714}#)
+ (cadr #{x\ 1648}#)
+ (let ((#{m\ 1650}#
+ (if (null? #{rest\ 1649}#)
'e
- (car #{rest\ 1714}#)))
- (#{esew\ 1716}#
- (if (let ((#{t\ 1717}# (null? #{rest\ 1714}#)))
- (if #{t\ 1717}#
- #{t\ 1717}#
- (null? (cdr #{rest\ 1714}#))))
+ (car #{rest\ 1649}#)))
+ (#{esew\ 1651}#
+ (if (let ((#{t\ 1652}# (null? #{rest\ 1649}#)))
+ (if #{t\ 1652}#
+ #{t\ 1652}#
+ (null? (cdr #{rest\ 1649}#))))
'(eval)
- (cadr #{rest\ 1714}#))))
+ (cadr #{rest\ 1649}#))))
(with-fluid*
#{*mode*\ 85}#
- #{m\ 1715}#
+ #{m\ 1650}#
(lambda ()
(#{chi-top\ 166}#
- #{x\ 1713}#
+ #{x\ 1648}#
'()
'((top))
- #{m\ 1715}#
- #{esew\ 1716}#
+ #{m\ 1650}#
+ #{esew\ 1651}#
(cons 'hygiene
(module-name (current-module))))))))))
(set! identifier?
- (lambda (#{x\ 1718}#)
- (#{nonsymbol-id?\ 130}# #{x\ 1718}#)))
+ (lambda (#{x\ 1653}#)
+ (#{nonsymbol-id?\ 130}# #{x\ 1653}#)))
(set! datum->syntax
- (lambda (#{id\ 1719}# #{datum\ 1720}#)
+ (lambda (#{id\ 1654}# #{datum\ 1655}#)
(#{make-syntax-object\ 114}#
- #{datum\ 1720}#
- (#{syntax-object-wrap\ 117}# #{id\ 1719}#)
+ #{datum\ 1655}#
+ (#{syntax-object-wrap\ 117}# #{id\ 1654}#)
#f)))
(set! syntax->datum
- (lambda (#{x\ 1721}#)
- (#{strip\ 180}# #{x\ 1721}# (quote (())))))
+ (lambda (#{x\ 1656}#)
+ (#{strip\ 180}# #{x\ 1656}# (quote (())))))
(set! generate-temporaries
- (lambda (#{ls\ 1722}#)
+ (lambda (#{ls\ 1657}#)
(begin
- (let ((#{x\ 1723}# #{ls\ 1722}#))
- (if (not (list? #{x\ 1723}#))
+ (let ((#{x\ 1658}# #{ls\ 1657}#))
+ (if (not (list? #{x\ 1658}#))
(syntax-violation
'generate-temporaries
"invalid argument"
- #{x\ 1723}#)))
- (map (lambda (#{x\ 1724}#)
+ #{x\ 1658}#)))
+ (map (lambda (#{x\ 1659}#)
(#{wrap\ 159}# (gensym) (quote ((top))) #f))
- #{ls\ 1722}#))))
+ #{ls\ 1657}#))))
(set! free-identifier=?
- (lambda (#{x\ 1725}# #{y\ 1726}#)
+ (lambda (#{x\ 1660}# #{y\ 1661}#)
(begin
- (let ((#{x\ 1727}# #{x\ 1725}#))
- (if (not (#{nonsymbol-id?\ 130}# #{x\ 1727}#))
+ (let ((#{x\ 1662}# #{x\ 1660}#))
+ (if (not (#{nonsymbol-id?\ 130}# #{x\ 1662}#))
(syntax-violation
'free-identifier=?
"invalid argument"
- #{x\ 1727}#)))
- (let ((#{x\ 1728}# #{y\ 1726}#))
- (if (not (#{nonsymbol-id?\ 130}# #{x\ 1728}#))
+ #{x\ 1662}#)))
+ (let ((#{x\ 1663}# #{y\ 1661}#))
+ (if (not (#{nonsymbol-id?\ 130}# #{x\ 1663}#))
(syntax-violation
'free-identifier=?
"invalid argument"
- #{x\ 1728}#)))
- (#{free-id=?\ 154}# #{x\ 1725}# #{y\ 1726}#))))
+ #{x\ 1663}#)))
+ (#{free-id=?\ 154}# #{x\ 1660}# #{y\ 1661}#))))
(set! bound-identifier=?
- (lambda (#{x\ 1729}# #{y\ 1730}#)
+ (lambda (#{x\ 1664}# #{y\ 1665}#)
(begin
- (let ((#{x\ 1731}# #{x\ 1729}#))
- (if (not (#{nonsymbol-id?\ 130}# #{x\ 1731}#))
+ (let ((#{x\ 1666}# #{x\ 1664}#))
+ (if (not (#{nonsymbol-id?\ 130}# #{x\ 1666}#))
(syntax-violation
'bound-identifier=?
"invalid argument"
- #{x\ 1731}#)))
- (let ((#{x\ 1732}# #{y\ 1730}#))
- (if (not (#{nonsymbol-id?\ 130}# #{x\ 1732}#))
+ #{x\ 1666}#)))
+ (let ((#{x\ 1667}# #{y\ 1665}#))
+ (if (not (#{nonsymbol-id?\ 130}# #{x\ 1667}#))
(syntax-violation
'bound-identifier=?
"invalid argument"
- #{x\ 1732}#)))
- (#{bound-id=?\ 155}# #{x\ 1729}# #{y\ 1730}#))))
+ #{x\ 1667}#)))
+ (#{bound-id=?\ 155}# #{x\ 1664}# #{y\ 1665}#))))
(set! syntax-violation
- (lambda (#{who\ 1733}#
- #{message\ 1734}#
- #{form\ 1735}#
+ (lambda (#{who\ 1668}#
+ #{message\ 1669}#
+ #{form\ 1670}#
.
- #{subform\ 1736}#)
+ #{subform\ 1671}#)
(begin
- (let ((#{x\ 1737}# #{who\ 1733}#))
- (if (not ((lambda (#{x\ 1738}#)
- (let ((#{t\ 1739}# (not #{x\ 1738}#)))
- (if #{t\ 1739}#
- #{t\ 1739}#
- (let ((#{t\ 1740}# (string? #{x\ 1738}#)))
- (if #{t\ 1740}#
- #{t\ 1740}#
- (symbol? #{x\ 1738}#))))))
- #{x\ 1737}#))
+ (let ((#{x\ 1672}# #{who\ 1668}#))
+ (if (not ((lambda (#{x\ 1673}#)
+ (let ((#{t\ 1674}# (not #{x\ 1673}#)))
+ (if #{t\ 1674}#
+ #{t\ 1674}#
+ (let ((#{t\ 1675}# (string? #{x\ 1673}#)))
+ (if #{t\ 1675}#
+ #{t\ 1675}#
+ (symbol? #{x\ 1673}#))))))
+ #{x\ 1672}#))
(syntax-violation
'syntax-violation
"invalid argument"
- #{x\ 1737}#)))
- (let ((#{x\ 1741}# #{message\ 1734}#))
- (if (not (string? #{x\ 1741}#))
+ #{x\ 1672}#)))
+ (let ((#{x\ 1676}# #{message\ 1669}#))
+ (if (not (string? #{x\ 1676}#))
(syntax-violation
'syntax-violation
"invalid argument"
- #{x\ 1741}#)))
+ #{x\ 1676}#)))
(scm-error
'syntax-error
'sc-expand
(string-append
- (if #{who\ 1733}# "~a: " "")
+ (if #{who\ 1668}# "~a: " "")
"~a "
- (if (null? #{subform\ 1736}#)
+ (if (null? #{subform\ 1671}#)
"in ~a"
"in subform `~s' of `~s'"))
- (let ((#{tail\ 1742}#
- (cons #{message\ 1734}#
- (map (lambda (#{x\ 1743}#)
- (#{strip\ 180}# #{x\ 1743}# (quote (()))))
+ (let ((#{tail\ 1677}#
+ (cons #{message\ 1669}#
+ (map (lambda (#{x\ 1678}#)
+ (#{strip\ 180}# #{x\ 1678}# (quote (()))))
(append
- #{subform\ 1736}#
- (list #{form\ 1735}#))))))
- (if #{who\ 1733}#
- (cons #{who\ 1733}# #{tail\ 1742}#)
- #{tail\ 1742}#))
+ #{subform\ 1671}#
+ (list #{form\ 1670}#))))))
+ (if #{who\ 1668}#
+ (cons #{who\ 1668}# #{tail\ 1677}#)
+ #{tail\ 1677}#))
#f))))
- (letrec ((#{match\ 1748}#
- (lambda (#{e\ 1749}#
- #{p\ 1750}#
- #{w\ 1751}#
- #{r\ 1752}#
- #{mod\ 1753}#)
- (if (not #{r\ 1752}#)
+ (letrec ((#{match\ 1683}#
+ (lambda (#{e\ 1684}#
+ #{p\ 1685}#
+ #{w\ 1686}#
+ #{r\ 1687}#
+ #{mod\ 1688}#)
+ (if (not #{r\ 1687}#)
#f
- (if (eq? #{p\ 1750}# (quote any))
+ (if (eq? #{p\ 1685}# (quote any))
(cons (#{wrap\ 159}#
- #{e\ 1749}#
- #{w\ 1751}#
- #{mod\ 1753}#)
- #{r\ 1752}#)
- (if (#{syntax-object?\ 115}# #{e\ 1749}#)
- (#{match*\ 1747}#
- (#{syntax-object-expression\ 116}# #{e\ 1749}#)
- #{p\ 1750}#
+ #{e\ 1684}#
+ #{w\ 1686}#
+ #{mod\ 1688}#)
+ #{r\ 1687}#)
+ (if (#{syntax-object?\ 115}# #{e\ 1684}#)
+ (#{match*\ 1682}#
+ (#{syntax-object-expression\ 116}# #{e\ 1684}#)
+ #{p\ 1685}#
(#{join-wraps\ 150}#
- #{w\ 1751}#
- (#{syntax-object-wrap\ 117}# #{e\ 1749}#))
- #{r\ 1752}#
- (#{syntax-object-module\ 118}# #{e\ 1749}#))
- (#{match*\ 1747}#
- #{e\ 1749}#
- #{p\ 1750}#
- #{w\ 1751}#
- #{r\ 1752}#
- #{mod\ 1753}#))))))
- (#{match*\ 1747}#
- (lambda (#{e\ 1754}#
- #{p\ 1755}#
- #{w\ 1756}#
- #{r\ 1757}#
- #{mod\ 1758}#)
- (if (null? #{p\ 1755}#)
- (if (null? #{e\ 1754}#) #{r\ 1757}# #f)
- (if (pair? #{p\ 1755}#)
- (if (pair? #{e\ 1754}#)
- (#{match\ 1748}#
- (car #{e\ 1754}#)
- (car #{p\ 1755}#)
- #{w\ 1756}#
- (#{match\ 1748}#
- (cdr #{e\ 1754}#)
- (cdr #{p\ 1755}#)
- #{w\ 1756}#
- #{r\ 1757}#
- #{mod\ 1758}#)
- #{mod\ 1758}#)
+ #{w\ 1686}#
+ (#{syntax-object-wrap\ 117}# #{e\ 1684}#))
+ #{r\ 1687}#
+ (#{syntax-object-module\ 118}# #{e\ 1684}#))
+ (#{match*\ 1682}#
+ #{e\ 1684}#
+ #{p\ 1685}#
+ #{w\ 1686}#
+ #{r\ 1687}#
+ #{mod\ 1688}#))))))
+ (#{match*\ 1682}#
+ (lambda (#{e\ 1689}#
+ #{p\ 1690}#
+ #{w\ 1691}#
+ #{r\ 1692}#
+ #{mod\ 1693}#)
+ (if (null? #{p\ 1690}#)
+ (if (null? #{e\ 1689}#) #{r\ 1692}# #f)
+ (if (pair? #{p\ 1690}#)
+ (if (pair? #{e\ 1689}#)
+ (#{match\ 1683}#
+ (car #{e\ 1689}#)
+ (car #{p\ 1690}#)
+ #{w\ 1691}#
+ (#{match\ 1683}#
+ (cdr #{e\ 1689}#)
+ (cdr #{p\ 1690}#)
+ #{w\ 1691}#
+ #{r\ 1692}#
+ #{mod\ 1693}#)
+ #{mod\ 1693}#)
#f)
- (if (eq? #{p\ 1755}# (quote each-any))
- (let ((#{l\ 1759}#
- (#{match-each-any\ 1745}#
- #{e\ 1754}#
- #{w\ 1756}#
- #{mod\ 1758}#)))
- (if #{l\ 1759}#
- (cons #{l\ 1759}# #{r\ 1757}#)
+ (if (eq? #{p\ 1690}# (quote each-any))
+ (let ((#{l\ 1694}#
+ (#{match-each-any\ 1680}#
+ #{e\ 1689}#
+ #{w\ 1691}#
+ #{mod\ 1693}#)))
+ (if #{l\ 1694}#
+ (cons #{l\ 1694}# #{r\ 1692}#)
#f))
- (let ((#{atom-key\ 1760}# (vector-ref #{p\ 1755}# 0)))
- (if (memv #{atom-key\ 1760}# (quote (each)))
- (if (null? #{e\ 1754}#)
- (#{match-empty\ 1746}#
- (vector-ref #{p\ 1755}# 1)
- #{r\ 1757}#)
- (let ((#{l\ 1761}#
- (#{match-each\ 1744}#
- #{e\ 1754}#
- (vector-ref #{p\ 1755}# 1)
- #{w\ 1756}#
- #{mod\ 1758}#)))
- (if #{l\ 1761}#
- (letrec ((#{collect\ 1762}#
- (lambda (#{l\ 1763}#)
- (if (null? (car #{l\ 1763}#))
- #{r\ 1757}#
- (cons (map car #{l\ 1763}#)
- (#{collect\ 1762}#
+ (let ((#{atom-key\ 1695}# (vector-ref #{p\ 1690}# 0)))
+ (if (memv #{atom-key\ 1695}# (quote (each)))
+ (if (null? #{e\ 1689}#)
+ (#{match-empty\ 1681}#
+ (vector-ref #{p\ 1690}# 1)
+ #{r\ 1692}#)
+ (let ((#{l\ 1696}#
+ (#{match-each\ 1679}#
+ #{e\ 1689}#
+ (vector-ref #{p\ 1690}# 1)
+ #{w\ 1691}#
+ #{mod\ 1693}#)))
+ (if #{l\ 1696}#
+ (letrec ((#{collect\ 1697}#
+ (lambda (#{l\ 1698}#)
+ (if (null? (car #{l\ 1698}#))
+ #{r\ 1692}#
+ (cons (map car #{l\ 1698}#)
+ (#{collect\ 1697}#
(map cdr
- #{l\
1763}#)))))))
- (#{collect\ 1762}# #{l\ 1761}#))
+ #{l\
1698}#)))))))
+ (#{collect\ 1697}# #{l\ 1696}#))
#f)))
- (if (memv #{atom-key\ 1760}# (quote (free-id)))
- (if (#{id?\ 131}# #{e\ 1754}#)
+ (if (memv #{atom-key\ 1695}# (quote (free-id)))
+ (if (#{id?\ 131}# #{e\ 1689}#)
(if (#{free-id=?\ 154}#
(#{wrap\ 159}#
- #{e\ 1754}#
- #{w\ 1756}#
- #{mod\ 1758}#)
- (vector-ref #{p\ 1755}# 1))
- #{r\ 1757}#
+ #{e\ 1689}#
+ #{w\ 1691}#
+ #{mod\ 1693}#)
+ (vector-ref #{p\ 1690}# 1))
+ #{r\ 1692}#
#f)
#f)
- (if (memv #{atom-key\ 1760}# (quote (atom)))
+ (if (memv #{atom-key\ 1695}# (quote (atom)))
(if (equal?
- (vector-ref #{p\ 1755}# 1)
+ (vector-ref #{p\ 1690}# 1)
(#{strip\ 180}#
- #{e\ 1754}#
- #{w\ 1756}#))
- #{r\ 1757}#
+ #{e\ 1689}#
+ #{w\ 1691}#))
+ #{r\ 1692}#
#f)
- (if (memv #{atom-key\ 1760}# (quote (vector)))
- (if (vector? #{e\ 1754}#)
- (#{match\ 1748}#
- (vector->list #{e\ 1754}#)
- (vector-ref #{p\ 1755}# 1)
- #{w\ 1756}#
- #{r\ 1757}#
- #{mod\ 1758}#)
+ (if (memv #{atom-key\ 1695}# (quote (vector)))
+ (if (vector? #{e\ 1689}#)
+ (#{match\ 1683}#
+ (vector->list #{e\ 1689}#)
+ (vector-ref #{p\ 1690}# 1)
+ #{w\ 1691}#
+ #{r\ 1692}#
+ #{mod\ 1693}#)
#f)))))))))))
- (#{match-empty\ 1746}#
- (lambda (#{p\ 1764}# #{r\ 1765}#)
- (if (null? #{p\ 1764}#)
- #{r\ 1765}#
- (if (eq? #{p\ 1764}# (quote any))
- (cons (quote ()) #{r\ 1765}#)
- (if (pair? #{p\ 1764}#)
- (#{match-empty\ 1746}#
- (car #{p\ 1764}#)
- (#{match-empty\ 1746}#
- (cdr #{p\ 1764}#)
- #{r\ 1765}#))
- (if (eq? #{p\ 1764}# (quote each-any))
- (cons (quote ()) #{r\ 1765}#)
- (let ((#{atom-key\ 1766}#
- (vector-ref #{p\ 1764}# 0)))
- (if (memv #{atom-key\ 1766}# (quote (each)))
- (#{match-empty\ 1746}#
- (vector-ref #{p\ 1764}# 1)
- #{r\ 1765}#)
- (if (memv #{atom-key\ 1766}#
+ (#{match-empty\ 1681}#
+ (lambda (#{p\ 1699}# #{r\ 1700}#)
+ (if (null? #{p\ 1699}#)
+ #{r\ 1700}#
+ (if (eq? #{p\ 1699}# (quote any))
+ (cons (quote ()) #{r\ 1700}#)
+ (if (pair? #{p\ 1699}#)
+ (#{match-empty\ 1681}#
+ (car #{p\ 1699}#)
+ (#{match-empty\ 1681}#
+ (cdr #{p\ 1699}#)
+ #{r\ 1700}#))
+ (if (eq? #{p\ 1699}# (quote each-any))
+ (cons (quote ()) #{r\ 1700}#)
+ (let ((#{atom-key\ 1701}#
+ (vector-ref #{p\ 1699}# 0)))
+ (if (memv #{atom-key\ 1701}# (quote (each)))
+ (#{match-empty\ 1681}#
+ (vector-ref #{p\ 1699}# 1)
+ #{r\ 1700}#)
+ (if (memv #{atom-key\ 1701}#
'(free-id atom))
- #{r\ 1765}#
- (if (memv #{atom-key\ 1766}# (quote (vector)))
- (#{match-empty\ 1746}#
- (vector-ref #{p\ 1764}# 1)
- #{r\ 1765}#)))))))))))
- (#{match-each-any\ 1745}#
- (lambda (#{e\ 1767}# #{w\ 1768}# #{mod\ 1769}#)
- (if (pair? #{e\ 1767}#)
- (let ((#{l\ 1770}#
- (#{match-each-any\ 1745}#
- (cdr #{e\ 1767}#)
- #{w\ 1768}#
- #{mod\ 1769}#)))
- (if #{l\ 1770}#
+ #{r\ 1700}#
+ (if (memv #{atom-key\ 1701}# (quote (vector)))
+ (#{match-empty\ 1681}#
+ (vector-ref #{p\ 1699}# 1)
+ #{r\ 1700}#)))))))))))
+ (#{match-each-any\ 1680}#
+ (lambda (#{e\ 1702}# #{w\ 1703}# #{mod\ 1704}#)
+ (if (pair? #{e\ 1702}#)
+ (let ((#{l\ 1705}#
+ (#{match-each-any\ 1680}#
+ (cdr #{e\ 1702}#)
+ #{w\ 1703}#
+ #{mod\ 1704}#)))
+ (if #{l\ 1705}#
(cons (#{wrap\ 159}#
- (car #{e\ 1767}#)
- #{w\ 1768}#
- #{mod\ 1769}#)
- #{l\ 1770}#)
+ (car #{e\ 1702}#)
+ #{w\ 1703}#
+ #{mod\ 1704}#)
+ #{l\ 1705}#)
#f))
- (if (null? #{e\ 1767}#)
+ (if (null? #{e\ 1702}#)
'()
- (if (#{syntax-object?\ 115}# #{e\ 1767}#)
- (#{match-each-any\ 1745}#
- (#{syntax-object-expression\ 116}# #{e\ 1767}#)
+ (if (#{syntax-object?\ 115}# #{e\ 1702}#)
+ (#{match-each-any\ 1680}#
+ (#{syntax-object-expression\ 116}# #{e\ 1702}#)
(#{join-wraps\ 150}#
- #{w\ 1768}#
- (#{syntax-object-wrap\ 117}# #{e\ 1767}#))
- #{mod\ 1769}#)
+ #{w\ 1703}#
+ (#{syntax-object-wrap\ 117}# #{e\ 1702}#))
+ #{mod\ 1704}#)
#f)))))
- (#{match-each\ 1744}#
- (lambda (#{e\ 1771}#
- #{p\ 1772}#
- #{w\ 1773}#
- #{mod\ 1774}#)
- (if (pair? #{e\ 1771}#)
- (let ((#{first\ 1775}#
- (#{match\ 1748}#
- (car #{e\ 1771}#)
- #{p\ 1772}#
- #{w\ 1773}#
+ (#{match-each\ 1679}#
+ (lambda (#{e\ 1706}#
+ #{p\ 1707}#
+ #{w\ 1708}#
+ #{mod\ 1709}#)
+ (if (pair? #{e\ 1706}#)
+ (let ((#{first\ 1710}#
+ (#{match\ 1683}#
+ (car #{e\ 1706}#)
+ #{p\ 1707}#
+ #{w\ 1708}#
'()
- #{mod\ 1774}#)))
- (if #{first\ 1775}#
- (let ((#{rest\ 1776}#
- (#{match-each\ 1744}#
- (cdr #{e\ 1771}#)
- #{p\ 1772}#
- #{w\ 1773}#
- #{mod\ 1774}#)))
- (if #{rest\ 1776}#
- (cons #{first\ 1775}# #{rest\ 1776}#)
+ #{mod\ 1709}#)))
+ (if #{first\ 1710}#
+ (let ((#{rest\ 1711}#
+ (#{match-each\ 1679}#
+ (cdr #{e\ 1706}#)
+ #{p\ 1707}#
+ #{w\ 1708}#
+ #{mod\ 1709}#)))
+ (if #{rest\ 1711}#
+ (cons #{first\ 1710}# #{rest\ 1711}#)
#f))
#f))
- (if (null? #{e\ 1771}#)
+ (if (null? #{e\ 1706}#)
'()
- (if (#{syntax-object?\ 115}# #{e\ 1771}#)
- (#{match-each\ 1744}#
- (#{syntax-object-expression\ 116}# #{e\ 1771}#)
- #{p\ 1772}#
+ (if (#{syntax-object?\ 115}# #{e\ 1706}#)
+ (#{match-each\ 1679}#
+ (#{syntax-object-expression\ 116}# #{e\ 1706}#)
+ #{p\ 1707}#
(#{join-wraps\ 150}#
- #{w\ 1773}#
- (#{syntax-object-wrap\ 117}# #{e\ 1771}#))
- (#{syntax-object-module\ 118}# #{e\ 1771}#))
+ #{w\ 1708}#
+ (#{syntax-object-wrap\ 117}# #{e\ 1706}#))
+ (#{syntax-object-module\ 118}# #{e\ 1706}#))
#f))))))
(set! $sc-dispatch
- (lambda (#{e\ 1777}# #{p\ 1778}#)
- (if (eq? #{p\ 1778}# (quote any))
- (list #{e\ 1777}#)
- (if (#{syntax-object?\ 115}# #{e\ 1777}#)
- (#{match*\ 1747}#
- (#{syntax-object-expression\ 116}# #{e\ 1777}#)
- #{p\ 1778}#
- (#{syntax-object-wrap\ 117}# #{e\ 1777}#)
+ (lambda (#{e\ 1712}# #{p\ 1713}#)
+ (if (eq? #{p\ 1713}# (quote any))
+ (list #{e\ 1712}#)
+ (if (#{syntax-object?\ 115}# #{e\ 1712}#)
+ (#{match*\ 1682}#
+ (#{syntax-object-expression\ 116}# #{e\ 1712}#)
+ #{p\ 1713}#
+ (#{syntax-object-wrap\ 117}# #{e\ 1712}#)
'()
- (#{syntax-object-module\ 118}# #{e\ 1777}#))
- (#{match*\ 1747}#
- #{e\ 1777}#
- #{p\ 1778}#
+ (#{syntax-object-module\ 118}# #{e\ 1712}#))
+ (#{match*\ 1682}#
+ #{e\ 1712}#
+ #{p\ 1713}#
'(())
'()
#f)))))))))
@@ -11629,11 +11388,11 @@
(define with-syntax
(make-syncase-macro
'macro
- (lambda (#{x\ 1779}#)
- ((lambda (#{tmp\ 1780}#)
- ((lambda (#{tmp\ 1781}#)
- (if #{tmp\ 1781}#
- (apply (lambda (#{_\ 1782}# #{e1\ 1783}# #{e2\ 1784}#)
+ (lambda (#{x\ 1714}#)
+ ((lambda (#{tmp\ 1715}#)
+ ((lambda (#{tmp\ 1716}#)
+ (if #{tmp\ 1716}#
+ (apply (lambda (#{_\ 1717}# #{e1\ 1718}# #{e2\ 1719}#)
(cons '#(syntax-object
begin
((top)
@@ -11644,15 +11403,15 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- (cons #{e1\ 1783}# #{e2\ 1784}#)))
- #{tmp\ 1781}#)
- ((lambda (#{tmp\ 1786}#)
- (if #{tmp\ 1786}#
- (apply (lambda (#{_\ 1787}#
- #{out\ 1788}#
- #{in\ 1789}#
- #{e1\ 1790}#
- #{e2\ 1791}#)
+ (cons #{e1\ 1718}# #{e2\ 1719}#)))
+ #{tmp\ 1716}#)
+ ((lambda (#{tmp\ 1721}#)
+ (if #{tmp\ 1721}#
+ (apply (lambda (#{_\ 1722}#
+ #{out\ 1723}#
+ #{in\ 1724}#
+ #{e1\ 1725}#
+ #{e2\ 1726}#)
(list '#(syntax-object
syntax-case
((top)
@@ -11663,9 +11422,9 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- #{in\ 1789}#
+ #{in\ 1724}#
'()
- (list #{out\ 1788}#
+ (list #{out\ 1723}#
(cons '#(syntax-object
begin
((top)
@@ -11683,16 +11442,16 @@
#((top))
#("i")))
(hygiene guile))
- (cons #{e1\ 1790}#
- #{e2\ 1791}#)))))
- #{tmp\ 1786}#)
- ((lambda (#{tmp\ 1793}#)
- (if #{tmp\ 1793}#
- (apply (lambda (#{_\ 1794}#
- #{out\ 1795}#
- #{in\ 1796}#
- #{e1\ 1797}#
- #{e2\ 1798}#)
+ (cons #{e1\ 1725}#
+ #{e2\ 1726}#)))))
+ #{tmp\ 1721}#)
+ ((lambda (#{tmp\ 1728}#)
+ (if #{tmp\ 1728}#
+ (apply (lambda (#{_\ 1729}#
+ #{out\ 1730}#
+ #{in\ 1731}#
+ #{e1\ 1732}#
+ #{e2\ 1733}#)
(list '#(syntax-object
syntax-case
((top)
@@ -11720,9 +11479,9 @@
#((top))
#("i")))
(hygiene guile))
- #{in\ 1796}#)
+ #{in\ 1731}#)
'()
- (list #{out\ 1795}#
+ (list #{out\ 1730}#
(cons '#(syntax-object
begin
((top)
@@ -11744,36 +11503,36 @@
#((top))
#("i")))
(hygiene guile))
- (cons #{e1\ 1797}#
- #{e2\ 1798}#)))))
- #{tmp\ 1793}#)
+ (cons #{e1\ 1732}#
+ #{e2\ 1733}#)))))
+ #{tmp\ 1728}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1780}#)))
+ #{tmp\ 1715}#)))
($sc-dispatch
- #{tmp\ 1780}#
+ #{tmp\ 1715}#
'(any #(each (any any)) any . each-any)))))
($sc-dispatch
- #{tmp\ 1780}#
+ #{tmp\ 1715}#
'(any ((any any)) any . each-any)))))
($sc-dispatch
- #{tmp\ 1780}#
+ #{tmp\ 1715}#
'(any () any . each-any))))
- #{x\ 1779}#))))
+ #{x\ 1714}#))))
(define syntax-rules
(make-syncase-macro
'macro
- (lambda (#{x\ 1802}#)
- ((lambda (#{tmp\ 1803}#)
- ((lambda (#{tmp\ 1804}#)
- (if #{tmp\ 1804}#
- (apply (lambda (#{_\ 1805}#
- #{k\ 1806}#
- #{keyword\ 1807}#
- #{pattern\ 1808}#
- #{template\ 1809}#)
+ (lambda (#{x\ 1737}#)
+ ((lambda (#{tmp\ 1738}#)
+ ((lambda (#{tmp\ 1739}#)
+ (if #{tmp\ 1739}#
+ (apply (lambda (#{_\ 1740}#
+ #{k\ 1741}#
+ #{keyword\ 1742}#
+ #{pattern\ 1743}#
+ #{template\ 1744}#)
(list '#(syntax-object
lambda
((top)
@@ -11814,9 +11573,9 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- (cons #{k\ 1806}#
- (map (lambda (#{tmp\ 1812}#
- #{tmp\ 1811}#)
+ (cons #{k\ 1741}#
+ (map (lambda (#{tmp\ 1747}#
+ #{tmp\ 1746}#)
(list (cons
'#(syntax-object
dummy
((top)
@@ -11846,7 +11605,7 @@
#("i")))
(hygiene
guile))
- #{tmp\
1811}#)
+ #{tmp\
1746}#)
(list
'#(syntax-object
syntax
((top)
@@ -11876,43 +11635,43 @@
#("i")))
(hygiene
guile))
- #{tmp\
1812}#)))
- #{template\ 1809}#
- #{pattern\ 1808}#))))))
- #{tmp\ 1804}#)
+ #{tmp\
1747}#)))
+ #{template\ 1744}#
+ #{pattern\ 1743}#))))))
+ #{tmp\ 1739}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1803}#)))
+ #{tmp\ 1738}#)))
($sc-dispatch
- #{tmp\ 1803}#
+ #{tmp\ 1738}#
'(any each-any . #(each ((any . any) any))))))
- #{x\ 1802}#))))
+ #{x\ 1737}#))))
(define let*
(make-extended-syncase-macro
(module-ref (current-module) (quote let*))
'macro
- (lambda (#{x\ 1813}#)
- ((lambda (#{tmp\ 1814}#)
- ((lambda (#{tmp\ 1815}#)
- (if (if #{tmp\ 1815}#
- (apply (lambda (#{let*\ 1816}#
- #{x\ 1817}#
- #{v\ 1818}#
- #{e1\ 1819}#
- #{e2\ 1820}#)
- (and-map identifier? #{x\ 1817}#))
- #{tmp\ 1815}#)
+ (lambda (#{x\ 1748}#)
+ ((lambda (#{tmp\ 1749}#)
+ ((lambda (#{tmp\ 1750}#)
+ (if (if #{tmp\ 1750}#
+ (apply (lambda (#{let*\ 1751}#
+ #{x\ 1752}#
+ #{v\ 1753}#
+ #{e1\ 1754}#
+ #{e2\ 1755}#)
+ (and-map identifier? #{x\ 1752}#))
+ #{tmp\ 1750}#)
#f)
- (apply (lambda (#{let*\ 1822}#
- #{x\ 1823}#
- #{v\ 1824}#
- #{e1\ 1825}#
- #{e2\ 1826}#)
- (letrec ((#{f\ 1827}#
- (lambda (#{bindings\ 1828}#)
- (if (null? #{bindings\ 1828}#)
+ (apply (lambda (#{let*\ 1757}#
+ #{x\ 1758}#
+ #{v\ 1759}#
+ #{e1\ 1760}#
+ #{e2\ 1761}#)
+ (letrec ((#{f\ 1762}#
+ (lambda (#{bindings\ 1763}#)
+ (if (null? #{bindings\ 1763}#)
(cons '#(syntax-object
let
((top)
@@ -11936,13 +11695,13 @@
#("i")))
(hygiene guile))
(cons '()
- (cons #{e1\ 1825}#
- #{e2\ 1826}#)))
- ((lambda (#{tmp\ 1832}#)
- ((lambda (#{tmp\ 1833}#)
- (if #{tmp\ 1833}#
- (apply (lambda (#{body\ 1834}#
- #{binding\
1835}#)
+ (cons #{e1\ 1760}#
+ #{e2\ 1761}#)))
+ ((lambda (#{tmp\ 1767}#)
+ ((lambda (#{tmp\ 1768}#)
+ (if #{tmp\ 1768}#
+ (apply (lambda (#{body\ 1769}#
+ #{binding\
1770}#)
(list '#(syntax-object
let
((top)
@@ -11988,52 +11747,52 @@
#("i")))
(hygiene
guile))
- (list #{binding\
1835}#)
- #{body\ 1834}#))
- #{tmp\ 1833}#)
+ (list #{binding\
1770}#)
+ #{body\ 1769}#))
+ #{tmp\ 1768}#)
(syntax-violation
#f
"source expression failed to
match any pattern"
- #{tmp\ 1832}#)))
+ #{tmp\ 1767}#)))
($sc-dispatch
- #{tmp\ 1832}#
+ #{tmp\ 1767}#
'(any any))))
- (list (#{f\ 1827}#
- (cdr #{bindings\ 1828}#))
- (car #{bindings\ 1828}#)))))))
- (#{f\ 1827}# (map list #{x\ 1823}# #{v\ 1824}#))))
- #{tmp\ 1815}#)
+ (list (#{f\ 1762}#
+ (cdr #{bindings\ 1763}#))
+ (car #{bindings\ 1763}#)))))))
+ (#{f\ 1762}# (map list #{x\ 1758}# #{v\ 1759}#))))
+ #{tmp\ 1750}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1814}#)))
+ #{tmp\ 1749}#)))
($sc-dispatch
- #{tmp\ 1814}#
+ #{tmp\ 1749}#
'(any #(each (any any)) any . each-any))))
- #{x\ 1813}#))))
+ #{x\ 1748}#))))
(define do
(make-extended-syncase-macro
(module-ref (current-module) (quote do))
'macro
- (lambda (#{orig-x\ 1836}#)
- ((lambda (#{tmp\ 1837}#)
- ((lambda (#{tmp\ 1838}#)
- (if #{tmp\ 1838}#
- (apply (lambda (#{_\ 1839}#
- #{var\ 1840}#
- #{init\ 1841}#
- #{step\ 1842}#
- #{e0\ 1843}#
- #{e1\ 1844}#
- #{c\ 1845}#)
- ((lambda (#{tmp\ 1846}#)
- ((lambda (#{tmp\ 1847}#)
- (if #{tmp\ 1847}#
- (apply (lambda (#{step\ 1848}#)
- ((lambda (#{tmp\ 1849}#)
- ((lambda (#{tmp\ 1850}#)
- (if #{tmp\ 1850}#
+ (lambda (#{orig-x\ 1771}#)
+ ((lambda (#{tmp\ 1772}#)
+ ((lambda (#{tmp\ 1773}#)
+ (if #{tmp\ 1773}#
+ (apply (lambda (#{_\ 1774}#
+ #{var\ 1775}#
+ #{init\ 1776}#
+ #{step\ 1777}#
+ #{e0\ 1778}#
+ #{e1\ 1779}#
+ #{c\ 1780}#)
+ ((lambda (#{tmp\ 1781}#)
+ ((lambda (#{tmp\ 1782}#)
+ (if #{tmp\ 1782}#
+ (apply (lambda (#{step\ 1783}#)
+ ((lambda (#{tmp\ 1784}#)
+ ((lambda (#{tmp\ 1785}#)
+ (if #{tmp\ 1785}#
(apply (lambda ()
(list '#(syntax-object
let
@@ -12114,8 +11873,8 @@
(hygiene
guile))
(map list
- #{var\
1840}#
- #{init\
1841}#)
+ #{var\
1775}#
+ #{init\
1776}#)
(list
'#(syntax-object
if
((top)
@@ -12194,7 +11953,7 @@
#("i")))
(hygiene
guile))
-
#{e0\ 1843}#)
+
#{e0\ 1778}#)
(cons
'#(syntax-object
begin
((top)
@@ -12235,7 +11994,7 @@
(hygiene
guile))
(append
-
#{c\ 1845}#
+
#{c\ 1780}#
(list (cons '#(syntax-object
doloop
((top)
@@ -12275,12 +12034,12 @@
#("i")))
(hygiene
guile))
-
#{step\ 1848}#)))))))
- #{tmp\ 1850}#)
- ((lambda (#{tmp\ 1855}#)
- (if #{tmp\ 1855}#
- (apply (lambda (#{e1\
1856}#
- #{e2\
1857}#)
+
#{step\ 1783}#)))))))
+ #{tmp\ 1785}#)
+ ((lambda (#{tmp\ 1790}#)
+ (if #{tmp\ 1790}#
+ (apply (lambda (#{e1\
1791}#
+ #{e2\
1792}#)
(list
'#(syntax-object
let
((top)
@@ -12374,8 +12133,8 @@
(hygiene
guile))
(map list
-
#{var\ 1840}#
-
#{init\ 1841}#)
+
#{var\ 1775}#
+
#{init\ 1776}#)
(list
'#(syntax-object
if
((top)
@@ -12422,7 +12181,7 @@
#("i")))
(hygiene
guile))
-
#{e0\ 1843}#
+
#{e0\ 1778}#
(cons '#(syntax-object
begin
((top)
@@ -12469,8 +12228,8 @@
#("i")))
(hygiene
guile))
-
(cons #{e1\ 1856}#
-
#{e2\ 1857}#))
+
(cons #{e1\ 1791}#
+
#{e2\ 1792}#))
(cons '#(syntax-object
begin
((top)
@@ -12518,7 +12277,7 @@
(hygiene
guile))
(append
-
#{c\ 1845}#
+
#{c\ 1780}#
(list (cons '#(syntax-object
doloop
((top)
@@ -12565,81 +12324,81 @@
#("i")))
(hygiene
guile))
-
#{step\ 1848}#)))))))
- #{tmp\ 1855}#)
+
#{step\ 1783}#)))))))
+ #{tmp\ 1790}#)
(syntax-violation
#f
"source expression
failed to match any pattern"
- #{tmp\ 1849}#)))
+ #{tmp\ 1784}#)))
($sc-dispatch
- #{tmp\ 1849}#
+ #{tmp\ 1784}#
'(any . each-any)))))
($sc-dispatch
- #{tmp\ 1849}#
+ #{tmp\ 1784}#
'())))
- #{e1\ 1844}#))
- #{tmp\ 1847}#)
+ #{e1\ 1779}#))
+ #{tmp\ 1782}#)
(syntax-violation
#f
"source expression failed to match any
pattern"
- #{tmp\ 1846}#)))
- ($sc-dispatch #{tmp\ 1846}# (quote each-any))))
- (map (lambda (#{v\ 1864}# #{s\ 1865}#)
- ((lambda (#{tmp\ 1866}#)
- ((lambda (#{tmp\ 1867}#)
- (if #{tmp\ 1867}#
- (apply (lambda () #{v\ 1864}#)
- #{tmp\ 1867}#)
- ((lambda (#{tmp\ 1868}#)
- (if #{tmp\ 1868}#
- (apply (lambda (#{e\ 1869}#)
- #{e\ 1869}#)
- #{tmp\ 1868}#)
- ((lambda (#{_\ 1870}#)
+ #{tmp\ 1781}#)))
+ ($sc-dispatch #{tmp\ 1781}# (quote each-any))))
+ (map (lambda (#{v\ 1799}# #{s\ 1800}#)
+ ((lambda (#{tmp\ 1801}#)
+ ((lambda (#{tmp\ 1802}#)
+ (if #{tmp\ 1802}#
+ (apply (lambda () #{v\ 1799}#)
+ #{tmp\ 1802}#)
+ ((lambda (#{tmp\ 1803}#)
+ (if #{tmp\ 1803}#
+ (apply (lambda (#{e\ 1804}#)
+ #{e\ 1804}#)
+ #{tmp\ 1803}#)
+ ((lambda (#{_\ 1805}#)
(syntax-violation
'do
"bad step expression"
- #{orig-x\ 1836}#
- #{s\ 1865}#))
- #{tmp\ 1866}#)))
+ #{orig-x\ 1771}#
+ #{s\ 1800}#))
+ #{tmp\ 1801}#)))
($sc-dispatch
- #{tmp\ 1866}#
+ #{tmp\ 1801}#
'(any)))))
- ($sc-dispatch #{tmp\ 1866}# (quote ()))))
- #{s\ 1865}#))
- #{var\ 1840}#
- #{step\ 1842}#)))
- #{tmp\ 1838}#)
+ ($sc-dispatch #{tmp\ 1801}# (quote ()))))
+ #{s\ 1800}#))
+ #{var\ 1775}#
+ #{step\ 1777}#)))
+ #{tmp\ 1773}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1837}#)))
+ #{tmp\ 1772}#)))
($sc-dispatch
- #{tmp\ 1837}#
+ #{tmp\ 1772}#
'(any #(each (any any . any))
(any . each-any)
.
each-any))))
- #{orig-x\ 1836}#))))
+ #{orig-x\ 1771}#))))
(define quasiquote
(make-extended-syncase-macro
(module-ref (current-module) (quote quasiquote))
'macro
- (letrec ((#{quasicons\ 1873}#
- (lambda (#{x\ 1877}# #{y\ 1878}#)
- ((lambda (#{tmp\ 1879}#)
- ((lambda (#{tmp\ 1880}#)
- (if #{tmp\ 1880}#
- (apply (lambda (#{x\ 1881}# #{y\ 1882}#)
- ((lambda (#{tmp\ 1883}#)
- ((lambda (#{tmp\ 1884}#)
- (if #{tmp\ 1884}#
- (apply (lambda (#{dy\ 1885}#)
- ((lambda (#{tmp\ 1886}#)
- ((lambda (#{tmp\ 1887}#)
- (if #{tmp\ 1887}#
- (apply (lambda
(#{dx\ 1888}#)
+ (letrec ((#{quasicons\ 1808}#
+ (lambda (#{x\ 1812}# #{y\ 1813}#)
+ ((lambda (#{tmp\ 1814}#)
+ ((lambda (#{tmp\ 1815}#)
+ (if #{tmp\ 1815}#
+ (apply (lambda (#{x\ 1816}# #{y\ 1817}#)
+ ((lambda (#{tmp\ 1818}#)
+ ((lambda (#{tmp\ 1819}#)
+ (if #{tmp\ 1819}#
+ (apply (lambda (#{dy\ 1820}#)
+ ((lambda (#{tmp\ 1821}#)
+ ((lambda (#{tmp\ 1822}#)
+ (if #{tmp\ 1822}#
+ (apply (lambda
(#{dx\ 1823}#)
(list
'#(syntax-object
quote
((top)
@@ -12688,11 +12447,11 @@
"i")))
(hygiene
guile))
-
(cons #{dx\ 1888}#
-
#{dy\ 1885}#)))
- #{tmp\
1887}#)
- ((lambda (#{_\
1889}#)
- (if (null? #{dy\
1885}#)
+
(cons #{dx\ 1823}#
+
#{dy\ 1820}#)))
+ #{tmp\
1822}#)
+ ((lambda (#{_\
1824}#)
+ (if (null? #{dy\
1820}#)
(list
'#(syntax-object
list
((top)
@@ -12741,7 +12500,7 @@
"i")))
(hygiene
guile))
- #{x\
1881}#)
+ #{x\
1816}#)
(list
'#(syntax-object
cons
((top)
@@ -12790,11 +12549,11 @@
"i")))
(hygiene
guile))
- #{x\
1881}#
- #{y\
1882}#)))
- #{tmp\ 1886}#)))
+ #{x\
1816}#
+ #{y\
1817}#)))
+ #{tmp\ 1821}#)))
($sc-dispatch
- #{tmp\ 1886}#
+ #{tmp\ 1821}#
'(#(free-id
#(syntax-object
quote
@@ -12837,11 +12596,11 @@
(hygiene
guile)))
any))))
- #{x\ 1881}#))
- #{tmp\ 1884}#)
- ((lambda (#{tmp\ 1890}#)
- (if #{tmp\ 1890}#
- (apply (lambda (#{stuff\ 1891}#)
+ #{x\ 1816}#))
+ #{tmp\ 1819}#)
+ ((lambda (#{tmp\ 1825}#)
+ (if #{tmp\ 1825}#
+ (apply (lambda (#{stuff\ 1826}#)
(cons '#(syntax-object
list
((top)
@@ -12882,10 +12641,10 @@
"i")))
(hygiene
guile))
- (cons #{x\ 1881}#
- #{stuff\
1891}#)))
- #{tmp\ 1890}#)
- ((lambda (#{else\ 1892}#)
+ (cons #{x\ 1816}#
+ #{stuff\
1826}#)))
+ #{tmp\ 1825}#)
+ ((lambda (#{else\ 1827}#)
(list '#(syntax-object
cons
((top)
@@ -12917,11 +12676,11 @@
"i"
"i")))
(hygiene guile))
- #{x\ 1881}#
- #{y\ 1882}#))
- #{tmp\ 1883}#)))
+ #{x\ 1816}#
+ #{y\ 1817}#))
+ #{tmp\ 1818}#)))
($sc-dispatch
- #{tmp\ 1883}#
+ #{tmp\ 1818}#
'(#(free-id
#(syntax-object
list
@@ -12950,7 +12709,7 @@
.
any)))))
($sc-dispatch
- #{tmp\ 1883}#
+ #{tmp\ 1818}#
'(#(free-id
#(syntax-object
quote
@@ -12974,26 +12733,26 @@
#("i" "i" "i" "i")))
(hygiene guile)))
any))))
- #{y\ 1882}#))
- #{tmp\ 1880}#)
+ #{y\ 1817}#))
+ #{tmp\ 1815}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1879}#)))
- ($sc-dispatch #{tmp\ 1879}# (quote (any any)))))
- (list #{x\ 1877}# #{y\ 1878}#))))
- (#{quasiappend\ 1874}#
- (lambda (#{x\ 1893}# #{y\ 1894}#)
- ((lambda (#{tmp\ 1895}#)
- ((lambda (#{tmp\ 1896}#)
- (if #{tmp\ 1896}#
- (apply (lambda (#{x\ 1897}# #{y\ 1898}#)
- ((lambda (#{tmp\ 1899}#)
- ((lambda (#{tmp\ 1900}#)
- (if #{tmp\ 1900}#
- (apply (lambda () #{x\ 1897}#)
- #{tmp\ 1900}#)
- ((lambda (#{_\ 1901}#)
+ #{tmp\ 1814}#)))
+ ($sc-dispatch #{tmp\ 1814}# (quote (any any)))))
+ (list #{x\ 1812}# #{y\ 1813}#))))
+ (#{quasiappend\ 1809}#
+ (lambda (#{x\ 1828}# #{y\ 1829}#)
+ ((lambda (#{tmp\ 1830}#)
+ ((lambda (#{tmp\ 1831}#)
+ (if #{tmp\ 1831}#
+ (apply (lambda (#{x\ 1832}# #{y\ 1833}#)
+ ((lambda (#{tmp\ 1834}#)
+ ((lambda (#{tmp\ 1835}#)
+ (if #{tmp\ 1835}#
+ (apply (lambda () #{x\ 1832}#)
+ #{tmp\ 1835}#)
+ ((lambda (#{_\ 1836}#)
(list '#(syntax-object
append
((top)
@@ -13022,11 +12781,11 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile))
- #{x\ 1897}#
- #{y\ 1898}#))
- #{tmp\ 1899}#)))
+ #{x\ 1832}#
+ #{y\ 1833}#))
+ #{tmp\ 1834}#)))
($sc-dispatch
- #{tmp\ 1899}#
+ #{tmp\ 1834}#
'(#(free-id
#(syntax-object
quote
@@ -13050,22 +12809,22 @@
#("i" "i" "i" "i")))
(hygiene guile)))
()))))
- #{y\ 1898}#))
- #{tmp\ 1896}#)
+ #{y\ 1833}#))
+ #{tmp\ 1831}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1895}#)))
- ($sc-dispatch #{tmp\ 1895}# (quote (any any)))))
- (list #{x\ 1893}# #{y\ 1894}#))))
- (#{quasivector\ 1875}#
- (lambda (#{x\ 1902}#)
- ((lambda (#{tmp\ 1903}#)
- ((lambda (#{x\ 1904}#)
- ((lambda (#{tmp\ 1905}#)
- ((lambda (#{tmp\ 1906}#)
- (if #{tmp\ 1906}#
- (apply (lambda (#{x\ 1907}#)
+ #{tmp\ 1830}#)))
+ ($sc-dispatch #{tmp\ 1830}# (quote (any any)))))
+ (list #{x\ 1828}# #{y\ 1829}#))))
+ (#{quasivector\ 1810}#
+ (lambda (#{x\ 1837}#)
+ ((lambda (#{tmp\ 1838}#)
+ ((lambda (#{x\ 1839}#)
+ ((lambda (#{tmp\ 1840}#)
+ ((lambda (#{tmp\ 1841}#)
+ (if #{tmp\ 1841}#
+ (apply (lambda (#{x\ 1842}#)
(list '#(syntax-object
quote
((top)
@@ -13091,11 +12850,11 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- (list->vector #{x\ 1907}#)))
- #{tmp\ 1906}#)
- ((lambda (#{tmp\ 1909}#)
- (if #{tmp\ 1909}#
- (apply (lambda (#{x\ 1910}#)
+ (list->vector #{x\ 1842}#)))
+ #{tmp\ 1841}#)
+ ((lambda (#{tmp\ 1844}#)
+ (if #{tmp\ 1844}#
+ (apply (lambda (#{x\ 1845}#)
(cons '#(syntax-object
vector
((top)
@@ -13124,9 +12883,9 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile))
- #{x\ 1910}#))
- #{tmp\ 1909}#)
- ((lambda (#{_\ 1912}#)
+ #{x\ 1845}#))
+ #{tmp\ 1844}#)
+ ((lambda (#{_\ 1847}#)
(list '#(syntax-object
list->vector
((top)
@@ -13152,10 +12911,10 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- #{x\ 1904}#))
- #{tmp\ 1905}#)))
+ #{x\ 1839}#))
+ #{tmp\ 1840}#)))
($sc-dispatch
- #{tmp\ 1905}#
+ #{tmp\ 1840}#
'(#(free-id
#(syntax-object
list
@@ -13175,7 +12934,7 @@
.
each-any)))))
($sc-dispatch
- #{tmp\ 1905}#
+ #{tmp\ 1840}#
'(#(free-id
#(syntax-object
quote
@@ -13193,18 +12952,18 @@
#("i" "i" "i" "i")))
(hygiene guile)))
each-any))))
- #{x\ 1904}#))
- #{tmp\ 1903}#))
- #{x\ 1902}#)))
- (#{quasi\ 1876}#
- (lambda (#{p\ 1913}# #{lev\ 1914}#)
- ((lambda (#{tmp\ 1915}#)
- ((lambda (#{tmp\ 1916}#)
- (if #{tmp\ 1916}#
- (apply (lambda (#{p\ 1917}#)
- (if (= #{lev\ 1914}# 0)
- #{p\ 1917}#
- (#{quasicons\ 1873}#
+ #{x\ 1839}#))
+ #{tmp\ 1838}#))
+ #{x\ 1837}#)))
+ (#{quasi\ 1811}#
+ (lambda (#{p\ 1848}# #{lev\ 1849}#)
+ ((lambda (#{tmp\ 1850}#)
+ ((lambda (#{tmp\ 1851}#)
+ (if #{tmp\ 1851}#
+ (apply (lambda (#{p\ 1852}#)
+ (if (= #{lev\ 1849}# 0)
+ #{p\ 1852}#
+ (#{quasicons\ 1808}#
'(#(syntax-object
quote
((top)
@@ -13239,21 +12998,21 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile)))
- (#{quasi\ 1876}#
- (list #{p\ 1917}#)
- (- #{lev\ 1914}# 1)))))
- #{tmp\ 1916}#)
- ((lambda (#{tmp\ 1918}#)
- (if (if #{tmp\ 1918}#
- (apply (lambda (#{args\ 1919}#)
- (= #{lev\ 1914}# 0))
- #{tmp\ 1918}#)
+ (#{quasi\ 1811}#
+ (list #{p\ 1852}#)
+ (- #{lev\ 1849}# 1)))))
+ #{tmp\ 1851}#)
+ ((lambda (#{tmp\ 1853}#)
+ (if (if #{tmp\ 1853}#
+ (apply (lambda (#{args\ 1854}#)
+ (= #{lev\ 1849}# 0))
+ #{tmp\ 1853}#)
#f)
- (apply (lambda (#{args\ 1920}#)
+ (apply (lambda (#{args\ 1855}#)
(syntax-violation
'unquote
"unquote takes exactly one argument"
- #{p\ 1913}#
+ #{p\ 1848}#
(cons '#(syntax-object
unquote
((top)
@@ -13274,19 +13033,19 @@
#((top) (top) (top) (top))
#("i" "i" "i" "i")))
(hygiene guile))
- #{args\ 1920}#)))
- #{tmp\ 1918}#)
- ((lambda (#{tmp\ 1921}#)
- (if #{tmp\ 1921}#
- (apply (lambda (#{p\ 1922}# #{q\ 1923}#)
- (if (= #{lev\ 1914}# 0)
- (#{quasiappend\ 1874}#
- #{p\ 1922}#
- (#{quasi\ 1876}#
- #{q\ 1923}#
- #{lev\ 1914}#))
- (#{quasicons\ 1873}#
- (#{quasicons\ 1873}#
+ #{args\ 1855}#)))
+ #{tmp\ 1853}#)
+ ((lambda (#{tmp\ 1856}#)
+ (if #{tmp\ 1856}#
+ (apply (lambda (#{p\ 1857}# #{q\ 1858}#)
+ (if (= #{lev\ 1849}# 0)
+ (#{quasiappend\ 1809}#
+ #{p\ 1857}#
+ (#{quasi\ 1811}#
+ #{q\ 1858}#
+ #{lev\ 1849}#))
+ (#{quasicons\ 1808}#
+ (#{quasicons\ 1808}#
'(#(syntax-object
quote
((top)
@@ -13333,26 +13092,26 @@
(top))
#("i" "i" "i" "i")))
(hygiene guile)))
- (#{quasi\ 1876}#
- (list #{p\ 1922}#)
- (- #{lev\ 1914}# 1)))
- (#{quasi\ 1876}#
- #{q\ 1923}#
- #{lev\ 1914}#))))
- #{tmp\ 1921}#)
- ((lambda (#{tmp\ 1924}#)
- (if (if #{tmp\ 1924}#
- (apply (lambda (#{args\ 1925}#
- #{q\ 1926}#)
- (= #{lev\ 1914}# 0))
- #{tmp\ 1924}#)
+ (#{quasi\ 1811}#
+ (list #{p\ 1857}#)
+ (- #{lev\ 1849}# 1)))
+ (#{quasi\ 1811}#
+ #{q\ 1858}#
+ #{lev\ 1849}#))))
+ #{tmp\ 1856}#)
+ ((lambda (#{tmp\ 1859}#)
+ (if (if #{tmp\ 1859}#
+ (apply (lambda (#{args\ 1860}#
+ #{q\ 1861}#)
+ (= #{lev\ 1849}# 0))
+ #{tmp\ 1859}#)
#f)
- (apply (lambda (#{args\ 1927}#
- #{q\ 1928}#)
+ (apply (lambda (#{args\ 1862}#
+ #{q\ 1863}#)
(syntax-violation
'unquote-splicing
"unquote-splicing takes
exactly one argument"
- #{p\ 1913}#
+ #{p\ 1848}#
(cons '#(syntax-object
unquote-splicing
((top)
@@ -13382,12 +13141,12 @@
"i"
"i")))
(hygiene guile))
- #{args\ 1927}#)))
- #{tmp\ 1924}#)
- ((lambda (#{tmp\ 1929}#)
- (if #{tmp\ 1929}#
- (apply (lambda (#{p\ 1930}#)
- (#{quasicons\ 1873}#
+ #{args\ 1862}#)))
+ #{tmp\ 1859}#)
+ ((lambda (#{tmp\ 1864}#)
+ (if #{tmp\ 1864}#
+ (apply (lambda (#{p\ 1865}#)
+ (#{quasicons\ 1808}#
'(#(syntax-object
quote
((top)
@@ -13446,32 +13205,32 @@
"i"
"i")))
(hygiene guile)))
- (#{quasi\ 1876}#
- (list #{p\ 1930}#)
- (+ #{lev\ 1914}#
+ (#{quasi\ 1811}#
+ (list #{p\ 1865}#)
+ (+ #{lev\ 1849}#
1))))
- #{tmp\ 1929}#)
- ((lambda (#{tmp\ 1931}#)
- (if #{tmp\ 1931}#
- (apply (lambda (#{p\ 1932}#
- #{q\ 1933}#)
- (#{quasicons\ 1873}#
- (#{quasi\ 1876}#
- #{p\ 1932}#
- #{lev\ 1914}#)
- (#{quasi\ 1876}#
- #{q\ 1933}#
- #{lev\ 1914}#)))
- #{tmp\ 1931}#)
- ((lambda (#{tmp\ 1934}#)
- (if #{tmp\ 1934}#
- (apply (lambda (#{x\
1935}#)
-
(#{quasivector\ 1875}#
- (#{quasi\
1876}#
- #{x\ 1935}#
- #{lev\
1914}#)))
- #{tmp\ 1934}#)
- ((lambda (#{p\ 1937}#)
+ #{tmp\ 1864}#)
+ ((lambda (#{tmp\ 1866}#)
+ (if #{tmp\ 1866}#
+ (apply (lambda (#{p\ 1867}#
+ #{q\ 1868}#)
+ (#{quasicons\ 1808}#
+ (#{quasi\ 1811}#
+ #{p\ 1867}#
+ #{lev\ 1849}#)
+ (#{quasi\ 1811}#
+ #{q\ 1868}#
+ #{lev\ 1849}#)))
+ #{tmp\ 1866}#)
+ ((lambda (#{tmp\ 1869}#)
+ (if #{tmp\ 1869}#
+ (apply (lambda (#{x\
1870}#)
+
(#{quasivector\ 1810}#
+ (#{quasi\
1811}#
+ #{x\ 1870}#
+ #{lev\
1849}#)))
+ #{tmp\ 1869}#)
+ ((lambda (#{p\ 1872}#)
(list
'#(syntax-object
quote
((top)
@@ -13504,16 +13263,16 @@
"i")))
(hygiene
guile))
- #{p\ 1937}#))
- #{tmp\ 1915}#)))
+ #{p\ 1872}#))
+ #{tmp\ 1850}#)))
($sc-dispatch
- #{tmp\ 1915}#
+ #{tmp\ 1850}#
'#(vector each-any)))))
($sc-dispatch
- #{tmp\ 1915}#
+ #{tmp\ 1850}#
'(any . any)))))
($sc-dispatch
- #{tmp\ 1915}#
+ #{tmp\ 1850}#
'(#(free-id
#(syntax-object
quasiquote
@@ -13533,7 +13292,7 @@
(hygiene guile)))
any)))))
($sc-dispatch
- #{tmp\ 1915}#
+ #{tmp\ 1850}#
'((#(free-id
#(syntax-object
unquote-splicing
@@ -13556,7 +13315,7 @@
.
any)))))
($sc-dispatch
- #{tmp\ 1915}#
+ #{tmp\ 1850}#
'((#(free-id
#(syntax-object
unquote-splicing
@@ -13578,7 +13337,7 @@
.
any)))))
($sc-dispatch
- #{tmp\ 1915}#
+ #{tmp\ 1850}#
'(#(free-id
#(syntax-object
unquote
@@ -13596,7 +13355,7 @@
.
any)))))
($sc-dispatch
- #{tmp\ 1915}#
+ #{tmp\ 1850}#
'(#(free-id
#(syntax-object
unquote
@@ -13609,49 +13368,49 @@
#("i" "i" "i" "i")))
(hygiene guile)))
any))))
- #{p\ 1913}#))))
- (lambda (#{x\ 1938}#)
- ((lambda (#{tmp\ 1939}#)
- ((lambda (#{tmp\ 1940}#)
- (if #{tmp\ 1940}#
- (apply (lambda (#{_\ 1941}# #{e\ 1942}#)
- (#{quasi\ 1876}# #{e\ 1942}# 0))
- #{tmp\ 1940}#)
+ #{p\ 1848}#))))
+ (lambda (#{x\ 1873}#)
+ ((lambda (#{tmp\ 1874}#)
+ ((lambda (#{tmp\ 1875}#)
+ (if #{tmp\ 1875}#
+ (apply (lambda (#{_\ 1876}# #{e\ 1877}#)
+ (#{quasi\ 1811}# #{e\ 1877}# 0))
+ #{tmp\ 1875}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1939}#)))
- ($sc-dispatch #{tmp\ 1939}# (quote (any any)))))
- #{x\ 1938}#)))))
+ #{tmp\ 1874}#)))
+ ($sc-dispatch #{tmp\ 1874}# (quote (any any)))))
+ #{x\ 1873}#)))))
(define include
(make-syncase-macro
'macro
- (lambda (#{x\ 1943}#)
- (letrec ((#{read-file\ 1944}#
- (lambda (#{fn\ 1945}# #{k\ 1946}#)
- (let ((#{p\ 1947}# (open-input-file #{fn\ 1945}#)))
- (letrec ((#{f\ 1948}#
- (lambda (#{x\ 1949}#)
- (if (eof-object? #{x\ 1949}#)
+ (lambda (#{x\ 1878}#)
+ (letrec ((#{read-file\ 1879}#
+ (lambda (#{fn\ 1880}# #{k\ 1881}#)
+ (let ((#{p\ 1882}# (open-input-file #{fn\ 1880}#)))
+ (letrec ((#{f\ 1883}#
+ (lambda (#{x\ 1884}#)
+ (if (eof-object? #{x\ 1884}#)
(begin
- (close-input-port #{p\ 1947}#)
+ (close-input-port #{p\ 1882}#)
'())
(cons (datum->syntax
- #{k\ 1946}#
- #{x\ 1949}#)
- (#{f\ 1948}# (read #{p\ 1947}#)))))))
- (#{f\ 1948}# (read #{p\ 1947}#)))))))
- ((lambda (#{tmp\ 1950}#)
- ((lambda (#{tmp\ 1951}#)
- (if #{tmp\ 1951}#
- (apply (lambda (#{k\ 1952}# #{filename\ 1953}#)
- (let ((#{fn\ 1954}#
- (syntax->datum #{filename\ 1953}#)))
- ((lambda (#{tmp\ 1955}#)
- ((lambda (#{tmp\ 1956}#)
- (if #{tmp\ 1956}#
- (apply (lambda (#{exp\ 1957}#)
+ #{k\ 1881}#
+ #{x\ 1884}#)
+ (#{f\ 1883}# (read #{p\ 1882}#)))))))
+ (#{f\ 1883}# (read #{p\ 1882}#)))))))
+ ((lambda (#{tmp\ 1885}#)
+ ((lambda (#{tmp\ 1886}#)
+ (if #{tmp\ 1886}#
+ (apply (lambda (#{k\ 1887}# #{filename\ 1888}#)
+ (let ((#{fn\ 1889}#
+ (syntax->datum #{filename\ 1888}#)))
+ ((lambda (#{tmp\ 1890}#)
+ ((lambda (#{tmp\ 1891}#)
+ (if #{tmp\ 1891}#
+ (apply (lambda (#{exp\ 1892}#)
(cons '#(syntax-object
begin
((top)
@@ -13678,33 +13437,33 @@
#((top))
#("i")))
(hygiene guile))
- #{exp\ 1957}#))
- #{tmp\ 1956}#)
+ #{exp\ 1892}#))
+ #{tmp\ 1891}#)
(syntax-violation
#f
"source expression failed to match any
pattern"
- #{tmp\ 1955}#)))
- ($sc-dispatch #{tmp\ 1955}# (quote each-any))))
- (#{read-file\ 1944}# #{fn\ 1954}# #{k\ 1952}#))))
- #{tmp\ 1951}#)
+ #{tmp\ 1890}#)))
+ ($sc-dispatch #{tmp\ 1890}# (quote each-any))))
+ (#{read-file\ 1879}# #{fn\ 1889}# #{k\ 1887}#))))
+ #{tmp\ 1886}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1950}#)))
- ($sc-dispatch #{tmp\ 1950}# (quote (any any)))))
- #{x\ 1943}#)))))
+ #{tmp\ 1885}#)))
+ ($sc-dispatch #{tmp\ 1885}# (quote (any any)))))
+ #{x\ 1878}#)))))
(define include-from-path
(make-syncase-macro
'macro
- (lambda (#{x\ 1959}#)
- ((lambda (#{tmp\ 1960}#)
- ((lambda (#{tmp\ 1961}#)
- (if #{tmp\ 1961}#
- (apply (lambda (#{k\ 1962}# #{filename\ 1963}#)
- (let ((#{fn\ 1964}# (syntax->datum #{filename\ 1963}#)))
- ((lambda (#{tmp\ 1965}#)
- ((lambda (#{fn\ 1966}#)
+ (lambda (#{x\ 1894}#)
+ ((lambda (#{tmp\ 1895}#)
+ ((lambda (#{tmp\ 1896}#)
+ (if #{tmp\ 1896}#
+ (apply (lambda (#{k\ 1897}# #{filename\ 1898}#)
+ (let ((#{fn\ 1899}# (syntax->datum #{filename\ 1898}#)))
+ ((lambda (#{tmp\ 1900}#)
+ ((lambda (#{fn\ 1901}#)
(list '#(syntax-object
include
((top)
@@ -13719,78 +13478,78 @@
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
- #{fn\ 1966}#))
- #{tmp\ 1965}#))
- (let ((#{t\ 1967}# (%search-load-path #{fn\ 1964}#)))
- (if #{t\ 1967}#
- #{t\ 1967}#
+ #{fn\ 1901}#))
+ #{tmp\ 1900}#))
+ (let ((#{t\ 1902}# (%search-load-path #{fn\ 1899}#)))
+ (if #{t\ 1902}#
+ #{t\ 1902}#
(syntax-violation
'include-from-path
"file not found in path"
- #{x\ 1959}#
- #{filename\ 1963}#))))))
- #{tmp\ 1961}#)
+ #{x\ 1894}#
+ #{filename\ 1898}#))))))
+ #{tmp\ 1896}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1960}#)))
- ($sc-dispatch #{tmp\ 1960}# (quote (any any)))))
- #{x\ 1959}#))))
+ #{tmp\ 1895}#)))
+ ($sc-dispatch #{tmp\ 1895}# (quote (any any)))))
+ #{x\ 1894}#))))
(define unquote
(make-syncase-macro
'macro
- (lambda (#{x\ 1968}#)
- ((lambda (#{tmp\ 1969}#)
- ((lambda (#{tmp\ 1970}#)
- (if #{tmp\ 1970}#
- (apply (lambda (#{_\ 1971}# #{e\ 1972}#)
+ (lambda (#{x\ 1903}#)
+ ((lambda (#{tmp\ 1904}#)
+ ((lambda (#{tmp\ 1905}#)
+ (if #{tmp\ 1905}#
+ (apply (lambda (#{_\ 1906}# #{e\ 1907}#)
(syntax-violation
'unquote
"expression not valid outside of quasiquote"
- #{x\ 1968}#))
- #{tmp\ 1970}#)
+ #{x\ 1903}#))
+ #{tmp\ 1905}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1969}#)))
- ($sc-dispatch #{tmp\ 1969}# (quote (any any)))))
- #{x\ 1968}#))))
+ #{tmp\ 1904}#)))
+ ($sc-dispatch #{tmp\ 1904}# (quote (any any)))))
+ #{x\ 1903}#))))
(define unquote-splicing
(make-syncase-macro
'macro
- (lambda (#{x\ 1973}#)
- ((lambda (#{tmp\ 1974}#)
- ((lambda (#{tmp\ 1975}#)
- (if #{tmp\ 1975}#
- (apply (lambda (#{_\ 1976}# #{e\ 1977}#)
+ (lambda (#{x\ 1908}#)
+ ((lambda (#{tmp\ 1909}#)
+ ((lambda (#{tmp\ 1910}#)
+ (if #{tmp\ 1910}#
+ (apply (lambda (#{_\ 1911}# #{e\ 1912}#)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
- #{x\ 1973}#))
- #{tmp\ 1975}#)
+ #{x\ 1908}#))
+ #{tmp\ 1910}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1974}#)))
- ($sc-dispatch #{tmp\ 1974}# (quote (any any)))))
- #{x\ 1973}#))))
+ #{tmp\ 1909}#)))
+ ($sc-dispatch #{tmp\ 1909}# (quote (any any)))))
+ #{x\ 1908}#))))
(define case
(make-extended-syncase-macro
(module-ref (current-module) (quote case))
'macro
- (lambda (#{x\ 1978}#)
- ((lambda (#{tmp\ 1979}#)
- ((lambda (#{tmp\ 1980}#)
- (if #{tmp\ 1980}#
- (apply (lambda (#{_\ 1981}#
- #{e\ 1982}#
- #{m1\ 1983}#
- #{m2\ 1984}#)
- ((lambda (#{tmp\ 1985}#)
- ((lambda (#{body\ 1986}#)
+ (lambda (#{x\ 1913}#)
+ ((lambda (#{tmp\ 1914}#)
+ ((lambda (#{tmp\ 1915}#)
+ (if #{tmp\ 1915}#
+ (apply (lambda (#{_\ 1916}#
+ #{e\ 1917}#
+ #{m1\ 1918}#
+ #{m2\ 1919}#)
+ ((lambda (#{tmp\ 1920}#)
+ ((lambda (#{body\ 1921}#)
(list '#(syntax-object
let
((top)
@@ -13819,17 +13578,17 @@
#((top))
#("i")))
(hygiene guile))
- #{e\ 1982}#))
- #{body\ 1986}#))
- #{tmp\ 1985}#))
- (letrec ((#{f\ 1987}#
- (lambda (#{clause\ 1988}# #{clauses\ 1989}#)
- (if (null? #{clauses\ 1989}#)
- ((lambda (#{tmp\ 1991}#)
- ((lambda (#{tmp\ 1992}#)
- (if #{tmp\ 1992}#
- (apply (lambda (#{e1\ 1993}#
- #{e2\ 1994}#)
+ #{e\ 1917}#))
+ #{body\ 1921}#))
+ #{tmp\ 1920}#))
+ (letrec ((#{f\ 1922}#
+ (lambda (#{clause\ 1923}# #{clauses\ 1924}#)
+ (if (null? #{clauses\ 1924}#)
+ ((lambda (#{tmp\ 1926}#)
+ ((lambda (#{tmp\ 1927}#)
+ (if #{tmp\ 1927}#
+ (apply (lambda (#{e1\ 1928}#
+ #{e2\ 1929}#)
(cons '#(syntax-object
begin
((top)
@@ -13875,14 +13634,14 @@
#("i")))
(hygiene
guile))
- (cons #{e1\
1993}#
- #{e2\
1994}#)))
- #{tmp\ 1992}#)
- ((lambda (#{tmp\ 1996}#)
- (if #{tmp\ 1996}#
- (apply (lambda (#{k\ 1997}#
- #{e1\
1998}#
- #{e2\
1999}#)
+ (cons #{e1\
1928}#
+ #{e2\
1929}#)))
+ #{tmp\ 1927}#)
+ ((lambda (#{tmp\ 1931}#)
+ (if #{tmp\ 1931}#
+ (apply (lambda (#{k\ 1932}#
+ #{e1\
1933}#
+ #{e2\
1934}#)
(list
'#(syntax-object
if
((top)
@@ -14083,7 +13842,7 @@
#("i")))
(hygiene
guile))
-
#{k\ 1997}#))
+
#{k\ 1932}#))
(cons
'#(syntax-object
begin
((top)
@@ -14134,24 +13893,24 @@
#("i")))
(hygiene
guile))
- (cons
#{e1\ 1998}#
-
#{e2\ 1999}#))))
- #{tmp\ 1996}#)
- ((lambda (#{_\ 2002}#)
+ (cons
#{e1\ 1933}#
+
#{e2\ 1934}#))))
+ #{tmp\ 1931}#)
+ ((lambda (#{_\ 1937}#)
(syntax-violation
'case
"bad clause"
- #{x\ 1978}#
- #{clause\ 1988}#))
- #{tmp\ 1991}#)))
+ #{x\ 1913}#
+ #{clause\ 1923}#))
+ #{tmp\ 1926}#)))
($sc-dispatch
- #{tmp\ 1991}#
+ #{tmp\ 1926}#
'(each-any
any
.
each-any)))))
($sc-dispatch
- #{tmp\ 1991}#
+ #{tmp\ 1926}#
'(#(free-id
#(syntax-object
else
@@ -14177,15 +13936,15 @@
any
.
each-any))))
- #{clause\ 1988}#)
- ((lambda (#{tmp\ 2003}#)
- ((lambda (#{rest\ 2004}#)
- ((lambda (#{tmp\ 2005}#)
- ((lambda (#{tmp\ 2006}#)
- (if #{tmp\ 2006}#
- (apply (lambda (#{k\
2007}#
- #{e1\
2008}#
- #{e2\
2009}#)
+ #{clause\ 1923}#)
+ ((lambda (#{tmp\ 1938}#)
+ ((lambda (#{rest\ 1939}#)
+ ((lambda (#{tmp\ 1940}#)
+ ((lambda (#{tmp\ 1941}#)
+ (if #{tmp\ 1941}#
+ (apply (lambda (#{k\
1942}#
+ #{e1\
1943}#
+ #{e2\
1944}#)
(list
'#(syntax-object
if
((top)
@@ -14402,7 +14161,7 @@
#("i")))
(hygiene
guile))
-
#{k\ 2007}#))
+
#{k\ 1942}#))
(cons
'#(syntax-object
begin
((top)
@@ -14457,47 +14216,47 @@
#("i")))
(hygiene
guile))
-
(cons #{e1\ 2008}#
-
#{e2\ 2009}#))
- #{rest\
2004}#))
- #{tmp\ 2006}#)
- ((lambda (#{_\ 2012}#)
+
(cons #{e1\ 1943}#
+
#{e2\ 1944}#))
+ #{rest\
1939}#))
+ #{tmp\ 1941}#)
+ ((lambda (#{_\ 1947}#)
(syntax-violation
'case
"bad clause"
- #{x\ 1978}#
- #{clause\ 1988}#))
- #{tmp\ 2005}#)))
+ #{x\ 1913}#
+ #{clause\ 1923}#))
+ #{tmp\ 1940}#)))
($sc-dispatch
- #{tmp\ 2005}#
+ #{tmp\ 1940}#
'(each-any
any
.
each-any))))
- #{clause\ 1988}#))
- #{tmp\ 2003}#))
- (#{f\ 1987}#
- (car #{clauses\ 1989}#)
- (cdr #{clauses\ 1989}#)))))))
- (#{f\ 1987}# #{m1\ 1983}# #{m2\ 1984}#))))
- #{tmp\ 1980}#)
+ #{clause\ 1923}#))
+ #{tmp\ 1938}#))
+ (#{f\ 1922}#
+ (car #{clauses\ 1924}#)
+ (cdr #{clauses\ 1924}#)))))))
+ (#{f\ 1922}# #{m1\ 1918}# #{m2\ 1919}#))))
+ #{tmp\ 1915}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 1979}#)))
+ #{tmp\ 1914}#)))
($sc-dispatch
- #{tmp\ 1979}#
+ #{tmp\ 1914}#
'(any any any . each-any))))
- #{x\ 1978}#))))
+ #{x\ 1913}#))))
(define identifier-syntax
(make-syncase-macro
'macro
- (lambda (#{x\ 2013}#)
- ((lambda (#{tmp\ 2014}#)
- ((lambda (#{tmp\ 2015}#)
- (if #{tmp\ 2015}#
- (apply (lambda (#{_\ 2016}# #{e\ 2017}#)
+ (lambda (#{x\ 1948}#)
+ ((lambda (#{tmp\ 1949}#)
+ ((lambda (#{tmp\ 1950}#)
+ (if #{tmp\ 1950}#
+ (apply (lambda (#{_\ 1951}# #{e\ 1952}#)
(list '#(syntax-object
lambda
((top)
@@ -14586,8 +14345,8 @@
#((top))
#("i")))
(hygiene guile))
- #{e\ 2017}#))
- (list (cons #{_\ 2016}#
+ #{e\ 1952}#))
+ (list (cons #{_\ 1951}#
'(#(syntax-object
x
((top)
@@ -14627,7 +14386,7 @@
#((top))
#("i")))
(hygiene guile))
- (cons #{e\ 2017}#
+ (cons #{e\ 1952}#
'(#(syntax-object
x
((top)
@@ -14655,26 +14414,26 @@
#("i")))
(hygiene
guile)))))))))
- #{tmp\ 2015}#)
+ #{tmp\ 1950}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 2014}#)))
- ($sc-dispatch #{tmp\ 2014}# (quote (any any)))))
- #{x\ 2013}#))))
+ #{tmp\ 1949}#)))
+ ($sc-dispatch #{tmp\ 1949}# (quote (any any)))))
+ #{x\ 1948}#))))
(define define*
(make-syncase-macro
'macro
- (lambda (#{x\ 2018}#)
- ((lambda (#{tmp\ 2019}#)
- ((lambda (#{tmp\ 2020}#)
- (if #{tmp\ 2020}#
- (apply (lambda (#{dummy\ 2021}#
- #{id\ 2022}#
- #{args\ 2023}#
- #{b0\ 2024}#
- #{b1\ 2025}#)
+ (lambda (#{x\ 1953}#)
+ ((lambda (#{tmp\ 1954}#)
+ ((lambda (#{tmp\ 1955}#)
+ (if #{tmp\ 1955}#
+ (apply (lambda (#{dummy\ 1956}#
+ #{id\ 1957}#
+ #{args\ 1958}#
+ #{b0\ 1959}#
+ #{b1\ 1960}#)
(list '#(syntax-object
define
((top)
@@ -14685,7 +14444,7 @@
#(ribcage () () ())
#(ribcage #(x) #(("m" top)) #("i")))
(hygiene guile))
- #{id\ 2022}#
+ #{id\ 1957}#
(cons '#(syntax-object
lambda*
((top)
@@ -14696,15 +14455,15 @@
#(ribcage () () ())
#(ribcage #(x) #(("m" top)) #("i")))
(hygiene guile))
- (cons #{args\ 2023}#
- (cons #{b0\ 2024}# #{b1\ 2025}#)))))
- #{tmp\ 2020}#)
+ (cons #{args\ 1958}#
+ (cons #{b0\ 1959}# #{b1\ 1960}#)))))
+ #{tmp\ 1955}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp\ 2019}#)))
+ #{tmp\ 1954}#)))
($sc-dispatch
- #{tmp\ 2019}#
+ #{tmp\ 1954}#
'(any (any . any) any . each-any))))
- #{x\ 2018}#))))
+ #{x\ 1953}#))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index d0073c1..ae75bc6 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -449,10 +449,10 @@
(else (decorate-source `(define ,var ,exp) source)))))
;; Ideally we would have all lambdas be case lambdas, but that would
- ;; need special support in the interpreter for the full capabilities of
- ;; case-lambda, with optional and keyword args, predicates, and else
- ;; clauses. This will come with the new interpreter, but for now we
- ;; separate the cases.
+ ;; need special support in the interpreter for the full capabilities
+ ;; of case-lambda, with optional and keyword args and else clauses.
+ ;; This will come with the new interpreter, but for now we separate
+ ;; the cases.
(define build-simple-lambda
(lambda (src req rest vars docstring exp)
(case (fluid-ref *mode*)
@@ -460,8 +460,8 @@
(if docstring `((documentation . ,docstring)) '())
;; hah, a case in which kwargs would be nice.
((@ (language tree-il) make-lambda-case)
- ;; src req opt rest kw inits vars predicate body else
- src req #f rest #f '() vars #f exp #f)))
+ ;; src req opt rest kw inits vars body else
+ src req #f rest #f '() vars exp #f)))
(else (decorate-source
`(lambda ,(if rest (apply cons* vars) vars)
,@(if docstring (list docstring) '())
@@ -490,14 +490,13 @@
;; vars: (sym ...)
;; vars map to named arguments in the following order:
;; required, optional (positional), rest, keyword.
- ;; predicate: something you can stuff in a (lambda ,vars ,pred), already
expanded
;; the body of a lambda: anything, already expanded
;; else: lambda-case | #f
- (lambda (src req opt rest kw inits vars predicate body else-case)
+ (lambda (src req opt rest kw inits vars body else-case)
(case (fluid-ref *mode*)
((c)
((@ (language tree-il) make-lambda-case)
- src req opt rest kw inits vars predicate body else-case))
+ src req opt rest kw inits vars body else-case))
(else
;; Very much like the logic of (language tree-il compile-glil).
(let* ((nreq (length req))
@@ -519,7 +518,6 @@
`((((@@ (ice-9 optargs) parse-lambda-case)
'(,nreq ,nopt ,rest-idx ,nargs ,allow-other-keys? ,kw-indices)
(list ,@(map (lambda (i) `(lambda ,vars ,i)) inits))
- ,(if predicate `(lambda ,vars ,predicate) #f)
%%args)
;; FIXME: This _ is here to work around a bug in the
;; memoizer. The %%% makes it different from %%, also a
@@ -1585,7 +1583,7 @@
(define (check req rest)
(cond
((distinct-bound-ids? (if rest (cons rest req) req))
- (values req #f rest #f #f))
+ (values req #f rest #f))
(else
(syntax-violation 'lambda "duplicate identifier in argument list"
orig-args))))
@@ -1610,44 +1608,40 @@
(define (req args rreq)
(syntax-case args ()
(()
- (check (reverse rreq) '() #f '() #f))
+ (check (reverse rreq) '() #f '()))
((a . b) (id? #'a)
(req #'b (cons #'a rreq)))
((a . b) (eq? (syntax->datum #'a) #:optional)
(opt #'b (reverse rreq) '()))
((a . b) (eq? (syntax->datum #'a) #:key)
(key #'b (reverse rreq) '() '()))
- ((a . b) (eq? (syntax->datum #'a) #:predicate)
- (pred #'b (reverse rreq) '() '()))
((a b) (eq? (syntax->datum #'a) #:rest)
- (rest #'b (reverse rreq) '() '() #f))
+ (rest #'b (reverse rreq) '() '()))
(r (id? #'r)
- (rest #'r (reverse rreq) '() '() #f))
+ (rest #'r (reverse rreq) '() '()))
(else
(syntax-violation 'lambda* "invalid argument list" orig-args
args))))
(define (opt args req ropt)
(syntax-case args ()
(()
- (check req (reverse ropt) #f '() #f))
+ (check req (reverse ropt) #f '()))
((a . b) (id? #'a)
(opt #'b req (cons #'(a #f) ropt)))
(((a init) . b) (id? #'a)
(opt #'b req (cons #'(a init) ropt)))
((a . b) (eq? (syntax->datum #'a) #:key)
(key #'b req (reverse ropt) '()))
- ((a . b) (eq? (syntax->datum #'a) #:predicate)
- (pred #'b req (reverse ropt) '()))
((a b) (eq? (syntax->datum #'a) #:rest)
- (rest #'b req (reverse ropt) '() #f))
+ (rest #'b req (reverse ropt) '()))
(r (id? #'r)
- (rest #'r req (reverse ropt) '() #f))
+ (rest #'r req (reverse ropt) '()))
(else
(syntax-violation 'lambda* "invalid optional argument list"
orig-args args))))
(define (key args req opt rkey)
(syntax-case args ()
(()
- (check req opt #f (cons #f (reverse rkey)) #f))
+ (check req opt #f (cons #f (reverse rkey))))
((a . b) (id? #'a)
(with-syntax ((k (symbol->keyword (syntax->datum #'a))))
(key #'b req opt (cons #'(k a #f) rkey))))
@@ -1658,48 +1652,33 @@
(keyword? (syntax->datum #'k)))
(key #'b req opt (cons #'(k a init) rkey)))
((aok) (eq? (syntax->datum #'aok) #:allow-other-keys)
- (check req opt #f (cons #t (reverse rkey)) #f))
- ((aok a . b) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
- (eq? (syntax->datum #'a) #:predicate))
- (pred #'b req opt (cons #t (reverse rkey))))
+ (check req opt #f (cons #t (reverse rkey))))
((aok a b) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
(eq? (syntax->datum #'a) #:rest))
- (rest #'b req opt (cons #t (reverse rkey)) #f))
+ (rest #'b req opt (cons #t (reverse rkey))))
((aok . r) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
(id? #'r))
- (rest #'r req opt (cons #t (reverse rkey)) #f))
- ((a . b) (eq? (syntax->datum #'a) #:predicate)
- (pred #'b req opt (cons #f (reverse rkey))))
+ (rest #'r req opt (cons #t (reverse rkey))))
((a b) (eq? (syntax->datum #'a) #:rest)
- (rest #'b req opt (cons #f (reverse rkey)) #f))
+ (rest #'b req opt (cons #f (reverse rkey))))
(r (id? #'r)
- (rest #'r req opt (cons #f (reverse rkey)) #f))
+ (rest #'r req opt (cons #f (reverse rkey))))
(else
(syntax-violation 'lambda* "invalid keyword argument list"
orig-args args))))
- (define (pred args req opt kw)
- (syntax-case args ()
- ((x) (check req opt #f kw #'x))
- ((x a b) (eq? (syntax->datum #'a) #:rest)
- (rest #'b req opt kw #f))
- ((x . b) (id? #'b)
- (rest #'b req opt kw #f))
- (else
- (syntax-violation 'lambda* "invalid argument list following
#:predicate"
- orig-args args))))
- (define (rest args req opt kw pred)
+ (define (rest args req opt kw)
(syntax-case args ()
(r (id? #'r)
- (check req opt #'r kw pred))
+ (check req opt #'r kw))
(else
(syntax-violation 'lambda* "invalid rest argument"
orig-args args))))
- (define (check req opt rest kw pred)
+ (define (check req opt rest kw)
(cond
((distinct-bound-ids?
(append req (map car opt) (if rest (list rest) '())
(if (pair? kw) (map cadr (cdr kw)) '())))
- (values req opt rest kw pred))
+ (values req opt rest kw))
(else
(syntax-violation 'lambda* "duplicate identifier in argument list"
orig-args))))
@@ -1707,14 +1686,14 @@
(define chi-lambda-case
(lambda (e r w s mod get-formals clauses)
- (define (expand-req req opt rest kw pred body)
+ (define (expand-req req opt rest kw body)
(let ((vars (map gen-var req))
(labels (gen-labels req)))
(let ((r* (extend-var-env labels vars r))
(w* (make-binding-wrap req labels w)))
(expand-opt (map syntax->datum req)
- opt rest kw pred body (reverse vars) r* w* '() '()))))
- (define (expand-opt req opt rest kw pred body vars r* w* out inits)
+ opt rest kw body (reverse vars) r* w* '() '()))))
+ (define (expand-opt req opt rest kw body vars r* w* out inits)
(cond
((pair? opt)
(syntax-case (car opt) ()
@@ -1723,7 +1702,7 @@
(l (gen-labels (list v)))
(r** (extend-var-env l (list v) r*))
(w** (make-binding-wrap (list #'id) l w*)))
- (expand-opt req (cdr opt) rest kw pred body (cons v vars)
+ (expand-opt req (cdr opt) rest kw body (cons v vars)
r** w** (cons (syntax->datum #'id) out)
(cons (chi #'i r* w* mod) inits))))))
(rest
@@ -1734,16 +1713,16 @@
(expand-kw req (if (pair? out) (reverse out) #f)
(syntax->datum rest)
(if (pair? kw) (cdr kw) kw)
- pred body (cons v vars) r* w*
+ body (cons v vars) r* w*
(if (pair? kw) (car kw) #f)
'() inits)))
(else
(expand-kw req (if (pair? out) (reverse out) #f) #f
(if (pair? kw) (cdr kw) kw)
- pred body vars r* w*
+ body vars r* w*
(if (pair? kw) (car kw) #f)
'() inits))))
- (define (expand-kw req opt rest kw pred body vars r* w* aok out inits)
+ (define (expand-kw req opt rest kw body vars r* w* aok out inits)
(cond
((pair? kw)
(syntax-case (car kw) ()
@@ -1752,7 +1731,7 @@
(l (gen-labels (list v)))
(r** (extend-var-env l (list v) r*))
(w** (make-binding-wrap (list #'id) l w*)))
- (expand-kw req opt rest (cdr kw) pred body (cons v vars)
+ (expand-kw req opt rest (cdr kw) body (cons v vars)
r** w** aok
(cons (list (syntax->datum #'k)
(syntax->datum #'id)
@@ -1760,20 +1739,17 @@
out)
(cons (chi #'i r* w* mod) inits))))))
(else
- (expand-pred req opt rest
+ (expand-body req opt rest
(if (or aok (pair? out)) (cons aok (reverse out)) #f)
- pred body (reverse vars) r* w* (reverse inits)))))
- (define (expand-pred req opt rest kw pred body vars r* w* inits)
- (expand-body req opt rest kw (and pred (chi pred r* w* mod))
- body vars r* w* inits))
- (define (expand-body req opt rest kw pred body vars r* w* inits)
+ body (reverse vars) r* w* (reverse inits)))))
+ (define (expand-body req opt rest kw body vars r* w* inits)
(syntax-case body ()
((docstring e1 e2 ...) (string? (syntax->datum #'docstring))
- (values (syntax->datum #'docstring) req opt rest kw inits vars pred
+ (values (syntax->datum #'docstring) req opt rest kw inits vars
(chi-body #'(e1 e2 ...) (source-wrap e w s mod)
r* w* mod)))
((e1 e2 ...)
- (values #f req opt rest kw inits vars pred
+ (values #f req opt rest kw inits vars
(chi-body #'(e1 e2 ...) (source-wrap e w s mod)
r* w* mod)))))
@@ -1781,10 +1757,10 @@
(() (values #f #f))
(((args e1 e2 ...) (args* e1* e2* ...) ...)
(call-with-values (lambda () (get-formals #'args))
- (lambda (req opt rest kw pred)
+ (lambda (req opt rest kw)
(call-with-values (lambda ()
- (expand-req req opt rest kw pred #'(e1 e2
...)))
- (lambda (docstring req opt rest kw inits vars pred body)
+ (expand-req req opt rest kw #'(e1 e2 ...)))
+ (lambda (docstring req opt rest kw inits vars body)
(call-with-values
(lambda ()
(chi-lambda-case e r w s mod get-formals
@@ -1793,7 +1769,7 @@
(values
(or docstring docstring*)
(build-lambda-case s req opt rest kw inits vars
- pred body else*))))))))))))
+ body else*))))))))))))
;;; data
@@ -2055,12 +2031,12 @@
(syntax-case e ()
((_ args docstring e1 e2 ...) (string? (syntax->datum
#'docstring))
(call-with-values (lambda () (lambda-formals #'args))
- (lambda (req opt rest kw pred)
+ (lambda (req opt rest kw)
(chi-simple-lambda e r w s mod req rest
(syntax->datum #'docstring)
#'(e1 e2 ...)))))
((_ args e1 e2 ...)
(call-with-values (lambda () (lambda-formals #'args))
- (lambda (req opt rest kw pred)
+ (lambda (req opt rest kw)
(chi-simple-lambda e r w s mod req rest #f #'(e1 e2
...)))))
(_ (syntax-violation 'lambda "bad lambda" e)))))
diff --git a/module/language/brainfuck/compile-tree-il.scm
b/module/language/brainfuck/compile-tree-il.scm
index 4cd6316..33d5634 100644
--- a/module/language/brainfuck/compile-tree-il.scm
+++ b/module/language/brainfuck/compile-tree-il.scm
@@ -170,7 +170,7 @@
(emit `(letrec (iterate) (,iterate)
((lambda ()
(lambda-case
- ((() #f #f #f () () #f)
+ ((() #f #f #f () ())
(if (apply (primitive =)
(apply (primitive vector-ref)
(lexical tape) (lexical
pointer))
diff --git a/module/language/ecmascript/compile-tree-il.scm
b/module/language/ecmascript/compile-tree-il.scm
index a97a4c1..a97e555 100644
--- a/module/language/ecmascript/compile-tree-il.scm
+++ b/module/language/ecmascript/compile-tree-il.scm
@@ -337,14 +337,14 @@
formals)))
`(lambda ()
(lambda-case
- ((() ,formals #f #f ,(map (lambda (x) (@implv *undefined*))
formals) ,syms #f)
+ ((() ,formals #f #f ,(map (lambda (x) (@implv *undefined*))
formals) ,syms)
,(comp-body e body formals syms))))))
((call/this ,obj ,prop . ,args)
(@impl call/this*
obj
(-> (lambda '()
`(lambda-case
- ((() #f #f #f () () #f)
+ ((() #f #f #f () ())
(apply ,(@impl pget obj prop) ,@args)))))))
((call (pref ,obj ,prop) ,args)
(comp `(call/this ,(comp obj e)
@@ -447,13 +447,13 @@
(-> (letrec '(%loop %continue) (list %loop %continue)
(list (-> (lambda '()
(-> (lambda-case
- `((() #f #f #f () () #f)
+ `((() #f #f #f () ())
,(-> (begin
(comp statement e)
(-> (apply (-> (lexical
'%continue %continue)))))))))))
(-> (lambda '()
(-> (lambda-case
- `((() #f #f #f () () #f)
+ `((() #f #f #f () ())
,(-> (if (@impl ->boolean (comp test
e))
(-> (apply (-> (lexical
'%loop %loop))))
(@implv *undefined*)))))))))
@@ -464,7 +464,7 @@
(-> (letrec '(%continue) (list %continue)
(list (-> (lambda '()
(-> (lambda-case
- `((() #f #f #f () () #f)
+ `((() #f #f #f () ())
,(-> (if (@impl ->boolean (comp test
e))
(-> (begin (comp statement
e)
(-> (apply (->
(lexical '%continue %continue))))))
@@ -477,7 +477,7 @@
(-> (letrec '(%continue) (list %continue)
(list (-> (lambda '()
(-> (lambda-case
- `((() #f #f #f () () #f)
+ `((() #f #f #f () ())
,(-> (if (if test
(@impl ->boolean (comp
test e))
(comp 'true e))
@@ -496,7 +496,7 @@
(list (@impl make-enumerator (comp object e))
(-> (lambda '()
(-> (lambda-case
- `((() #f #f #f () () #f)
+ `((() #f #f #f () ())
(-> (if (@impl ->boolean
(@impl pget
(-> (lexical
'%enum %enum))
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index e6a8213..db9b467 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -40,7 +40,7 @@
<lambda-case> lambda-case? make-lambda-case lambda-case-src
lambda-case-req lambda-case-opt lambda-case-rest
lambda-case-kw
lambda-case-inits lambda-case-vars
- lambda-case-predicate lambda-case-body
lambda-case-else
+ lambda-case-body lambda-case-else
<let> let? make-let let-src let-names let-vars let-vals let-body
<letrec> letrec? make-letrec letrec-src letrec-names letrec-vars
letrec-vals letrec-body
<fix> fix? make-fix fix-src fix-names fix-vars fix-vals fix-body
@@ -70,7 +70,7 @@
(<application> proc args)
(<sequence> exps)
(<lambda> meta body)
- (<lambda-case> req opt rest kw inits vars predicate body else)
+ (<lambda-case> req opt rest kw inits vars body else)
(<let> names vars vals body)
(<letrec> names vars vals body)
(<fix> names vars vals body)
@@ -135,17 +135,15 @@
((lambda ,meta ,body)
(make-lambda loc meta (retrans body)))
- ((lambda-case ((,req ,opt ,rest ,kw ,inits ,vars ,predicate) ,body) ,else)
+ ((lambda-case ((,req ,opt ,rest ,kw ,inits ,vars) ,body) ,else)
(make-lambda-case loc req opt rest kw
(map retrans inits) vars
- (and=> predicate retrans)
(retrans body)
(and=> else retrans)))
- ((lambda-case ((,req ,opt ,rest ,kw ,inits ,vars ,predicate) ,body))
+ ((lambda-case ((,req ,opt ,rest ,kw ,inits ,vars) ,body))
(make-lambda-case loc req opt rest kw
(map retrans inits) vars
- (and=> predicate retrans)
(retrans body)
#f))
@@ -208,9 +206,8 @@
((<lambda> meta body)
`(lambda ,meta ,(unparse-tree-il body)))
- ((<lambda-case> req opt rest kw inits vars predicate body else)
- `(lambda-case ((,req ,opt ,rest ,kw ,(map unparse-tree-il inits) ,vars
- ,(and=> predicate unparse-tree-il))
+ ((<lambda-case> req opt rest kw inits vars body else)
+ `(lambda-case ((,req ,opt ,rest ,kw ,(map unparse-tree-il inits) ,vars)
,(unparse-tree-il body))
. ,(if else (list (unparse-tree-il else)) '())))
@@ -276,7 +273,7 @@
`(lambda ,@(car (tree-il->scheme body)))
`(case-lambda ,@(tree-il->scheme body))))
- ((<lambda-case> req opt rest kw inits vars predicate body else)
+ ((<lambda-case> req opt rest kw inits vars body else)
;; FIXME! use parse-lambda-case?
`((,(if rest (apply cons* vars) vars)
,(tree-il->scheme body))
@@ -300,7 +297,7 @@
;; not a typo, we really do translate back to letrec
`(letrec ,(map list vars (map tree-il->scheme vals)) ,(tree-il->scheme
body)))
- ((<let-values> vars exp body)
+ ((<let-values> exp body)
`(call-with-values (lambda () ,(tree-il->scheme exp))
,(tree-il->scheme (make-lambda #f '() body))))))
@@ -336,15 +333,11 @@ This is an implementation of `foldts' as described by
Andy Wingo in
(up tree (loop exps (down tree result))))
((<lambda> body)
(up tree (loop body (down tree result))))
- ((<lambda-case> inits predicate body else)
+ ((<lambda-case> inits body else)
(up tree (if else
(loop else
- (if predicate
- (loop body (loop predicate (loop inits (down
tree result))))
- (loop body (loop inits (down tree result)))))
- (if predicate
- (loop body (loop predicate (loop inits (down tree
result))))
- (loop body (loop inits (down tree result)))))))
+ (loop body (loop inits (down tree result))))
+ (loop body (loop inits (down tree result))))))
((<let> vals body)
(up tree (loop body
(loop vals
@@ -396,19 +389,12 @@ This is an implementation of `foldts' as described by
Andy Wingo in
(fold-values foldts exps seed ...))
((<lambda> body)
(foldts body seed ...))
- ((<lambda-case> inits predicate body else)
+ ((<lambda-case> inits body else)
(let-values (((seed ...) (fold-values foldts inits seed
...)))
- (if predicate
- (if else
- (let*-values (((seed ...) (foldts predicate seed
...))
- ((seed ...) (foldts body seed ...)))
- (foldts else seed ...))
- (let-values (((seed ...) (foldts predicate seed
...)))
- (foldts body seed ...)))
- (if else
- (let-values (((seed ...) (foldts body seed ...)))
- (foldts else seed ...))
- (foldts body seed ...)))))
+ (if else
+ (let-values (((seed ...) (foldts body seed ...)))
+ (foldts else seed ...))
+ (foldts body seed ...))))
((<let> vals body)
(let*-values (((seed ...) (fold-values foldts vals seed
...)))
(foldts body seed ...)))
@@ -452,10 +438,8 @@ This is an implementation of `foldts' as described by Andy
Wingo in
((<lambda> body)
(set! (lambda-body x) (lp body)))
- ((<lambda-case> inits predicate body else)
+ ((<lambda-case> inits body else)
(set! inits (map lp inits))
- (if predicate
- (set! (lambda-case-predicate x) (lp predicate)))
(set! (lambda-case-body x) (lp body))
(if else
(set! (lambda-case-else x) (lp else))))
@@ -511,9 +495,8 @@ This is an implementation of `foldts' as described by Andy
Wingo in
((<lambda> body)
(set! (lambda-body x) (lp body)))
- ((<lambda-case> inits predicate body else)
+ ((<lambda-case> inits body else)
(set! inits (map lp inits))
- (if predicate (set! (lambda-case-predicate x) (lp predicate)))
(set! (lambda-case-body x) (lp body))
(if else (set! (lambda-case-else x) (lp else))))
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index e06a5af..d00fe1d 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -190,8 +190,7 @@
(length tail-call-args))
(not (lambda-case-opt c))
(not (lambda-case-kw c))
- (not (lambda-case-rest c))
- (not (lambda-case-predicate c)))
+ (not (lambda-case-rest c)))
(lp (lambda-case-else c)))))))))
(hashq-set! labels gensym #f))
(list gensym))
@@ -226,7 +225,7 @@
(hashq-set! free-vars x free)
free))
- ((<lambda-case> opt kw inits vars predicate body else)
+ ((<lambda-case> opt kw inits vars body else)
(hashq-set! bound-vars proc
(append (reverse vars) (hashq-ref bound-vars proc)))
(lset-union
@@ -234,7 +233,6 @@
(lset-difference eq?
(lset-union eq?
(apply lset-union eq? (map step inits))
- (if predicate (step predicate) '())
(step-tail body))
vars)
(if else (step-tail else) '())))
@@ -381,13 +379,12 @@
(hashq-set! allocation x (cons labels free-addresses)))
n)
- ((<lambda-case> opt kw inits vars predicate body else)
+ ((<lambda-case> opt kw inits vars body else)
(max
(let lp ((vars vars) (n n))
(if (null? vars)
(let ((nlocs (apply
max
- (if predicate (allocate! predicate body n) n)
(allocate! body proc n)
;; inits not logically at the end, but they
;; are the list...
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index fba0c67..1781c46 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -60,7 +60,7 @@
(analyze-tree analyses x e))
(let* ((x (make-lambda (tree-il-src x) '()
- (make-lambda-case #f '() #f #f #f '() '() #f x #f)))
+ (make-lambda-case #f '() #f #f #f '() '() x #f)))
(x (optimize! x e opts))
(allocation (analyze-lexicals x)))
@@ -92,6 +92,10 @@
((quotient . 2) . quo)
((remainder . 2) . rem)
((modulo . 2) . mod)
+ ((ash . 2) . ash)
+ ((logand . 2) . logand)
+ ((logior . 2) . logior)
+ ((logxor . 2) . logxor)
((not . 1) . not)
((pair? . 1) . pair?)
((cons . 2) . cons)
@@ -103,6 +107,7 @@
((list? . 1) . list?)
(list . list)
(vector . vector)
+ ((class-of . 1) . class-of)
((@slot-ref . 2) . slot-ref)
((@slot-set! . 3) . slot-set)
((vector-ref . 2) . vector-ref)
@@ -487,7 +492,7 @@
(emit-branch #f 'br RA)
(emit-label POST)))))))))
- ((<conditional> src test then else)
+ ((<conditional> src test then (alternate else))
;; TEST
;; (br-if-not L1)
;; THEN
@@ -495,15 +500,68 @@
;; L1: ELSE
;; L2:
(let ((L1 (make-label)) (L2 (make-label)))
- (comp-push test)
- (emit-branch src 'br-if-not L1)
+ ;; need a pattern matcher
+ (record-case test
+ ((<application> proc args)
+ (record-case proc
+ ((<primitive-ref> name)
+ (let ((len (length args)))
+ (cond
+
+ ((and (eq? name 'eq?) (= len 2))
+ (comp-push (car args))
+ (comp-push (cadr args))
+ (emit-branch src 'br-if-not-eq L1))
+
+ ((and (eq? name 'null?) (= len 1))
+ (comp-push (car args))
+ (emit-branch src 'br-if-not-null L1))
+
+ ((and (eq? name 'not) (= len 1))
+ (let ((app (car args)))
+ (record-case app
+ ((<application> proc args)
+ (let ((len (length args)))
+ (record-case proc
+ ((<primitive-ref> name)
+ (cond
+
+ ((and (eq? name 'eq?) (= len 2))
+ (comp-push (car args))
+ (comp-push (cadr args))
+ (emit-branch src 'br-if-eq L1))
+
+ ((and (eq? name 'null?) (= len 1))
+ (comp-push (car args))
+ (emit-branch src 'br-if-null L1))
+
+ (else
+ (comp-push app)
+ (emit-branch src 'br-if L1))))
+ (else
+ (comp-push app)
+ (emit-branch src 'br-if L1)))))
+ (else
+ (comp-push app)
+ (emit-branch src 'br-if L1)))))
+
+ (else
+ (comp-push test)
+ (emit-branch src 'br-if-not L1)))))
+ (else
+ (comp-push test)
+ (emit-branch src 'br-if-not L1))))
+ (else
+ (comp-push test)
+ (emit-branch src 'br-if-not L1)))
+
(comp-tail then)
;; if there is an RA, comp-tail will cause a jump to it -- just
;; have to clean up here if there is no RA.
(if (and (not RA) (not (eq? context 'tail)))
(emit-branch #f 'br L2))
(emit-label L1)
- (comp-tail else)
+ (comp-tail alternate)
(if (and (not RA) (not (eq? context 'tail)))
(emit-label L2))))
@@ -603,14 +661,13 @@
(emit-code #f (make-glil-call 'make-closure 2)))))))
(maybe-emit-return))
- ((<lambda-case> src req opt rest kw inits vars predicate else body)
+ ((<lambda-case> src req opt rest kw inits vars else body)
;; o/~ feature on top of feature o/~
;; req := (name ...)
;; opt := (name ...) | #f
;; rest := name | #f
;; kw: (allow-other-keys? (keyword name var) ...) | #f
;; vars: (sym ...)
- ;; predicate: tree-il in context of vars
;; init: tree-il in context of vars
;; vars map to named arguments in the following order:
;; required, optional (positional), rest, keyword.
@@ -691,15 +748,6 @@
(#t (error "what" inits))))))
;; post-prelude case label for label calls
(emit-label (car (hashq-ref allocation x)))
- (if predicate
- (begin
- (comp-push predicate)
- (if else-label
- ;; fixme: debox if necessary
- (emit-branch src 'br-if-not else-label)
- (comp-push (make-application
- src (make-primitive-ref #f 'error)
- (list (make-const #f "precondition not
met")))))))
(comp-tail body)
(if (not (null? vars))
(emit-code #f (make-glil-unbind)))
@@ -828,8 +876,8 @@
((<let-values> src exp body)
(record-case body
- ((<lambda-case> req opt kw rest vars predicate body else)
- (if (or opt kw predicate else)
+ ((<lambda-case> req opt kw rest vars body else)
+ (if (or opt kw else)
(error "unexpected lambda-case in let-values" x))
(let ((MV (make-label)))
(comp-vals exp MV)
diff --git a/module/language/tree-il/inline.scm
b/module/language/tree-il/inline.scm
index 9b53ec6..facaa38 100644
--- a/module/language/tree-il/inline.scm
+++ b/module/language/tree-il/inline.scm
@@ -44,9 +44,8 @@
(let lp ((lcase body))
(and lcase
(record-case lcase
- ((<lambda-case> req opt rest kw inits vars predicate body
else)
- (if (and (= (length vars) (length req) (length args))
- (not predicate))
+ ((<lambda-case> req opt rest kw inits vars body else)
+ (if (and (= (length vars) (length req) (length args)))
(let ((x (make-let src req vars args body)))
(or (inline1 x) x))
(lp else)))))))
@@ -65,7 +64,6 @@
(lambda-case? (lambda-body consumer))
(not (lambda-case-opt (lambda-body consumer)))
(not (lambda-case-kw (lambda-body consumer)))
- (not (lambda-case-predicate (lambda-body consumer)))
(not (lambda-case-else (lambda-body consumer))))
(make-let-values
src
diff --git a/module/language/tree-il/primitives.scm
b/module/language/tree-il/primitives.scm
index 8d93760..531a14a 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -36,6 +36,7 @@
eq? eqv? equal?
= < > <= >= zero?
+ * - / 1- 1+ quotient remainder modulo
+ ash logand logior logxor
not
pair? null? list? acons cons cons*
@@ -276,8 +277,8 @@
(define-primitive-expander acons (x y z)
(cons (cons x y) z))
-(define-primitive-expander apply (f . args)
- (@apply f . args))
+(define-primitive-expander apply (f a0 . args)
+ (@apply f a0 . args))
(define-primitive-expander call-with-values (producer consumer)
(@call-with-values producer consumer))
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 7871c2f..a9e26b5 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -73,7 +73,7 @@
primitive-generic-generic enable-primitive-generic!
method-procedure accessor-method-slot-definition
slot-exists? make find-method get-keyword)
- :replace (<class> <operator-class> <entity-class> <entity>)
+ :replace (<class> <entity-class> <entity>)
:no-backtrace)
(define *goops-module* (current-module))
@@ -82,6 +82,12 @@
(eval-when (eval load compile)
(%init-goops-builtins))
+(eval-when (eval load compile)
+ (use-modules ((language tree-il primitives) :select
(add-interesting-primitive!)))
+ (add-interesting-primitive! 'class-of)
+ (add-interesting-primitive! '@slot-ref)
+ (add-interesting-primitive! '@slot-set!))
+
;; Then load the rest of GOOPS
(use-modules (oop goops util)
(oop goops dispatch)
@@ -1125,11 +1131,6 @@
;; the idea is to compile the index into the procedure, for fastest
;; lookup. Also, @slot-ref and @slot-set! have their own bytecodes.
-(eval-when (compile)
- (use-modules ((language tree-il primitives) :select
(add-interesting-primitive!)))
- (add-interesting-primitive! '@slot-ref)
- (add-interesting-primitive! '@slot-set!))
-
(eval-when (eval load compile)
(define num-standard-pre-cache 20))
@@ -1484,14 +1485,6 @@
(set-object-procedure! object
(lambda args (apply proc args)))))))
-(define-method (initialize (class <operator-class>) initargs)
- (next-method)
- (initialize-object-procedure class initargs))
-
-(define-method (initialize (owsc <operator-with-setter-class>) initargs)
- (next-method)
- (%set-object-setter! owsc (get-keyword #:setter initargs #f)))
-
(define-method (initialize (entity <entity>) initargs)
(next-method)
(initialize-object-procedure entity initargs))
diff --git a/module/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index 7407feb..5d6557d 100644
--- a/module/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -78,15 +78,15 @@
(define (condition-type-id ct)
(and (condition-type? ct)
- (struct-ref ct 3)))
+ (struct-ref ct (+ vtable-offset-user 0))))
(define (condition-type-parent ct)
(and (condition-type? ct)
- (struct-ref ct 4)))
+ (struct-ref ct (+ vtable-offset-user 1))))
(define (condition-type-all-fields ct)
(and (condition-type? ct)
- (struct-ref ct 5)))
+ (struct-ref ct (+ vtable-offset-user 2))))
(define (struct-layout-for-condition field-names)
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index f02fbe6..24e3def 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -198,7 +198,7 @@
(source:line s) (source:column s))))
(number->string (object-address prog) 16))
(let ((arities (program-arities prog)))
- (if (null? arities)
+ (if (or (not arities) (null? arities))
""
(string-append
" " (string-join (map (lambda (a)
diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test
index e114abb..2c2ca0c 100644
--- a/test-suite/tests/structs.test
+++ b/test-suite/tests/structs.test
@@ -1,7 +1,7 @@
;;;; structs.test --- Test suite for Guile's structures. -*- Scheme -*-
;;;; Ludovic Courtès <address@hidden>, 2006-06-12.
;;;;
-;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009 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
@@ -86,7 +86,7 @@
(with-test-prefix "equal?"
(pass-if "simple structs"
- (let* ((vtable (make-vtable-vtable "pr" 0))
+ (let* ((vtable (make-vtable "pr"))
(s1 (make-struct vtable 0 "hello"))
(s2 (make-struct vtable 0 "hello")))
(equal? s1 s2)))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 874552f..3fe6865 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -322,7 +322,7 @@
(with-test-prefix "lambda"
(assert-tree-il->glil
(lambda ()
- (lambda-case (((x) #f #f #f () (y) #f) (const 2)) #f))
+ (lambda-case (((x) #f #f #f () (y)) (const 2)) #f))
(program () (std-prelude 0 0 #f) (label _)
(program () (std-prelude 1 1 #f)
(bind (x #f 0)) (label _)
@@ -331,7 +331,7 @@
(assert-tree-il->glil
(lambda ()
- (lambda-case (((x y) #f #f #f () (x1 y1) #f)
+ (lambda-case (((x y) #f #f #f () (x1 y1))
(const 2))
#f))
(program () (std-prelude 0 0 #f) (label _)
@@ -343,7 +343,7 @@
(assert-tree-il->glil
(lambda ()
- (lambda-case ((() #f x #f () (y) #f) (const 2))
+ (lambda-case ((() #f x #f () (y)) (const 2))
#f))
(program () (std-prelude 0 0 #f) (label _)
(program () (opt-prelude 0 0 0 1 #f)
@@ -354,7 +354,7 @@
(assert-tree-il->glil
(lambda ()
- (lambda-case (((x) #f x1 #f () (y y1) #f) (const 2))
+ (lambda-case (((x) #f x1 #f () (y y1)) (const 2))
#f))
(program () (std-prelude 0 0 #f) (label _)
(program () (opt-prelude 1 0 1 2 #f)
@@ -365,7 +365,7 @@
(assert-tree-il->glil
(lambda ()
- (lambda-case (((x) #f x1 #f () (y y1) #f) (lexical x y))
+ (lambda-case (((x) #f x1 #f () (y y1)) (lexical x y))
#f))
(program () (std-prelude 0 0 #f) (label _)
(program () (opt-prelude 1 0 1 2 #f)
@@ -376,7 +376,7 @@
(assert-tree-il->glil
(lambda ()
- (lambda-case (((x) #f x1 #f () (y y1) #f) (lexical x1 y1))
+ (lambda-case (((x) #f x1 #f () (y y1)) (lexical x1 y1))
#f))
(program () (std-prelude 0 0 #f) (label _)
(program () (opt-prelude 1 0 1 2 #f)
@@ -387,9 +387,9 @@
(assert-tree-il->glil
(lambda ()
- (lambda-case (((x) #f #f #f () (x1) #f)
+ (lambda-case (((x) #f #f #f () (x1))
(lambda ()
- (lambda-case (((y) #f #f #f () (y1) #f)
+ (lambda-case (((y) #f #f #f () (y1))
(lexical x x1))
#f)))
#f))
@@ -523,7 +523,7 @@
(parse-tree-il
'(lambda ()
(lambda-case
- (((x y) #f #f #f () (x1 y1) #f)
+ (((x y) #f #f #f () (x1 y1))
(apply (toplevel +)
(lexical x x1)
(lexical y y1)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] | Current Thread | [Next in Thread] |