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 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 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 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 +AC_LINK_IFELSE([AC_LANG_SOURCE([[ +#include 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_once_t foo = PTHREAD_ONCE_INIT;], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include + 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_mutex_t foo = PTHREAD_MUTEX_INITIALIZER;], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include + 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 . */ + +#include + +#include "dirname.h" + +#include + +/* 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 . */ + +#include + +#include "dirname.h" + +#include +#include + +/* 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 . */ + +#ifndef DIRNAME_H_ +# define DIRNAME_H_ 1 + +# include +# include +# 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 . */ + +/* Written by Volker Borchert, Eric Blake. */ + +#include + +#include + +#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 +# include +# include +# include +# include + +# define WIN32_LEAN_AND_MEAN +# include + +# 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 +# include +# include +# include +# include +# include + +# 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 . */ + +#include + +#include + +#include +#include + +#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 . */ + +#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 . */ + +#include + +#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 # 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; + SCM str = SCM_CAR (list); + size_t len; /* String length in bytes */ + char *c_str = scm_to_locale_stringn (str, &len); - str = SCM_CAR (list); - len = scm_c_string_length (str); + /* 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 pointers"); - memcpy (result[i], scm_i_string_chars (str), len); + 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 -#endif - -#include "libguile/__scm.h" - -#include -#include -#include - -#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 - -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 +# include + ]], + [[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 +# include + ]], + [[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 +# include +# include + ]], + [[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 +# include + ]], + [[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 + #include + #include +]], [[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 @@ (( 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))))) (( 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"