summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--NEWS1
-rw-r--r--acinclude.m412
-rw-r--r--configure.ac22
-rw-r--r--lib/Makefile.am35
-rw-r--r--lib/basename-lgpl.c75
-rw-r--r--lib/dirname-lgpl.c86
-rw-r--r--lib/dirname.h46
-rw-r--r--lib/rename.c473
-rw-r--r--lib/rmdir.c53
-rw-r--r--lib/same-inode.h25
-rw-r--r--lib/stripslash.c45
-rw-r--r--libguile/Makefile.am4
-rw-r--r--libguile/filesys.c6
-rw-r--r--libguile/load.c29
-rw-r--r--libguile/strings.c41
-rw-r--r--libguile/win32-dirent.c133
-rw-r--r--libguile/win32-dirent.h65
-rw-r--r--m4/dirname.m419
-rw-r--r--m4/gnulib-cache.m43
-rw-r--r--m4/gnulib-comp.m427
-rw-r--r--m4/rename.m4184
-rw-r--r--m4/rmdir.m434
-rw-r--r--module/ice-9/boot-9.scm12
-rw-r--r--module/ice-9/psyntax-pp.scm3607
-rw-r--r--module/ice-9/psyntax.scm3
-rw-r--r--module/language/tree-il/compile-glil.scm85
-rw-r--r--module/language/tree-il/primitives.scm8
-rw-r--r--module/system/base/language.scm5
-rw-r--r--test-suite/tests/compiler.test17
-rw-r--r--test-suite/tests/tree-il.test20
30 files changed, 3079 insertions, 2096 deletions
diff --git a/NEWS b/NEWS
index 7ae9c11ff..2ca0272a1 100644
--- a/NEWS
+++ b/NEWS
@@ -166,6 +166,7 @@ ports)' documentation from the R6RS documentation. Thanks Andreas!
** Fix multithreaded access to internal hash tables
** Emit a 1-based line number in error messages
** Fix define-module ordering
+** Fix several POSIX functions to use the locale encoding
Changes in 2.0.1 (since 2.0.0):
diff --git a/acinclude.m4 b/acinclude.m4
index ba8b09031..5bd1cedab 100644
--- a/acinclude.m4
+++ b/acinclude.m4
@@ -529,8 +529,14 @@ AC_DEFUN([gl_CLOCK_TIME],
AC_SUBST([LIB_CLOCK_GETTIME])
gl_saved_libs=$LIBS
AC_SEARCH_LIBS([clock_gettime], [rt posix4],
- [test "$ac_cv_search_clock_gettime" = "none required" ||
- LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime])
- AC_CHECK_FUNCS([clock_gettime clock_settime])
+ [if test "$ac_cv_search_clock_gettime" = "none required"; then
+ AC_SEARCH_LIBS([clock_getcpuclockid], [rt posix4],
+ [test "$ac_cv_search_clock_getcpuclockid" = "none required" \
+ || LIB_CLOCK_GETTIME=$ac_cv_search_clock_getcpuclockid],
+ [LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime])
+ else
+ LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime
+ fi])
+ AC_CHECK_FUNCS([clock_gettime clock_settime clock_getcpuclockid])
LIBS=$gl_saved_libs
])
diff --git a/configure.ac b/configure.ac
index 57c06d5ae..ea3ca614b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -67,7 +67,8 @@ AC_PROG_LN_S
dnl Gnulib.
gl_INIT
dnl FIXME: remove me and the acinclude.m4 code when clock-gettime is
-dnl LGPL-compatible and can be imported normally.
+dnl fixed for clock_getcpuclockid and can be imported normally from
+dnl gnulib.
gl_CLOCK_TIME
AC_PROG_CC_C89
@@ -716,7 +717,6 @@ case $host in
[Define if you have the <winsock2.h> header file.])])
AC_CHECK_LIB(ws2_32, main)
AC_LIBOBJ([win32-uname])
- AC_LIBOBJ([win32-dirent])
if test "$enable_networking" = yes ; then
AC_LIBOBJ([win32-socket])
fi
@@ -1145,19 +1145,19 @@ AC_CHECK_FUNCS(asinh acosh atanh copysign finite sincos trunc)
# use <math.h> so doesn't detect on macro-only systems like HP-UX.
#
AC_MSG_CHECKING([for isinf])
-AC_LINK_IFELSE(AC_LANG_SOURCE(
+AC_LINK_IFELSE([AC_LANG_SOURCE(
[[#include <math.h>
volatile double x = 0.0;
-int main () { return (isinf(x) != 0); }]]),
+int main () { return (isinf(x) != 0); }]])],
[AC_MSG_RESULT([yes])
AC_DEFINE([HAVE_ISINF], 1,
[Define to 1 if you have the `isinf' macro or function.])],
[AC_MSG_RESULT([no])])
AC_MSG_CHECKING([for isnan])
-AC_LINK_IFELSE(AC_LANG_SOURCE(
-[[#include <math.h>
+AC_LINK_IFELSE([AC_LANG_SOURCE([[
+#include <math.h>
volatile double x = 0.0;
-int main () { return (isnan(x) != 0); }]]),
+int main () { return (isnan(x) != 0); }]])],
[AC_MSG_RESULT([yes])
AC_DEFINE([HAVE_ISNAN], 1,
[Define to 1 if you have the `isnan' macro or function.])],
@@ -1438,8 +1438,8 @@ case "$with_threads" in
AC_CACHE_CHECK([whether PTHREAD_ONCE_INIT needs braces],
guile_cv_need_braces_on_pthread_once_init,
- [AC_COMPILE_IFELSE([#include <pthread.h>
- pthread_once_t foo = PTHREAD_ONCE_INIT;],
+ [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <pthread.h>
+ pthread_once_t foo = PTHREAD_ONCE_INIT;]])],
[guile_cv_need_braces_on_pthread_once_init=no],
[guile_cv_need_braces_on_pthread_once_init=yes])])
if test "$guile_cv_need_braces_on_pthread_once_init" = yes; then
@@ -1450,8 +1450,8 @@ case "$with_threads" in
# 6.5.30m with GCC 3.3.
AC_CACHE_CHECK([whether PTHREAD_MUTEX_INITIALIZER needs braces],
guile_cv_need_braces_on_pthread_mutex_initializer,
- [AC_COMPILE_IFELSE([#include <pthread.h>
- pthread_mutex_t foo = PTHREAD_MUTEX_INITIALIZER;],
+ [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <pthread.h>
+ pthread_mutex_t foo = PTHREAD_MUTEX_INITIALIZER;]])],
[guile_cv_need_braces_on_pthread_mutex_initializer=no],
[guile_cv_need_braces_on_pthread_mutex_initializer=yes])])
if test "$guile_cv_need_braces_on_pthread_mutex_initializer" = yes; then
diff --git a/lib/Makefile.am b/lib/Makefile.am
index dfba180a9..5ae7948be 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -9,7 +9,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap canonicalize-lgpl ceil close connect duplocale environ extensions flock floor fpieee frexp full-read full-write func gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring listen locale log1p maintainer-makefile malloc-gnu malloca nproc open pipe2 putenv recv recvfrom send sendto setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat trunc verify vsnprintf warnings wchar
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap canonicalize-lgpl ceil close connect duplocale environ extensions flock floor fpieee frexp full-read full-write func gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring listen locale log1p maintainer-makefile malloc-gnu malloca nproc open pipe2 putenv recv recvfrom rename send sendto setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat trunc verify vsnprintf warnings wchar
AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
@@ -277,6 +277,14 @@ EXTRA_libgnu_la_SOURCES += connect.c
## end gnulib module connect
+## begin gnulib module dirname-lgpl
+
+libgnu_la_SOURCES += dirname-lgpl.c basename-lgpl.c stripslash.c
+
+EXTRA_DIST += dirname.h
+
+## end gnulib module dirname-lgpl
+
## begin gnulib module dosname
@@ -1111,6 +1119,24 @@ EXTRA_libgnu_la_SOURCES += recvfrom.c
## end gnulib module recvfrom
+## begin gnulib module rename
+
+
+EXTRA_DIST += rename.c
+
+EXTRA_libgnu_la_SOURCES += rename.c
+
+## end gnulib module rename
+
+## begin gnulib module rmdir
+
+
+EXTRA_DIST += rmdir.c
+
+EXTRA_libgnu_la_SOURCES += rmdir.c
+
+## end gnulib module rmdir
+
## begin gnulib module safe-read
libgnu_la_SOURCES += safe-read.c
@@ -1129,6 +1155,13 @@ EXTRA_libgnu_la_SOURCES += safe-read.c
## end gnulib module safe-write
+## begin gnulib module same-inode
+
+
+EXTRA_DIST += same-inode.h
+
+## end gnulib module same-inode
+
## begin gnulib module send
diff --git a/lib/basename-lgpl.c b/lib/basename-lgpl.c
new file mode 100644
index 000000000..685cbc722
--- /dev/null
+++ b/lib/basename-lgpl.c
@@ -0,0 +1,75 @@
+/* basename.c -- return the last element in a file name
+
+ Copyright (C) 1990, 1998-2001, 2003-2006, 2009-2011 Free Software
+ Foundation, Inc.
+
+ This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "dirname.h"
+
+#include <string.h>
+
+/* Return the address of the last file name component of NAME. If
+ NAME has no relative file name components because it is a file
+ system root, return the empty string. */
+
+char *
+last_component (char const *name)
+{
+ char const *base = name + FILE_SYSTEM_PREFIX_LEN (name);
+ char const *p;
+ bool saw_slash = false;
+
+ while (ISSLASH (*base))
+ base++;
+
+ for (p = base; *p; p++)
+ {
+ if (ISSLASH (*p))
+ saw_slash = true;
+ else if (saw_slash)
+ {
+ base = p;
+ saw_slash = false;
+ }
+ }
+
+ return (char *) base;
+}
+
+/* Return the length of the basename NAME. Typically NAME is the
+ value returned by base_name or last_component. Act like strlen
+ (NAME), except omit all trailing slashes. */
+
+size_t
+base_len (char const *name)
+{
+ size_t len;
+ size_t prefix_len = FILE_SYSTEM_PREFIX_LEN (name);
+
+ for (len = strlen (name); 1 < len && ISSLASH (name[len - 1]); len--)
+ continue;
+
+ if (DOUBLE_SLASH_IS_DISTINCT_ROOT && len == 1
+ && ISSLASH (name[0]) && ISSLASH (name[1]) && ! name[2])
+ return 2;
+
+ if (FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE && prefix_len
+ && len == prefix_len && ISSLASH (name[prefix_len]))
+ return prefix_len + 1;
+
+ return len;
+}
diff --git a/lib/dirname-lgpl.c b/lib/dirname-lgpl.c
new file mode 100644
index 000000000..934c271cd
--- /dev/null
+++ b/lib/dirname-lgpl.c
@@ -0,0 +1,86 @@
+/* dirname.c -- return all but the last element in a file name
+
+ Copyright (C) 1990, 1998, 2000-2001, 2003-2006, 2009-2011 Free Software
+ Foundation, Inc.
+
+ This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "dirname.h"
+
+#include <stdlib.h>
+#include <string.h>
+
+/* Return the length of the prefix of FILE that will be used by
+ dir_name. If FILE is in the working directory, this returns zero
+ even though `dir_name (FILE)' will return ".". Works properly even
+ if there are trailing slashes (by effectively ignoring them). */
+
+size_t
+dir_len (char const *file)
+{
+ size_t prefix_length = FILE_SYSTEM_PREFIX_LEN (file);
+ size_t length;
+
+ /* Advance prefix_length beyond important leading slashes. */
+ prefix_length += (prefix_length != 0
+ ? (FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
+ && ISSLASH (file[prefix_length]))
+ : (ISSLASH (file[0])
+ ? ((DOUBLE_SLASH_IS_DISTINCT_ROOT
+ && ISSLASH (file[1]) && ! ISSLASH (file[2])
+ ? 2 : 1))
+ : 0));
+
+ /* Strip the basename and any redundant slashes before it. */
+ for (length = last_component (file) - file;
+ prefix_length < length; length--)
+ if (! ISSLASH (file[length - 1]))
+ break;
+ return length;
+}
+
+
+/* In general, we can't use the builtin `dirname' function if available,
+ since it has different meanings in different environments.
+ In some environments the builtin `dirname' modifies its argument.
+
+ Return the leading directories part of FILE, allocated with malloc.
+ Works properly even if there are trailing slashes (by effectively
+ ignoring them). Return NULL on failure.
+
+ If lstat (FILE) would succeed, then { chdir (dir_name (FILE));
+ lstat (base_name (FILE)); } will access the same file. Likewise,
+ if the sequence { chdir (dir_name (FILE));
+ rename (base_name (FILE), "foo"); } succeeds, you have renamed FILE
+ to "foo" in the same directory FILE was in. */
+
+char *
+mdir_name (char const *file)
+{
+ size_t length = dir_len (file);
+ bool append_dot = (length == 0
+ || (FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE
+ && length == FILE_SYSTEM_PREFIX_LEN (file)
+ && file[2] != '\0' && ! ISSLASH (file[2])));
+ char *dir = malloc (length + append_dot + 1);
+ if (!dir)
+ return NULL;
+ memcpy (dir, file, length);
+ if (append_dot)
+ dir[length++] = '.';
+ dir[length] = '\0';
+ return dir;
+}
diff --git a/lib/dirname.h b/lib/dirname.h
new file mode 100644
index 000000000..6e7f1e9dd
--- /dev/null
+++ b/lib/dirname.h
@@ -0,0 +1,46 @@
+/* Take file names apart into directory and base names.
+
+ Copyright (C) 1998, 2001, 2003-2006, 2009-2011 Free Software Foundation,
+ Inc.
+
+ This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef DIRNAME_H_
+# define DIRNAME_H_ 1
+
+# include <stdbool.h>
+# include <stddef.h>
+# include "dosname.h"
+
+# ifndef DIRECTORY_SEPARATOR
+# define DIRECTORY_SEPARATOR '/'
+# endif
+
+# ifndef DOUBLE_SLASH_IS_DISTINCT_ROOT
+# define DOUBLE_SLASH_IS_DISTINCT_ROOT 0
+# endif
+
+# if GNULIB_DIRNAME
+char *base_name (char const *file);
+char *dir_name (char const *file);
+# endif
+
+char *mdir_name (char const *file);
+size_t base_len (char const *file);
+size_t dir_len (char const *file);
+char *last_component (char const *file);
+
+bool strip_trailing_slashes (char *file);
+
+#endif /* not DIRNAME_H_ */
diff --git a/lib/rename.c b/lib/rename.c
new file mode 100644
index 000000000..ebbbfeae5
--- /dev/null
+++ b/lib/rename.c
@@ -0,0 +1,473 @@
+/* Work around rename bugs in some systems.
+
+ Copyright (C) 2001-2003, 2005-2006, 2009-2011 Free Software Foundation, Inc.
+
+ This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. */
+
+/* Written by Volker Borchert, Eric Blake. */
+
+#include <config.h>
+
+#include <stdio.h>
+
+#undef rename
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+/* The mingw rename has problems with trailing slashes; it also
+ requires use of native Windows calls to allow atomic renames over
+ existing files. */
+
+# include <errno.h>
+# include <stdbool.h>
+# include <stdlib.h>
+# include <sys/stat.h>
+# include <unistd.h>
+
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+
+# include "dirname.h"
+
+/* Rename the file SRC to DST. This replacement is necessary on
+ Windows, on which the system rename function will not replace
+ an existing DST. */
+int
+rpl_rename (char const *src, char const *dst)
+{
+ int error;
+ size_t src_len = strlen (src);
+ size_t dst_len = strlen (dst);
+ char *src_base = last_component (src);
+ char *dst_base = last_component (dst);
+ bool src_slash;
+ bool dst_slash;
+ bool dst_exists;
+ struct stat src_st;
+ struct stat dst_st;
+
+ /* Filter out dot as last component. */
+ if (!src_len || !dst_len)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+ if (*src_base == '.')
+ {
+ size_t len = base_len (src_base);
+ if (len == 1 || (len == 2 && src_base[1] == '.'))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ }
+ if (*dst_base == '.')
+ {
+ size_t len = base_len (dst_base);
+ if (len == 1 || (len == 2 && dst_base[1] == '.'))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ }
+
+ /* Presence of a trailing slash requires directory semantics. If
+ the source does not exist, or if the destination cannot be turned
+ into a directory, give up now. Otherwise, strip trailing slashes
+ before calling rename. There are no symlinks on mingw, so stat
+ works instead of lstat. */
+ src_slash = ISSLASH (src[src_len - 1]);
+ dst_slash = ISSLASH (dst[dst_len - 1]);
+ if (stat (src, &src_st))
+ return -1;
+ if (stat (dst, &dst_st))
+ {
+ if (errno != ENOENT || (!S_ISDIR (src_st.st_mode) && dst_slash))
+ return -1;
+ dst_exists = false;
+ }
+ else
+ {
+ if (S_ISDIR (dst_st.st_mode) != S_ISDIR (src_st.st_mode))
+ {
+ errno = S_ISDIR (dst_st.st_mode) ? EISDIR : ENOTDIR;
+ return -1;
+ }
+ dst_exists = true;
+ }
+
+ /* There are no symlinks, so if a file existed with a trailing
+ slash, it must be a directory, and we don't have to worry about
+ stripping strip trailing slash. However, mingw refuses to
+ replace an existing empty directory, so we have to help it out.
+ And canonicalize_file_name is not yet ported to mingw; however,
+ for directories, getcwd works as a viable alternative. Ensure
+ that we can get back to where we started before using it; later
+ attempts to return are fatal. Note that we can end up losing a
+ directory if rename then fails, but it was empty, so not much
+ damage was done. */
+ if (dst_exists && S_ISDIR (dst_st.st_mode))
+ {
+ char *cwd = getcwd (NULL, 0);
+ char *src_temp;
+ char *dst_temp;
+ if (!cwd || chdir (cwd))
+ return -1;
+ if (IS_ABSOLUTE_FILE_NAME (src))
+ {
+ dst_temp = chdir (dst) ? NULL : getcwd (NULL, 0);
+ src_temp = chdir (src) ? NULL : getcwd (NULL, 0);
+ }
+ else
+ {
+ src_temp = chdir (src) ? NULL : getcwd (NULL, 0);
+ if (!IS_ABSOLUTE_FILE_NAME (dst) && chdir (cwd))
+ abort ();
+ dst_temp = chdir (dst) ? NULL : getcwd (NULL, 0);
+ }
+ if (chdir (cwd))
+ abort ();
+ free (cwd);
+ if (!src_temp || !dst_temp)
+ {
+ free (src_temp);
+ free (dst_temp);
+ errno = ENOMEM;
+ return -1;
+ }
+ src_len = strlen (src_temp);
+ if (strncmp (src_temp, dst_temp, src_len) == 0
+ && (ISSLASH (dst_temp[src_len]) || dst_temp[src_len] == '\0'))
+ {
+ error = dst_temp[src_len];
+ free (src_temp);
+ free (dst_temp);
+ if (error)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ return 0;
+ }
+ if (rmdir (dst))
+ {
+ error = errno;
+ free (src_temp);
+ free (dst_temp);
+ errno = error;
+ return -1;
+ }
+ free (src_temp);
+ free (dst_temp);
+ }
+
+ /* MoveFileEx works if SRC is a directory without any flags, but
+ fails with MOVEFILE_REPLACE_EXISTING, so try without flags first.
+ Thankfully, MoveFileEx handles hard links correctly, even though
+ rename() does not. */
+ if (MoveFileEx (src, dst, 0))
+ return 0;
+
+ /* Retry with MOVEFILE_REPLACE_EXISTING if the move failed
+ due to the destination already existing. */
+ error = GetLastError ();
+ if (error == ERROR_FILE_EXISTS || error == ERROR_ALREADY_EXISTS)
+ {
+ if (MoveFileEx (src, dst, MOVEFILE_REPLACE_EXISTING))
+ return 0;
+
+ error = GetLastError ();
+ }
+
+ switch (error)
+ {
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ case ERROR_BAD_PATHNAME:
+ case ERROR_DIRECTORY:
+ errno = ENOENT;
+ break;
+
+ case ERROR_ACCESS_DENIED:
+ case ERROR_SHARING_VIOLATION:
+ errno = EACCES;
+ break;
+
+ case ERROR_OUTOFMEMORY:
+ errno = ENOMEM;
+ break;
+
+ case ERROR_CURRENT_DIRECTORY:
+ errno = EBUSY;
+ break;
+
+ case ERROR_NOT_SAME_DEVICE:
+ errno = EXDEV;
+ break;
+
+ case ERROR_WRITE_PROTECT:
+ errno = EROFS;
+ break;
+
+ case ERROR_WRITE_FAULT:
+ case ERROR_READ_FAULT:
+ case ERROR_GEN_FAILURE:
+ errno = EIO;
+ break;
+
+ case ERROR_HANDLE_DISK_FULL:
+ case ERROR_DISK_FULL:
+ case ERROR_DISK_TOO_FRAGMENTED:
+ errno = ENOSPC;
+ break;
+
+ case ERROR_FILE_EXISTS:
+ case ERROR_ALREADY_EXISTS:
+ errno = EEXIST;
+ break;
+
+ case ERROR_BUFFER_OVERFLOW:
+ case ERROR_FILENAME_EXCED_RANGE:
+ errno = ENAMETOOLONG;
+ break;
+
+ case ERROR_INVALID_NAME:
+ case ERROR_DELETE_PENDING:
+ errno = EPERM; /* ? */
+ break;
+
+# ifndef ERROR_FILE_TOO_LARGE
+/* This value is documented but not defined in all versions of windows.h. */
+# define ERROR_FILE_TOO_LARGE 223
+# endif
+ case ERROR_FILE_TOO_LARGE:
+ errno = EFBIG;
+ break;
+
+ default:
+ errno = EINVAL;
+ break;
+ }
+
+ return -1;
+}
+
+#else /* ! W32 platform */
+
+# include <errno.h>
+# include <stdio.h>
+# include <stdlib.h>
+# include <string.h>
+# include <sys/stat.h>
+# include <unistd.h>
+
+# include "dirname.h"
+# include "same-inode.h"
+
+/* Rename the file SRC to DST, fixing any trailing slash bugs. */
+
+int
+rpl_rename (char const *src, char const *dst)
+{
+ size_t src_len = strlen (src);
+ size_t dst_len = strlen (dst);
+ char *src_temp = (char *) src;
+ char *dst_temp = (char *) dst;
+ bool src_slash;
+ bool dst_slash;
+ bool dst_exists;
+ int ret_val = -1;
+ int rename_errno = ENOTDIR;
+ struct stat src_st;
+ struct stat dst_st;
+
+ if (!src_len || !dst_len)
+ return rename (src, dst); /* Let strace see the ENOENT failure. */
+
+# if RENAME_DEST_EXISTS_BUG
+ {
+ char *src_base = last_component (src);
+ char *dst_base = last_component (dst);
+ if (*src_base == '.')
+ {
+ size_t len = base_len (src_base);
+ if (len == 1 || (len == 2 && src_base[1] == '.'))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ }
+ if (*dst_base == '.')
+ {
+ size_t len = base_len (dst_base);
+ if (len == 1 || (len == 2 && dst_base[1] == '.'))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ }
+ }
+# endif /* RENAME_DEST_EXISTS_BUG */
+
+ src_slash = src[src_len - 1] == '/';
+ dst_slash = dst[dst_len - 1] == '/';
+
+# if !RENAME_HARD_LINK_BUG && !RENAME_DEST_EXISTS_BUG
+ /* If there are no trailing slashes, then trust the native
+ implementation unless we also suspect issues with hard link
+ detection or file/directory conflicts. */
+ if (!src_slash && !dst_slash)
+ return rename (src, dst);
+# endif /* !RENAME_HARD_LINK_BUG && !RENAME_DEST_EXISTS_BUG */
+
+ /* Presence of a trailing slash requires directory semantics. If
+ the source does not exist, or if the destination cannot be turned
+ into a directory, give up now. Otherwise, strip trailing slashes
+ before calling rename. */
+ if (lstat (src, &src_st))
+ return -1;
+ if (lstat (dst, &dst_st))
+ {
+ if (errno != ENOENT || (!S_ISDIR (src_st.st_mode) && dst_slash))
+ return -1;
+ dst_exists = false;
+ }
+ else
+ {
+ if (S_ISDIR (dst_st.st_mode) != S_ISDIR (src_st.st_mode))
+ {
+ errno = S_ISDIR (dst_st.st_mode) ? EISDIR : ENOTDIR;
+ return -1;
+ }
+# if RENAME_HARD_LINK_BUG
+ if (SAME_INODE (src_st, dst_st))
+ return 0;
+# endif /* RENAME_HARD_LINK_BUG */
+ dst_exists = true;
+ }
+
+# if (RENAME_TRAILING_SLASH_SOURCE_BUG || RENAME_DEST_EXISTS_BUG \
+ || RENAME_HARD_LINK_BUG)
+ /* If the only bug was that a trailing slash was allowed on a
+ non-existing file destination, as in Solaris 10, then we've
+ already covered that situation. But if there is any problem with
+ a trailing slash on an existing source or destination, as in
+ Solaris 9, or if a directory can overwrite a symlink, as on
+ Cygwin 1.5, or if directories cannot be created with trailing
+ slash, as on NetBSD 1.6, then we must strip the offending slash
+ and check that we have not encountered a symlink instead of a
+ directory.
+
+ Stripping a trailing slash interferes with POSIX semantics, where
+ rename behavior on a symlink with a trailing slash operates on
+ the corresponding target directory. We prefer the GNU semantics
+ of rejecting any use of a symlink with trailing slash, but do not
+ enforce them, since Solaris 10 is able to obey POSIX semantics
+ and there might be clients expecting it, as counter-intuitive as
+ those semantics are.
+
+ Technically, we could also follow the POSIX behavior by chasing a
+ readlink trail, but that is harder to implement. */
+ if (src_slash)
+ {
+ src_temp = strdup (src);
+ if (!src_temp)
+ {
+ /* Rather than rely on strdup-posix, we set errno ourselves. */
+ rename_errno = ENOMEM;
+ goto out;
+ }
+ strip_trailing_slashes (src_temp);
+ if (lstat (src_temp, &src_st))
+ {
+ rename_errno = errno;
+ goto out;
+ }
+ if (S_ISLNK (src_st.st_mode))
+ goto out;
+ }
+ if (dst_slash)
+ {
+ dst_temp = strdup (dst);
+ if (!dst_temp)
+ {
+ rename_errno = ENOMEM;
+ goto out;
+ }
+ strip_trailing_slashes (dst_temp);
+ if (lstat (dst_temp, &dst_st))
+ {
+ if (errno != ENOENT)
+ {
+ rename_errno = errno;
+ goto out;
+ }
+ }
+ else if (S_ISLNK (dst_st.st_mode))
+ goto out;
+ }
+# endif /* RENAME_TRAILING_SLASH_SOURCE_BUG || RENAME_DEST_EXISTS_BUG
+ || RENAME_HARD_LINK_BUG */
+
+# if RENAME_DEST_EXISTS_BUG
+ /* Cygwin 1.5 sometimes behaves oddly when moving a non-empty
+ directory on top of an empty one (the old directory name can
+ reappear if the new directory tree is removed). Work around this
+ by removing the target first, but don't remove the target if it
+ is a subdirectory of the source. Note that we can end up losing
+ a directory if rename then fails, but it was empty, so not much
+ damage was done. */
+ if (dst_exists && S_ISDIR (dst_st.st_mode))
+ {
+ if (src_st.st_dev != dst_st.st_dev)
+ {
+ rename_errno = EXDEV;
+ goto out;
+ }
+ if (src_temp != src)
+ free (src_temp);
+ src_temp = canonicalize_file_name (src);
+ if (dst_temp != dst)
+ free (dst_temp);
+ dst_temp = canonicalize_file_name (dst);
+ if (!src_temp || !dst_temp)
+ {
+ rename_errno = ENOMEM;
+ goto out;
+ }
+ src_len = strlen (src_temp);
+ if (strncmp (src_temp, dst_temp, src_len) == 0
+ && dst_temp[src_len] == '/')
+ {
+ rename_errno = EINVAL;
+ goto out;
+ }
+ if (rmdir (dst))
+ {
+ rename_errno = errno;
+ goto out;
+ }
+ }
+# endif /* RENAME_DEST_EXISTS_BUG */
+
+ ret_val = rename (src_temp, dst_temp);
+ rename_errno = errno;
+ out:
+ if (src_temp != src)
+ free (src_temp);
+ if (dst_temp != dst)
+ free (dst_temp);
+ errno = rename_errno;
+ return ret_val;
+}
+#endif /* ! W32 platform */
diff --git a/lib/rmdir.c b/lib/rmdir.c
new file mode 100644
index 000000000..98104bfc1
--- /dev/null
+++ b/lib/rmdir.c
@@ -0,0 +1,53 @@
+/* Work around rmdir bugs.
+
+ Copyright (C) 1988, 1990, 1999, 2003-2006, 2009-2011 Free Software
+ Foundation, Inc.
+
+ This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include <unistd.h>
+
+#include <errno.h>
+#include <string.h>
+
+#include "dosname.h"
+
+#undef rmdir
+
+/* Remove directory DIR.
+ Return 0 if successful, -1 if not. */
+
+int
+rpl_rmdir (char const *dir)
+{
+ /* Work around cygwin 1.5.x bug where rmdir("dir/./") succeeds. */
+ size_t len = strlen (dir);
+ int result;
+ while (len && ISSLASH (dir[len - 1]))
+ len--;
+ if (len && dir[len - 1] == '.' && (1 == len || ISSLASH (dir[len - 2])))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ result = rmdir (dir);
+ /* Work around mingw bug, where rmdir("file/") fails with EINVAL
+ instead of ENOTDIR. We've already filtered out trailing ., the
+ only reason allowed by POSIX for EINVAL. */
+ if (result == -1 && errno == EINVAL)
+ errno = ENOTDIR;
+ return result;
+}
diff --git a/lib/same-inode.h b/lib/same-inode.h
new file mode 100644
index 000000000..e89cb539a
--- /dev/null
+++ b/lib/same-inode.h
@@ -0,0 +1,25 @@
+/* Determine whether two stat buffers refer to the same file.
+
+ Copyright (C) 2006, 2009-2011 Free Software Foundation, Inc.
+
+ This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. */
+
+#ifndef SAME_INODE_H
+# define SAME_INODE_H 1
+
+# define SAME_INODE(Stat_buf_1, Stat_buf_2) \
+ ((Stat_buf_1).st_ino == (Stat_buf_2).st_ino \
+ && (Stat_buf_1).st_dev == (Stat_buf_2).st_dev)
+
+#endif
diff --git a/lib/stripslash.c b/lib/stripslash.c
new file mode 100644
index 000000000..31034cb5d
--- /dev/null
+++ b/lib/stripslash.c
@@ -0,0 +1,45 @@
+/* stripslash.c -- remove redundant trailing slashes from a file name
+
+ Copyright (C) 1990, 2001, 2003-2006, 2009-2011 Free Software Foundation,
+ Inc.
+
+ This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "dirname.h"
+
+/* Remove trailing slashes from FILE. Return true if a trailing slash
+ was removed. This is useful when using file name completion from a
+ shell that adds a "/" after directory names (such as tcsh and
+ bash), because on symlinks to directories, several system calls
+ have different semantics according to whether a trailing slash is
+ present. */
+
+bool
+strip_trailing_slashes (char *file)
+{
+ char *base = last_component (file);
+ char *base_lim;
+ bool had_slash;
+
+ /* last_component returns "" for file system roots, but we need to turn
+ `///' into `/'. */
+ if (! *base)
+ base = file;
+ base_lim = base + base_len (base);
+ had_slash = (*base_lim != '\0');
+ *base_lim = '\0';
+ return had_slash;
+}
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 9cc14344f..e69a1551e 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -433,7 +433,7 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h \
dynl.c regex-posix.c \
posix.c net_db.c socket.c \
debug-malloc.c mkstemp.c \
- win32-uname.c win32-dirent.c win32-socket.c \
+ win32-uname.c win32-socket.c \
locale-categories.h
## delete guile-snarf.awk from the installation bindir, in case it's
@@ -450,7 +450,7 @@ noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c \
ieee-754.h \
srfi-14.i.c \
quicksort.i.c \
- win32-uname.h win32-dirent.h win32-socket.h \
+ win32-uname.h win32-socket.h \
private-gc.h private-options.h
# vm instructions
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 2429e80a6..86287a170 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -97,11 +97,7 @@
#endif
-#if defined (__MINGW32__) || defined (_MSC_VER) || defined (__BORLANDC__)
-# include "win32-dirent.h"
-# define NAMLEN(dirent) strlen((dirent)->d_name)
-/* The following bits are per AC_HEADER_DIRENT doco in the autoconf manual */
-#elif HAVE_DIRENT_H
+#if HAVE_DIRENT_H
# include <dirent.h>
# define NAMLEN(dirent) strlen((dirent)->d_name)
#else
diff --git a/libguile/load.c b/libguile/load.c
index fa19a2a66..b06fd7730 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -293,6 +293,12 @@ scm_init_load_path ()
snprintf (cachedir, sizeof(cachedir), "%s/.cache/" FALLBACK_DIR,
pwd->pw_dir);
#endif /* HAVE_GETPWENT */
+#ifdef __MINGW32__
+ else if ((e = getenv ("LOCALAPPDATA")))
+ snprintf (cachedir, sizeof (cachedir), "%s/.cache/" FALLBACK_DIR, e);
+ else if ((e = getenv ("APPDATA")))
+ snprintf (cachedir, sizeof (cachedir), "%s/.cache/" FALLBACK_DIR, e);
+#endif /* __MINGW32__ */
else
cachedir[0] = 0;
@@ -730,14 +736,27 @@ static SCM
auto_compile_catch_handler (void *data, SCM tag, SCM throw_args)
{
SCM source = PTR2SCM (data);
+ SCM oport, lines;
+
+ oport = scm_open_output_string ();
+ scm_print_exception (oport, SCM_BOOL_F, tag, throw_args);
+
scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
scm_display (source, scm_current_error_port ());
scm_puts (" failed:\n", scm_current_error_port ());
- scm_puts (";;; key ", scm_current_error_port ());
- scm_write (tag, scm_current_error_port ());
- scm_puts (", throw args ", scm_current_error_port ());
- scm_write (throw_args, scm_current_error_port ());
- scm_newline (scm_current_error_port ());
+
+ lines = scm_string_split (scm_get_output_string (oport),
+ SCM_MAKE_CHAR ('\n'));
+ for (; scm_is_pair (lines); lines = scm_cdr (lines))
+ if (scm_c_string_length (scm_car (lines)))
+ {
+ scm_puts (";;; ", scm_current_error_port ());
+ scm_display (scm_car (lines), scm_current_error_port ());
+ scm_newline (scm_current_error_port ());
+ }
+
+ scm_close_port (oport);
+
return SCM_BOOL_F;
}
diff --git a/libguile/strings.c b/libguile/strings.c
index e54c27d32..b43ccaba2 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -2052,8 +2052,9 @@ SCM_DEFINE (scm_string_normalize_nfkd, "string-normalize-nfkd", 1, 0, 0,
}
#undef FUNC_NAME
-/* converts C scm_array of strings to SCM scm_list of strings. */
-/* If argc < 0, a null terminated scm_array is assumed. */
+/* converts C scm_array of strings to SCM scm_list of strings.
+ If argc < 0, a null terminated scm_array is assumed.
+ The current locale encoding is assumed */
SCM
scm_makfromstrs (int argc, char **argv)
{
@@ -2067,37 +2068,43 @@ scm_makfromstrs (int argc, char **argv)
}
/* Return a newly allocated array of char pointers to each of the strings
- in args, with a terminating NULL pointer. */
+ in args, with a terminating NULL pointer. The strings are encoded using
+ the current locale. */
char **
scm_i_allocate_string_pointers (SCM list)
#define FUNC_NAME "scm_i_allocate_string_pointers"
{
char **result;
- int len = scm_ilength (list);
+ int list_len = scm_ilength (list);
int i;
- if (len < 0)
+ if (list_len < 0)
scm_wrong_type_arg_msg (NULL, 0, list, "proper list");
- result = scm_gc_malloc ((len + 1) * sizeof (char *),
+ result = scm_gc_malloc ((list_len + 1) * sizeof (char *),
"string pointers");
- result[len] = NULL;
+ result[list_len] = NULL;
- /* The list might be have been modified in another thread, so
+ /* The list might have been modified in another thread, so
we check LIST before each access.
*/
- for (i = 0; i < len && scm_is_pair (list); i++)
+ for (i = 0; i < list_len && scm_is_pair (list); i++)
{
- SCM str;
- size_t len;
-
- str = SCM_CAR (list);
- len = scm_c_string_length (str);
-
- result[i] = scm_gc_malloc_pointerless (len + 1, "string pointers");
- memcpy (result[i], scm_i_string_chars (str), len);
+ SCM str = SCM_CAR (list);
+ size_t len; /* String length in bytes */
+ char *c_str = scm_to_locale_stringn (str, &len);
+
+ /* OPTIMIZE-ME: Right now, scm_to_locale_stringn always uses
+ scm_malloc to allocate the returned string, which must be
+ explicitly deallocated. This forces us to copy the string a
+ second time into a new buffer. Ideally there would be variants
+ of scm_to_*_stringn that can return garbage-collected buffers. */
+
+ result[i] = scm_gc_malloc_pointerless (len + 1, "string");
+ memcpy (result[i], c_str, len);
result[i][len] = '\0';
+ free (c_str);
list = SCM_CDR (list);
}
diff --git a/libguile/win32-dirent.c b/libguile/win32-dirent.c
deleted file mode 100644
index de170c70b..000000000
--- a/libguile/win32-dirent.c
+++ /dev/null
@@ -1,133 +0,0 @@
-/* Copyright (C) 2001, 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
- */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include "libguile/__scm.h"
-
-#include <windows.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "win32-dirent.h"
-
-DIR *
-opendir (const char * name)
-{
- DIR *dir;
- HANDLE hnd;
- char *file;
- WIN32_FIND_DATA find;
-
- if (!name || !*name)
- return NULL;
- file = malloc (strlen (name) + 3);
- strcpy (file, name);
- if (file[strlen (name) - 1] != '/' && file[strlen (name) - 1] != '\\')
- strcat (file, "/*");
- else
- strcat (file, "*");
-
- if ((hnd = FindFirstFile (file, &find)) == INVALID_HANDLE_VALUE)
- {
- free (file);
- return NULL;
- }
-
- dir = malloc (sizeof (DIR));
- dir->mask = file;
- dir->fd = (int) hnd;
- dir->data = malloc (sizeof (WIN32_FIND_DATA));
- dir->allocation = sizeof (WIN32_FIND_DATA);
- dir->size = dir->allocation;
- dir->filepos = 0;
- memcpy (dir->data, &find, sizeof (WIN32_FIND_DATA));
- return dir;
-}
-
-struct dirent *
-readdir (DIR * dir)
-{
- static struct dirent entry;
- WIN32_FIND_DATA *find;
-
- entry.d_ino = 0;
- entry.d_type = 0;
- find = (WIN32_FIND_DATA *) dir->data;
-
- if (dir->filepos)
- {
- if (!FindNextFile ((HANDLE) dir->fd, find))
- return NULL;
- }
-
- entry.d_off = dir->filepos;
- strncpy (entry.d_name, find->cFileName, sizeof (entry.d_name));
- entry.d_reclen = strlen (find->cFileName);
- dir->filepos++;
- return &entry;
-}
-
-int
-closedir (DIR * dir)
-{
- HANDLE hnd = (HANDLE) dir->fd;
- free (dir->data);
- free (dir->mask);
- free (dir);
- return FindClose (hnd) ? 0 : -1;
-}
-
-void
-rewinddir (DIR * dir)
-{
- HANDLE hnd = (HANDLE) dir->fd;
- WIN32_FIND_DATA *find = (WIN32_FIND_DATA *) dir->data;
-
- FindClose (hnd);
- hnd = FindFirstFile (dir->mask, find);
- dir->fd = (int) hnd;
- dir->filepos = 0;
-}
-
-void
-seekdir (DIR * dir, off_t offset)
-{
- off_t n;
-
- rewinddir (dir);
- for (n = 0; n < offset; n++)
- {
- if (FindNextFile ((HANDLE) dir->fd, (WIN32_FIND_DATA *) dir->data))
- dir->filepos++;
- }
-}
-
-off_t
-telldir (DIR * dir)
-{
- return dir->filepos;
-}
-
-int
-dirfd (DIR * dir)
-{
- return dir->fd;
-}
diff --git a/libguile/win32-dirent.h b/libguile/win32-dirent.h
deleted file mode 100644
index 578db49b9..000000000
--- a/libguile/win32-dirent.h
+++ /dev/null
@@ -1,65 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_WIN32_DIRENT_H
-#define SCM_WIN32_DIRENT_H
-
-/* Copyright (C) 2001, 2006 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
- */
-
-/* Directory stream type.
- The miscellaneous Unix `readdir' implementations read directory data
- into a buffer and return `struct dirent *' pointers into it. */
-
-#include <sys/types.h>
-
-struct dirstream
-{
- int fd; /* File descriptor. */
- char *data; /* Directory block. */
- size_t allocation; /* Space allocated for the block. */
- size_t size; /* Total valid data in the block. */
- size_t offset; /* Current offset into the block. */
- off_t filepos; /* Position of next entry to read. */
- char *mask; /* Initial file mask. */
-};
-
-struct dirent
-{
- long d_ino;
- off_t d_off;
- unsigned short int d_reclen;
- unsigned char d_type;
- char d_name[256];
-};
-
-#define d_fileno d_ino /* Backwards compatibility. */
-
-/* This is the data type of directory stream objects.
- The actual structure is opaque to users. */
-
-typedef struct dirstream DIR;
-
-DIR * opendir (const char * name);
-struct dirent * readdir (DIR * dir);
-int closedir (DIR * dir);
-void rewinddir (DIR * dir);
-void seekdir (DIR * dir, off_t offset);
-off_t telldir (DIR * dir);
-int dirfd (DIR * dir);
-
-#endif /* SCM_WIN32_DIRENT_H */
diff --git a/m4/dirname.m4 b/m4/dirname.m4
new file mode 100644
index 000000000..dcec7e489
--- /dev/null
+++ b/m4/dirname.m4
@@ -0,0 +1,19 @@
+#serial 10 -*- autoconf -*-
+dnl Copyright (C) 2002-2006, 2009-2011 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_DIRNAME],
+[
+ AC_REQUIRE([gl_DIRNAME_LGPL])
+])
+
+AC_DEFUN([gl_DIRNAME_LGPL],
+[
+ dnl Prerequisites of lib/dirname.h.
+ AC_REQUIRE([gl_DOUBLE_SLASH_ROOT])
+
+ dnl No prerequisites of lib/basename-lgpl.c, lib/dirname-lgpl.c,
+ dnl lib/stripslash.c.
+])
diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4
index 64dfef04b..a0d0ff843 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -15,7 +15,7 @@
# Specification in the form of a command-line invocation:
-# gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap canonicalize-lgpl ceil close connect duplocale environ extensions flock floor fpieee frexp full-read full-write func gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring listen locale log1p maintainer-makefile malloc-gnu malloca nproc open pipe2 putenv recv recvfrom send sendto setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat trunc verify vsnprintf warnings wchar
+# gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap canonicalize-lgpl ceil close connect duplocale environ extensions flock floor fpieee frexp full-read full-write func gendocs getaddrinfo getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring listen locale log1p maintainer-makefile malloc-gnu malloca nproc open pipe2 putenv recv recvfrom rename send sendto setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat trunc verify vsnprintf warnings wchar
# Specification in the form of a few gnulib-tool.m4 macro invocations:
gl_LOCAL_DIR([])
@@ -72,6 +72,7 @@ gl_MODULES([
putenv
recv
recvfrom
+ rename
send
sendto
setsockopt
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 79f61fb3d..f532ac6d7 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -46,7 +46,9 @@ AC_DEFUN([gl_EARLY],
# Code from module ceil:
# Code from module close:
# Code from module connect:
+ # Code from module dirname-lgpl:
# Code from module dosname:
+ # Code from module double-slash-root:
# Code from module duplocale:
# Code from module environ:
# Code from module errno:
@@ -130,8 +132,11 @@ AC_DEFUN([gl_EARLY],
# Code from module readlink:
# Code from module recv:
# Code from module recvfrom:
+ # Code from module rename:
+ # Code from module rmdir:
# Code from module safe-read:
# Code from module safe-write:
+ # Code from module same-inode:
# Code from module send:
# Code from module sendto:
# Code from module servent:
@@ -230,6 +235,8 @@ if test "$ac_cv_header_winsock2_h" = yes; then
AC_LIBOBJ([connect])
fi
gl_SYS_SOCKET_MODULE_INDICATOR([connect])
+gl_DIRNAME_LGPL
+gl_DOUBLE_SLASH_ROOT
gl_FUNC_DUPLOCALE
if test $REPLACE_DUPLOCALE = 1; then
AC_LIBOBJ([duplocale])
@@ -472,6 +479,16 @@ if test "$ac_cv_header_winsock2_h" = yes; then
AC_LIBOBJ([recvfrom])
fi
gl_SYS_SOCKET_MODULE_INDICATOR([recvfrom])
+gl_FUNC_RENAME
+if test $REPLACE_RENAME = 1; then
+ AC_LIBOBJ([rename])
+fi
+gl_STDIO_MODULE_INDICATOR([rename])
+gl_FUNC_RMDIR
+if test $REPLACE_RMDIR = 1; then
+ AC_LIBOBJ([rmdir])
+fi
+gl_UNISTD_MODULE_INDICATOR([rmdir])
gl_PREREQ_SAFE_READ
gl_PREREQ_SAFE_WRITE
AC_REQUIRE([gl_HEADER_SYS_SOCKET])
@@ -736,6 +753,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/alloca.in.h
lib/arpa_inet.in.h
lib/asnprintf.c
+ lib/basename-lgpl.c
lib/binary-io.h
lib/bind.c
lib/byteswap.in.h
@@ -749,6 +767,8 @@ AC_DEFUN([gl_FILE_LIST], [
lib/ceil.c
lib/close.c
lib/connect.c
+ lib/dirname-lgpl.c
+ lib/dirname.h
lib/dosname.h
lib/duplocale.c
lib/errno.in.h
@@ -825,10 +845,13 @@ AC_DEFUN([gl_FILE_LIST], [
lib/readlink.c
lib/recv.c
lib/recvfrom.c
+ lib/rename.c
+ lib/rmdir.c
lib/safe-read.c
lib/safe-read.h
lib/safe-write.c
lib/safe-write.h
+ lib/same-inode.h
lib/send.c
lib/sendto.c
lib/setsockopt.c
@@ -851,6 +874,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/striconveh.c
lib/striconveh.h
lib/string.in.h
+ lib/stripslash.c
lib/sys_file.in.h
lib/sys_socket.in.h
lib/sys_stat.in.h
@@ -888,6 +912,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/ceil.m4
m4/check-math-lib.m4
m4/close.m4
+ m4/dirname.m4
m4/double-slash-root.m4
m4/duplocale.m4
m4/eealloc.m4
@@ -961,6 +986,8 @@ AC_DEFUN([gl_FILE_LIST], [
m4/putenv.m4
m4/read.m4
m4/readlink.m4
+ m4/rename.m4
+ m4/rmdir.m4
m4/safe-read.m4
m4/safe-write.m4
m4/servent.m4
diff --git a/m4/rename.m4 b/m4/rename.m4
new file mode 100644
index 000000000..c938b0d00
--- /dev/null
+++ b/m4/rename.m4
@@ -0,0 +1,184 @@
+# serial 24
+
+# Copyright (C) 2001, 2003, 2005-2006, 2009-2011 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Volker Borchert.
+dnl Determine whether rename works for source file names with a trailing slash.
+dnl The rename from SunOS 4.1.1_U1 doesn't.
+dnl
+dnl If it doesn't, then define RENAME_TRAILING_SLASH_BUG and arrange
+dnl to compile the wrapper function.
+dnl
+
+AC_DEFUN([gl_FUNC_RENAME],
+[
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ AC_REQUIRE([gl_STDIO_H_DEFAULTS])
+ AC_CHECK_FUNCS_ONCE([lstat])
+
+ dnl Solaris 10, AIX 7.1 mistakenly allow rename("file","name/").
+ dnl NetBSD 1.6 mistakenly forbids rename("dir","name/").
+ dnl FreeBSD 7.2 mistakenly allows rename("file","link-to-file/").
+ dnl The Solaris bug can be worked around without stripping
+ dnl trailing slash, while the NetBSD bug requires stripping;
+ dnl the two conditions can be distinguished by whether hard
+ dnl links are also broken.
+ AC_CACHE_CHECK([whether rename honors trailing slash on destination],
+ [gl_cv_func_rename_slash_dst_works],
+ [rm -rf conftest.f conftest.f1 conftest.f2 conftest.d1 conftest.d2 conftest.lnk
+ touch conftest.f && touch conftest.f1 && mkdir conftest.d1 ||
+ AC_MSG_ERROR([cannot create temporary files])
+ # Assume that if we have lstat, we can also check symlinks.
+ if test $ac_cv_func_lstat = yes; then
+ ln -s conftest.f conftest.lnk
+ fi
+ AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM([[
+# include <stdio.h>
+# include <stdlib.h>
+ ]],
+ [[int result = 0;
+ if (rename ("conftest.f1", "conftest.f2/") == 0)
+ result |= 1;
+ if (rename ("conftest.d1", "conftest.d2/") != 0)
+ result |= 2;
+#if HAVE_LSTAT
+ if (rename ("conftest.f", "conftest.lnk/") == 0)
+ result |= 4;
+#endif
+ return result;
+ ]])],
+ [gl_cv_func_rename_slash_dst_works=yes],
+ [gl_cv_func_rename_slash_dst_works=no],
+ dnl When crosscompiling, assume rename is broken.
+ [gl_cv_func_rename_slash_dst_works="guessing no"])
+ rm -rf conftest.f conftest.f1 conftest.f2 conftest.d1 conftest.d2 conftest.lnk
+ ])
+ if test "x$gl_cv_func_rename_slash_dst_works" != xyes; then
+ REPLACE_RENAME=1
+ AC_DEFINE([RENAME_TRAILING_SLASH_DEST_BUG], [1],
+ [Define if rename does not correctly handle slashes on the destination
+ argument, such as on Solaris 10 or NetBSD 1.6.])
+ fi
+
+ dnl SunOS 4.1.1_U1 mistakenly forbids rename("dir/","name").
+ dnl Solaris 9 mistakenly allows rename("file/","name").
+ dnl FreeBSD 7.2 mistakenly allows rename("link-to-file/","name").
+ dnl These bugs require stripping trailing slash to avoid corrupting
+ dnl symlinks with a trailing slash.
+ AC_CACHE_CHECK([whether rename honors trailing slash on source],
+ [gl_cv_func_rename_slash_src_works],
+ [rm -rf conftest.f conftest.f1 conftest.d1 conftest.d2 conftest.d3 conftest.lnk
+ touch conftest.f && touch conftest.f1 && mkdir conftest.d1 ||
+ AC_MSG_ERROR([cannot create temporary files])
+ # Assume that if we have lstat, we can also check symlinks.
+ if test $ac_cv_func_lstat = yes; then
+ ln -s conftest.f conftest.lnk
+ fi
+ AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM([[
+# include <stdio.h>
+# include <stdlib.h>
+ ]],
+ [[int result = 0;
+ if (rename ("conftest.f1/", "conftest.d3") == 0)
+ result |= 1;
+ if (rename ("conftest.d1/", "conftest.d2") != 0)
+ result |= 2;
+#if HAVE_LSTAT
+ if (rename ("conftest.lnk/", "conftest.f") == 0)
+ result |= 4;
+#endif
+ return result;
+ ]])],
+ [gl_cv_func_rename_slash_src_works=yes],
+ [gl_cv_func_rename_slash_src_works=no],
+ dnl When crosscompiling, assume rename is broken.
+ [gl_cv_func_rename_slash_src_works="guessing no"])
+ rm -rf conftest.f conftest.f1 conftest.d1 conftest.d2 conftest.d3 conftest.lnk
+ ])
+ if test "x$gl_cv_func_rename_slash_src_works" != xyes; then
+ REPLACE_RENAME=1
+ AC_DEFINE([RENAME_TRAILING_SLASH_SOURCE_BUG], [1],
+ [Define if rename does not correctly handle slashes on the source
+ argument, such as on Solaris 9 or cygwin 1.5.])
+ fi
+
+ dnl NetBSD 1.6 and cygwin 1.5.x mistakenly reduce hard link count
+ dnl on rename("h1","h2").
+ dnl This bug requires stat'ting targets prior to attempting rename.
+ AC_CACHE_CHECK([whether rename manages hard links correctly],
+ [gl_cv_func_rename_link_works],
+ [rm -rf conftest.f conftest.f1
+ if touch conftest.f && ln conftest.f conftest.f1 &&
+ set x `ls -i conftest.f conftest.f1` && test "$2" = "$4"; then
+ AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM([[
+# include <stdio.h>
+# include <stdlib.h>
+# include <unistd.h>
+ ]],
+ [[int result = 0;
+ if (rename ("conftest.f", "conftest.f1"))
+ result |= 1;
+ if (unlink ("conftest.f1"))
+ result |= 2;
+ if (rename ("conftest.f", "conftest.f"))
+ result |= 4;
+ if (rename ("conftest.f1", "conftest.f1") == 0)
+ result |= 8;
+ return result;
+ ]])],
+ [gl_cv_func_rename_link_works=yes],
+ [gl_cv_func_rename_link_works=no],
+ dnl When crosscompiling, assume rename is broken.
+ [gl_cv_func_rename_link_works="guessing no"])
+ else
+ gl_cv_func_rename_link_works="guessing no"
+ fi
+ rm -rf conftest.f conftest.f1
+ ])
+ if test "x$gl_cv_func_rename_link_works" != xyes; then
+ REPLACE_RENAME=1
+ AC_DEFINE([RENAME_HARD_LINK_BUG], [1],
+ [Define if rename fails to leave hard links alone, as on NetBSD 1.6
+ or Cygwin 1.5.])
+ fi
+
+ dnl Cygwin 1.5.x mistakenly allows rename("dir","file").
+ dnl mingw mistakenly forbids rename("dir1","dir2").
+ dnl These bugs require stripping trailing slash to avoid corrupting
+ dnl symlinks with a trailing slash.
+ AC_CACHE_CHECK([whether rename manages existing destinations correctly],
+ [gl_cv_func_rename_dest_works],
+ [rm -rf conftest.f conftest.d1 conftest.d2
+ touch conftest.f && mkdir conftest.d1 conftest.d2 ||
+ AC_MSG_ERROR([cannot create temporary files])
+ AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM([[
+# include <stdio.h>
+# include <stdlib.h>
+ ]],
+ [[int result = 0;
+ if (rename ("conftest.d1", "conftest.d2") != 0)
+ result |= 1;
+ if (rename ("conftest.d2", "conftest.f") == 0)
+ result |= 2;
+ return result;
+ ]])],
+ [gl_cv_func_rename_dest_works=yes],
+ [gl_cv_func_rename_dest_works=no],
+ dnl When crosscompiling, assume rename is broken.
+ [gl_cv_func_rename_dest_works="guessing no"])
+ rm -rf conftest.f conftest.d1 conftest.d2
+ ])
+ if test "x$gl_cv_func_rename_dest_works" != xyes; then
+ REPLACE_RENAME=1
+ AC_DEFINE([RENAME_DEST_EXISTS_BUG], [1],
+ [Define if rename does not work when the destination file exists,
+ as on Cygwin 1.5 or Windows.])
+ fi
+])
diff --git a/m4/rmdir.m4 b/m4/rmdir.m4
new file mode 100644
index 000000000..5284c7ef0
--- /dev/null
+++ b/m4/rmdir.m4
@@ -0,0 +1,34 @@
+# rmdir.m4 serial 11
+dnl Copyright (C) 2002, 2005, 2009-2011 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_RMDIR],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ dnl Detect cygwin 1.5.x bug.
+ AC_CACHE_CHECK([whether rmdir works], [gl_cv_func_rmdir_works],
+ [mkdir conftest.dir
+ touch conftest.file
+ AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <stdio.h>
+ #include <errno.h>
+ #include <unistd.h>
+]], [[int result = 0;
+ if (!rmdir ("conftest.file/"))
+ result |= 1;
+ else if (errno != ENOTDIR)
+ result |= 2;
+ if (!rmdir ("conftest.dir/./"))
+ result |= 4;
+ return result;
+ ]])],
+ [gl_cv_func_rmdir_works=yes], [gl_cv_func_rmdir_works=no],
+ [gl_cv_func_rmdir_works="guessing no"])
+ rm -rf conftest.dir conftest.file])
+ if test x"$gl_cv_func_rmdir_works" != xyes; then
+ REPLACE_RMDIR=1
+ fi
+])
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 7c9e3c5eb..2d965d8f4 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3411,7 +3411,7 @@ module '(ice-9 q) '(make-q q-length))}."
(define %auto-compilation-options
;; Default `compile-file' option when auto-compiling.
- '(#:warnings (unbound-variable arity-mismatch)))
+ '(#:warnings (unbound-variable arity-mismatch format)))
(define* (load-in-vicinity dir path #:optional reader)
;; Returns the .go file corresponding to `name'. Does not search load
@@ -3470,8 +3470,14 @@ module '(ice-9 q) '(make-q q-length))}."
(else #f))))))
(lambda (k . args)
(format (current-error-port)
- ";;; WARNING: compilation of ~a failed:\n;;; key ~a, throw_args ~s\n"
- name k args)
+ ";;; WARNING: compilation of ~a failed:\n" name)
+ (for-each (lambda (s)
+ (if (not (string-null? s))
+ (format (current-error-port) ";;; ~a\n" s)))
+ (string-split
+ (call-with-output-string
+ (lambda (port) (print-exception port #f k args)))
+ #\newline))
#f)))
(define (absolute-path? path)
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 714308ffb..ffd51d33f 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1143,7 +1143,7 @@
'(eval)
#{mod 1618}#)
#{mod 1618}#))
- #{exps 1595}#))
+ (values #{exps 1595}#)))
(if (memq 'load #{when-list 1656}#)
(if (let ((#{t 1666}#
(memq 'compile
@@ -1179,7 +1179,7 @@
'(load)
#{mod 1618}#
#{exps 1595}#)
- #{exps 1595}#))
+ (values #{exps 1595}#)))
(if (let ((#{t 1677}#
(memq 'compile
#{when-list 1656}#)))
@@ -1206,8 +1206,8 @@
'(eval)
#{mod 1618}#)
#{mod 1618}#)
- #{exps 1595}#)
- #{exps 1595}#)))))
+ (values #{exps 1595}#))
+ (values #{exps 1595}#))))))
#{tmp 1647}#)
(syntax-violation
#f
@@ -1235,18 +1235,20 @@
#{e 1692}#
#{mod 1618}#)
(if (memq 'load #{esew 1593}#)
- (cons #{e 1692}# #{exps 1595}#)
- #{exps 1595}#)))
+ (values
+ (cons #{e 1692}# #{exps 1595}#))
+ (values #{exps 1595}#))))
(if (memq 'load #{esew 1593}#)
- (cons (#{chi-install-global 417}#
- #{n 1688}#
- (#{chi 423}#
- #{e 1615}#
- #{r 1689}#
- #{w 1616}#
- #{mod 1618}#))
- #{exps 1595}#)
- #{exps 1595}#))
+ (values
+ (cons (#{chi-install-global 417}#
+ #{n 1688}#
+ (#{chi 423}#
+ #{e 1615}#
+ #{r 1689}#
+ #{w 1616}#
+ #{mod 1618}#))
+ #{exps 1595}#))
+ (values #{exps 1595}#)))
(if (memv #{m 1592}# '(c&e))
(let ((#{e 1695}#
(#{chi-install-global 417}#
@@ -1260,7 +1262,8 @@
(#{top-level-eval-hook 252}#
#{e 1695}#
#{mod 1618}#)
- (cons #{e 1695}# #{exps 1595}#)))
+ (values
+ (cons #{e 1695}# #{exps 1595}#))))
(begin
(if (memq 'eval #{esew 1593}#)
(#{top-level-eval-hook 252}#
@@ -1272,7 +1275,7 @@
#{w 1616}#
#{mod 1618}#))
#{mod 1618}#))
- #{exps 1595}#))))
+ (values #{exps 1595}#)))))
(if (memv #{type 1613}# '(define-form))
(let ((#{n 1700}#
(#{id-var-name 397}#
@@ -1312,31 +1315,32 @@
(current-module)
#{n 1700}#
(make-undefined-variable)))))
- (cons (if (eq? #{m 1592}# 'c&e)
- (let ((#{x 1713}#
- (#{build-global-definition 283}#
- #{s 1617}#
- #{n 1700}#
- (#{chi 423}#
- #{e 1615}#
- #{r 1589}#
- #{w 1616}#
- #{mod 1618}#))))
- (begin
- (#{top-level-eval-hook 252}#
- #{x 1713}#
- #{mod 1618}#)
- #{x 1713}#))
- (lambda ()
- (#{build-global-definition 283}#
- #{s 1617}#
- #{n 1700}#
- (#{chi 423}#
- #{e 1615}#
- #{r 1589}#
- #{w 1616}#
- #{mod 1618}#))))
- #{exps 1595}#))
+ (values
+ (cons (if (eq? #{m 1592}# 'c&e)
+ (let ((#{x 1713}#
+ (#{build-global-definition 283}#
+ #{s 1617}#
+ #{n 1700}#
+ (#{chi 423}#
+ #{e 1615}#
+ #{r 1589}#
+ #{w 1616}#
+ #{mod 1618}#))))
+ (begin
+ (#{top-level-eval-hook 252}#
+ #{x 1713}#
+ #{mod 1618}#)
+ #{x 1713}#))
+ (lambda ()
+ (#{build-global-definition 283}#
+ #{s 1617}#
+ #{n 1700}#
+ (#{chi 423}#
+ #{e 1615}#
+ #{r 1589}#
+ #{w 1616}#
+ #{mod 1618}#))))
+ #{exps 1595}#)))
(if (memv #{type 1702}#
'(displaced-lexical))
(syntax-violation
@@ -1355,31 +1359,32 @@
#{value 1614}#
#{w 1616}#
#{mod 1618}#))))))
- (cons (if (eq? #{m 1592}# 'c&e)
- (let ((#{x 1718}#
- (#{chi-expr 425}#
- #{type 1613}#
- #{value 1614}#
- #{e 1615}#
- #{r 1589}#
- #{w 1616}#
- #{s 1617}#
- #{mod 1618}#)))
- (begin
- (#{top-level-eval-hook 252}#
- #{x 1718}#
- #{mod 1618}#)
- #{x 1718}#))
- (lambda ()
- (#{chi-expr 425}#
- #{type 1613}#
- #{value 1614}#
- #{e 1615}#
- #{r 1589}#
- #{w 1616}#
- #{s 1617}#
- #{mod 1618}#)))
- #{exps 1595}#)))))))))
+ (values
+ (cons (if (eq? #{m 1592}# 'c&e)
+ (let ((#{x 1718}#
+ (#{chi-expr 425}#
+ #{type 1613}#
+ #{value 1614}#
+ #{e 1615}#
+ #{r 1589}#
+ #{w 1616}#
+ #{s 1617}#
+ #{mod 1618}#)))
+ (begin
+ (#{top-level-eval-hook 252}#
+ #{x 1718}#
+ #{mod 1618}#)
+ #{x 1718}#))
+ (lambda ()
+ (#{chi-expr 425}#
+ #{type 1613}#
+ #{value 1614}#
+ #{e 1615}#
+ #{r 1589}#
+ #{w 1616}#
+ #{s 1617}#
+ #{mod 1618}#)))
+ #{exps 1595}#))))))))))
(lambda (#{exps 1719}#)
(#{scan 1587}#
(cdr #{body 1588}#)
@@ -13541,377 +13546,379 @@
'generate-temporaries
"invalid argument"
#{x 3972}#)))
- (map (lambda (#{x 3973}#)
- (#{wrap 409}# (gensym) '((top)) #f))
- #{ls 3968}#))))
+ (let ((#{mod 3974}#
+ (cons 'hygiene (module-name (current-module)))))
+ (map (lambda (#{x 3975}#)
+ (#{wrap 409}# (gensym) '((top)) #{mod 3974}#))
+ #{ls 3968}#)))))
(set! free-identifier=?
- (lambda (#{x 3977}# #{y 3978}#)
+ (lambda (#{x 3979}# #{y 3980}#)
(begin
- (let ((#{x 3983}# #{x 3977}#))
- (if (not (#{nonsymbol-id? 341}# #{x 3983}#))
+ (let ((#{x 3985}# #{x 3979}#))
+ (if (not (#{nonsymbol-id? 341}# #{x 3985}#))
(syntax-violation
'free-identifier=?
"invalid argument"
- #{x 3983}#)))
- (let ((#{x 3986}# #{y 3978}#))
- (if (not (#{nonsymbol-id? 341}# #{x 3986}#))
+ #{x 3985}#)))
+ (let ((#{x 3988}# #{y 3980}#))
+ (if (not (#{nonsymbol-id? 341}# #{x 3988}#))
(syntax-violation
'free-identifier=?
"invalid argument"
- #{x 3986}#)))
- (#{free-id=? 399}# #{x 3977}# #{y 3978}#))))
+ #{x 3988}#)))
+ (#{free-id=? 399}# #{x 3979}# #{y 3980}#))))
(set! bound-identifier=?
- (lambda (#{x 3987}# #{y 3988}#)
+ (lambda (#{x 3989}# #{y 3990}#)
(begin
- (let ((#{x 3993}# #{x 3987}#))
- (if (not (#{nonsymbol-id? 341}# #{x 3993}#))
+ (let ((#{x 3995}# #{x 3989}#))
+ (if (not (#{nonsymbol-id? 341}# #{x 3995}#))
(syntax-violation
'bound-identifier=?
"invalid argument"
- #{x 3993}#)))
- (let ((#{x 3996}# #{y 3988}#))
- (if (not (#{nonsymbol-id? 341}# #{x 3996}#))
+ #{x 3995}#)))
+ (let ((#{x 3998}# #{y 3990}#))
+ (if (not (#{nonsymbol-id? 341}# #{x 3998}#))
(syntax-violation
'bound-identifier=?
"invalid argument"
- #{x 3996}#)))
- (#{bound-id=? 401}# #{x 3987}# #{y 3988}#))))
+ #{x 3998}#)))
+ (#{bound-id=? 401}# #{x 3989}# #{y 3990}#))))
(set! syntax-violation
(lambda*
- (#{who 3997}#
- #{message 3998}#
- #{form 3999}#
+ (#{who 3999}#
+ #{message 4000}#
+ #{form 4001}#
#:optional
- (#{subform 4003}# #f))
+ (#{subform 4005}# #f))
(begin
- (let ((#{x 4007}# #{who 3997}#))
- (if (not (let ((#{x 4008}# #{x 4007}#))
- (let ((#{t 4012}# (not #{x 4008}#)))
- (if #{t 4012}#
- #{t 4012}#
- (let ((#{t 4015}# (string? #{x 4008}#)))
- (if #{t 4015}#
- #{t 4015}#
- (symbol? #{x 4008}#)))))))
+ (let ((#{x 4009}# #{who 3999}#))
+ (if (not (let ((#{x 4010}# #{x 4009}#))
+ (let ((#{t 4014}# (not #{x 4010}#)))
+ (if #{t 4014}#
+ #{t 4014}#
+ (let ((#{t 4017}# (string? #{x 4010}#)))
+ (if #{t 4017}#
+ #{t 4017}#
+ (symbol? #{x 4010}#)))))))
(syntax-violation
'syntax-violation
"invalid argument"
- #{x 4007}#)))
- (let ((#{x 4019}# #{message 3998}#))
- (if (not (string? #{x 4019}#))
+ #{x 4009}#)))
+ (let ((#{x 4021}# #{message 4000}#))
+ (if (not (string? #{x 4021}#))
(syntax-violation
'syntax-violation
"invalid argument"
- #{x 4019}#)))
+ #{x 4021}#)))
(throw 'syntax-error
- #{who 3997}#
- #{message 3998}#
+ #{who 3999}#
+ #{message 4000}#
(#{source-annotation 324}#
- (let ((#{t 4022}# #{form 3999}#))
- (if #{t 4022}# #{t 4022}# #{subform 4003}#)))
- (#{strip 449}# #{form 3999}# '(()))
- (if #{subform 4003}#
- (#{strip 449}# #{subform 4003}# '(()))
+ (let ((#{t 4024}# #{form 4001}#))
+ (if #{t 4024}# #{t 4024}# #{subform 4005}#)))
+ (#{strip 449}# #{form 4001}# '(()))
+ (if #{subform 4005}#
+ (#{strip 449}# #{subform 4005}# '(()))
#f)))))
(letrec*
- ((#{match-each 4029}#
- (lambda (#{e 4042}# #{p 4043}# #{w 4044}# #{mod 4045}#)
- (if (pair? #{e 4042}#)
- (let ((#{first 4053}#
- (#{match 4041}#
- (car #{e 4042}#)
- #{p 4043}#
- #{w 4044}#
+ ((#{match-each 4031}#
+ (lambda (#{e 4044}# #{p 4045}# #{w 4046}# #{mod 4047}#)
+ (if (pair? #{e 4044}#)
+ (let ((#{first 4055}#
+ (#{match 4043}#
+ (car #{e 4044}#)
+ #{p 4045}#
+ #{w 4046}#
'()
- #{mod 4045}#)))
- (if #{first 4053}#
- (let ((#{rest 4057}#
- (#{match-each 4029}#
- (cdr #{e 4042}#)
- #{p 4043}#
- #{w 4044}#
- #{mod 4045}#)))
- (if #{rest 4057}#
- (cons #{first 4053}# #{rest 4057}#)
+ #{mod 4047}#)))
+ (if #{first 4055}#
+ (let ((#{rest 4059}#
+ (#{match-each 4031}#
+ (cdr #{e 4044}#)
+ #{p 4045}#
+ #{w 4046}#
+ #{mod 4047}#)))
+ (if #{rest 4059}#
+ (cons #{first 4055}# #{rest 4059}#)
#f))
#f))
- (if (null? #{e 4042}#)
+ (if (null? #{e 4044}#)
'()
- (if (#{syntax-object? 309}# #{e 4042}#)
- (#{match-each 4029}#
- (#{syntax-object-expression 311}# #{e 4042}#)
- #{p 4043}#
+ (if (#{syntax-object? 309}# #{e 4044}#)
+ (#{match-each 4031}#
+ (#{syntax-object-expression 311}# #{e 4044}#)
+ #{p 4045}#
(#{join-wraps 391}#
- #{w 4044}#
- (#{syntax-object-wrap 313}# #{e 4042}#))
- (#{syntax-object-module 315}# #{e 4042}#))
+ #{w 4046}#
+ (#{syntax-object-wrap 313}# #{e 4044}#))
+ (#{syntax-object-module 315}# #{e 4044}#))
#f)))))
- (#{match-each+ 4031}#
- (lambda (#{e 4065}#
- #{x-pat 4066}#
- #{y-pat 4067}#
- #{z-pat 4068}#
- #{w 4069}#
- #{r 4070}#
- #{mod 4071}#)
+ (#{match-each+ 4033}#
+ (lambda (#{e 4067}#
+ #{x-pat 4068}#
+ #{y-pat 4069}#
+ #{z-pat 4070}#
+ #{w 4071}#
+ #{r 4072}#
+ #{mod 4073}#)
(letrec*
- ((#{f 4082}#
- (lambda (#{e 4083}# #{w 4084}#)
- (if (pair? #{e 4083}#)
+ ((#{f 4084}#
+ (lambda (#{e 4085}# #{w 4086}#)
+ (if (pair? #{e 4085}#)
(call-with-values
(lambda ()
- (#{f 4082}# (cdr #{e 4083}#) #{w 4084}#))
- (lambda (#{xr* 4087}# #{y-pat 4088}# #{r 4089}#)
- (if #{r 4089}#
- (if (null? #{y-pat 4088}#)
- (let ((#{xr 4094}#
- (#{match 4041}#
- (car #{e 4083}#)
- #{x-pat 4066}#
- #{w 4084}#
+ (#{f 4084}# (cdr #{e 4085}#) #{w 4086}#))
+ (lambda (#{xr* 4089}# #{y-pat 4090}# #{r 4091}#)
+ (if #{r 4091}#
+ (if (null? #{y-pat 4090}#)
+ (let ((#{xr 4096}#
+ (#{match 4043}#
+ (car #{e 4085}#)
+ #{x-pat 4068}#
+ #{w 4086}#
'()
- #{mod 4071}#)))
- (if #{xr 4094}#
+ #{mod 4073}#)))
+ (if #{xr 4096}#
(values
- (cons #{xr 4094}# #{xr* 4087}#)
- #{y-pat 4088}#
- #{r 4089}#)
+ (cons #{xr 4096}# #{xr* 4089}#)
+ #{y-pat 4090}#
+ #{r 4091}#)
(values #f #f #f)))
(values
'()
- (cdr #{y-pat 4088}#)
- (#{match 4041}#
- (car #{e 4083}#)
- (car #{y-pat 4088}#)
- #{w 4084}#
- #{r 4089}#
- #{mod 4071}#)))
+ (cdr #{y-pat 4090}#)
+ (#{match 4043}#
+ (car #{e 4085}#)
+ (car #{y-pat 4090}#)
+ #{w 4086}#
+ #{r 4091}#
+ #{mod 4073}#)))
(values #f #f #f))))
- (if (#{syntax-object? 309}# #{e 4083}#)
- (#{f 4082}#
- (#{syntax-object-expression 311}# #{e 4083}#)
- (#{join-wraps 391}# #{w 4084}# #{e 4083}#))
+ (if (#{syntax-object? 309}# #{e 4085}#)
+ (#{f 4084}#
+ (#{syntax-object-expression 311}# #{e 4085}#)
+ (#{join-wraps 391}# #{w 4086}# #{e 4085}#))
(values
'()
- #{y-pat 4067}#
- (#{match 4041}#
- #{e 4083}#
- #{z-pat 4068}#
- #{w 4084}#
- #{r 4070}#
- #{mod 4071}#)))))))
- (#{f 4082}# #{e 4065}# #{w 4069}#))))
- (#{match-each-any 4033}#
- (lambda (#{e 4098}# #{w 4099}# #{mod 4100}#)
- (if (pair? #{e 4098}#)
- (let ((#{l 4107}#
- (#{match-each-any 4033}#
- (cdr #{e 4098}#)
- #{w 4099}#
- #{mod 4100}#)))
- (if #{l 4107}#
+ #{y-pat 4069}#
+ (#{match 4043}#
+ #{e 4085}#
+ #{z-pat 4070}#
+ #{w 4086}#
+ #{r 4072}#
+ #{mod 4073}#)))))))
+ (#{f 4084}# #{e 4067}# #{w 4071}#))))
+ (#{match-each-any 4035}#
+ (lambda (#{e 4100}# #{w 4101}# #{mod 4102}#)
+ (if (pair? #{e 4100}#)
+ (let ((#{l 4109}#
+ (#{match-each-any 4035}#
+ (cdr #{e 4100}#)
+ #{w 4101}#
+ #{mod 4102}#)))
+ (if #{l 4109}#
(cons (#{wrap 409}#
- (car #{e 4098}#)
- #{w 4099}#
- #{mod 4100}#)
- #{l 4107}#)
+ (car #{e 4100}#)
+ #{w 4101}#
+ #{mod 4102}#)
+ #{l 4109}#)
#f))
- (if (null? #{e 4098}#)
+ (if (null? #{e 4100}#)
'()
- (if (#{syntax-object? 309}# #{e 4098}#)
- (#{match-each-any 4033}#
- (#{syntax-object-expression 311}# #{e 4098}#)
+ (if (#{syntax-object? 309}# #{e 4100}#)
+ (#{match-each-any 4035}#
+ (#{syntax-object-expression 311}# #{e 4100}#)
(#{join-wraps 391}#
- #{w 4099}#
- (#{syntax-object-wrap 313}# #{e 4098}#))
- #{mod 4100}#)
+ #{w 4101}#
+ (#{syntax-object-wrap 313}# #{e 4100}#))
+ #{mod 4102}#)
#f)))))
- (#{match-empty 4035}#
- (lambda (#{p 4115}# #{r 4116}#)
- (if (null? #{p 4115}#)
- #{r 4116}#
- (if (eq? #{p 4115}# '_)
- #{r 4116}#
- (if (eq? #{p 4115}# 'any)
- (cons '() #{r 4116}#)
- (if (pair? #{p 4115}#)
- (#{match-empty 4035}#
- (car #{p 4115}#)
- (#{match-empty 4035}#
- (cdr #{p 4115}#)
- #{r 4116}#))
- (if (eq? #{p 4115}# 'each-any)
- (cons '() #{r 4116}#)
- (let ((#{atom-key 4132}# (vector-ref #{p 4115}# 0)))
- (if (memv #{atom-key 4132}# '(each))
- (#{match-empty 4035}#
- (vector-ref #{p 4115}# 1)
- #{r 4116}#)
- (if (memv #{atom-key 4132}# '(each+))
- (#{match-empty 4035}#
- (vector-ref #{p 4115}# 1)
- (#{match-empty 4035}#
- (reverse (vector-ref #{p 4115}# 2))
- (#{match-empty 4035}#
- (vector-ref #{p 4115}# 3)
- #{r 4116}#)))
- (if (memv #{atom-key 4132}# '(free-id atom))
- #{r 4116}#
- (if (memv #{atom-key 4132}# '(vector))
- (#{match-empty 4035}#
- (vector-ref #{p 4115}# 1)
- #{r 4116}#)))))))))))))
- (#{combine 4037}#
- (lambda (#{r* 4137}# #{r 4138}#)
- (if (null? (car #{r* 4137}#))
- #{r 4138}#
- (cons (map car #{r* 4137}#)
- (#{combine 4037}#
- (map cdr #{r* 4137}#)
- #{r 4138}#)))))
- (#{match* 4039}#
- (lambda (#{e 4141}#
- #{p 4142}#
- #{w 4143}#
- #{r 4144}#
- #{mod 4145}#)
- (if (null? #{p 4142}#)
- (if (null? #{e 4141}#) #{r 4144}# #f)
- (if (pair? #{p 4142}#)
- (if (pair? #{e 4141}#)
- (#{match 4041}#
- (car #{e 4141}#)
- (car #{p 4142}#)
- #{w 4143}#
- (#{match 4041}#
- (cdr #{e 4141}#)
- (cdr #{p 4142}#)
- #{w 4143}#
- #{r 4144}#
- #{mod 4145}#)
- #{mod 4145}#)
+ (#{match-empty 4037}#
+ (lambda (#{p 4117}# #{r 4118}#)
+ (if (null? #{p 4117}#)
+ #{r 4118}#
+ (if (eq? #{p 4117}# '_)
+ #{r 4118}#
+ (if (eq? #{p 4117}# 'any)
+ (cons '() #{r 4118}#)
+ (if (pair? #{p 4117}#)
+ (#{match-empty 4037}#
+ (car #{p 4117}#)
+ (#{match-empty 4037}#
+ (cdr #{p 4117}#)
+ #{r 4118}#))
+ (if (eq? #{p 4117}# 'each-any)
+ (cons '() #{r 4118}#)
+ (let ((#{atom-key 4134}# (vector-ref #{p 4117}# 0)))
+ (if (memv #{atom-key 4134}# '(each))
+ (#{match-empty 4037}#
+ (vector-ref #{p 4117}# 1)
+ #{r 4118}#)
+ (if (memv #{atom-key 4134}# '(each+))
+ (#{match-empty 4037}#
+ (vector-ref #{p 4117}# 1)
+ (#{match-empty 4037}#
+ (reverse (vector-ref #{p 4117}# 2))
+ (#{match-empty 4037}#
+ (vector-ref #{p 4117}# 3)
+ #{r 4118}#)))
+ (if (memv #{atom-key 4134}# '(free-id atom))
+ #{r 4118}#
+ (if (memv #{atom-key 4134}# '(vector))
+ (#{match-empty 4037}#
+ (vector-ref #{p 4117}# 1)
+ #{r 4118}#)))))))))))))
+ (#{combine 4039}#
+ (lambda (#{r* 4139}# #{r 4140}#)
+ (if (null? (car #{r* 4139}#))
+ #{r 4140}#
+ (cons (map car #{r* 4139}#)
+ (#{combine 4039}#
+ (map cdr #{r* 4139}#)
+ #{r 4140}#)))))
+ (#{match* 4041}#
+ (lambda (#{e 4143}#
+ #{p 4144}#
+ #{w 4145}#
+ #{r 4146}#
+ #{mod 4147}#)
+ (if (null? #{p 4144}#)
+ (if (null? #{e 4143}#) #{r 4146}# #f)
+ (if (pair? #{p 4144}#)
+ (if (pair? #{e 4143}#)
+ (#{match 4043}#
+ (car #{e 4143}#)
+ (car #{p 4144}#)
+ #{w 4145}#
+ (#{match 4043}#
+ (cdr #{e 4143}#)
+ (cdr #{p 4144}#)
+ #{w 4145}#
+ #{r 4146}#
+ #{mod 4147}#)
+ #{mod 4147}#)
#f)
- (if (eq? #{p 4142}# 'each-any)
- (let ((#{l 4162}#
- (#{match-each-any 4033}#
- #{e 4141}#
- #{w 4143}#
- #{mod 4145}#)))
- (if #{l 4162}# (cons #{l 4162}# #{r 4144}#) #f))
- (let ((#{atom-key 4168}# (vector-ref #{p 4142}# 0)))
- (if (memv #{atom-key 4168}# '(each))
- (if (null? #{e 4141}#)
- (#{match-empty 4035}#
- (vector-ref #{p 4142}# 1)
- #{r 4144}#)
- (let ((#{l 4171}#
- (#{match-each 4029}#
- #{e 4141}#
- (vector-ref #{p 4142}# 1)
- #{w 4143}#
- #{mod 4145}#)))
- (if #{l 4171}#
+ (if (eq? #{p 4144}# 'each-any)
+ (let ((#{l 4164}#
+ (#{match-each-any 4035}#
+ #{e 4143}#
+ #{w 4145}#
+ #{mod 4147}#)))
+ (if #{l 4164}# (cons #{l 4164}# #{r 4146}#) #f))
+ (let ((#{atom-key 4170}# (vector-ref #{p 4144}# 0)))
+ (if (memv #{atom-key 4170}# '(each))
+ (if (null? #{e 4143}#)
+ (#{match-empty 4037}#
+ (vector-ref #{p 4144}# 1)
+ #{r 4146}#)
+ (let ((#{l 4173}#
+ (#{match-each 4031}#
+ #{e 4143}#
+ (vector-ref #{p 4144}# 1)
+ #{w 4145}#
+ #{mod 4147}#)))
+ (if #{l 4173}#
(letrec*
- ((#{collect 4176}#
- (lambda (#{l 4177}#)
- (if (null? (car #{l 4177}#))
- #{r 4144}#
- (cons (map car #{l 4177}#)
- (#{collect 4176}#
- (map cdr #{l 4177}#)))))))
- (#{collect 4176}# #{l 4171}#))
+ ((#{collect 4178}#
+ (lambda (#{l 4179}#)
+ (if (null? (car #{l 4179}#))
+ #{r 4146}#
+ (cons (map car #{l 4179}#)
+ (#{collect 4178}#
+ (map cdr #{l 4179}#)))))))
+ (#{collect 4178}# #{l 4173}#))
#f)))
- (if (memv #{atom-key 4168}# '(each+))
+ (if (memv #{atom-key 4170}# '(each+))
(call-with-values
(lambda ()
- (#{match-each+ 4031}#
- #{e 4141}#
- (vector-ref #{p 4142}# 1)
- (vector-ref #{p 4142}# 2)
- (vector-ref #{p 4142}# 3)
- #{w 4143}#
- #{r 4144}#
- #{mod 4145}#))
- (lambda (#{xr* 4179}# #{y-pat 4180}# #{r 4181}#)
- (if #{r 4181}#
- (if (null? #{y-pat 4180}#)
- (if (null? #{xr* 4179}#)
- (#{match-empty 4035}#
- (vector-ref #{p 4142}# 1)
- #{r 4181}#)
- (#{combine 4037}# #{xr* 4179}# #{r 4181}#))
+ (#{match-each+ 4033}#
+ #{e 4143}#
+ (vector-ref #{p 4144}# 1)
+ (vector-ref #{p 4144}# 2)
+ (vector-ref #{p 4144}# 3)
+ #{w 4145}#
+ #{r 4146}#
+ #{mod 4147}#))
+ (lambda (#{xr* 4181}# #{y-pat 4182}# #{r 4183}#)
+ (if #{r 4183}#
+ (if (null? #{y-pat 4182}#)
+ (if (null? #{xr* 4181}#)
+ (#{match-empty 4037}#
+ (vector-ref #{p 4144}# 1)
+ #{r 4183}#)
+ (#{combine 4039}# #{xr* 4181}# #{r 4183}#))
#f)
#f)))
- (if (memv #{atom-key 4168}# '(free-id))
- (if (#{id? 343}# #{e 4141}#)
+ (if (memv #{atom-key 4170}# '(free-id))
+ (if (#{id? 343}# #{e 4143}#)
(if (#{free-id=? 399}#
(#{wrap 409}#
- #{e 4141}#
- #{w 4143}#
- #{mod 4145}#)
- (vector-ref #{p 4142}# 1))
- #{r 4144}#
+ #{e 4143}#
+ #{w 4145}#
+ #{mod 4147}#)
+ (vector-ref #{p 4144}# 1))
+ #{r 4146}#
#f)
#f)
- (if (memv #{atom-key 4168}# '(atom))
+ (if (memv #{atom-key 4170}# '(atom))
(if (equal?
- (vector-ref #{p 4142}# 1)
- (#{strip 449}# #{e 4141}# #{w 4143}#))
- #{r 4144}#
+ (vector-ref #{p 4144}# 1)
+ (#{strip 449}# #{e 4143}# #{w 4145}#))
+ #{r 4146}#
#f)
- (if (memv #{atom-key 4168}# '(vector))
- (if (vector? #{e 4141}#)
- (#{match 4041}#
- (vector->list #{e 4141}#)
- (vector-ref #{p 4142}# 1)
- #{w 4143}#
- #{r 4144}#
- #{mod 4145}#)
+ (if (memv #{atom-key 4170}# '(vector))
+ (if (vector? #{e 4143}#)
+ (#{match 4043}#
+ (vector->list #{e 4143}#)
+ (vector-ref #{p 4144}# 1)
+ #{w 4145}#
+ #{r 4146}#
+ #{mod 4147}#)
#f))))))))))))
- (#{match 4041}#
- (lambda (#{e 4198}#
- #{p 4199}#
- #{w 4200}#
- #{r 4201}#
- #{mod 4202}#)
- (if (not #{r 4201}#)
+ (#{match 4043}#
+ (lambda (#{e 4200}#
+ #{p 4201}#
+ #{w 4202}#
+ #{r 4203}#
+ #{mod 4204}#)
+ (if (not #{r 4203}#)
#f
- (if (eq? #{p 4199}# '_)
- #{r 4201}#
- (if (eq? #{p 4199}# 'any)
- (cons (#{wrap 409}# #{e 4198}# #{w 4200}# #{mod 4202}#)
- #{r 4201}#)
- (if (#{syntax-object? 309}# #{e 4198}#)
- (#{match* 4039}#
- (#{syntax-object-expression 311}# #{e 4198}#)
- #{p 4199}#
+ (if (eq? #{p 4201}# '_)
+ #{r 4203}#
+ (if (eq? #{p 4201}# 'any)
+ (cons (#{wrap 409}# #{e 4200}# #{w 4202}# #{mod 4204}#)
+ #{r 4203}#)
+ (if (#{syntax-object? 309}# #{e 4200}#)
+ (#{match* 4041}#
+ (#{syntax-object-expression 311}# #{e 4200}#)
+ #{p 4201}#
(#{join-wraps 391}#
- #{w 4200}#
- (#{syntax-object-wrap 313}# #{e 4198}#))
- #{r 4201}#
- (#{syntax-object-module 315}# #{e 4198}#))
- (#{match* 4039}#
- #{e 4198}#
- #{p 4199}#
- #{w 4200}#
- #{r 4201}#
- #{mod 4202}#))))))))
+ #{w 4202}#
+ (#{syntax-object-wrap 313}# #{e 4200}#))
+ #{r 4203}#
+ (#{syntax-object-module 315}# #{e 4200}#))
+ (#{match* 4041}#
+ #{e 4200}#
+ #{p 4201}#
+ #{w 4202}#
+ #{r 4203}#
+ #{mod 4204}#))))))))
(set! $sc-dispatch
- (lambda (#{e 4217}# #{p 4218}#)
- (if (eq? #{p 4218}# 'any)
- (list #{e 4217}#)
- (if (eq? #{p 4218}# '_)
+ (lambda (#{e 4219}# #{p 4220}#)
+ (if (eq? #{p 4220}# 'any)
+ (list #{e 4219}#)
+ (if (eq? #{p 4220}# '_)
'()
- (if (#{syntax-object? 309}# #{e 4217}#)
- (#{match* 4039}#
- (#{syntax-object-expression 311}# #{e 4217}#)
- #{p 4218}#
- (#{syntax-object-wrap 313}# #{e 4217}#)
+ (if (#{syntax-object? 309}# #{e 4219}#)
+ (#{match* 4041}#
+ (#{syntax-object-expression 311}# #{e 4219}#)
+ #{p 4220}#
+ (#{syntax-object-wrap 313}# #{e 4219}#)
'()
- (#{syntax-object-module 315}# #{e 4217}#))
- (#{match* 4039}#
- #{e 4217}#
- #{p 4218}#
+ (#{syntax-object-module 315}# #{e 4219}#))
+ (#{match* 4041}#
+ #{e 4219}#
+ #{p 4220}#
'(())
'()
#f)))))))))
@@ -13920,82 +13927,82 @@
(make-syntax-transformer
'with-syntax
'macro
- (lambda (#{x 4229}#)
- (let ((#{tmp 4231}# #{x 4229}#))
- (let ((#{tmp 4232}#
+ (lambda (#{x 4231}#)
+ (let ((#{tmp 4233}# #{x 4231}#))
+ (let ((#{tmp 4234}#
($sc-dispatch
- #{tmp 4231}#
+ #{tmp 4233}#
'(_ () any . each-any))))
- (if #{tmp 4232}#
+ (if #{tmp 4234}#
(@apply
- (lambda (#{e1 4235}# #{e2 4236}#)
+ (lambda (#{e1 4237}# #{e2 4238}#)
(cons '#(syntax-object
let
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("i4233" "i4234"))
+ #("i4235" "i4236"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4230")))
+ #(ribcage #(x) #((top)) #("i4232")))
(hygiene guile))
- (cons '() (cons #{e1 4235}# #{e2 4236}#))))
- #{tmp 4232}#)
- (let ((#{tmp 4238}#
+ (cons '() (cons #{e1 4237}# #{e2 4238}#))))
+ #{tmp 4234}#)
+ (let ((#{tmp 4240}#
($sc-dispatch
- #{tmp 4231}#
+ #{tmp 4233}#
'(_ ((any any)) any . each-any))))
- (if #{tmp 4238}#
+ (if #{tmp 4240}#
(@apply
- (lambda (#{out 4243}#
- #{in 4244}#
- #{e1 4245}#
- #{e2 4246}#)
+ (lambda (#{out 4245}#
+ #{in 4246}#
+ #{e1 4247}#
+ #{e2 4248}#)
(list '#(syntax-object
syntax-case
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("i4239" "i4240" "i4241" "i4242"))
+ #("i4241" "i4242" "i4243" "i4244"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4230")))
+ #(ribcage #(x) #((top)) #("i4232")))
(hygiene guile))
- #{in 4244}#
+ #{in 4246}#
'()
- (list #{out 4243}#
+ (list #{out 4245}#
(cons '#(syntax-object
let
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("i4239" "i4240" "i4241" "i4242"))
+ #("i4241" "i4242" "i4243" "i4244"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4230")))
+ #(ribcage #(x) #((top)) #("i4232")))
(hygiene guile))
(cons '()
- (cons #{e1 4245}# #{e2 4246}#))))))
- #{tmp 4238}#)
- (let ((#{tmp 4248}#
+ (cons #{e1 4247}# #{e2 4248}#))))))
+ #{tmp 4240}#)
+ (let ((#{tmp 4250}#
($sc-dispatch
- #{tmp 4231}#
+ #{tmp 4233}#
'(_ #(each (any any)) any . each-any))))
- (if #{tmp 4248}#
+ (if #{tmp 4250}#
(@apply
- (lambda (#{out 4253}#
- #{in 4254}#
- #{e1 4255}#
- #{e2 4256}#)
+ (lambda (#{out 4255}#
+ #{in 4256}#
+ #{e1 4257}#
+ #{e2 4258}#)
(list '#(syntax-object
syntax-case
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("i4249" "i4250" "i4251" "i4252"))
+ #("i4251" "i4252" "i4253" "i4254"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4230")))
+ #(ribcage #(x) #((top)) #("i4232")))
(hygiene guile))
(cons '#(syntax-object
list
@@ -14003,63 +14010,63 @@
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("i4249" "i4250" "i4251" "i4252"))
+ #("i4251" "i4252" "i4253" "i4254"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4230")))
+ #(ribcage #(x) #((top)) #("i4232")))
(hygiene guile))
- #{in 4254}#)
+ #{in 4256}#)
'()
- (list #{out 4253}#
+ (list #{out 4255}#
(cons '#(syntax-object
let
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("i4249"
- "i4250"
- "i4251"
- "i4252"))
+ #("i4251"
+ "i4252"
+ "i4253"
+ "i4254"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4230")))
+ #("i4232")))
(hygiene guile))
(cons '()
- (cons #{e1 4255}#
- #{e2 4256}#))))))
- #{tmp 4248}#)
+ (cons #{e1 4257}#
+ #{e2 4258}#))))))
+ #{tmp 4250}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4231}#)))))))))))
+ #{tmp 4233}#)))))))))))
(define syntax-rules
(make-syntax-transformer
'syntax-rules
'macro
- (lambda (#{x 4260}#)
- (let ((#{tmp 4262}# #{x 4260}#))
- (let ((#{tmp 4263}#
+ (lambda (#{x 4262}#)
+ (let ((#{tmp 4264}# #{x 4262}#))
+ (let ((#{tmp 4265}#
($sc-dispatch
- #{tmp 4262}#
+ #{tmp 4264}#
'(_ each-any . #(each ((any . any) any))))))
- (if #{tmp 4263}#
+ (if #{tmp 4265}#
(@apply
- (lambda (#{k 4268}#
- #{keyword 4269}#
- #{pattern 4270}#
- #{template 4271}#)
+ (lambda (#{k 4270}#
+ #{keyword 4271}#
+ #{pattern 4272}#
+ #{template 4273}#)
(list '#(syntax-object
lambda
((top)
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("i4264" "i4265" "i4266" "i4267"))
+ #("i4266" "i4267" "i4268" "i4269"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
'(#(syntax-object
x
@@ -14067,9 +14074,9 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("i4264" "i4265" "i4266" "i4267"))
+ #("i4266" "i4267" "i4268" "i4269"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile)))
(vector
'(#(syntax-object
@@ -14078,9 +14085,9 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("i4264" "i4265" "i4266" "i4267"))
+ #("i4266" "i4267" "i4268" "i4269"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
.
#(syntax-object
@@ -14089,9 +14096,9 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("i4264" "i4265" "i4266" "i4267"))
+ #("i4266" "i4267" "i4268" "i4269"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile)))
(cons '#(syntax-object
patterns
@@ -14099,20 +14106,20 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("i4264" "i4265" "i4266" "i4267"))
+ #("i4266" "i4267" "i4268" "i4269"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
- #{pattern 4270}#))
+ #{pattern 4272}#))
(cons '#(syntax-object
syntax-case
((top)
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("i4264" "i4265" "i4266" "i4267"))
+ #("i4266" "i4267" "i4268" "i4269"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
(cons '#(syntax-object
x
@@ -14120,13 +14127,13 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("i4264" "i4265" "i4266" "i4267"))
+ #("i4266" "i4267" "i4268" "i4269"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
- (cons #{k 4268}#
- (map (lambda (#{tmp 4275}#
- #{tmp 4274}#)
+ (cons #{k 4270}#
+ (map (lambda (#{tmp 4277}#
+ #{tmp 4276}#)
(list (cons '#(syntax-object
dummy
((top)
@@ -14139,10 +14146,10 @@
(top)
(top)
(top))
- #("i4264"
- "i4265"
- "i4266"
- "i4267"))
+ #("i4266"
+ "i4267"
+ "i4268"
+ "i4269"))
#(ribcage
()
()
@@ -14150,9 +14157,9 @@
#(ribcage
#(x)
#((top))
- #("i4261")))
+ #("i4263")))
(hygiene guile))
- #{tmp 4274}#)
+ #{tmp 4276}#)
(list '#(syntax-object
syntax
((top)
@@ -14165,10 +14172,10 @@
(top)
(top)
(top))
- #("i4264"
- "i4265"
- "i4266"
- "i4267"))
+ #("i4266"
+ "i4267"
+ "i4268"
+ "i4269"))
#(ribcage
()
()
@@ -14176,41 +14183,41 @@
#(ribcage
#(x)
#((top))
- #("i4261")))
+ #("i4263")))
(hygiene guile))
- #{tmp 4275}#)))
- #{template 4271}#
- #{pattern 4270}#))))))
- #{tmp 4263}#)
- (let ((#{tmp 4276}#
+ #{tmp 4277}#)))
+ #{template 4273}#
+ #{pattern 4272}#))))))
+ #{tmp 4265}#)
+ (let ((#{tmp 4278}#
($sc-dispatch
- #{tmp 4262}#
+ #{tmp 4264}#
'(_ each-any any . #(each ((any . any) any))))))
- (if (if #{tmp 4276}#
+ (if (if #{tmp 4278}#
(@apply
- (lambda (#{k 4282}#
- #{docstring 4283}#
- #{keyword 4284}#
- #{pattern 4285}#
- #{template 4286}#)
- (string? (syntax->datum #{docstring 4283}#)))
- #{tmp 4276}#)
+ (lambda (#{k 4284}#
+ #{docstring 4285}#
+ #{keyword 4286}#
+ #{pattern 4287}#
+ #{template 4288}#)
+ (string? (syntax->datum #{docstring 4285}#)))
+ #{tmp 4278}#)
#f)
(@apply
- (lambda (#{k 4292}#
- #{docstring 4293}#
- #{keyword 4294}#
- #{pattern 4295}#
- #{template 4296}#)
+ (lambda (#{k 4294}#
+ #{docstring 4295}#
+ #{keyword 4296}#
+ #{pattern 4297}#
+ #{template 4298}#)
(list '#(syntax-object
lambda
((top)
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("i4287" "i4288" "i4289" "i4290" "i4291"))
+ #("i4289" "i4290" "i4291" "i4292" "i4293"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
'(#(syntax-object
x
@@ -14218,11 +14225,11 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("i4287" "i4288" "i4289" "i4290" "i4291"))
+ #("i4289" "i4290" "i4291" "i4292" "i4293"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile)))
- #{docstring 4293}#
+ #{docstring 4295}#
(vector
'(#(syntax-object
macro-type
@@ -14230,9 +14237,9 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("i4287" "i4288" "i4289" "i4290" "i4291"))
+ #("i4289" "i4290" "i4291" "i4292" "i4293"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
.
#(syntax-object
@@ -14241,9 +14248,9 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("i4287" "i4288" "i4289" "i4290" "i4291"))
+ #("i4289" "i4290" "i4291" "i4292" "i4293"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile)))
(cons '#(syntax-object
patterns
@@ -14251,28 +14258,28 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("i4287"
- "i4288"
- "i4289"
+ #("i4289"
"i4290"
- "i4291"))
+ "i4291"
+ "i4292"
+ "i4293"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
- #{pattern 4295}#))
+ #{pattern 4297}#))
(cons '#(syntax-object
syntax-case
((top)
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("i4287"
- "i4288"
- "i4289"
+ #("i4289"
"i4290"
- "i4291"))
+ "i4291"
+ "i4292"
+ "i4293"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
(cons '#(syntax-object
x
@@ -14284,17 +14291,17 @@
pattern
template)
#((top) (top) (top) (top) (top))
- #("i4287"
- "i4288"
- "i4289"
+ #("i4289"
"i4290"
- "i4291"))
+ "i4291"
+ "i4292"
+ "i4293"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4261")))
+ #(ribcage #(x) #((top)) #("i4263")))
(hygiene guile))
- (cons #{k 4292}#
- (map (lambda (#{tmp 4300}#
- #{tmp 4299}#)
+ (cons #{k 4294}#
+ (map (lambda (#{tmp 4302}#
+ #{tmp 4301}#)
(list (cons '#(syntax-object
dummy
((top)
@@ -14309,11 +14316,11 @@
(top)
(top)
(top))
- #("i4287"
- "i4288"
- "i4289"
+ #("i4289"
"i4290"
- "i4291"))
+ "i4291"
+ "i4292"
+ "i4293"))
#(ribcage
()
()
@@ -14321,10 +14328,10 @@
#(ribcage
#(x)
#((top))
- #("i4261")))
+ #("i4263")))
(hygiene
guile))
- #{tmp 4299}#)
+ #{tmp 4301}#)
(list '#(syntax-object
syntax
((top)
@@ -14339,11 +14346,11 @@
(top)
(top)
(top))
- #("i4287"
- "i4288"
- "i4289"
+ #("i4289"
"i4290"
- "i4291"))
+ "i4291"
+ "i4292"
+ "i4293"))
#(ribcage
()
()
@@ -14351,48 +14358,48 @@
#(ribcage
#(x)
#((top))
- #("i4261")))
+ #("i4263")))
(hygiene
guile))
- #{tmp 4300}#)))
- #{template 4296}#
- #{pattern 4295}#))))))
- #{tmp 4276}#)
+ #{tmp 4302}#)))
+ #{template 4298}#
+ #{pattern 4297}#))))))
+ #{tmp 4278}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4262}#)))))))))
+ #{tmp 4264}#)))))))))
(define let*
(make-syntax-transformer
'let*
'macro
- (lambda (#{x 4301}#)
- (let ((#{tmp 4303}# #{x 4301}#))
- (let ((#{tmp 4304}#
+ (lambda (#{x 4303}#)
+ (let ((#{tmp 4305}# #{x 4303}#))
+ (let ((#{tmp 4306}#
($sc-dispatch
- #{tmp 4303}#
+ #{tmp 4305}#
'(any #(each (any any)) any . each-any))))
- (if (if #{tmp 4304}#
+ (if (if #{tmp 4306}#
(@apply
- (lambda (#{let* 4310}#
- #{x 4311}#
- #{v 4312}#
- #{e1 4313}#
- #{e2 4314}#)
- (and-map identifier? #{x 4311}#))
- #{tmp 4304}#)
+ (lambda (#{let* 4312}#
+ #{x 4313}#
+ #{v 4314}#
+ #{e1 4315}#
+ #{e2 4316}#)
+ (and-map identifier? #{x 4313}#))
+ #{tmp 4306}#)
#f)
(@apply
- (lambda (#{let* 4321}#
- #{x 4322}#
- #{v 4323}#
- #{e1 4324}#
- #{e2 4325}#)
+ (lambda (#{let* 4323}#
+ #{x 4324}#
+ #{v 4325}#
+ #{e1 4326}#
+ #{e2 4327}#)
(letrec*
- ((#{f 4328}#
- (lambda (#{bindings 4329}#)
- (if (null? #{bindings 4329}#)
+ ((#{f 4330}#
+ (lambda (#{bindings 4331}#)
+ (if (null? #{bindings 4331}#)
(cons '#(syntax-object
let
((top)
@@ -14400,27 +14407,27 @@
#(ribcage
#(f bindings)
#((top) (top))
- #("i4326" "i4327"))
+ #("i4328" "i4329"))
#(ribcage
#(let* x v e1 e2)
#((top) (top) (top) (top) (top))
- #("i4316"
- "i4317"
- "i4318"
+ #("i4318"
"i4319"
- "i4320"))
+ "i4320"
+ "i4321"
+ "i4322"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4302")))
+ #(ribcage #(x) #((top)) #("i4304")))
(hygiene guile))
- (cons '() (cons #{e1 4324}# #{e2 4325}#)))
- (let ((#{tmp 4334}#
- (list (#{f 4328}# (cdr #{bindings 4329}#))
- (car #{bindings 4329}#))))
- (let ((#{tmp 4335}#
- ($sc-dispatch #{tmp 4334}# '(any any))))
- (if #{tmp 4335}#
+ (cons '() (cons #{e1 4326}# #{e2 4327}#)))
+ (let ((#{tmp 4336}#
+ (list (#{f 4330}# (cdr #{bindings 4331}#))
+ (car #{bindings 4331}#))))
+ (let ((#{tmp 4337}#
+ ($sc-dispatch #{tmp 4336}# '(any any))))
+ (if #{tmp 4337}#
(@apply
- (lambda (#{body 4338}# #{binding 4339}#)
+ (lambda (#{body 4340}# #{binding 4341}#)
(list '#(syntax-object
let
((top)
@@ -14428,95 +14435,95 @@
#(ribcage
#(body binding)
#((top) (top))
- #("i4336" "i4337"))
+ #("i4338" "i4339"))
#(ribcage () () ())
#(ribcage
#(f bindings)
#((top) (top))
- #("i4326" "i4327"))
+ #("i4328" "i4329"))
#(ribcage
#(let* x v e1 e2)
#((top) (top) (top) (top) (top))
- #("i4316"
- "i4317"
- "i4318"
+ #("i4318"
"i4319"
- "i4320"))
+ "i4320"
+ "i4321"
+ "i4322"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4302")))
+ #("i4304")))
(hygiene guile))
- (list #{binding 4339}#)
- #{body 4338}#))
- #{tmp 4335}#)
+ (list #{binding 4341}#)
+ #{body 4340}#))
+ #{tmp 4337}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4334}#))))))))
- (#{f 4328}# (map list #{x 4322}# #{v 4323}#))))
- #{tmp 4304}#)
+ #{tmp 4336}#))))))))
+ (#{f 4330}# (map list #{x 4324}# #{v 4325}#))))
+ #{tmp 4306}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4303}#)))))))
+ #{tmp 4305}#)))))))
(define do
(make-syntax-transformer
'do
'macro
- (lambda (#{orig-x 4340}#)
- (let ((#{tmp 4342}# #{orig-x 4340}#))
- (let ((#{tmp 4343}#
+ (lambda (#{orig-x 4342}#)
+ (let ((#{tmp 4344}# #{orig-x 4342}#))
+ (let ((#{tmp 4345}#
($sc-dispatch
- #{tmp 4342}#
+ #{tmp 4344}#
'(_ #(each (any any . any))
(any . each-any)
.
each-any))))
- (if #{tmp 4343}#
+ (if #{tmp 4345}#
(@apply
- (lambda (#{var 4350}#
- #{init 4351}#
- #{step 4352}#
- #{e0 4353}#
- #{e1 4354}#
- #{c 4355}#)
- (let ((#{tmp 4357}#
- (map (lambda (#{v 4378}# #{s 4379}#)
- (let ((#{tmp 4382}# #{s 4379}#))
- (let ((#{tmp 4383}#
- ($sc-dispatch #{tmp 4382}# '())))
- (if #{tmp 4383}#
+ (lambda (#{var 4352}#
+ #{init 4353}#
+ #{step 4354}#
+ #{e0 4355}#
+ #{e1 4356}#
+ #{c 4357}#)
+ (let ((#{tmp 4359}#
+ (map (lambda (#{v 4380}# #{s 4381}#)
+ (let ((#{tmp 4384}# #{s 4381}#))
+ (let ((#{tmp 4385}#
+ ($sc-dispatch #{tmp 4384}# '())))
+ (if #{tmp 4385}#
(@apply
- (lambda () #{v 4378}#)
- #{tmp 4383}#)
- (let ((#{tmp 4384}#
+ (lambda () #{v 4380}#)
+ #{tmp 4385}#)
+ (let ((#{tmp 4386}#
($sc-dispatch
- #{tmp 4382}#
+ #{tmp 4384}#
'(any))))
- (if #{tmp 4384}#
+ (if #{tmp 4386}#
(@apply
- (lambda (#{e 4386}#) #{e 4386}#)
- #{tmp 4384}#)
- (let ((#{_ 4388}# #{tmp 4382}#))
+ (lambda (#{e 4388}#) #{e 4388}#)
+ #{tmp 4386}#)
+ (let ((#{_ 4390}# #{tmp 4384}#))
(syntax-violation
'do
"bad step expression"
- #{orig-x 4340}#
- #{s 4379}#))))))))
- #{var 4350}#
- #{step 4352}#)))
- (let ((#{tmp 4358}#
- ($sc-dispatch #{tmp 4357}# 'each-any)))
- (if #{tmp 4358}#
+ #{orig-x 4342}#
+ #{s 4381}#))))))))
+ #{var 4352}#
+ #{step 4354}#)))
+ (let ((#{tmp 4360}#
+ ($sc-dispatch #{tmp 4359}# 'each-any)))
+ (if #{tmp 4360}#
(@apply
- (lambda (#{step 4360}#)
- (let ((#{tmp 4361}# #{e1 4354}#))
- (let ((#{tmp 4362}#
- ($sc-dispatch #{tmp 4361}# '())))
- (if #{tmp 4362}#
+ (lambda (#{step 4362}#)
+ (let ((#{tmp 4363}# #{e1 4356}#))
+ (let ((#{tmp 4364}#
+ ($sc-dispatch #{tmp 4363}# '())))
+ (if #{tmp 4364}#
(@apply
(lambda ()
(list '#(syntax-object
@@ -14526,7 +14533,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -14535,17 +14542,17 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
'#(syntax-object
doloop
@@ -14554,7 +14561,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -14563,19 +14570,19 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
- (map list #{var 4350}# #{init 4351}#)
+ (map list #{var 4352}# #{init 4353}#)
(list '#(syntax-object
if
((top)
@@ -14583,7 +14590,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -14592,17 +14599,17 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
(list '#(syntax-object
not
@@ -14611,7 +14618,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var
init
@@ -14625,19 +14632,19 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
- #{e0 4353}#)
+ #{e0 4355}#)
(cons '#(syntax-object
begin
((top)
@@ -14645,7 +14652,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var
init
@@ -14659,20 +14666,20 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
(append
- #{c 4355}#
+ #{c 4357}#
(list (cons '#(syntax-object
doloop
((top)
@@ -14683,7 +14690,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var
init
@@ -14697,12 +14704,12 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage
()
()
@@ -14710,30 +14717,30 @@
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene
guile))
- #{step 4360}#)))))))
- #{tmp 4362}#)
- (let ((#{tmp 4367}#
+ #{step 4362}#)))))))
+ #{tmp 4364}#)
+ (let ((#{tmp 4369}#
($sc-dispatch
- #{tmp 4361}#
+ #{tmp 4363}#
'(any . each-any))))
- (if #{tmp 4367}#
+ (if #{tmp 4369}#
(@apply
- (lambda (#{e1 4370}# #{e2 4371}#)
+ (lambda (#{e1 4372}# #{e2 4373}#)
(list '#(syntax-object
let
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("i4368" "i4369"))
+ #("i4370" "i4371"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -14742,17 +14749,17 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
'#(syntax-object
doloop
@@ -14760,12 +14767,12 @@
#(ribcage
#(e1 e2)
#((top) (top))
- #("i4368" "i4369"))
+ #("i4370" "i4371"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -14774,33 +14781,33 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
(map list
- #{var 4350}#
- #{init 4351}#)
+ #{var 4352}#
+ #{init 4353}#)
(list '#(syntax-object
if
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("i4368" "i4369"))
+ #("i4370" "i4371"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var
init
@@ -14814,27 +14821,27 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
- #{e0 4353}#
+ #{e0 4355}#
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("i4368"
- "i4369"))
+ #("i4370"
+ "i4371"))
#(ribcage
()
()
@@ -14842,7 +14849,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var
init
@@ -14856,12 +14863,12 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage
()
()
@@ -14869,18 +14876,18 @@
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
- (cons #{e1 4370}#
- #{e2 4371}#))
+ (cons #{e1 4372}#
+ #{e2 4373}#))
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("i4368"
- "i4369"))
+ #("i4370"
+ "i4371"))
#(ribcage
()
()
@@ -14888,7 +14895,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var
init
@@ -14902,12 +14909,12 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage
()
()
@@ -14915,10 +14922,10 @@
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene guile))
(append
- #{c 4355}#
+ #{c 4357}#
(list (cons '#(syntax-object
doloop
((top)
@@ -14927,8 +14934,8 @@
e2)
#((top)
(top))
- #("i4368"
- "i4369"))
+ #("i4370"
+ "i4371"))
#(ribcage
()
()
@@ -14936,7 +14943,7 @@
#(ribcage
#(step)
#((top))
- #("i4359"))
+ #("i4361"))
#(ribcage
#(var
init
@@ -14950,12 +14957,12 @@
(top)
(top)
(top))
- #("i4344"
- "i4345"
- "i4346"
+ #("i4346"
"i4347"
"i4348"
- "i4349"))
+ "i4349"
+ "i4350"
+ "i4351"))
#(ribcage
()
()
@@ -14963,37 +14970,37 @@
#(ribcage
#(orig-x)
#((top))
- #("i4341")))
+ #("i4343")))
(hygiene
guile))
- #{step 4360}#)))))))
- #{tmp 4367}#)
+ #{step 4362}#)))))))
+ #{tmp 4369}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4361}#)))))))
- #{tmp 4358}#)
+ #{tmp 4363}#)))))))
+ #{tmp 4360}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4357}#)))))
- #{tmp 4343}#)
+ #{tmp 4359}#)))))
+ #{tmp 4345}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4342}#)))))))
+ #{tmp 4344}#)))))))
(define quasiquote
(make-syntax-transformer
'quasiquote
'macro
(letrec*
- ((#{quasi 4392}#
- (lambda (#{p 4405}# #{lev 4406}#)
- (let ((#{tmp 4409}# #{p 4405}#))
- (let ((#{tmp 4410}#
+ ((#{quasi 4394}#
+ (lambda (#{p 4407}# #{lev 4408}#)
+ (let ((#{tmp 4411}# #{p 4407}#))
+ (let ((#{tmp 4412}#
($sc-dispatch
- #{tmp 4409}#
+ #{tmp 4411}#
'(#(free-id
#(syntax-object
unquote
@@ -15002,7 +15009,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15011,28 +15018,28 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
any))))
- (if #{tmp 4410}#
+ (if #{tmp 4412}#
(@apply
- (lambda (#{p 4412}#)
- (if (= #{lev 4406}# 0)
+ (lambda (#{p 4414}#)
+ (if (= #{lev 4408}# 0)
(list '#(syntax-object
"value"
((top)
- #(ribcage #(p) #((top)) #("i4411"))
+ #(ribcage #(p) #((top)) #("i4413"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15041,25 +15048,25 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{p 4412}#)
- (#{quasicons 4396}#
+ #{p 4414}#)
+ (#{quasicons 4398}#
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("i4411"))
+ #(ribcage #(p) #((top)) #("i4413"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15068,23 +15075,23 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
#(syntax-object
unquote
((top)
- #(ribcage #(p) #((top)) #("i4411"))
+ #(ribcage #(p) #((top)) #("i4413"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15093,21 +15100,21 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
- (#{quasi 4392}#
- (list #{p 4412}#)
- (#{1-}# #{lev 4406}#)))))
- #{tmp 4410}#)
- (let ((#{tmp 4413}#
+ (#{quasi 4394}#
+ (list #{p 4414}#)
+ (#{1-}# #{lev 4408}#)))))
+ #{tmp 4412}#)
+ (let ((#{tmp 4415}#
($sc-dispatch
- #{tmp 4409}#
+ #{tmp 4411}#
'(#(free-id
#(syntax-object
quasiquote
@@ -15116,7 +15123,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15125,28 +15132,28 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
any))))
- (if #{tmp 4413}#
+ (if #{tmp 4415}#
(@apply
- (lambda (#{p 4415}#)
- (#{quasicons 4396}#
+ (lambda (#{p 4417}#)
+ (#{quasicons 4398}#
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("i4414"))
+ #(ribcage #(p) #((top)) #("i4416"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15155,23 +15162,23 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
#(syntax-object
quasiquote
((top)
- #(ribcage #(p) #((top)) #("i4414"))
+ #(ribcage #(p) #((top)) #("i4416"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15180,27 +15187,27 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
- (#{quasi 4392}#
- (list #{p 4415}#)
- (#{1+}# #{lev 4406}#))))
- #{tmp 4413}#)
- (let ((#{tmp 4416}#
- ($sc-dispatch #{tmp 4409}# '(any . any))))
- (if #{tmp 4416}#
+ (#{quasi 4394}#
+ (list #{p 4417}#)
+ (#{1+}# #{lev 4408}#))))
+ #{tmp 4415}#)
+ (let ((#{tmp 4418}#
+ ($sc-dispatch #{tmp 4411}# '(any . any))))
+ (if #{tmp 4418}#
(@apply
- (lambda (#{p 4419}# #{q 4420}#)
- (let ((#{tmp 4421}# #{p 4419}#))
- (let ((#{tmp 4422}#
+ (lambda (#{p 4421}# #{q 4422}#)
+ (let ((#{tmp 4423}# #{p 4421}#))
+ (let ((#{tmp 4424}#
($sc-dispatch
- #{tmp 4421}#
+ #{tmp 4423}#
'(#(free-id
#(syntax-object
unquote
@@ -15208,12 +15215,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("i4417" "i4418"))
+ #("i4419" "i4420"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15228,40 +15235,40 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
.
each-any))))
- (if #{tmp 4422}#
+ (if #{tmp 4424}#
(@apply
- (lambda (#{p 4424}#)
- (if (= #{lev 4406}# 0)
- (#{quasilist* 4400}#
- (map (lambda (#{tmp 4425}#)
+ (lambda (#{p 4426}#)
+ (if (= #{lev 4408}# 0)
+ (#{quasilist* 4402}#
+ (map (lambda (#{tmp 4427}#)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("i4423"))
+ #("i4425"))
#(ribcage
#(p q)
#((top) (top))
- #("i4417"
- "i4418"))
+ #("i4419"
+ "i4420"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407"
- "i4408"))
+ #("i4409"
+ "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15276,37 +15283,37 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{tmp 4425}#))
- #{p 4424}#)
- (#{quasi 4392}#
- #{q 4420}#
- #{lev 4406}#))
- (#{quasicons 4396}#
- (#{quasicons 4396}#
+ #{tmp 4427}#))
+ #{p 4426}#)
+ (#{quasi 4394}#
+ #{q 4422}#
+ #{lev 4408}#))
+ (#{quasicons 4398}#
+ (#{quasicons 4398}#
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("i4423"))
+ #("i4425"))
#(ribcage
#(p q)
#((top) (top))
- #("i4417" "i4418"))
+ #("i4419" "i4420"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15321,13 +15328,13 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
#(syntax-object
unquote
@@ -15335,16 +15342,16 @@
#(ribcage
#(p)
#((top))
- #("i4423"))
+ #("i4425"))
#(ribcage
#(p q)
#((top) (top))
- #("i4417" "i4418"))
+ #("i4419" "i4420"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15359,24 +15366,24 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
- (#{quasi 4392}#
- #{p 4424}#
- (#{1-}# #{lev 4406}#)))
- (#{quasi 4392}#
- #{q 4420}#
- #{lev 4406}#))))
- #{tmp 4422}#)
- (let ((#{tmp 4427}#
+ (#{quasi 4394}#
+ #{p 4426}#
+ (#{1-}# #{lev 4408}#)))
+ (#{quasi 4394}#
+ #{q 4422}#
+ #{lev 4408}#))))
+ #{tmp 4424}#)
+ (let ((#{tmp 4429}#
($sc-dispatch
- #{tmp 4421}#
+ #{tmp 4423}#
'(#(free-id
#(syntax-object
unquote-splicing
@@ -15384,12 +15391,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("i4417" "i4418"))
+ #("i4419" "i4420"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15404,35 +15411,35 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
.
each-any))))
- (if #{tmp 4427}#
+ (if #{tmp 4429}#
(@apply
- (lambda (#{p 4429}#)
- (if (= #{lev 4406}# 0)
- (#{quasiappend 4398}#
- (map (lambda (#{tmp 4430}#)
+ (lambda (#{p 4431}#)
+ (if (= #{lev 4408}# 0)
+ (#{quasiappend 4400}#
+ (map (lambda (#{tmp 4432}#)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("i4428"))
+ #("i4430"))
#(ribcage
#(p q)
#((top)
(top))
- #("i4417"
- "i4418"))
+ #("i4419"
+ "i4420"))
#(ribcage
()
()
@@ -15441,8 +15448,8 @@
#(p lev)
#((top)
(top))
- #("i4407"
- "i4408"))
+ #("i4409"
+ "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15457,37 +15464,37 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{tmp 4430}#))
- #{p 4429}#)
- (#{quasi 4392}#
- #{q 4420}#
- #{lev 4406}#))
- (#{quasicons 4396}#
- (#{quasicons 4396}#
+ #{tmp 4432}#))
+ #{p 4431}#)
+ (#{quasi 4394}#
+ #{q 4422}#
+ #{lev 4408}#))
+ (#{quasicons 4398}#
+ (#{quasicons 4398}#
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("i4428"))
+ #("i4430"))
#(ribcage
#(p q)
#((top) (top))
- #("i4417" "i4418"))
+ #("i4419" "i4420"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15502,13 +15509,13 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
#(syntax-object
unquote-splicing
@@ -15516,16 +15523,16 @@
#(ribcage
#(p)
#((top))
- #("i4428"))
+ #("i4430"))
#(ribcage
#(p q)
#((top) (top))
- #("i4417" "i4418"))
+ #("i4419" "i4420"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15540,50 +15547,50 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
- (#{quasi 4392}#
- #{p 4429}#
- (#{1-}# #{lev 4406}#)))
- (#{quasi 4392}#
- #{q 4420}#
- #{lev 4406}#))))
- #{tmp 4427}#)
- (let ((#{_ 4433}# #{tmp 4421}#))
- (#{quasicons 4396}#
- (#{quasi 4392}#
- #{p 4419}#
- #{lev 4406}#)
- (#{quasi 4392}#
- #{q 4420}#
- #{lev 4406}#)))))))))
- #{tmp 4416}#)
- (let ((#{tmp 4434}#
+ (#{quasi 4394}#
+ #{p 4431}#
+ (#{1-}# #{lev 4408}#)))
+ (#{quasi 4394}#
+ #{q 4422}#
+ #{lev 4408}#))))
+ #{tmp 4429}#)
+ (let ((#{_ 4435}# #{tmp 4423}#))
+ (#{quasicons 4398}#
+ (#{quasi 4394}#
+ #{p 4421}#
+ #{lev 4408}#)
+ (#{quasi 4394}#
+ #{q 4422}#
+ #{lev 4408}#)))))))))
+ #{tmp 4418}#)
+ (let ((#{tmp 4436}#
($sc-dispatch
- #{tmp 4409}#
+ #{tmp 4411}#
'#(vector each-any))))
- (if #{tmp 4434}#
+ (if #{tmp 4436}#
(@apply
- (lambda (#{x 4436}#)
- (#{quasivector 4402}#
- (#{vquasi 4394}# #{x 4436}# #{lev 4406}#)))
- #{tmp 4434}#)
- (let ((#{p 4439}# #{tmp 4409}#))
+ (lambda (#{x 4438}#)
+ (#{quasivector 4404}#
+ (#{vquasi 4396}# #{x 4438}# #{lev 4408}#)))
+ #{tmp 4436}#)
+ (let ((#{p 4441}# #{tmp 4411}#))
(list '#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("i4438"))
+ #(ribcage #(p) #((top)) #("i4440"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4407" "i4408"))
+ #("i4409" "i4410"))
#(ribcage
(emit quasivector
quasilist*
@@ -15598,27 +15605,27 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{p 4439}#)))))))))))))
- (#{vquasi 4394}#
- (lambda (#{p 4440}# #{lev 4441}#)
- (let ((#{tmp 4444}# #{p 4440}#))
- (let ((#{tmp 4445}#
- ($sc-dispatch #{tmp 4444}# '(any . any))))
- (if #{tmp 4445}#
+ #{p 4441}#)))))))))))))
+ (#{vquasi 4396}#
+ (lambda (#{p 4442}# #{lev 4443}#)
+ (let ((#{tmp 4446}# #{p 4442}#))
+ (let ((#{tmp 4447}#
+ ($sc-dispatch #{tmp 4446}# '(any . any))))
+ (if #{tmp 4447}#
(@apply
- (lambda (#{p 4448}# #{q 4449}#)
- (let ((#{tmp 4450}# #{p 4448}#))
- (let ((#{tmp 4451}#
+ (lambda (#{p 4450}# #{q 4451}#)
+ (let ((#{tmp 4452}# #{p 4450}#))
+ (let ((#{tmp 4453}#
($sc-dispatch
- #{tmp 4450}#
+ #{tmp 4452}#
'(#(free-id
#(syntax-object
unquote
@@ -15626,12 +15633,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("i4446" "i4447"))
+ #("i4448" "i4449"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15646,38 +15653,38 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
.
each-any))))
- (if #{tmp 4451}#
+ (if #{tmp 4453}#
(@apply
- (lambda (#{p 4453}#)
- (if (= #{lev 4441}# 0)
- (#{quasilist* 4400}#
- (map (lambda (#{tmp 4454}#)
+ (lambda (#{p 4455}#)
+ (if (= #{lev 4443}# 0)
+ (#{quasilist* 4402}#
+ (map (lambda (#{tmp 4456}#)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("i4452"))
+ #("i4454"))
#(ribcage
#(p q)
#((top) (top))
- #("i4446" "i4447"))
+ #("i4448" "i4449"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15692,32 +15699,32 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{tmp 4454}#))
- #{p 4453}#)
- (#{vquasi 4394}# #{q 4449}# #{lev 4441}#))
- (#{quasicons 4396}#
- (#{quasicons 4396}#
+ #{tmp 4456}#))
+ #{p 4455}#)
+ (#{vquasi 4396}# #{q 4451}# #{lev 4443}#))
+ (#{quasicons 4398}#
+ (#{quasicons 4398}#
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("i4452"))
+ #(ribcage #(p) #((top)) #("i4454"))
#(ribcage
#(p q)
#((top) (top))
- #("i4446" "i4447"))
+ #("i4448" "i4449"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15732,27 +15739,27 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
#(syntax-object
unquote
((top)
- #(ribcage #(p) #((top)) #("i4452"))
+ #(ribcage #(p) #((top)) #("i4454"))
#(ribcage
#(p q)
#((top) (top))
- #("i4446" "i4447"))
+ #("i4448" "i4449"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15767,22 +15774,22 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
- (#{quasi 4392}#
- #{p 4453}#
- (#{1-}# #{lev 4441}#)))
- (#{vquasi 4394}# #{q 4449}# #{lev 4441}#))))
- #{tmp 4451}#)
- (let ((#{tmp 4456}#
+ (#{quasi 4394}#
+ #{p 4455}#
+ (#{1-}# #{lev 4443}#)))
+ (#{vquasi 4396}# #{q 4451}# #{lev 4443}#))))
+ #{tmp 4453}#)
+ (let ((#{tmp 4458}#
($sc-dispatch
- #{tmp 4450}#
+ #{tmp 4452}#
'(#(free-id
#(syntax-object
unquote-splicing
@@ -15790,12 +15797,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("i4446" "i4447"))
+ #("i4448" "i4449"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15810,38 +15817,38 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
.
each-any))))
- (if #{tmp 4456}#
+ (if #{tmp 4458}#
(@apply
- (lambda (#{p 4458}#)
- (if (= #{lev 4441}# 0)
- (#{quasiappend 4398}#
- (map (lambda (#{tmp 4459}#)
+ (lambda (#{p 4460}#)
+ (if (= #{lev 4443}# 0)
+ (#{quasiappend 4400}#
+ (map (lambda (#{tmp 4461}#)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("i4457"))
+ #("i4459"))
#(ribcage
#(p q)
#((top) (top))
- #("i4446" "i4447"))
+ #("i4448" "i4449"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15856,37 +15863,37 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{tmp 4459}#))
- #{p 4458}#)
- (#{vquasi 4394}#
- #{q 4449}#
- #{lev 4441}#))
- (#{quasicons 4396}#
- (#{quasicons 4396}#
+ #{tmp 4461}#))
+ #{p 4460}#)
+ (#{vquasi 4396}#
+ #{q 4451}#
+ #{lev 4443}#))
+ (#{quasicons 4398}#
+ (#{quasicons 4398}#
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("i4457"))
+ #("i4459"))
#(ribcage
#(p q)
#((top) (top))
- #("i4446" "i4447"))
+ #("i4448" "i4449"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15901,13 +15908,13 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
#(syntax-object
unquote-splicing
@@ -15915,16 +15922,16 @@
#(ribcage
#(p)
#((top))
- #("i4457"))
+ #("i4459"))
#(ribcage
#(p q)
#((top) (top))
- #("i4446" "i4447"))
+ #("i4448" "i4449"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15939,30 +15946,30 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile)))
- (#{quasi 4392}#
- #{p 4458}#
- (#{1-}# #{lev 4441}#)))
- (#{vquasi 4394}#
- #{q 4449}#
- #{lev 4441}#))))
- #{tmp 4456}#)
- (let ((#{_ 4462}# #{tmp 4450}#))
- (#{quasicons 4396}#
- (#{quasi 4392}# #{p 4448}# #{lev 4441}#)
- (#{vquasi 4394}#
- #{q 4449}#
- #{lev 4441}#)))))))))
- #{tmp 4445}#)
- (let ((#{tmp 4463}# ($sc-dispatch #{tmp 4444}# '())))
- (if #{tmp 4463}#
+ (#{quasi 4394}#
+ #{p 4460}#
+ (#{1-}# #{lev 4443}#)))
+ (#{vquasi 4396}#
+ #{q 4451}#
+ #{lev 4443}#))))
+ #{tmp 4458}#)
+ (let ((#{_ 4464}# #{tmp 4452}#))
+ (#{quasicons 4398}#
+ (#{quasi 4394}# #{p 4450}# #{lev 4443}#)
+ (#{vquasi 4396}#
+ #{q 4451}#
+ #{lev 4443}#)))))))))
+ #{tmp 4447}#)
+ (let ((#{tmp 4465}# ($sc-dispatch #{tmp 4446}# '())))
+ (if #{tmp 4465}#
(@apply
(lambda ()
'(#(syntax-object
@@ -15972,7 +15979,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("i4442" "i4443"))
+ #("i4444" "i4445"))
#(ribcage
(emit quasivector
quasilist*
@@ -15981,66 +15988,66 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
()))
- #{tmp 4463}#)
+ #{tmp 4465}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4444}#))))))))
- (#{quasicons 4396}#
- (lambda (#{x 4464}# #{y 4465}#)
- (let ((#{tmp 4469}# (list #{x 4464}# #{y 4465}#)))
- (let ((#{tmp 4470}#
- ($sc-dispatch #{tmp 4469}# '(any any))))
- (if #{tmp 4470}#
+ #{tmp 4446}#))))))))
+ (#{quasicons 4398}#
+ (lambda (#{x 4466}# #{y 4467}#)
+ (let ((#{tmp 4471}# (list #{x 4466}# #{y 4467}#)))
+ (let ((#{tmp 4472}#
+ ($sc-dispatch #{tmp 4471}# '(any any))))
+ (if #{tmp 4472}#
(@apply
- (lambda (#{x 4473}# #{y 4474}#)
- (let ((#{tmp 4475}# #{y 4474}#))
- (let ((#{tmp 4476}#
+ (lambda (#{x 4475}# #{y 4476}#)
+ (let ((#{tmp 4477}# #{y 4476}#))
+ (let ((#{tmp 4478}#
($sc-dispatch
- #{tmp 4475}#
+ #{tmp 4477}#
'(#(atom "quote") any))))
- (if #{tmp 4476}#
+ (if #{tmp 4478}#
(@apply
- (lambda (#{dy 4478}#)
- (let ((#{tmp 4479}# #{x 4473}#))
- (let ((#{tmp 4480}#
+ (lambda (#{dy 4480}#)
+ (let ((#{tmp 4481}# #{x 4475}#))
+ (let ((#{tmp 4482}#
($sc-dispatch
- #{tmp 4479}#
+ #{tmp 4481}#
'(#(atom "quote") any))))
- (if #{tmp 4480}#
+ (if #{tmp 4482}#
(@apply
- (lambda (#{dx 4482}#)
+ (lambda (#{dx 4484}#)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(dx)
#((top))
- #("i4481"))
+ #("i4483"))
#(ribcage
#(dy)
#((top))
- #("i4477"))
+ #("i4479"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4471" "i4472"))
+ #("i4473" "i4474"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4466" "i4467"))
+ #("i4468" "i4469"))
#(ribcage
(emit quasivector
quasilist*
@@ -16055,40 +16062,40 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- (cons #{dx 4482}# #{dy 4478}#)))
- #{tmp 4480}#)
- (let ((#{_ 4484}# #{tmp 4479}#))
- (if (null? #{dy 4478}#)
+ (cons #{dx 4484}# #{dy 4480}#)))
+ #{tmp 4482}#)
+ (let ((#{_ 4486}# #{tmp 4481}#))
+ (if (null? #{dy 4480}#)
(list '#(syntax-object
"list"
((top)
#(ribcage
#(_)
#((top))
- #("i4483"))
+ #("i4485"))
#(ribcage
#(dy)
#((top))
- #("i4477"))
+ #("i4479"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4471" "i4472"))
+ #("i4473" "i4474"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4466" "i4467"))
+ #("i4468" "i4469"))
#(ribcage
(emit quasivector
quasilist*
@@ -16103,37 +16110,37 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{x 4473}#)
+ #{x 4475}#)
(list '#(syntax-object
"list*"
((top)
#(ribcage
#(_)
#((top))
- #("i4483"))
+ #("i4485"))
#(ribcage
#(dy)
#((top))
- #("i4477"))
+ #("i4479"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4471" "i4472"))
+ #("i4473" "i4474"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4466" "i4467"))
+ #("i4468" "i4469"))
#(ribcage
(emit quasivector
quasilist*
@@ -16148,42 +16155,42 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{x 4473}#
- #{y 4474}#)))))))
- #{tmp 4476}#)
- (let ((#{tmp 4485}#
+ #{x 4475}#
+ #{y 4476}#)))))))
+ #{tmp 4478}#)
+ (let ((#{tmp 4487}#
($sc-dispatch
- #{tmp 4475}#
+ #{tmp 4477}#
'(#(atom "list") . any))))
- (if #{tmp 4485}#
+ (if #{tmp 4487}#
(@apply
- (lambda (#{stuff 4487}#)
+ (lambda (#{stuff 4489}#)
(cons '#(syntax-object
"list"
((top)
#(ribcage
#(stuff)
#((top))
- #("i4486"))
+ #("i4488"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4471" "i4472"))
+ #("i4473" "i4474"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4466" "i4467"))
+ #("i4468" "i4469"))
#(ribcage
(emit quasivector
quasilist*
@@ -16198,41 +16205,41 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- (cons #{x 4473}# #{stuff 4487}#)))
- #{tmp 4485}#)
- (let ((#{tmp 4488}#
+ (cons #{x 4475}# #{stuff 4489}#)))
+ #{tmp 4487}#)
+ (let ((#{tmp 4490}#
($sc-dispatch
- #{tmp 4475}#
+ #{tmp 4477}#
'(#(atom "list*") . any))))
- (if #{tmp 4488}#
+ (if #{tmp 4490}#
(@apply
- (lambda (#{stuff 4490}#)
+ (lambda (#{stuff 4492}#)
(cons '#(syntax-object
"list*"
((top)
#(ribcage
#(stuff)
#((top))
- #("i4489"))
+ #("i4491"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4471" "i4472"))
+ #("i4473" "i4474"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4466" "i4467"))
+ #("i4468" "i4469"))
#(ribcage
(emit quasivector
quasilist*
@@ -16247,35 +16254,35 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- (cons #{x 4473}# #{stuff 4490}#)))
- #{tmp 4488}#)
- (let ((#{_ 4492}# #{tmp 4475}#))
+ (cons #{x 4475}# #{stuff 4492}#)))
+ #{tmp 4490}#)
+ (let ((#{_ 4494}# #{tmp 4477}#))
(list '#(syntax-object
"list*"
((top)
#(ribcage
#(_)
#((top))
- #("i4491"))
+ #("i4493"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4471" "i4472"))
+ #("i4473" "i4474"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4466" "i4467"))
+ #("i4468" "i4469"))
#(ribcage
(emit quasivector
quasilist*
@@ -16290,30 +16297,30 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{x 4473}#
- #{y 4474}#))))))))))
- #{tmp 4470}#)
+ #{x 4475}#
+ #{y 4476}#))))))))))
+ #{tmp 4472}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4469}#))))))
- (#{quasiappend 4398}#
- (lambda (#{x 4493}# #{y 4494}#)
- (let ((#{tmp 4497}# #{y 4494}#))
- (let ((#{tmp 4498}#
- ($sc-dispatch #{tmp 4497}# '(#(atom "quote") ()))))
- (if #{tmp 4498}#
+ #{tmp 4471}#))))))
+ (#{quasiappend 4400}#
+ (lambda (#{x 4495}# #{y 4496}#)
+ (let ((#{tmp 4499}# #{y 4496}#))
+ (let ((#{tmp 4500}#
+ ($sc-dispatch #{tmp 4499}# '(#(atom "quote") ()))))
+ (if #{tmp 4500}#
(@apply
(lambda ()
- (if (null? #{x 4493}#)
+ (if (null? #{x 4495}#)
'(#(syntax-object
"quote"
((top)
@@ -16321,7 +16328,7 @@
#(ribcage
#(x y)
#((top) (top))
- #("i4495" "i4496"))
+ #("i4497" "i4498"))
#(ribcage
(emit quasivector
quasilist*
@@ -16330,23 +16337,23 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
())
- (if (null? (cdr #{x 4493}#))
- (car #{x 4493}#)
- (let ((#{tmp 4505}# #{x 4493}#))
- (let ((#{tmp 4506}#
- ($sc-dispatch #{tmp 4505}# 'each-any)))
- (if #{tmp 4506}#
+ (if (null? (cdr #{x 4495}#))
+ (car #{x 4495}#)
+ (let ((#{tmp 4507}# #{x 4495}#))
+ (let ((#{tmp 4508}#
+ ($sc-dispatch #{tmp 4507}# 'each-any)))
+ (if #{tmp 4508}#
(@apply
- (lambda (#{p 4508}#)
+ (lambda (#{p 4510}#)
(cons '#(syntax-object
"append"
((top)
@@ -16354,12 +16361,12 @@
#(ribcage
#(p)
#((top))
- #("i4507"))
+ #("i4509"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4495" "i4496"))
+ #("i4497" "i4498"))
#(ribcage
(emit quasivector
quasilist*
@@ -16374,30 +16381,30 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{p 4508}#))
- #{tmp 4506}#)
+ #{p 4510}#))
+ #{tmp 4508}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4505}#)))))))
- #{tmp 4498}#)
- (let ((#{_ 4511}# #{tmp 4497}#))
- (if (null? #{x 4493}#)
- #{y 4494}#
- (let ((#{tmp 4516}# (list #{x 4493}# #{y 4494}#)))
- (let ((#{tmp 4517}#
- ($sc-dispatch #{tmp 4516}# '(each-any any))))
- (if #{tmp 4517}#
+ #{tmp 4507}#)))))))
+ #{tmp 4500}#)
+ (let ((#{_ 4513}# #{tmp 4499}#))
+ (if (null? #{x 4495}#)
+ #{y 4496}#
+ (let ((#{tmp 4518}# (list #{x 4495}# #{y 4496}#)))
+ (let ((#{tmp 4519}#
+ ($sc-dispatch #{tmp 4518}# '(each-any any))))
+ (if #{tmp 4519}#
(@apply
- (lambda (#{p 4520}# #{y 4521}#)
+ (lambda (#{p 4522}# #{y 4523}#)
(cons '#(syntax-object
"append"
((top)
@@ -16405,13 +16412,13 @@
#(ribcage
#(p y)
#((top) (top))
- #("i4518" "i4519"))
- #(ribcage #(_) #((top)) #("i4510"))
+ #("i4520" "i4521"))
+ #(ribcage #(_) #((top)) #("i4512"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("i4495" "i4496"))
+ #("i4497" "i4498"))
#(ribcage
(emit quasivector
quasilist*
@@ -16426,47 +16433,47 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- (append #{p 4520}# (list #{y 4521}#))))
- #{tmp 4517}#)
+ (append #{p 4522}# (list #{y 4523}#))))
+ #{tmp 4519}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4516}#)))))))))))
- (#{quasilist* 4400}#
- (lambda (#{x 4523}# #{y 4524}#)
+ #{tmp 4518}#)))))))))))
+ (#{quasilist* 4402}#
+ (lambda (#{x 4525}# #{y 4526}#)
(letrec*
- ((#{f 4529}#
- (lambda (#{x 4530}#)
- (if (null? #{x 4530}#)
- #{y 4524}#
- (#{quasicons 4396}#
- (car #{x 4530}#)
- (#{f 4529}# (cdr #{x 4530}#)))))))
- (#{f 4529}# #{x 4523}#))))
- (#{quasivector 4402}#
- (lambda (#{x 4531}#)
- (let ((#{tmp 4533}# #{x 4531}#))
- (let ((#{tmp 4534}#
+ ((#{f 4531}#
+ (lambda (#{x 4532}#)
+ (if (null? #{x 4532}#)
+ #{y 4526}#
+ (#{quasicons 4398}#
+ (car #{x 4532}#)
+ (#{f 4531}# (cdr #{x 4532}#)))))))
+ (#{f 4531}# #{x 4525}#))))
+ (#{quasivector 4404}#
+ (lambda (#{x 4533}#)
+ (let ((#{tmp 4535}# #{x 4533}#))
+ (let ((#{tmp 4536}#
($sc-dispatch
- #{tmp 4533}#
+ #{tmp 4535}#
'(#(atom "quote") each-any))))
- (if #{tmp 4534}#
+ (if #{tmp 4536}#
(@apply
- (lambda (#{x 4536}#)
+ (lambda (#{x 4538}#)
(list '#(syntax-object
"quote"
((top)
- #(ribcage #(x) #((top)) #("i4535"))
+ #(ribcage #(x) #((top)) #("i4537"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4532"))
+ #(ribcage #(x) #((top)) #("i4534"))
#(ribcage
(emit quasivector
quasilist*
@@ -16475,53 +16482,53 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- (list->vector #{x 4536}#)))
- #{tmp 4534}#)
- (let ((#{_ 4539}# #{tmp 4533}#))
+ (list->vector #{x 4538}#)))
+ #{tmp 4536}#)
+ (let ((#{_ 4541}# #{tmp 4535}#))
(letrec*
- ((#{f 4543}#
- (lambda (#{y 4544}# #{k 4545}#)
- (let ((#{tmp 4556}# #{y 4544}#))
- (let ((#{tmp 4557}#
+ ((#{f 4545}#
+ (lambda (#{y 4546}# #{k 4547}#)
+ (let ((#{tmp 4558}# #{y 4546}#))
+ (let ((#{tmp 4559}#
($sc-dispatch
- #{tmp 4556}#
+ #{tmp 4558}#
'(#(atom "quote") each-any))))
- (if #{tmp 4557}#
+ (if #{tmp 4559}#
(@apply
- (lambda (#{y 4559}#)
- (#{k 4545}#
- (map (lambda (#{tmp 4560}#)
+ (lambda (#{y 4561}#)
+ (#{k 4547}#
+ (map (lambda (#{tmp 4562}#)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(y)
#((top))
- #("i4558"))
+ #("i4560"))
#(ribcage () () ())
#(ribcage
#(f y k)
#((top) (top) (top))
- #("i4540"
- "i4541"
- "i4542"))
+ #("i4542"
+ "i4543"
+ "i4544"))
#(ribcage
#(_)
#((top))
- #("i4538"))
+ #("i4540"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4532"))
+ #("i4534"))
#(ribcage
(emit quasivector
quasilist*
@@ -16536,75 +16543,75 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{tmp 4560}#))
- #{y 4559}#)))
- #{tmp 4557}#)
- (let ((#{tmp 4561}#
+ #{tmp 4562}#))
+ #{y 4561}#)))
+ #{tmp 4559}#)
+ (let ((#{tmp 4563}#
($sc-dispatch
- #{tmp 4556}#
+ #{tmp 4558}#
'(#(atom "list") . each-any))))
- (if #{tmp 4561}#
+ (if #{tmp 4563}#
(@apply
- (lambda (#{y 4563}#)
- (#{k 4545}# #{y 4563}#))
- #{tmp 4561}#)
- (let ((#{tmp 4565}#
+ (lambda (#{y 4565}#)
+ (#{k 4547}# #{y 4565}#))
+ #{tmp 4563}#)
+ (let ((#{tmp 4567}#
($sc-dispatch
- #{tmp 4556}#
+ #{tmp 4558}#
'(#(atom "list*")
.
#(each+ any (any) ())))))
- (if #{tmp 4565}#
+ (if #{tmp 4567}#
(@apply
- (lambda (#{y 4568}# #{z 4569}#)
- (#{f 4543}#
- #{z 4569}#
- (lambda (#{ls 4570}#)
- (#{k 4545}#
+ (lambda (#{y 4570}# #{z 4571}#)
+ (#{f 4545}#
+ #{z 4571}#
+ (lambda (#{ls 4572}#)
+ (#{k 4547}#
(append
- #{y 4568}#
- #{ls 4570}#)))))
- #{tmp 4565}#)
- (let ((#{else 4574}# #{tmp 4556}#))
- (let ((#{tmp 4578}# #{x 4531}#))
- (let ((#{ g4575 4580}#
- #{tmp 4578}#))
+ #{y 4570}#
+ #{ls 4572}#)))))
+ #{tmp 4567}#)
+ (let ((#{else 4576}# #{tmp 4558}#))
+ (let ((#{tmp 4580}# #{x 4533}#))
+ (let ((#{ g4577 4582}#
+ #{tmp 4580}#))
(list '#(syntax-object
"list->vector"
((top)
#(ribcage () () ())
#(ribcage
- #(#{ g4575}#)
- #((m4576 top))
- #("i4579"))
+ #(#{ g4577}#)
+ #((m4578 top))
+ #("i4581"))
#(ribcage
#(else)
#((top))
- #("i4573"))
+ #("i4575"))
#(ribcage () () ())
#(ribcage
#(f y k)
#((top) (top) (top))
- #("i4540"
- "i4541"
- "i4542"))
+ #("i4542"
+ "i4543"
+ "i4544"))
#(ribcage
#(_)
#((top))
- #("i4538"))
+ #("i4540"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4532"))
+ #("i4534"))
#(ribcage
(emit quasivector
quasilist*
@@ -16619,48 +16626,48 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{ g4575 4580}#))))))))))))))
- (#{f 4543}#
- #{x 4531}#
- (lambda (#{ls 4546}#)
- (let ((#{tmp 4551}# #{ls 4546}#))
- (let ((#{tmp 4552}#
- ($sc-dispatch #{tmp 4551}# 'each-any)))
- (if #{tmp 4552}#
+ #{ g4577 4582}#))))))))))))))
+ (#{f 4545}#
+ #{x 4533}#
+ (lambda (#{ls 4548}#)
+ (let ((#{tmp 4553}# #{ls 4548}#))
+ (let ((#{tmp 4554}#
+ ($sc-dispatch #{tmp 4553}# 'each-any)))
+ (if #{tmp 4554}#
(@apply
- (lambda (#{ g4548 4554}#)
+ (lambda (#{ g4550 4556}#)
(cons '#(syntax-object
"vector"
((top)
#(ribcage () () ())
#(ribcage
- #(#{ g4548}#)
- #((m4549 top))
- #("i4553"))
+ #(#{ g4550}#)
+ #((m4551 top))
+ #("i4555"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(ls)
#((top))
- #("i4547"))
+ #("i4549"))
#(ribcage
#(_)
#((top))
- #("i4538"))
+ #("i4540"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4532"))
+ #("i4534"))
#(ribcage
(emit quasivector
quasilist*
@@ -16675,36 +16682,36 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{ g4548 4554}#))
- #{tmp 4552}#)
+ #{ g4550 4556}#))
+ #{tmp 4554}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4551}#)))))))))))))
- (#{emit 4404}#
- (lambda (#{x 4581}#)
- (let ((#{tmp 4583}# #{x 4581}#))
- (let ((#{tmp 4584}#
+ #{tmp 4553}#)))))))))))))
+ (#{emit 4406}#
+ (lambda (#{x 4583}#)
+ (let ((#{tmp 4585}# #{x 4583}#))
+ (let ((#{tmp 4586}#
($sc-dispatch
- #{tmp 4583}#
+ #{tmp 4585}#
'(#(atom "quote") any))))
- (if #{tmp 4584}#
+ (if #{tmp 4586}#
(@apply
- (lambda (#{x 4586}#)
+ (lambda (#{x 4588}#)
(list '#(syntax-object
quote
((top)
- #(ribcage #(x) #((top)) #("i4585"))
+ #(ribcage #(x) #((top)) #("i4587"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4582"))
+ #(ribcage #(x) #((top)) #("i4584"))
#(ribcage
(emit quasivector
quasilist*
@@ -16713,46 +16720,46 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{x 4586}#))
- #{tmp 4584}#)
- (let ((#{tmp 4587}#
+ #{x 4588}#))
+ #{tmp 4586}#)
+ (let ((#{tmp 4589}#
($sc-dispatch
- #{tmp 4583}#
+ #{tmp 4585}#
'(#(atom "list") . each-any))))
- (if #{tmp 4587}#
+ (if #{tmp 4589}#
(@apply
- (lambda (#{x 4589}#)
- (let ((#{tmp 4593}# (map #{emit 4404}# #{x 4589}#)))
- (let ((#{tmp 4594}#
- ($sc-dispatch #{tmp 4593}# 'each-any)))
- (if #{tmp 4594}#
+ (lambda (#{x 4591}#)
+ (let ((#{tmp 4595}# (map #{emit 4406}# #{x 4591}#)))
+ (let ((#{tmp 4596}#
+ ($sc-dispatch #{tmp 4595}# 'each-any)))
+ (if #{tmp 4596}#
(@apply
- (lambda (#{ g4590 4596}#)
+ (lambda (#{ g4592 4598}#)
(cons '#(syntax-object
list
((top)
#(ribcage () () ())
#(ribcage
- #(#{ g4590}#)
- #((m4591 top))
- #("i4595"))
+ #(#{ g4592}#)
+ #((m4593 top))
+ #("i4597"))
#(ribcage
#(x)
#((top))
- #("i4588"))
+ #("i4590"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4582"))
+ #("i4584"))
#(ribcage
(emit quasivector
quasilist*
@@ -16767,70 +16774,70 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{ g4590 4596}#))
- #{tmp 4594}#)
+ #{ g4592 4598}#))
+ #{tmp 4596}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4593}#)))))
- #{tmp 4587}#)
- (let ((#{tmp 4599}#
+ #{tmp 4595}#)))))
+ #{tmp 4589}#)
+ (let ((#{tmp 4601}#
($sc-dispatch
- #{tmp 4583}#
+ #{tmp 4585}#
'(#(atom "list*") . #(each+ any (any) ())))))
- (if #{tmp 4599}#
+ (if #{tmp 4601}#
(@apply
- (lambda (#{x 4602}# #{y 4603}#)
+ (lambda (#{x 4604}# #{y 4605}#)
(letrec*
- ((#{f 4606}#
- (lambda (#{x* 4607}#)
- (if (null? #{x* 4607}#)
- (#{emit 4404}# #{y 4603}#)
- (let ((#{tmp 4613}#
- (list (#{emit 4404}#
- (car #{x* 4607}#))
- (#{f 4606}#
- (cdr #{x* 4607}#)))))
- (let ((#{tmp 4614}#
+ ((#{f 4608}#
+ (lambda (#{x* 4609}#)
+ (if (null? #{x* 4609}#)
+ (#{emit 4406}# #{y 4605}#)
+ (let ((#{tmp 4615}#
+ (list (#{emit 4406}#
+ (car #{x* 4609}#))
+ (#{f 4608}#
+ (cdr #{x* 4609}#)))))
+ (let ((#{tmp 4616}#
($sc-dispatch
- #{tmp 4613}#
+ #{tmp 4615}#
'(any any))))
- (if #{tmp 4614}#
+ (if #{tmp 4616}#
(@apply
- (lambda (#{ g4610 4617}#
- #{ g4609 4618}#)
+ (lambda (#{ g4612 4619}#
+ #{ g4611 4620}#)
(list '#(syntax-object
cons
((top)
#(ribcage () () ())
#(ribcage
- #(#{ g4610}#
- #{ g4609}#)
- #((m4611 top)
- (m4611 top))
- #("i4615" "i4616"))
+ #(#{ g4612}#
+ #{ g4611}#)
+ #((m4613 top)
+ (m4613 top))
+ #("i4617" "i4618"))
#(ribcage () () ())
#(ribcage
#(f x*)
#((top) (top))
- #("i4604" "i4605"))
+ #("i4606" "i4607"))
#(ribcage
#(x y)
#((top) (top))
- #("i4600" "i4601"))
+ #("i4602" "i4603"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4582"))
+ #("i4584"))
#(ribcage
(emit quasivector
quasilist*
@@ -16845,56 +16852,56 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{ g4610 4617}#
- #{ g4609 4618}#))
- #{tmp 4614}#)
+ #{ g4612 4619}#
+ #{ g4611 4620}#))
+ #{tmp 4616}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4613}#))))))))
- (#{f 4606}# #{x 4602}#)))
- #{tmp 4599}#)
- (let ((#{tmp 4619}#
+ #{tmp 4615}#))))))))
+ (#{f 4608}# #{x 4604}#)))
+ #{tmp 4601}#)
+ (let ((#{tmp 4621}#
($sc-dispatch
- #{tmp 4583}#
+ #{tmp 4585}#
'(#(atom "append") . each-any))))
- (if #{tmp 4619}#
+ (if #{tmp 4621}#
(@apply
- (lambda (#{x 4621}#)
- (let ((#{tmp 4625}#
- (map #{emit 4404}# #{x 4621}#)))
- (let ((#{tmp 4626}#
+ (lambda (#{x 4623}#)
+ (let ((#{tmp 4627}#
+ (map #{emit 4406}# #{x 4623}#)))
+ (let ((#{tmp 4628}#
($sc-dispatch
- #{tmp 4625}#
+ #{tmp 4627}#
'each-any)))
- (if #{tmp 4626}#
+ (if #{tmp 4628}#
(@apply
- (lambda (#{ g4622 4628}#)
+ (lambda (#{ g4624 4630}#)
(cons '#(syntax-object
append
((top)
#(ribcage () () ())
#(ribcage
- #(#{ g4622}#)
- #((m4623 top))
- #("i4627"))
+ #(#{ g4624}#)
+ #((m4625 top))
+ #("i4629"))
#(ribcage
#(x)
#((top))
- #("i4620"))
+ #("i4622"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4582"))
+ #("i4584"))
#(ribcage
(emit quasivector
quasilist*
@@ -16909,54 +16916,54 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{ g4622 4628}#))
- #{tmp 4626}#)
+ #{ g4624 4630}#))
+ #{tmp 4628}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4625}#)))))
- #{tmp 4619}#)
- (let ((#{tmp 4631}#
+ #{tmp 4627}#)))))
+ #{tmp 4621}#)
+ (let ((#{tmp 4633}#
($sc-dispatch
- #{tmp 4583}#
+ #{tmp 4585}#
'(#(atom "vector") . each-any))))
- (if #{tmp 4631}#
+ (if #{tmp 4633}#
(@apply
- (lambda (#{x 4633}#)
- (let ((#{tmp 4637}#
- (map #{emit 4404}# #{x 4633}#)))
- (let ((#{tmp 4638}#
+ (lambda (#{x 4635}#)
+ (let ((#{tmp 4639}#
+ (map #{emit 4406}# #{x 4635}#)))
+ (let ((#{tmp 4640}#
($sc-dispatch
- #{tmp 4637}#
+ #{tmp 4639}#
'each-any)))
- (if #{tmp 4638}#
+ (if #{tmp 4640}#
(@apply
- (lambda (#{ g4634 4640}#)
+ (lambda (#{ g4636 4642}#)
(cons '#(syntax-object
vector
((top)
#(ribcage () () ())
#(ribcage
- #(#{ g4634}#)
- #((m4635 top))
- #("i4639"))
+ #(#{ g4636}#)
+ #((m4637 top))
+ #("i4641"))
#(ribcage
#(x)
#((top))
- #("i4632"))
+ #("i4634"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4582"))
+ #("i4584"))
#(ribcage
(emit quasivector
quasilist*
@@ -16971,49 +16978,49 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{ g4634 4640}#))
- #{tmp 4638}#)
+ #{ g4636 4642}#))
+ #{tmp 4640}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4637}#)))))
- #{tmp 4631}#)
- (let ((#{tmp 4643}#
+ #{tmp 4639}#)))))
+ #{tmp 4633}#)
+ (let ((#{tmp 4645}#
($sc-dispatch
- #{tmp 4583}#
+ #{tmp 4585}#
'(#(atom "list->vector") any))))
- (if #{tmp 4643}#
+ (if #{tmp 4645}#
(@apply
- (lambda (#{x 4645}#)
- (let ((#{tmp 4649}#
- (#{emit 4404}# #{x 4645}#)))
- (let ((#{ g4646 4651}#
- #{tmp 4649}#))
+ (lambda (#{x 4647}#)
+ (let ((#{tmp 4651}#
+ (#{emit 4406}# #{x 4647}#)))
+ (let ((#{ g4648 4653}#
+ #{tmp 4651}#))
(list '#(syntax-object
list->vector
((top)
#(ribcage () () ())
#(ribcage
- #(#{ g4646}#)
- #((m4647 top))
- #("i4650"))
+ #(#{ g4648}#)
+ #((m4649 top))
+ #("i4652"))
#(ribcage
#(x)
#((top))
- #("i4644"))
+ #("i4646"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4582"))
+ #("i4584"))
#(ribcage
(emit quasivector
quasilist*
@@ -17028,197 +17035,197 @@
(top)
(top)
(top))
- ("i4403"
+ ("i4405"
+ "i4403"
"i4401"
"i4399"
"i4397"
"i4395"
- "i4393"
- "i4391")))
+ "i4393")))
(hygiene guile))
- #{ g4646 4651}#))))
- #{tmp 4643}#)
- (let ((#{tmp 4652}#
+ #{ g4648 4653}#))))
+ #{tmp 4645}#)
+ (let ((#{tmp 4654}#
($sc-dispatch
- #{tmp 4583}#
+ #{tmp 4585}#
'(#(atom "value") any))))
- (if #{tmp 4652}#
+ (if #{tmp 4654}#
(@apply
- (lambda (#{x 4654}#) #{x 4654}#)
- #{tmp 4652}#)
+ (lambda (#{x 4656}#) #{x 4656}#)
+ #{tmp 4654}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4583}#)))))))))))))))))))
- (lambda (#{x 4655}#)
- (let ((#{tmp 4657}# #{x 4655}#))
- (let ((#{tmp 4658}#
- ($sc-dispatch #{tmp 4657}# '(_ any))))
- (if #{tmp 4658}#
+ #{tmp 4585}#)))))))))))))))))))
+ (lambda (#{x 4657}#)
+ (let ((#{tmp 4659}# #{x 4657}#))
+ (let ((#{tmp 4660}#
+ ($sc-dispatch #{tmp 4659}# '(_ any))))
+ (if #{tmp 4660}#
(@apply
- (lambda (#{e 4660}#)
- (#{emit 4404}# (#{quasi 4392}# #{e 4660}# 0)))
- #{tmp 4658}#)
+ (lambda (#{e 4662}#)
+ (#{emit 4406}# (#{quasi 4394}# #{e 4662}# 0)))
+ #{tmp 4660}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4657}#))))))))
+ #{tmp 4659}#))))))))
(define include
(make-syntax-transformer
'include
'macro
- (lambda (#{x 4661}#)
+ (lambda (#{x 4663}#)
(letrec*
- ((#{read-file 4664}#
- (lambda (#{fn 4665}# #{k 4666}#)
- (let ((#{p 4670}# (open-input-file #{fn 4665}#)))
+ ((#{read-file 4666}#
+ (lambda (#{fn 4667}# #{k 4668}#)
+ (let ((#{p 4672}# (open-input-file #{fn 4667}#)))
(letrec*
- ((#{f 4674}#
- (lambda (#{x 4675}# #{result 4676}#)
- (if (eof-object? #{x 4675}#)
+ ((#{f 4676}#
+ (lambda (#{x 4677}# #{result 4678}#)
+ (if (eof-object? #{x 4677}#)
(begin
- (close-input-port #{p 4670}#)
- (reverse #{result 4676}#))
- (#{f 4674}#
- (read #{p 4670}#)
- (cons (datum->syntax #{k 4666}# #{x 4675}#)
- #{result 4676}#))))))
- (#{f 4674}# (read #{p 4670}#) '()))))))
- (let ((#{tmp 4677}# #{x 4661}#))
- (let ((#{tmp 4678}#
- ($sc-dispatch #{tmp 4677}# '(any any))))
- (if #{tmp 4678}#
+ (close-input-port #{p 4672}#)
+ (reverse #{result 4678}#))
+ (#{f 4676}#
+ (read #{p 4672}#)
+ (cons (datum->syntax #{k 4668}# #{x 4677}#)
+ #{result 4678}#))))))
+ (#{f 4676}# (read #{p 4672}#) '()))))))
+ (let ((#{tmp 4679}# #{x 4663}#))
+ (let ((#{tmp 4680}#
+ ($sc-dispatch #{tmp 4679}# '(any any))))
+ (if #{tmp 4680}#
(@apply
- (lambda (#{k 4681}# #{filename 4682}#)
- (let ((#{fn 4684}# (syntax->datum #{filename 4682}#)))
- (let ((#{tmp 4686}#
- (#{read-file 4664}#
- #{fn 4684}#
- #{filename 4682}#)))
- (let ((#{tmp 4687}#
- ($sc-dispatch #{tmp 4686}# 'each-any)))
- (if #{tmp 4687}#
+ (lambda (#{k 4683}# #{filename 4684}#)
+ (let ((#{fn 4686}# (syntax->datum #{filename 4684}#)))
+ (let ((#{tmp 4688}#
+ (#{read-file 4666}#
+ #{fn 4686}#
+ #{filename 4684}#)))
+ (let ((#{tmp 4689}#
+ ($sc-dispatch #{tmp 4688}# 'each-any)))
+ (if #{tmp 4689}#
(@apply
- (lambda (#{exp 4689}#)
+ (lambda (#{exp 4691}#)
(cons '#(syntax-object
begin
((top)
#(ribcage () () ())
- #(ribcage #(exp) #((top)) #("i4688"))
+ #(ribcage #(exp) #((top)) #("i4690"))
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("i4683"))
+ #(ribcage #(fn) #((top)) #("i4685"))
#(ribcage
#(k filename)
#((top) (top))
- #("i4679" "i4680"))
+ #("i4681" "i4682"))
#(ribcage
(read-file)
((top))
- ("i4663"))
- #(ribcage #(x) #((top)) #("i4662")))
+ ("i4665"))
+ #(ribcage #(x) #((top)) #("i4664")))
(hygiene guile))
- #{exp 4689}#))
- #{tmp 4687}#)
+ #{exp 4691}#))
+ #{tmp 4689}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4686}#))))))
- #{tmp 4678}#)
+ #{tmp 4688}#))))))
+ #{tmp 4680}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4677}#))))))))
+ #{tmp 4679}#))))))))
(define include-from-path
(make-syntax-transformer
'include-from-path
'macro
- (lambda (#{x 4691}#)
- (let ((#{tmp 4693}# #{x 4691}#))
- (let ((#{tmp 4694}#
- ($sc-dispatch #{tmp 4693}# '(any any))))
- (if #{tmp 4694}#
+ (lambda (#{x 4693}#)
+ (let ((#{tmp 4695}# #{x 4693}#))
+ (let ((#{tmp 4696}#
+ ($sc-dispatch #{tmp 4695}# '(any any))))
+ (if #{tmp 4696}#
(@apply
- (lambda (#{k 4697}# #{filename 4698}#)
- (let ((#{fn 4700}# (syntax->datum #{filename 4698}#)))
- (let ((#{tmp 4702}#
+ (lambda (#{k 4699}# #{filename 4700}#)
+ (let ((#{fn 4702}# (syntax->datum #{filename 4700}#)))
+ (let ((#{tmp 4704}#
(datum->syntax
- #{filename 4698}#
- (let ((#{t 4707}# (%search-load-path #{fn 4700}#)))
- (if #{t 4707}#
- #{t 4707}#
+ #{filename 4700}#
+ (let ((#{t 4709}# (%search-load-path #{fn 4702}#)))
+ (if #{t 4709}#
+ #{t 4709}#
(syntax-violation
'include-from-path
"file not found in path"
- #{x 4691}#
- #{filename 4698}#))))))
- (let ((#{fn 4704}# #{tmp 4702}#))
+ #{x 4693}#
+ #{filename 4700}#))))))
+ (let ((#{fn 4706}# #{tmp 4704}#))
(list '#(syntax-object
include
((top)
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("i4703"))
+ #(ribcage #(fn) #((top)) #("i4705"))
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("i4699"))
+ #(ribcage #(fn) #((top)) #("i4701"))
#(ribcage
#(k filename)
#((top) (top))
- #("i4695" "i4696"))
+ #("i4697" "i4698"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4692")))
+ #(ribcage #(x) #((top)) #("i4694")))
(hygiene guile))
- #{fn 4704}#)))))
- #{tmp 4694}#)
+ #{fn 4706}#)))))
+ #{tmp 4696}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4693}#)))))))
+ #{tmp 4695}#)))))))
(define unquote
(make-syntax-transformer
'unquote
'macro
- (lambda (#{x 4709}#)
+ (lambda (#{x 4711}#)
(syntax-violation
'unquote
"expression not valid outside of quasiquote"
- #{x 4709}#))))
+ #{x 4711}#))))
(define unquote-splicing
(make-syntax-transformer
'unquote-splicing
'macro
- (lambda (#{x 4711}#)
+ (lambda (#{x 4713}#)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
- #{x 4711}#))))
+ #{x 4713}#))))
(define case
(make-syntax-transformer
'case
'macro
- (lambda (#{x 4713}#)
- (let ((#{tmp 4715}# #{x 4713}#))
- (let ((#{tmp 4716}#
+ (lambda (#{x 4715}#)
+ (let ((#{tmp 4717}# #{x 4715}#))
+ (let ((#{tmp 4718}#
($sc-dispatch
- #{tmp 4715}#
+ #{tmp 4717}#
'(_ any any . each-any))))
- (if #{tmp 4716}#
+ (if #{tmp 4718}#
(@apply
- (lambda (#{e 4720}# #{m1 4721}# #{m2 4722}#)
- (let ((#{tmp 4724}#
+ (lambda (#{e 4722}# #{m1 4723}# #{m2 4724}#)
+ (let ((#{tmp 4726}#
(letrec*
- ((#{f 4730}#
- (lambda (#{clause 4731}# #{clauses 4732}#)
- (if (null? #{clauses 4732}#)
- (let ((#{tmp 4734}# #{clause 4731}#))
- (let ((#{tmp 4735}#
+ ((#{f 4732}#
+ (lambda (#{clause 4733}# #{clauses 4734}#)
+ (if (null? #{clauses 4734}#)
+ (let ((#{tmp 4736}# #{clause 4733}#))
+ (let ((#{tmp 4737}#
($sc-dispatch
- #{tmp 4734}#
+ #{tmp 4736}#
'(#(free-id
#(syntax-object
else
@@ -17227,92 +17234,92 @@
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile)))
any
.
each-any))))
- (if #{tmp 4735}#
+ (if #{tmp 4737}#
(@apply
- (lambda (#{e1 4738}# #{e2 4739}#)
+ (lambda (#{e1 4740}# #{e2 4741}#)
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("i4736" "i4737"))
+ #("i4738" "i4739"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
- (cons #{e1 4738}#
- #{e2 4739}#)))
- #{tmp 4735}#)
- (let ((#{tmp 4741}#
+ (cons #{e1 4740}#
+ #{e2 4741}#)))
+ #{tmp 4737}#)
+ (let ((#{tmp 4743}#
($sc-dispatch
- #{tmp 4734}#
+ #{tmp 4736}#
'(each-any any . each-any))))
- (if #{tmp 4741}#
+ (if #{tmp 4743}#
(@apply
- (lambda (#{k 4745}#
- #{e1 4746}#
- #{e2 4747}#)
+ (lambda (#{k 4747}#
+ #{e1 4748}#
+ #{e2 4749}#)
(list '#(syntax-object
if
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("i4742"
- "i4743"
- "i4744"))
+ #("i4744"
+ "i4745"
+ "i4746"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
(list '#(syntax-object
memv
@@ -17322,9 +17329,9 @@
#((top)
(top)
(top))
- #("i4742"
- "i4743"
- "i4744"))
+ #("i4744"
+ "i4745"
+ "i4746"))
#(ribcage
()
()
@@ -17336,17 +17343,17 @@
#((top)
(top)
(top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage
()
()
@@ -17354,7 +17361,7 @@
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
'#(syntax-object
t
@@ -17364,9 +17371,9 @@
#((top)
(top)
(top))
- #("i4742"
- "i4743"
- "i4744"))
+ #("i4744"
+ "i4745"
+ "i4746"))
#(ribcage
()
()
@@ -17378,17 +17385,17 @@
#((top)
(top)
(top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage
()
()
@@ -17396,7 +17403,7 @@
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
(list '#(syntax-object
quote
@@ -17408,9 +17415,9 @@
#((top)
(top)
(top))
- #("i4742"
- "i4743"
- "i4744"))
+ #("i4744"
+ "i4745"
+ "i4746"))
#(ribcage
()
()
@@ -17422,9 +17429,9 @@
#((top)
(top)
(top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e
m1
@@ -17432,9 +17439,9 @@
#((top)
(top)
(top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage
()
()
@@ -17442,10 +17449,10 @@
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene
guile))
- #{k 4745}#))
+ #{k 4747}#))
(cons '#(syntax-object
begin
((top)
@@ -17454,9 +17461,9 @@
#((top)
(top)
(top))
- #("i4742"
- "i4743"
- "i4744"))
+ #("i4744"
+ "i4745"
+ "i4746"))
#(ribcage
()
()
@@ -17468,17 +17475,17 @@
#((top)
(top)
(top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage
()
()
@@ -17486,64 +17493,64 @@
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
- (cons #{e1 4746}#
- #{e2 4747}#))))
- #{tmp 4741}#)
- (let ((#{_ 4751}# #{tmp 4734}#))
+ (cons #{e1 4748}#
+ #{e2 4749}#))))
+ #{tmp 4743}#)
+ (let ((#{_ 4753}# #{tmp 4736}#))
(syntax-violation
'case
"bad clause"
- #{x 4713}#
- #{clause 4731}#)))))))
- (let ((#{tmp 4753}#
- (#{f 4730}#
- (car #{clauses 4732}#)
- (cdr #{clauses 4732}#))))
- (let ((#{rest 4755}# #{tmp 4753}#))
- (let ((#{tmp 4756}# #{clause 4731}#))
- (let ((#{tmp 4757}#
+ #{x 4715}#
+ #{clause 4733}#)))))))
+ (let ((#{tmp 4755}#
+ (#{f 4732}#
+ (car #{clauses 4734}#)
+ (cdr #{clauses 4734}#))))
+ (let ((#{rest 4757}# #{tmp 4755}#))
+ (let ((#{tmp 4758}# #{clause 4733}#))
+ (let ((#{tmp 4759}#
($sc-dispatch
- #{tmp 4756}#
+ #{tmp 4758}#
'(each-any any . each-any))))
- (if #{tmp 4757}#
+ (if #{tmp 4759}#
(@apply
- (lambda (#{k 4761}#
- #{e1 4762}#
- #{e2 4763}#)
+ (lambda (#{k 4763}#
+ #{e1 4764}#
+ #{e2 4765}#)
(list '#(syntax-object
if
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("i4758"
- "i4759"
- "i4760"))
+ #("i4760"
+ "i4761"
+ "i4762"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("i4754"))
+ #("i4756"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
(list '#(syntax-object
memv
@@ -17553,9 +17560,9 @@
#((top)
(top)
(top))
- #("i4758"
- "i4759"
- "i4760"))
+ #("i4760"
+ "i4761"
+ "i4762"))
#(ribcage
()
()
@@ -17563,7 +17570,7 @@
#(ribcage
#(rest)
#((top))
- #("i4754"))
+ #("i4756"))
#(ribcage
()
()
@@ -17575,17 +17582,17 @@
#((top)
(top)
(top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage
()
()
@@ -17593,7 +17600,7 @@
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
'#(syntax-object
t
@@ -17603,9 +17610,9 @@
#((top)
(top)
(top))
- #("i4758"
- "i4759"
- "i4760"))
+ #("i4760"
+ "i4761"
+ "i4762"))
#(ribcage
()
()
@@ -17613,7 +17620,7 @@
#(ribcage
#(rest)
#((top))
- #("i4754"))
+ #("i4756"))
#(ribcage
()
()
@@ -17625,17 +17632,17 @@
#((top)
(top)
(top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage
()
()
@@ -17643,7 +17650,7 @@
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
(list '#(syntax-object
quote
@@ -17655,9 +17662,9 @@
#((top)
(top)
(top))
- #("i4758"
- "i4759"
- "i4760"))
+ #("i4760"
+ "i4761"
+ "i4762"))
#(ribcage
()
()
@@ -17665,7 +17672,7 @@
#(ribcage
#(rest)
#((top))
- #("i4754"))
+ #("i4756"))
#(ribcage
()
()
@@ -17677,9 +17684,9 @@
#((top)
(top)
(top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e
m1
@@ -17687,9 +17694,9 @@
#((top)
(top)
(top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage
()
()
@@ -17697,10 +17704,10 @@
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene
guile))
- #{k 4761}#))
+ #{k 4763}#))
(cons '#(syntax-object
begin
((top)
@@ -17709,9 +17716,9 @@
#((top)
(top)
(top))
- #("i4758"
- "i4759"
- "i4760"))
+ #("i4760"
+ "i4761"
+ "i4762"))
#(ribcage
()
()
@@ -17719,7 +17726,7 @@
#(ribcage
#(rest)
#((top))
- #("i4754"))
+ #("i4756"))
#(ribcage
()
()
@@ -17731,17 +17738,17 @@
#((top)
(top)
(top))
- #("i4727"
- "i4728"
- "i4729"))
+ #("i4729"
+ "i4730"
+ "i4731"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("i4717"
- "i4718"
- "i4719"))
+ #("i4719"
+ "i4720"
+ "i4721"))
#(ribcage
()
()
@@ -17749,31 +17756,31 @@
#(ribcage
#(x)
#((top))
- #("i4714")))
+ #("i4716")))
(hygiene guile))
- (cons #{e1 4762}#
- #{e2 4763}#))
- #{rest 4755}#))
- #{tmp 4757}#)
- (let ((#{_ 4767}# #{tmp 4756}#))
+ (cons #{e1 4764}#
+ #{e2 4765}#))
+ #{rest 4757}#))
+ #{tmp 4759}#)
+ (let ((#{_ 4769}# #{tmp 4758}#))
(syntax-violation
'case
"bad clause"
- #{x 4713}#
- #{clause 4731}#)))))))))))
- (#{f 4730}# #{m1 4721}# #{m2 4722}#))))
- (let ((#{body 4726}# #{tmp 4724}#))
+ #{x 4715}#
+ #{clause 4733}#)))))))))))
+ (#{f 4732}# #{m1 4723}# #{m2 4724}#))))
+ (let ((#{body 4728}# #{tmp 4726}#))
(list '#(syntax-object
let
((top)
#(ribcage () () ())
- #(ribcage #(body) #((top)) #("i4725"))
+ #(ribcage #(body) #((top)) #("i4727"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("i4717" "i4718" "i4719"))
+ #("i4719" "i4720" "i4721"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4714")))
+ #(ribcage #(x) #((top)) #("i4716")))
(hygiene guile))
(list (list '#(syntax-object
t
@@ -17782,175 +17789,175 @@
#(ribcage
#(body)
#((top))
- #("i4725"))
+ #("i4727"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("i4717" "i4718" "i4719"))
+ #("i4719" "i4720" "i4721"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4714")))
+ #(ribcage #(x) #((top)) #("i4716")))
(hygiene guile))
- #{e 4720}#))
- #{body 4726}#))))
- #{tmp 4716}#)
+ #{e 4722}#))
+ #{body 4728}#))))
+ #{tmp 4718}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4715}#)))))))
+ #{tmp 4717}#)))))))
(define make-variable-transformer
- (lambda (#{proc 4768}#)
- (if (procedure? #{proc 4768}#)
+ (lambda (#{proc 4770}#)
+ (if (procedure? #{proc 4770}#)
(letrec*
- ((#{trans 4771}#
- (lambda (#{x 4772}#) (#{proc 4768}# #{x 4772}#))))
+ ((#{trans 4773}#
+ (lambda (#{x 4774}#) (#{proc 4770}# #{x 4774}#))))
(begin
(set-procedure-property!
- #{trans 4771}#
+ #{trans 4773}#
'variable-transformer
#t)
- #{trans 4771}#))
+ #{trans 4773}#))
(error "variable transformer not a procedure"
- #{proc 4768}#))))
+ #{proc 4770}#))))
(define identifier-syntax
(make-syntax-transformer
'identifier-syntax
'macro
- (lambda (#{x 4774}#)
- (let ((#{tmp 4776}# #{x 4774}#))
- (let ((#{tmp 4777}#
- ($sc-dispatch #{tmp 4776}# '(_ any))))
- (if #{tmp 4777}#
+ (lambda (#{x 4776}#)
+ (let ((#{tmp 4778}# #{x 4776}#))
+ (let ((#{tmp 4779}#
+ ($sc-dispatch #{tmp 4778}# '(_ any))))
+ (if #{tmp 4779}#
(@apply
- (lambda (#{e 4779}#)
+ (lambda (#{e 4781}#)
(list '#(syntax-object
lambda
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
'(#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile)))
'#((#(syntax-object
macro-type
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
.
#(syntax-object
identifier-syntax
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))))
(list '#(syntax-object
syntax-case
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
'#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
'()
(list '#(syntax-object
id
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
'(#(syntax-object
identifier?
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
(#(syntax-object
syntax
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
#(syntax-object
id
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))))
(list '#(syntax-object
syntax
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
- #{e 4779}#))
+ #{e 4781}#))
(list '(#(syntax-object
_
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
#(syntax-object
...
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile)))
(list '#(syntax-object
syntax
((top)
- #(ribcage #(e) #((top)) #("i4778"))
+ #(ribcage #(e) #((top)) #("i4780"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
- (cons #{e 4779}#
+ (cons #{e 4781}#
'(#(syntax-object
x
((top)
#(ribcage
#(e)
#((top))
- #("i4778"))
+ #("i4780"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
#(syntax-object
...
@@ -17958,55 +17965,55 @@
#(ribcage
#(e)
#((top))
- #("i4778"))
+ #("i4780"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile)))))))))
- #{tmp 4777}#)
- (let ((#{tmp 4780}#
+ #{tmp 4779}#)
+ (let ((#{tmp 4782}#
($sc-dispatch
- #{tmp 4776}#
+ #{tmp 4778}#
'(_ (any any)
((#(free-id
#(syntax-object
set!
((top)
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile)))
any
any)
any)))))
- (if (if #{tmp 4780}#
+ (if (if #{tmp 4782}#
(@apply
- (lambda (#{id 4786}#
- #{exp1 4787}#
- #{var 4788}#
- #{val 4789}#
- #{exp2 4790}#)
- (if (identifier? #{id 4786}#)
- (identifier? #{var 4788}#)
+ (lambda (#{id 4788}#
+ #{exp1 4789}#
+ #{var 4790}#
+ #{val 4791}#
+ #{exp2 4792}#)
+ (if (identifier? #{id 4788}#)
+ (identifier? #{var 4790}#)
#f))
- #{tmp 4780}#)
+ #{tmp 4782}#)
#f)
(@apply
- (lambda (#{id 4798}#
- #{exp1 4799}#
- #{var 4800}#
- #{val 4801}#
- #{exp2 4802}#)
+ (lambda (#{id 4800}#
+ #{exp1 4801}#
+ #{var 4802}#
+ #{val 4803}#
+ #{exp2 4804}#)
(list '#(syntax-object
make-variable-transformer
((top)
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("i4793" "i4794" "i4795" "i4796" "i4797"))
+ #("i4795" "i4796" "i4797" "i4798" "i4799"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
(list '#(syntax-object
lambda
@@ -18014,13 +18021,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
'(#(syntax-object
x
@@ -18028,13 +18035,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile)))
'#((#(syntax-object
macro-type
@@ -18042,13 +18049,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
.
#(syntax-object
@@ -18057,13 +18064,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))))
(list '#(syntax-object
syntax-case
@@ -18071,13 +18078,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
'#(syntax-object
x
@@ -18085,13 +18092,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile))
'(#(syntax-object
set!
@@ -18099,13 +18106,13 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4775")))
+ #(ribcage #(x) #((top)) #("i4777")))
(hygiene guile)))
(list (list '#(syntax-object
set!
@@ -18117,19 +18124,19 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
- #{var 4800}#
- #{val 4801}#)
+ #{var 4802}#
+ #{val 4803}#)
(list '#(syntax-object
syntax
((top)
@@ -18140,19 +18147,19 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
- #{exp2 4802}#))
- (list (cons #{id 4798}#
+ #{exp2 4804}#))
+ (list (cons #{id 4800}#
'(#(syntax-object
x
((top)
@@ -18167,16 +18174,16 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
#(syntax-object
...
@@ -18192,16 +18199,16 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))))
(list '#(syntax-object
syntax
@@ -18213,18 +18220,18 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
- (cons #{exp1 4799}#
+ (cons #{exp1 4801}#
'(#(syntax-object
x
((top)
@@ -18239,11 +18246,11 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage
()
()
@@ -18251,7 +18258,7 @@
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
#(syntax-object
...
@@ -18267,11 +18274,11 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage
()
()
@@ -18279,10 +18286,10 @@
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene
guile))))))
- (list #{id 4798}#
+ (list #{id 4800}#
(list '#(syntax-object
identifier?
((top)
@@ -18293,16 +18300,16 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
(list '#(syntax-object
syntax
@@ -18318,18 +18325,18 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
- #{id 4798}#))
+ #{id 4800}#))
(list '#(syntax-object
syntax
((top)
@@ -18340,69 +18347,69 @@
(top)
(top)
(top))
- #("i4793"
- "i4794"
- "i4795"
+ #("i4795"
"i4796"
- "i4797"))
+ "i4797"
+ "i4798"
+ "i4799"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("i4775")))
+ #("i4777")))
(hygiene guile))
- #{exp1 4799}#))))))
- #{tmp 4780}#)
+ #{exp1 4801}#))))))
+ #{tmp 4782}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4776}#)))))))))
+ #{tmp 4778}#)))))))))
(define define*
(make-syntax-transformer
'define*
'macro
- (lambda (#{x 4803}#)
- (let ((#{tmp 4805}# #{x 4803}#))
- (let ((#{tmp 4806}#
+ (lambda (#{x 4805}#)
+ (let ((#{tmp 4807}# #{x 4805}#))
+ (let ((#{tmp 4808}#
($sc-dispatch
- #{tmp 4805}#
+ #{tmp 4807}#
'(_ (any . any) any . each-any))))
- (if #{tmp 4806}#
+ (if #{tmp 4808}#
(@apply
- (lambda (#{id 4811}#
- #{args 4812}#
- #{b0 4813}#
- #{b1 4814}#)
+ (lambda (#{id 4813}#
+ #{args 4814}#
+ #{b0 4815}#
+ #{b1 4816}#)
(list '#(syntax-object
define
((top)
#(ribcage
#(id args b0 b1)
#((top) (top) (top) (top))
- #("i4807" "i4808" "i4809" "i4810"))
+ #("i4809" "i4810" "i4811" "i4812"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4804")))
+ #(ribcage #(x) #((top)) #("i4806")))
(hygiene guile))
- #{id 4811}#
+ #{id 4813}#
(cons '#(syntax-object
lambda*
((top)
#(ribcage
#(id args b0 b1)
#((top) (top) (top) (top))
- #("i4807" "i4808" "i4809" "i4810"))
+ #("i4809" "i4810" "i4811" "i4812"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4804")))
+ #(ribcage #(x) #((top)) #("i4806")))
(hygiene guile))
- (cons #{args 4812}#
- (cons #{b0 4813}# #{b1 4814}#)))))
- #{tmp 4806}#)
- (let ((#{tmp 4816}#
- ($sc-dispatch #{tmp 4805}# '(_ any any))))
- (if (if #{tmp 4816}#
+ (cons #{args 4814}#
+ (cons #{b0 4815}# #{b1 4816}#)))))
+ #{tmp 4808}#)
+ (let ((#{tmp 4818}#
+ ($sc-dispatch #{tmp 4807}# '(_ any any))))
+ (if (if #{tmp 4818}#
(@apply
- (lambda (#{id 4819}# #{val 4820}#)
+ (lambda (#{id 4821}# #{val 4822}#)
(identifier?
'#(syntax-object
x
@@ -18410,29 +18417,29 @@
#(ribcage
#(id val)
#((top) (top))
- #("i4817" "i4818"))
+ #("i4819" "i4820"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4804")))
+ #(ribcage #(x) #((top)) #("i4806")))
(hygiene guile))))
- #{tmp 4816}#)
+ #{tmp 4818}#)
#f)
(@apply
- (lambda (#{id 4823}# #{val 4824}#)
+ (lambda (#{id 4825}# #{val 4826}#)
(list '#(syntax-object
define
((top)
#(ribcage
#(id val)
#((top) (top))
- #("i4821" "i4822"))
+ #("i4823" "i4824"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("i4804")))
+ #(ribcage #(x) #((top)) #("i4806")))
(hygiene guile))
- #{id 4823}#
- #{val 4824}#))
- #{tmp 4816}#)
+ #{id 4825}#
+ #{val 4826}#))
+ #{tmp 4818}#)
(syntax-violation
#f
"source expression failed to match any pattern"
- #{tmp 4805}#)))))))))
+ #{tmp 4807}#)))))))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index ae9c273ae..4d67408ad 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2425,7 +2425,8 @@
(set! generate-temporaries
(lambda (ls)
(arg-check list? ls 'generate-temporaries)
- (map (lambda (x) (wrap (gensym-hook) top-wrap #f)) ls)))
+ (let ((mod (cons 'hygiene (module-name (current-module)))))
+ (map (lambda (x) (wrap (gensym-hook) top-wrap mod)) ls))))
(set! free-identifier=?
(lambda (x y)
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index 2cb0806d9..a22063b0e 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -207,10 +207,12 @@
;; write source info for proc
(if src (emit-code #f (make-glil-source src)))
;; compile the body, yo
- (flatten body allocation x self-label (car (hashq-ref allocation x))
- emit-code)))))))
+ (flatten-lambda-case body allocation x self-label
+ (car (hashq-ref allocation x))
+ emit-code)))))))
-(define (flatten x allocation self self-label fix-labels emit-code)
+(define (flatten-lambda-case lcase allocation self self-label fix-labels
+ emit-code)
(define (emit-label label)
(emit-code #f (make-glil-label label)))
(define (emit-branch src inst label)
@@ -218,7 +220,7 @@
;; RA: "return address"; #f unless we're in a non-tail fix with labels
;; MVRA: "multiple-values return address"; #f unless we're in a let-values
- (let comp ((x x) (context 'tail) (RA #f) (MVRA #f))
+ (let comp ((x lcase) (context 'tail) (RA #f) (MVRA #f))
(define (comp-tail tree) (comp tree context RA MVRA))
(define (comp-push tree) (comp tree 'push #f #f))
(define (comp-drop tree) (comp tree 'drop #f #f))
@@ -252,41 +254,26 @@
((<call> src proc args)
(cond
- ;; self-call in tail position
+ ;; call to the same lambda-case in tail position
((and (lexical-ref? proc)
self-label (eq? (lexical-ref-gensym proc) self-label)
- (eq? context 'tail))
- (let lp ((lcase (lambda-body self)))
- (cond
- ((and (lambda-case? lcase)
- (not (lambda-case-kw lcase))
- (not (lambda-case-rest lcase))
- (= (length args)
- (+ (length (lambda-case-req lcase))
- (or (and=> (lambda-case-opt lcase) length) 0))))
- ;; we have a case that matches the args; evaluate new
- ;; values, rename variables and goto the case label
- (for-each comp-push args)
- (for-each (lambda (sym)
- (pmatch (hashq-ref (hashq-ref allocation sym) self)
- ((#t #f . ,index) ; unboxed
- (emit-code #f (make-glil-lexical #t #f 'set index)))
- ((#t #t . ,index) ; boxed
- ;; new box
- (emit-code #f (make-glil-lexical #t #t 'box index)))
- (,x (error "bad lambda-case arg allocation" x))))
- (reverse (lambda-case-gensyms lcase)))
- (emit-branch src 'br (car (hashq-ref allocation lcase))))
- ((lambda-case? lcase)
- ;; no match, try next case
- (lp (lambda-case-alternate lcase)))
- (else
- ;; no cases left -- use the normal tail call mechanism. we
- ;; can't just shuffle the args down and jump back to the
- ;; self label, because we don't have space.
- (comp-push proc)
- (for-each comp-push args)
- (emit-code src (make-glil-call 'tail-call (length args)))))))
+ (eq? context 'tail)
+ (not (lambda-case-kw lcase))
+ (not (lambda-case-rest lcase))
+ (= (length args)
+ (+ (length (lambda-case-req lcase))
+ (or (and=> (lambda-case-opt lcase) length) 0))))
+ (for-each comp-push args)
+ (for-each (lambda (sym)
+ (pmatch (hashq-ref (hashq-ref allocation sym) self)
+ ((#t #f . ,index) ; unboxed
+ (emit-code #f (make-glil-lexical #t #f 'set index)))
+ ((#t #t . ,index) ; boxed
+ ;; new box
+ (emit-code #f (make-glil-lexical #t #t 'box index)))
+ (,x (error "bad lambda-case arg allocation" x))))
+ (reverse (lambda-case-gensyms lcase)))
+ (emit-branch src 'br (car (hashq-ref allocation lcase))))
;; lambda, the ultimate goto
((and (lexical-ref? proc)
@@ -378,20 +365,37 @@
(else
(comp-tail (make-primcall src 'apply (cons proc args))))))))
- ((values . _) (guard (not (eq? context 'push)))
+ ((values . _)
;; tail: (lambda () (values '(1 2)))
;; drop: (lambda () (values '(1 2)) 3)
;; push: (lambda () (list (values '(10 12)) 1))
;; vals: (let-values (((a b ...) (values 1 2 ...))) ...)
(case context
((drop) (for-each comp-drop args) (maybe-emit-return))
+ ((push)
+ (case (length args)
+ ((0)
+ ;; FIXME: This is surely an error. We need to add a
+ ;; values-mismatch warning pass.
+ (comp-push (make-call src (make-primitive-ref #f 'values)
+ '())))
+ ((1)
+ (comp-push (car args)))
+ (else
+ ;; Taking advantage of unspecified order of evaluation of
+ ;; arguments.
+ (for-each comp-drop (cdr args))
+ (comp-push (car args)))))
((vals)
(for-each comp-push args)
(emit-code #f (make-glil-const (length args)))
(emit-branch src 'br MVRA))
((tail)
(for-each comp-push args)
- (emit-code src (make-glil-call 'return/values (length args))))))
+ (emit-code src (let ((len (length args)))
+ (if (= len 1)
+ (make-glil-call 'return 1)
+ (make-glil-call 'return/values len)))))))
((@call-with-values ,producer ,consumer)
;; CONSUMER
@@ -724,7 +728,8 @@
(if alternate-label
(begin
(emit-label alternate-label)
- (comp-tail alternate)))))
+ (flatten-lambda-case alternate allocation self self-label
+ fix-labels emit-code)))))
((<let> src names gensyms vals body)
(for-each comp-push vals)
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 40fc19444..74c465ff5 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -249,7 +249,7 @@
(define-primitive-expander +
() 0
- (x) x
+ (x) (values x)
(x y) (if (and (const? y)
(let ((y (const-exp y)))
(and (number? y) (exact? y) (= y 1))))
@@ -267,7 +267,7 @@
(define-primitive-expander *
() 1
- (x) x
+ (x) (values x)
(x y z . rest) (* x (* y z . rest)))
(define-primitive-expander -
@@ -313,7 +313,7 @@
(define-primitive-expander cddddr (x) (cdr (cdr (cdr (cdr x)))))
(define-primitive-expander cons*
- (x) x
+ (x) (values x)
(x y) (cons x y)
(x y . rest) (cons x (cons* y . rest)))
@@ -332,8 +332,6 @@
(define-primitive-expander call/cc (proc)
(@call-with-current-continuation proc))
-(define-primitive-expander values (x) x)
-
(define-primitive-expander make-struct (vtable tail-size . args)
(if (and (const? tail-size)
(let ((n (const-exp tail-size)))
diff --git a/module/system/base/language.scm b/module/system/base/language.scm
index 31e77089f..10d2d7408 100644
--- a/module/system/base/language.scm
+++ b/module/system/base/language.scm
@@ -1,6 +1,6 @@
;;; Multi-language support
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011 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
@@ -112,7 +112,6 @@
;;;
(define *current-language* (make-fluid))
-(fluid-set! *current-language* 'scheme)
(define (current-language)
- (fluid-ref *current-language*))
+ (or (fluid-ref *current-language*) 'scheme))
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index 6b47086be..ee688c00a 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
;;;; compiler.test --- tests for the compiler -*- scheme -*-
-;;;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2008, 2009, 2010, 2011 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
@@ -149,3 +149,18 @@
((y) y)
((y z) (list y z)))))))
(not (not (memv 0 (map source:addr s))))))))
+
+(with-test-prefix "case-lambda"
+ (pass-if "self recursion to different clause"
+ (equal? (with-output-to-string
+ (lambda ()
+ (let ()
+ (define t
+ (case-lambda
+ ((x)
+ (t x 'y))
+ ((x y)
+ (display (list x y))
+ (list x y))))
+ (display (t 'x)))))
+ "(x y)(x y)")))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index a59835e0e..3dacb7277 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -474,6 +474,26 @@
(program () (std-prelude 0 0 #f) (label _)
(const 2) (call null? 1) (call return 1))))
+(with-test-prefix "values"
+ (assert-tree-il->glil
+ (primcall values
+ (primcall values (const 1) (const 2)))
+ (program () (std-prelude 0 0 #f) (label _)
+ (const 1) (call return 1)))
+
+ (assert-tree-il->glil
+ (primcall values
+ (primcall values (const 1) (const 2))
+ (const 3))
+ (program () (std-prelude 0 0 #f) (label _)
+ (const 1) (const 3) (call return/values 2)))
+
+ (assert-tree-il->glil
+ (primcall +
+ (primcall values (const 1) (const 2)))
+ (program () (std-prelude 0 0 #f) (label _)
+ (const 1) (call return 1))))
+
;; FIXME: binding info for or-hacked locals might bork the disassembler,
;; and could be tightened in any case
(with-test-prefix "the or hack"